Serving a Servant NoContent response with RIO

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)