haskell - 快照 : wrapping auth handler with CSRF checker

Question

我有以下处理程序，用于检查给定处理程序的授权:

  needsAuth :: Handler App (AuthManager App) () -> Handler App App ()
  needsAuth x = with auth $ requireUser auth noUserHandler x
    where noUserHandler = handleLogin (Just "must be logged in")

在Site.h我这样指定一条路线:("/transfers", needsAuth handleTransfers)其中 handleTransfers 的签名是 handleTransfers :: Handler App (AuthManager App) () .

我的应用程序中只有少数处理程序具有用户提交的表单；我想对它们使用 CSRF 检查，虽然用 CSRF 检查处理程序包装授权处理程序会很方便，所以我可以将路由更改为如下所示:

("/test", handleCSRF $ needsAuth handleTest)

基于 snap-extras 包中的想法，我创建了函数 handleCSRF:

handleCSRF :: Handler b v () -> Handler b v ()
handleCSRF x = do
  m <- getsRequest rqMethod
  if m /= POST
    then x
    else do tok <- getParam "_csrf"
          s <- gets session
          realTok <- withSession s csrfToken
          if tok == Just (E.encodeUtf8 realTok)
            then x
            else writeText $ "CSRF error"

编译错误为:

Couldn't match type `SessionManager' with `AuthManager b'
When using functional dependencies to combine
  MonadState v (Handler b v),
    arising from the dependency `m -> s'
    in the instance declaration in `snap-0.13.2.5:Snap.Snaplet.Internal.Type s'
  MonadState (AuthManager b) (Handler b SessionManager),
    arising from a use of `gets' at src\Site.hs:106:20-23
In a stmt of a 'do' block: s <- gets session
In the expression:
  do { tok <- getParam "_csrf";
       s <- gets session;
       realTok <- withSession s csrfToken;
       if tok == Just (E.encodeUtf8 realTok) then
           x
       else
           writeText $ "CSRF error" }

我尝试了多种不同的变体，但出现了不同种类的编译错误……我的方向是否正确？这是 Snap 中的正确方法吗？

编辑:这里有一些附加信息:

data App = App
{ _heist :: Snaplet (Heist App)
, _sess  :: Snaplet SessionManager
, _auth  :: Snaplet (AuthManager App)
, _wmConfig  :: WMConfig
}
makeLenses ''App

我正在像这样初始化 session snaplet:

   s <- nestSnaplet "sess" sess $
       initCookieSessionManager "site_key.txt" "sess" (Just 1200)

EDIT #2/Solution... @mightybyte 通过 IRC 给了我解决方案，用 realTok <- withSession sess (with sess csrfToken) 替换 realTok 行, 有效。

提前致谢，尼尔

Answer 1

试试这个:

handleCSRF :: Handler App App () -> Handler App App ()
handleCSRF x = do
  m <- getsRequest rqMethod
  if m /= POST
    then x
    else do tok <- getParam "_csrf"
          realTok <- withSession sess csrfToken
          if tok == Just (E.encodeUtf8 realTok)
            then x
            else writeText $ "CSRF error"

withSession的第一个参数应该是一个镜头，而不是 SessionManager 本身。