首页 > 解决方案 > 使用 RIO 在 Servant.Auth 中拒绝身份验证

问题描述

我正在尝试将 Servant 身份验证(servant-auth-server 包)与 RIO 结合起来作为我的处理程序 monad,以避免出现异常反模式。但是,我无法正确排列类型以处理被拒绝的身份验证。

我的(简化的)API 端点是

type UserEndpoint = "user" :> (
              Get '[JSON] User                                       
        :<|>  ReqBody '[JSON] UpdatedUser :> Put '[JSON] User        
    )

和对应的服务器

protectedServer
  :: HasLogFunc m
  => AuthResult AuthUserId
  -> ServerT UserEndpoint (RIO m)
protectedServer (Authenticated authUser) =
  getUser authUser :<|> updateUser authUser
-- Otherwise, we return a 401.
protectedServer _ = throwIO err401

拒绝身份验证的分支中出现类型错误:

    Could not deduce (MonadIO ((:<|>) (RIO m User)))
      arising from a use of ‘throwIO’
    [..]

我不理解这种类型的错误。据我了解(并给出 的签名protectedServer),返回类型应该是ServerT UserEndpoint (RIO m),它应该有一个 的实例MonadIO,因此根据异常教程的异常处理应该使用throwIO而不是throwAllfrom Servant.Auth.Server。看来我还没有完全理解Servant的类机械,我的错在哪里?

两个处理函数定义为

updateUser :: HasLogFunc m => AuthUserId -> UpdatedUser -> RIO m User
updateUser authUser updateUser = ...

getUser :: HasLogFunc m => AuthUserId -> RIO m User
getUser authUser = ...

标签: authenticationhaskellservantrio

解决方案


问题是这throwIO err401是一个单一 RIO的动作。但是当一个服务服务器有多个端点时,每个不同的处理程序都必须由:<|>组合器组成。

如果你的 API 有很多端点,为每个端点编写 401 返回处理程序很快就会变得很烦人。幸运的是, servant-auth-server似乎提供了一个throwAll帮助函数,它可以自动为整个 API 构建错误返回处理程序。

编辑:正如 Ulrich 所指出的,问题throwAll在于它仅适用于MonadErrormonad,而RIO不是MonadError. 但是应该可以修改类型类以使其支持RIO.

首先,一些导入和辅助数据类型:

{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleInstances,
             TypeFamilies, DataKinds, ImportQualifiedPost
             #-}
module Main where

import RIO (RIO) -- rio
import RIO qualified
import Data.Tagged               (Tagged (..)) -- package tagged
import Servant                   ((:<|>) (..), ServerError(..))
import Network.HTTP.Types -- package http-types
import Network.Wai -- package wai
import Data.ByteString.Char8 qualified as BS

这是主要的RIOThrowAll类型类:

class RIOThrowAll a where
    rioThrowAll :: ServerError -> a

-- for a composition of endpoints
instance (RIOThrowAll a, RIOThrowAll b) => RIOThrowAll (a :<|> b) where
    rioThrowAll e = rioThrowAll e :<|> rioThrowAll e

-- if we have a function, we ignore the argument and delegate on the result
instance (RIOThrowAll b) => RIOThrowAll (a -> b) where
    rioThrowAll e = \_ -> rioThrowAll e

-- if we reach a RIO action at the tip of a function
instance RIOThrowAll (RIO.RIO env x) where
    rioThrowAll e = RIO.throwIO e

-- this is only for Raw endpoints which embed a WAI app directly
instance RIOThrowAll (Tagged (RIO.RIO env x) Application) where
  rioThrowAll e = Tagged $ \_req respond ->
      respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
                            (errHeaders e)
                            (errBody e)

推荐阅读