如何为嵌套ServerT配置不同上下文以实现Servant分层授权

核心思路 #

你需要的不是直接生成WAI.Application，而是保留Servant的ServerT或Router层级抽象，让外层处理完认证/授权后，能将上下文传递给内层路由继续组合。要实现你期望的嵌套调用形态，关键是定义一个保留Servant服务器抽象的辅助函数，而非直接输出Application。

可行的函数形态 #

你想要的serveWithContext'本质是一个不终止于Application的组合函数，可以定义为适配分层逻辑的形态：

-- 通用版：接收上下文构建函数，返回组合后的ServerT
serveWithContext' :: (HasServer api ctx)
                  => Proxy api
                  -> Context ctx
                  -> (innerCtx -> ServerT api Handler)
                  -> ServerT (OuterLayer :> api) Handler

调整你的Layer类实现 #

你定义的Layer类方向正确，但可以更贴合嵌套组合需求，修改后如下：

class Layer a where
  type LayerContext a :: *
  -- 外层Layer处理后生成内层上下文，将内层ServerT组合为外层ServerT
  wrapLayer :: Proxy a
            -> (LayerContext a -> ServerT api Handler)
            -> ServerT (a :> api) Handler

-- 示例：用户认证层的实例
data UserAuthLayer = UserAuthLayer
instance Layer UserAuthLayer where
  type LayerContext UserAuthLayer = UserInfo
  wrapLayer _ innerServer = do
    -- 这里实现用户认证逻辑：从请求提取凭证、查询用户信息等
    userInfo <- authenticateUserFromRequest
    -- 将认证后的用户信息传递给内层服务器
    innerServer userInfo

-- 示例：项目授权层的实例
data ProjectAuthLayer = ProjectAuthLayer
instance Layer ProjectAuthLayer where
  type LayerContext ProjectAuthLayer = ProjectContext
  wrapLayer _ innerServer = do
    -- 从外层上下文（比如已认证的UserInfo）获取项目权限
    userInfo <- getContextEntry (Proxy :: Proxy UserInfo)
    projectCtx <- authorizeUserProject userInfo
    innerServer projectCtx

嵌套组合的使用方式 #

调整后就能按你期望的方式嵌套组合路由：

-- 定义各层级API Proxy
unauthenticatedApi :: Proxy UnauthenticatedApi
unauthenticatedApi = Proxy

authenticatedApi :: Proxy AuthenticatedApi
authenticatedApi = Proxy

projectScopedApi :: Proxy ProjectScopedApi
projectScopedApi = Proxy

-- 组合完整服务器逻辑
fullServer :: ServerT FullApi Handler
fullServer =
  -- 未认证路由直接处理
  unauthenticatedServer
  -- 用户认证层：传递UserInfo给内层
  :<|> wrapLayer (Proxy :: Proxy UserAuthLayer) (\userInfo ->
      authenticatedServer userInfo
      -- 项目授权层：基于UserInfo生成ProjectContext传递给内层
      :<|> wrapLayer (Proxy :: Proxy ProjectAuthLayer) (\projectCtx ->
          projectScopedServer userInfo projectCtx
        )
    )

-- 最后统一转换为WAI Application
fullApp :: Application
fullApp = serveWithContext fullApi fullContext fullServer

关键补充说明 #

1. 不要提前转换为Application：始终在ServerT层级完成所有路由组合，最后仅调用一次serveWithContext转换为Application，这样才能保留分层上下文的传递能力。
2. 适配ReaderT over IO模式：如果内层服务器使用ReaderT承载上下文，可配合hoistServerWithContext转换：

   wrapLayer _ innerServer = do
     userInfo <- authenticateUserFromRequest
     let appCtx = mkAppContext userInfo
     hoistServerWithContext authenticatedApi 
                            (Proxy :: Proxy '[AppContext])
                            (flip runReaderT appCtx)
                            (innerServer appCtx)
   

3. 原方案的调整建议：如果坚持使用Router层级，可将runLayer的返回值改为ServerT (a :> api) Handler而非直接Router env，这样就能继续参与后续组合。

内容的提问来源于stack exchange，提问作者GTF