$ whoami
type API = "users" :>
( Get '[JSON] [User]
:<|> ReqBody '[JSON] MkUser
:> Post '[JSON] NoContent
:<|> Capture "userId" UserId :>
( Get '[JSON] User
:<|> Delete '[JSON] NoContent
)
)
/
└─ users/
├─• GET
├─• POST
└─ <userId>/
├─• GET
└─• DELETE
listUsers :: Handler [User]
listUsers = liftIO getAllUsers
createUser :: MkUser -> Handler NoContent
createUser =
liftIO addUser >=>
either handleError handleSuccess
where
handleError _ = throwError err400
handleSuccess _ = pure NoContent
Handler
allows you to do IO, and to return non-200 HTTP codes with throwError
. It focuses on the data types, rather than HTTP itself
handlers :: Server API
handlers =
allUsers :<|> singleUser
where
allUsers =
listUsers :<|> createUser
singleUser userId =
getUser userId :<|> deleteUser userId
:kind!
λ> :kind! Server API
= Handler [User]
:<|> ((MkUser -> Handler NoContent)
:<|> (Int -> Handler User
:<|> Handler NoContent))
Server API
is not a real type, in case of doubt, use :kind!
to know what you’re actually dealing with. kind “evaluates” type families instances
TypeApplications
extension is quite useful in this context, I’ll use it from now on to have terser code
type MyHandler = ReaderT Env Handler
getAllUsers :: DbPool -> IO [User]
listUsers :: MyHandler [User]
listUsers =
asks pool
>>= liftIO . getAllUsers
Handler
is already a monad, we use the transformer version of Reader, to add Reader capabilities to the handler.
Server
is specialized for Handler
, so we need to use the more general ServerT
version.
server :: Env -> Server API
server env =
hoistServer @API Proxy withEnv handlers
where
withEnv :: (MyHandler a -> Handler a)
withEnv v = runReaderT v env
hoistServer
, and we provide a function transforming MyHandler
into Handler
. In our case it’s runReaderT
hoistServer :: HasServer api '[]
=> Proxy api
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
HasServer
is servant’s internal type-families-based machinery. What’s important is that we can go from a handler m to handler n. In our case, m is MyHandler
, n is Handler
. We can put all our endpoints in the monads we want as long as we end up with a Handler
.
forall x. m x -> n x
Handler
at all. So we can chain as many transformations as we want, as long as the last one gives us a Handler
.
newtype HasAdmin a =
HasAdmin (MyHandler a)
deriving (Monad, MonadReader, …)
deleteEverything :: HasAdmin NoContent
deleteEverything =
liftIO dropDatabase
>> pure NoContent
HasAdmin
wraps around our custom handler. It allows us to declare endpoints with extended capabilities. I’ve omitted all the instances derivation, to let it delegate to the inner handler.
ensureAdmin :: User
-> (HasAdmin a -> MyHandler a)
ensureAdmin user (HasAdmin handler)
| isAdmin user = handler
| otherwise = throwError err403
server :: Env -> Server API
server env user =
hoistServer @UserEndpoints
Proxy
withEnv
(userEps user :<|> adminEps user)
The main server is the same, it handles the reader monad. It also passes the user down to the other servers (it could also be put in the reader, but I chose not to, for clarity).
Pay special attention to the type annotations (especially the API vs UserEndpoints). It’s not intuitive, and it’s easy to be trapped (I sure was). Discuss it with the audienceadminEps :: User -> MyServer Admin
adminEps user =
hoistServer @Admin
Proxy
(ensureAdmin user)
deleteEverything
/ -- MyHandler
├─ users/
┆ ├─• GET
┆ ├─• POST
┆ └─ <userId>/
┆ ├─• GET
┆ └─• DELETE
└─ admin/ -- HasAdmin
└─ yolo/
└─• DELETE
Application -> Application
ReaderT
hoistServer