3
votes

I am building a web API with Servant and Persistent. I plan to define some API endpoints (about 15) that use a connection pool to access the DB.

For example, one of the endpoint definitions (Handlers) is:

getUser :: ConnectionPool -> Int -> Handler User
getUser pool uid = do
  user <- inPool pool $ get (toId @User uid)
  user & orErr err404 {errBody = "This user does not exist."}

where inPool is just a lifted withResource function, and orErr is a lifted fromMaybe.

Then, a higher level API definition (Servers) looks like this:

type Point (s :: Symbol) (a :: *) =
  s :> Capture "id" Int :>
  (                         Get  '[JSON] a
  :<|> ReqBody '[JSON] a :> Post '[JSON] NoContent
  )

type UserPoint = Point "users" User

userServer :: ConnectionPool -> Server UserPoint
userServer pool uid =
    getUser pool uid :<|>
    postUser pool uid

And I defined the main to be:

main = runStdoutLoggingT . withPostgresqlPool connectionString numConnections $ \pool -> do
  withResource pool (runSqlConn $ runMigration migrateAll)
  liftIO $ run appPort (userServer pool)

But I soon noticed that I would have to pass the pool down layer by layer (In the example above there are 2 layers, and in my real project there are 3), to every function (that is over 20). My intuition tells me this is bad smell, but I am not quite sure.

Then I thought of ReaderT, because I think that may abstract the pool out. But my concern is that the introduction of ReaderT may lead to unnecessary complexity:

  • I need to lift many things manually;
  • The mental model of types will become more complicated thus harder to think about;
  • It means I'll have to give up the Handler type, which makes using Servant harder too.

I am not sure whether I should use ReaderT in this case. Please offer some suggestions (I'll be grateful if you could also provide some guidelines about when to use ReaderT or even other monad transformers).

UPDATE: I found that I can use where-clauses to simplify this a lot, and this basically solves my problem. but I'm not sure if this is best practice, so I'm still looking forwand to an answer.

userServer :: Pooled (Server UserPoint)
userServer pool auth = c :<|> rud where
  c :: UserCreation -> Handler NoContent
  c = undefined
  rud uid = r :<|> u :<|> d where
    r :: Handler User
    r = do
      checkAuth pool auth
      user <- inPool pool $ get (toId @User uid)
      user & orErr err404 {errBody = "This user does not exist."}
    u :: User -> Handler NoContent
    u = undefined
    d :: Handler NoContent
    d = undefined
1
Encapsulate it in monadic state?bipll
@bipll Do you mean the StateT?daylily
@XyRen One problem with the where approach for avoiding having to pass the pool argument is that it forces you to define all handlers inside userServer. One question: when you write "pass the pool down layer by layer ", do you mean layers of function invocations?danidiaz
@danidiaz Defining handlers inside userServer is not yet a very big problem to me; and for your question, yes.daylily

1 Answers

0
votes

While defining your handlers along with your server will avoid you the parameter-passing, as the server grows in complexity you might want to define some handlers separately:

  • Perhaps some handler provides some generic functionality and could be useful in other servers.

  • Defining everything together means everything is aware of everything else. Moving handlers to the top level, or even to another module, will help make explicit which parts of the whole they really need to know. And this can make the handler easier to understand.

Once we separate a handler, supplying it with the environment will become necessary. This can be done with plain parameters to functions, or with a ReaderT. As the number of parameters grows, the ReaderT (often in combination with auxiliary HasX typeclasses) becomes more attractive because it frees you from having to care about parameter order.

I would have to pass the pool down layer by layer (In the example above there are 2 layers, and in my real project there are 3), to every function

Besides the extra (possibly inevitable) burden of having to pass parameters, I think there's a potentially worse problem lurking: you are threading a low-level detail (the connection pool) through several layers of functions. This can be bad because:

  • You are committing your whole application to using an actual database. What happens if, during testing, you want switch it with some kind of in-memory repository?

  • If you need to change the way you do persistence, the refactor will reverberate through all the layers of your application, instead of remaining localized.

One possible solution for these problems: the functions at layer N+1 should not receive as parameter the connection pool, but rather the functions they use from layer N. And those functions from layer N will already have been partially applied with the connection pool.

A trivial example: if you have some high level logic transferUser :: Conn -> Handle -> IO () that includes hardwired calls to functions readUserFromDb :: Conn -> IO User and writeUserToFile :: Handle -> User -> IO (), change it into a transferUser :: IO User -> (User -> IO) -> IO ().

Notice that the auxiliary functions from level N could be stored in the ReaderT context; the functions from level N+1 could get them from there.


It means I'll have to give up the Handler type, which makes using Servant harder too.

You can define your server using a ReaderT transformer over Handler, and then pass it to the hoistServer function which will "whittle it down" to a runnable server:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant
import Servant.API
import Control.Monad.Trans.Reader

type UserAPI1 = "users" :> Capture "foo" Int :> Get '[JSON] Int

data Env = Env

-- also valid type
--      server1 :: Int -> ReaderT Env Handler Int
server1 :: ServerT UserAPI1 (ReaderT Env Handler)
server1 = 
    \ param -> 
        do _ <- ask
           return param

-- also valid types:
--      server2 :: ServerT UserAPI1 Handler
--      server2 :: Int -> Handler Int
server2 :: Server UserAPI1 
server2 = hoistServer (Proxy :: Proxy UserAPI1) (flip runReaderT Env) server1