时间戳

首页 > 解决方案 > 如何为一组处理程序提供从 Db 中获取的值的服务？

haskell - 如何为一组处理程序提供从 Db 中获取的值的服务？

问题描述

我正在使用具有 JWT 身份验证的仆人。我正在尝试获取经过身份验证的用户并将其传递给处理程序，而不必在每个处理程序中重复相同的逻辑。

使用单个参数函数，它就像一个魅力： 

listMeters :: Entity User -> Handler [Meter]
protected :: Servant.Auth.Server.AuthResult Token -> Server Protected
protected (Servant.Auth.Server.Authenticated email) = do
  user <- getUser email
  listMeters user

另一方面，当我尝试对带有两个参数的函数执行相同操作时： 

addMeter :: Entity User -> Meter -> Handler Meter
protected :: Servant.Auth.Server.AuthResult Token -> Server Protected
protected (Servant.Auth.Server.Authenticated email) = do
  user <- getUser email
  addMeter user

它抛出编译错误： 

/usr/src/app/src/Handlers.hs:57:3: error:
    • Couldn't match type ‘Handler b0’ with ‘Meter -> Handler Meter’
      Expected type: Server Protected
        Actual type: Handler b0
    • In a stmt of a 'do' block: user <- getUser email
      In the expression:
        do user <- getUser email
           addMeter user
      In an equation for ‘protected’:
          protected (Authenticated email)
            = do user <- getUser email
                 addMeter user
   |
57 |   user <- getUser email
   |   ^^^^^^^^^^^^^^^^^^^^^

/usr/src/app/src/Handlers.hs:64:3: error:
    • Couldn't match expected type ‘Handler b0’
                  with actual type ‘Meter -> Handler Meter’
    • Probable cause: ‘addMeter’ is applied to too few arguments
      In a stmt of a 'do' block: addMeter user
      In the expression:
        do user <- getUser email
           addMeter user
      In an equation for ‘protected’:
          protected (Authenticated email)
            = do user <- getUser email
                 addMeter user
   |
64 |   addMeter user
   |   ^^^^^^^^^^^^^

从数据库中获取用户的函数： 

getUser :: Token -> Handler (Entity User)
getUser email = do
  userEntity <- liftIO $ runSql $ getBy $ UniqueEmail email
  case userEntity of
        Nothing -> throwError err401
        Just user -> return user

为什么第一个示例有效而另一个无效？如何在servant中正确解决这种情况？

标签： haskellservant

解决方案

在这个特殊问题中，创建 IsAuth 的自定义实例似乎是最好的解决方案。不过，似乎没有官方/惯用的方式。

我通过以下方式解决了这个问题：

data UserCookie

extractUser userId = (maybe mzero (return . Entity userId)) =<< fetch
  where
    fetch = liftIO $ runSql $ get userId

instance IsAuth UserCookie (Entity User) where
  type AuthArgs UserCookie = '[CookieSettings, JWTSettings]
  runAuth _ _ = \c jwt -> extractUser =<< cookieAuthCheck c jwt

此链接也可能有帮助：https ://github.com/haskell-servant/servant-auth/issues/73

推荐阅读