How to feed a group of handlers with value fetched from Db in servant?

Question

I'm using servant with JWT authentication. I'm trying to fetch authenticated user and pass it to handlers not to have to repeat same logic in each handler.

With a single argument function it works like a charm:

listMeters :: Entity User -> Handler [Meter]
protected :: Servant.Auth.Server.AuthResult Token -> Server Protected
protected (Servant.Auth.Server.Authenticated email) = do
  user <- getUser email
  listMeters user

On the other hand when I try to do the same with function that takes two parameters:

addMeter :: Entity User -> Meter -> Handler Meter
protected :: Servant.Auth.Server.AuthResult Token -> Server Protected
protected (Servant.Auth.Server.Authenticated email) = do
  user <- getUser email
  addMeter user 

It throws compilation error:

/usr/src/app/src/Handlers.hs:57:3: error:
    • Couldn't match type ‘Handler b0’ with ‘Meter -> Handler Meter’
      Expected type: Server Protected
        Actual type: Handler b0
    • In a stmt of a 'do' block: user <- getUser email
      In the expression:
        do user <- getUser email
           addMeter user
      In an equation for ‘protected’:
          protected (Authenticated email)
            = do user <- getUser email
                 addMeter user
   |
57 |   user <- getUser email
   |   ^^^^^^^^^^^^^^^^^^^^^

/usr/src/app/src/Handlers.hs:64:3: error:
    • Couldn't match expected type ‘Handler b0’
                  with actual type ‘Meter -> Handler Meter’
    • Probable cause: ‘addMeter’ is applied to too few arguments
      In a stmt of a 'do' block: addMeter user
      In the expression:
        do user <- getUser email
           addMeter user
      In an equation for ‘protected’:
          protected (Authenticated email)
            = do user <- getUser email
                 addMeter user
   |
64 |   addMeter user
   |   ^^^^^^^^^^^^^

Function fetching users from db:

getUser :: Token -> Handler (Entity User)
getUser email = do
  userEntity <- liftIO $ runSql $ getBy $ UniqueEmail email
  case userEntity of
        Nothing -> throwError err401
        Just user -> return user

Why does the first example work and the other doesn't? How to resolve such a case properly in servant?

Answer 1

In this particular problem creating a custom instance of IsAuth seems to be the best solution. There seem to be no official/idiomatic way though.

I've solved the problem by doing:

data UserCookie

extractUser userId = (maybe mzero (return . Entity userId)) =<< fetch
  where
    fetch = liftIO $ runSql $ get userId

instance IsAuth UserCookie (Entity User) where
  type AuthArgs UserCookie = '[CookieSettings, JWTSettings]
  runAuth _ _ = \c jwt -> extractUser =<< cookieAuthCheck c jwt

This link might also be helpful: https://github.com/haskell-servant/servant-auth/issues/73