CODEWITHSUNDEEP
haskellhaskell-snap-framework
Neil
Neil

Reputation: 359

Snap: wrapping auth handler with CSRF checker

I have the following handler which I use for checking authorization on a given handler:

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

In Site.h I specify a route like so: ("/transfers", needsAuth handleTransfers) where the signature of handleTransfers is handleTransfers :: Handler App (AuthManager App) ().

There are only a few handlers on my app that have user submitted forms; I want to use CSRF checking on them, and I though it would be convenient to wrap the authorized handler with a CSRF checking handler, so I could change the route to something like this:

("/test", handleCSRF $ needsAuth handleTest)

Based on ideas in the snap-extras package, I've created the function 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"

The compilation error is:

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" }

I've tried a number of different variations, but get compilation errors of different varieties... am I heading in the right direction? Is this the correct approach in Snap?

EDIT: here is some additional information:

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

I'm initializing the session snaplet like so:

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

EDIT #2/Solution... @mightybyte gave me the solution via IRC, which was to replace the realTok line with realTok <- withSession sess (with sess csrfToken), which worked.

Thanks in advance, Neil

Upvotes: 3

Views: 337

Answers (1)

mightybyte
mightybyte

Reputation: 7272

Try this:

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"

The first parameter to withSession should be a lens, not the SessionManager itself.

Upvotes: 3

Related Questions