How to use a strong type system to model business constraints?

Question

Following up on my ambiguous question, here's a question that is probably more focused.

Consider the following code snippet form a Haskell program:

data NightWatchCommand = InvalidCommand | DownloadCommand { url :: String } | PauseCommand { gid :: String } | UnpauseCommand { gid :: String } | StatusCommand { gid :: String } deriving (Show, Eq)
data AuthNightwatchCommand = AuthNightwatchCommand {
  command :: NightWatchCommand,
  user :: User
}

Now, the business constraint I want to enforce via the type-system is this: it should not be possible to instantiate an unauthenticated NightwatchCommand. And the only way to instantiate an AuthNightwatchCommand should be via a special function, say:

fromIncomingMsg :: String -> AuthNightwatchCommand

Just to provide greater context, the string argument to this function could possibly be:

status <some-id> <auth-token>

Now, to complicate matters further, fromIncomingMsg needs to validate the <auth-token> from the DB. Which means, it will do IO. A more appropriate function signature would be:

fromIncomingMsg :: String -> IO (AuthNightwatchCommand)

Apart from shoving this into a module and hiding the data constructors, is there any other way to do this?

Answer 1

Now, the business constraint I want to enforce via the type-system is this: it should not be possible to instantiate an unauthenticated NightwatchCommand.

Now, maybe I'm missing some piece of context here, but this has me very puzzled for the following reason: why would a "business constraint" care about what NightWatchCommands get instantiated or not? It sounds to me like the constraint should be something more like this:

• It should be impossible for an unauthenticated user to execute a night watch command.

And to my mind this suggests an organization like the following:

module NightWatch (NightWatchCommand, execute) where

import Something.Auth

data NightWatchCommand = ...
data Result = ...

execute 
  :: Auth 
  -> NightWatchCommand 
  -> IO (Either InsufficientPermissions Result)
execute auth cmd = do 
  allowed <- checkAuth auth cmd
  if allowed
  then fmap Right (reallyExecute cmd)
  else Left (InsufficientPermissions $ "insufficient auth: " ++ (cmd, auth))

reallyExecute :: NightWatchCommand -> IO Result
reallyExecute cmd = ...

Basically, what I'm arguing here is that security is not part of the NightWatchCommand's set of concerns—the core concerns for that type are just what the commands are. Security is a concern for the interpreter that executes the commands. If the only interpreter you provide demands and checks authentication, and you disallow other modules from writing their own interpreters (by not exporting the constructors for the NightWatchCommand type), then all callers have to go through your interpreter.

Answer 2

How about something like this (testing this code is an exercise for the reader):

{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving #-}

class Authorized a where
    fromIncomingMsg :: String -> IO (AuthNightwatchCommand)

instance Authroized AuthNightwatchCommand where
    fromIncomeMsg = error "Todo"

newtype Auth = Auth {unAuth :: forall a. Authorized a => a deriving (Authorized)}

--Please only use Auth

unAuth can convert from Auth to AuthNightwatchCommand (and is safe for others to use).

Answer 3

The question does not really give enough information, but judging from the comments phantom types might be (part of) a solution:

data NightwatchCommand' auth = NightwatchCommand' NightWatchCommand

data IsAuthorised
data NotAuthorised

fromIncomingMsg :: String -> IO (NightwatchCommand' NotAuthorised)

withNightwatchCommand :: ?? -> NightwatchCommand' a
                            -> NightwatchCommand' a

withNightwatchCommandUnsafe :: ?? -> NightwatchCommand' a
                                  -> NightwatchCommand' NotAuthorised

authoriseNightwatch :: Auth -> NightwatchCommand' a
                            -> NightwatchCommand' IsAuthorised

protectedFunction :: NightwatchCommand' IsAuthorised -> StartMissilesFunction