Question

我正在使用带有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

第一个示例为何起作用而另一个示例不起作用？如何在仆人中妥善解决这种情况？

Answer 1

在此特定问题中，创建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

如何使用从Db在仆人中获取的值来提供一组处理程序？

1 个答案: