使用 RIO 提供 Servant NoContent 响应

如何解决使用 RIO 提供 Servant NoContent 响应

在我尝试编写一个经过身份验证的 Servant API 时，处理程序使用 RIO monad 而不是 Servant 自己的 Handler monad，我被困在不返回任何内容的经过身份验证的路由上；即，Servant 的 NoContent 类型。当我尝试使用 RIO 将 Handler 服务器提升到 hoistServerWithContext 中时，我收到一个我不明白的类型错误。

这是简化的 API 和服务器设置：

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

其中 User 是一种记录类型，可以作为 cookie 的一部分序列化为 JWT。为了提升服务器，我按照示例 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

上述提升适用于返回某些内容的端点。但是，当 :<|> SV.DeleteNoContent 出现在 ProtectedEndpoint（以及服务器中的相应部分）中时，我收到以下类型错误：

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’

在没有认证的端点上不会出现问题；例如，API 类型定义中的 UnprotectedEndpoint 而不是 (AS.Auth '[AS.Cookie] User :> ProtectedEndpoint)。

hoistServerWithContext 是 HasServer 类型类的函数，但我不确定此处关注哪个实例。如果我让 GHC 推断类型，我会得到

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

对我来说，类型错误（加上我添加和删除无内容处理程序的实验）表明由 Servant 的类型机制派生的 protectedServer 不是 HasServer 类型类的成员。但我的 Haskell 类型级编程技能似乎无法胜任这项任务。问题究竟出在哪里？我是否缺少类型注释？语言扩展？

解决方法

类型错误似乎是因为servant 目前不允许向NoContentVerb 添加标题，因为缺少相应的类型实例。请参阅仆人身份验证 issue here。

即使我不完全理解细节，上述问题评论中的以下解决方法也避免了类型错误：

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