Musings about FP and CS

A log of my journey through FP and CS

a (new) tale of servant clients

by Clement Delafargue on September 10, 2019

Tagged as: , , .

I was super happy with my previous post about servant clients… And then, we upgraded to servant 0.16… which dropped entirely the generic mechanism we used (to be fair, it was not documented, so…).

Lo and behold, we migrated to the proper servant generic system.

Instead of declaring the API types and then replicating them in records, we directly declare the API types with records.

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeFamilies  #-}
module API where

import           Servant
import           Servant.API.Generic
import           Servant.Client.Generic

import           Types                  (User, UserData)

type API = BasicAuth "user-management" User :> ToServantApi UsersAPI

data UsersAPI mode
  = UsersAPI
  { getUsers :: mode :- Get '[JSON] [User]
  , postUser :: mode :- ReqBody '[JSON] UserData :> Post '[JSON] NoContent
  , withUser :: mode :- Capture "user_id" UserId :> ToServantApi UserAPI
  }
  deriving Generic

data UserAPI mode
  = UserAPI
  { getUser    :: mode :- Get '[JSON] User
  , putUser    :: mode :- ReqBody '[JSON] UserData :> Put '[JSON] NoContent
  , deleteUser :: mode :- Delete '[JSON] NoContent
  }
  deriving Generic

The magical part here is the mode. Choosing the mode allows us to get a record of api types, server types, or client types: we define everything in one place (the records), and then instantiate their fields to what we want:

  • UsersAPI AsAPI gives us a record of API types
  • UsersAPI AsServer gives us a record of Server types (the handlers)
  • UsersAPI (AsClientT ClientM) gives us a record of client types (functions taking parameters and returning ClientM values)

Notice that since record fields require “regular” servant API types, we can’t nest records directly as we did previously.

We need to turn the record of API types describing the sub-api into a regular API type. To do that, we can use ToServant to go from the records to the good old servant types.

We can get:

  • the API type with ToServantApi (a shortcut for ToServant UsersAPI AsAPI)
  • the server type with ToServant UsersAPI AsServer
  • the client type with ToServant UsersAPI (AsClientT ClientM)

So at the type level, we can use ToServant to go from the record types to the regular types. At the value level, we can go from the regular types to the record types, with fromServant. It may seem strange, but it makes sense: we are responsible for providing the types (and we do so with records). From records, we go to types that servant can understand (with ToServant). With those types, servant is responsible for providing a client, that we want to use as a record.

So given a regular servant client (here, ToServant UsersAPI (AsClientT ClientM)), we can get a record of clients (here, UsersAPI (AsClientT ClientM)). Instead of calling fromServant on client, we can directly use genericClient to get a record of clients.

It’s all good and well, except for a small difference: in the new way, you don’t nest records, you just reference regular types (that you generate from records with ToServantApi).

In the previous system, since we had nested records, we were able to compose accessors like this:

withUser >>> ($ userId) >>> putUser >>> ($ userData)

Now, every time we call a record accessor, we don’t get the next record, but a regular servant client. So we have to interleave fromServant calls between record accessors as such:

withUser >>> ($ userId) >>> fromServant >>> putUser ($ userData)

Not really satisfying.

However, with a couple helpers, we can improve it substantially:

(//) :: (m ~ AsClientT n)
     => GenericServant routes m
     => (a -> ToServant routes m)
     -> (routes m -> b)
     -> (a -> b)
f // f' = f >>> fromServant >>> f'

(/:) :: (a -> b -> c)
     -> b
     -> a -> c
(/:) = flip

// interleaves accessor calls with fromServant, while /: hides the (>>> ($ p)) pattern. I chose those names due to the similarity with the way routes are declared in many frameworks (with the leading : for captured parameters).

With all that done, we can go back to a nice style:

withUser /: userId // putUser /: userData

I’ve been told that servant generic records don’t compose elegantly; I hope I’ve shown they can.

Addendum

I kept the first part short and to the point, but I wanted to illustrate a bit more what’s going on behind the scenes.

You may think this is all magic, as Servant relies heavily on type families, which hide the “actual” types you’re dealing with. Fear not, we can see precisely what’s happening with :kind!. If you want to follow along, you can download a working example (it’s a stack executable file, if you run it, it will drop you in a GHCI session with everything in scope).

Let’s see the regular API type derived from UsersAPI:

λ> :kind! ToServantApi UsersAPI
ToServantApi UsersAPI :: *
= Verb 'GET 200 '[JSON] [User]
  :<|> ((ReqBody '[JSON] UserData :> Post '[JSON] NoContent)
        :<|> (Capture "user_id" UserId
              :> (Verb 'GET 200 '[JSON] User
                  :<|> ((ReqBody '[JSON] UserData :> Put '[JSON] NoContent)
                        :<|> Verb 'DELETE 200 '[JSON] NoContent))))

And now, the regular client type derived from UsersAPI.

λ> :kind! ToServant UsersAPI (AsClientT ClientM)
ToServant UsersAPI (AsClientT ClientM) :: *
= ClientM [User]
  :<|> ((UserData -> ClientM NoContent)
        :<|> (Int
              -> ClientM User
                 :<|> ((UserData -> ClientM NoContent) :<|> ClientM NoContent)))

That should help you getting by with the ToServant type family.

Now, if you want to understand more about the record types, :kind! will not help you directly. Since those records are… well, records, and not type families you won’t get interesting results:

λ> :kind UsersAPI
UsersAPI :: * -> *
λ> :kind UsersAPI AsApi
UsersAPI AsApi :: *

The records themselves keep the same structure, what changes is the types of their fields. Notice the :- bit?

λ> :kind! AsApi :- Get '[JSON] [User]
AsApi :- Get '[JSON] [User] :: *
= Verb 'GET 200 '[JSON] [User]

λ> :kind! AsServer :- Get '[JSON] [User]
AsServer :- Get '[JSON] [User] :: *
= Handler [User]

One last word: if the compiler complains of a mismatch between something that looks like an API type and something that looks like a server or a client type, make sure you’ve not forgotten the mode :- in your record fields :-)