使用 RIO 服务 Servant NoContent 响应

Question

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

这是简化的 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

上述提升对于 return 某些内容的端点工作正常。但是，当 :<|> 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’

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

hoistServerWithContext 是 HasServer 类型 class 的函数，但我不确定这里关注的是哪个实例。如果我让 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 类型的成员 class。但我的 Haskell 类型级编程技能似乎无法胜任这项任务。问题到底出在哪里？我是否缺少类型注释？语言扩展？

Answer 1

类型错误似乎是因为仆人当前不允许将 headers 添加到 NoContentVerb，因为缺少相应的类型实例。见 Servant-Auth issue here.

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

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

使用 RIO 服务 Servant NoContent 响应

Serving a Servant NoContent response with RIO

haskell

higher-kinded-types

type-level-computation

servant

rio