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)

编辑＃2 /解决方案 ... @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本身。

Snap：使用CSRF检查程序包装auth处理程序

1 个答案: