Local Capabilities with MTL

mtl.md

MTL is a popular approach to writing applications in Haskell. Monad constraints provide capabilities such as error handling (MonadError), writable state (MonadState), and environmental context (MonadReader). An application typically has one monad stack, implemented as a monad transformer.

However, a common problem with MTL is that the capabilities are global and the requirements of individual components may conflict. For example, an HTTP component may require a MonadError ServantError whereas a DB component may require something else. A typical workaround is to introduce a monolithic error ADT, and an unfortunate level of coupling. The problem repeats for other capabilities.

In this post, we will demonstrate a way to encode capabilities that remain local to a single component. Our example builds on the Servant Tutorial and will also show how Servant client endpoints can be mocked out for unit testing. This post is a transcription of a test from FFunctor, which may be consulted for import, build-depends, and other practical matters.

1. Records of Functions
2. Servant.Client
3. FFunctor
4. ExceptT

Records of Functions

Many capabilities are provided by the mtl but a typical application will require many domain-specific commands that correspond to I/O actions, such as HTTP or DB access, random numbers, timings from a clock. An application is often comprised of multiple layers of these components.

One way to encode these domain-specific components is by having data types containing functions. For example, we may wish to have access to an HTTP server through a UserApi, defined as:

data User = User
  { name              :: String
  , age               :: Int
  , email             :: String
  , registration_date :: UTCTime
  }
data UserApi m = UserApi
  { apiGetUsers  :: m [User]
  , apiPostUsers :: User -> m User
  , apiPutUsers  :: Integer -> User -> m User
  }

An advantage of records of functions is that we can write custom implementations for use in unit tests, without ever talking to a real HTTP server, or performing any IO. Compare to the alternatives: applications that use I/O directly are not so testable, and a class encoding of UserApi would suffer from typeclass coherence problems that are only partially addressed by DerivingVia.

For testing we may wish to have a trivial mock with the Identity monad, or to have state and error handling via Either and State. Every unit test can have its own custom behaviour.

mockApi :: UserApi Identity
mockApi = UserApi (pure []) (\u -> pure u) (\_ u -> pure u)

Servant.Client

We may formalise the /users API as a type

type API = "users" :> Get '[JSON] [User]
      :<|> "users" :> ReqBody '[JSON] User :> Post '[JSON] User
      :<|> "users" :> Capture "userid" Integer :> ReqBody '[JSON] User
                   :> Put '[JSON] User

and generate functions that use the servant ClientM monad

getUsers  :: ClientM [User]
postUsers :: User -> ClientM User
putUsers  :: Integer -> User -> ClientM User
getUsers :<|> postUsers :<|> putUsers = client (Proxy @API)

We can provide a UserApi ClientM for these generated functions:

servantApi :: UserApi ClientM
servantApi = UserApi getUsers postUsers putUsers

But we almost certainly do not want to use ClientM as our application's monad stack. Therefore we need a way to map a UserApi ClientM into a UserApi OurMonadStack. There are two parts to this:

1. we need a transformation from ClientM to a constrained m
2. and we need a way to apply that transformation to UserApi

The first part is easy: such a natural transformation is a one-liner:

liftClientM :: (MonadIO m, MonadError ServantError m)
            => ClientEnv -> ClientM a -> m a
liftClientM env ca = liftEither =<< (liftIO $ runClientM ca env)

where there are three requirements:

1. a Servant.Client.ClientEnv, giving the host, port and other connection settings
2. the ability to perform IO, implying MonadIO
3. the ability to handle ServantError, implying MonadError

To apply liftClientM, we need a new typeclass, FFunctor.

FFunctor

class FFunctor (f :: (* -> *) -> *) where
  ffmap :: (Functor m, Functor n)
        => (forall a . (m a -> n a)) -> f m -> f n

FFunctor allows us to map over the type parameter of something that has kind (* -> *) -> *. Note that HFunctor, MFunctor and MonadTrans do not have the correct shape, necessitating this new typeclass, first documented as such in Functor Functors.

However, not everything of the required kind may have an FFunctor defined. To be eligible, the f may only have m in covariant position (e.g. return parameters). A record of function that has a field of shape m a -> m b would not be able to have an FFunctor because m a appears in contravariant position.

Thankfully, UserAPI may have an instance of an FFunctor because all occurrences of m only appear in return values.

Writing instances of FFunctor is procedural. Each field has the natural transformation applied according to its number of parameters:

1. If there are no parameters, the nt is applied as a regular function

2. If there is one parameter, the nt is composed with (.)

3. If there are more than one parameter, the Data.Composition package may be used, providing compositions of arbitrary arity. Compositions are conveniently named such that the number of dots after the initial one are the number of parameters, so (.:) handles two parameters, (.:.) handles three, (.::) handles four, and so on.

   instance FFunctor UserApi where ffmap nt (UserApi f1 f2 f3) = UserApi (nt f1) (nt . f2) (nt .: f3)

We can now generate a UserApi for our application's monad stack, which we can create during initialisation from our ClientEnv configuration.

userApi :: (MonadIO m, MonadError ServantError m) => ClientEnv -> UserApi m
userApi env = ffmap (liftClientM env) servantApi

But this demands that we have a MonadError ServantError in our stack, that sucks!

ExceptT

The trick to overcome the problem of having MonadError ServantError in our global stack is to define a type alias

type UserApiT m = UserApi (ExceptT ServantError m)

This MTL trick can be used to add a variety of locally scoped capabilities to a component, e.g. MonadState via StateT, MonadReader via ReaderT, MonadWriter via WriterT.

Downstream user may prefer to depend on UserApiT and must handle ServantError at the point of use. They may chose to retry, recover, ignore errors, or translate errors into an application specific error ADT.

Note that we only need the minimal set of constraints, so we only require a Applicative to write:

doStuff :: Applicative m => UserApiT m -> String -> m Bool
doStuff http check = hasEmail <$> (runExceptT $ apiGetUsers http)
  where
    hasEmail (Left _)      = False
    hasEmail (Right users) = any (\u -> (email u) == check) users

Compare to the version where errors are ignored and must be handled at a higher layer.

doStuff' :: Applicative m => UserApi m -> String -> m Bool
doStuff' http check = hasEmail <$> apiGetUsers http
  where
    hasEmail users = any (\u -> (email u) == check) users

There is one remaining question, how do we create a UserApiT? Thankfully, Haskell is smarter than us and will happily conjure one up for us when we call userApi. The monad stack in this small application is IO with no additional capabilities:

myApp :: IO Bool
myApp = do
  mgr <- newManager defaultManagerSettings
  let base = BaseUrl Http "localhost" 8080 ""
      env = mkClientEnv mgr base
      api = userApi env
  doStuff api "wibble@wobble.com"