Serving a Servant NoContent response with RIO - haskell

Question

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?

Answer 1

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)