1
votes

In my attempt to write an authenticated Servant API where handlers use the RIO monad instead of Servant's own Handler monad, I am stuck on authenticated routes that return no content; i.e., Servant's NoContent type. When I try to hoist the RIO server into the Handler using hoistServerWithContext, I get a type error that I don't grok.

Here is the simplified API and server setup:

import qualified Servant                       as SV
import qualified Servant.Auth.Server           as AS

-- A login endpoint that sets authentication and XSRF cookies upon success.
-- Login is a credentials record.
type LoginEndpoint
  = "login" :> SV.ReqBody '[SV.JSON] Login :> SV.Verb 'SV.POST 204 '[SV.JSON] CookieHeader

loginServer
  :: AS.CookieSettings -> AS.JWTSettings -> SV.ServerT LoginEndpoint (RIO m)
loginServer = ... -- Perform credential check here. 

-- A protected endpoint that requires cookie authentication
-- The no-content handler is causing the problem described below.
type ProtectedEndpoint = "api" :> SV.Get '[SV.JSON] Text :<|> SV.DeleteNoContent 

protectedServer (AS.Authenticated _) =
  return "Authenticated" :<|> return SV.NoContent
protectedServer _ = throwIO SV.err401 :<|> throwIO SV.err401

-- The overall API, with cookie authentication on the protected endpoint
type Api
  = LoginEndpoint :<|> (AS.Auth '[AS.Cookie] User :> ProtectedEndpoint)

-- | The overall server for all endpoints.
server :: AS.CookieSettings -> AS.JWTSettings -> SV.ServerT Api (RIO m)
server cs jwt = loginServer cs jwt :<|> protectedServer

Where User is a record type that can be serialized as JWT as part of a cookie. To hoist the server, I follow the example here:

apiProxy :: Proxy Api
apiProxy = Proxy

contextProxy :: Proxy '[AS.CookieSettings, AS.JWTSettings]
contextProxy = Proxy

newtype Env = Env
  { config :: Text }

-- Helper function to hoist our RIO handler into a Servant Handler.
hoistAppServer :: AS.CookieSettings -> AS.JWTSettings -> Env -> SV.Server Api
hoistAppServer cookieSettings jwtSettings env = SV.hoistServerWithContext
  apiProxy
  contextProxy
  (nt env)
  (server cookieSettings jwtSettings)
 where
  -- Natural transformation to map the RIO monad stack to Servant's Handler.
  nt :: Env -> RIO Env a -> SV.Handler a
  nt e m = SV.Handler $ ExceptT $ try $ runRIO e m

main :: IO ()
main = do
  myKey <- AS.generateKey -- Key for encrypting the JWT.
  let jwtCfg = AS.defaultJWTSettings myKey
      cfg    = cookieConf :. jwtCfg :. SV.EmptyContext -- cookieConf sets XSRF handling
      env    = Env { config = "Some configuration string" }
  Warp.run 8081 $ SV.serveWithContext apiProxy cfg $ hoistAppServer cookieConf jwtCfg env

The above hoisting works fine for endpoints that return some content. However, when :<|> SV.DeleteNoContent is present in the ProtectedEndpoint (and the corresponding parts in the server), I get the following type error:

No instance for (HasServer
                   (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
                      (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
                         (NoContentVerb 'DELETE)))
                   '[CookieSettings, JWTSettings])
  arising from a use of ‘hoistServerWithContext’

The problem does not arise on an endpoint without authentication; e.g., UnprotectedEndpoint instead of (AS.Auth '[AS.Cookie] User :> ProtectedEndpoint) in the API type definition.

hoistServerWithContext is a function of the HasServer type class, but I'm not sure which instance is of concern here. If I let GHC infer the type, I get

hoistServerWithContext :: forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n

To me, the type error (plus my experiments adding and removing the no-content handler) indicate that the protectedServer derived by Servant's type machinery is not a member of the HasServer type class. But my Haskell type-level programming skills are not up to the task, it seems. Where exactly is the problem? Am I missing a type annotation? A language extension?

1
In Api, you mention only '[AS.Cookie], but contextProxy mentions both AS.CookieSettings and AS.JWTSettings. Might be related?danidiaz
Cookie authentication actually sets two cookies - one for the session, and one for XSRF protection. Therefore, the authentication Context must contain information for the session and JWT, it is not related to the issue at hand. If I build the example with '[AS.Cookie, AS.JWT], to allow both session and token authentication, I get the same type error.Ulrich Schuster
I found this Servant-Auth issue, deriving from this Servant issue, which might explain the error I'm seeing. Unfortunately, there is no solution yet.Ulrich Schuster

1 Answers

1
votes

The type error seems to result because servant currently does not allow adding headers to a NoContentVerb because the corresponding type instance is missing. See the Servant-Auth issue here.

Even though I don't fully understand the details, the following workaround from the above issue comment avoids the type error:

type instance ASC.AddSetCookieApi (SV.NoContentVerb 'SV.DELETE)
  = SV.Verb 'SV.DELETE 204 '[SV.JSON] (ASC.AddSetCookieApiVerb SV.NoContent)