Snap：使用 CSRF 检查器包装身份验证处理程序

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

我正在像这样初始化会话 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 本身。