Permalink
Browse files

Add convenience splices for CSRF token injection into the views

  • Loading branch information...
1 parent 47a9cf6 commit 8fe1b4b2a541753388a0a8ac58c708386bc4f3e2 @ozataman ozataman committed Apr 14, 2011
Showing with 46 additions and 0 deletions.
  1. +46 −0 src/Snap/Auth/Splices.hs
@@ -0,0 +1,46 @@
+{-|
+
+ Convenience Splices to be used in your views. They go hand-in hand with
+ handlers defined in this package to help automate some common patterns.
+
+-}
+
+module Snap.Auth.Splices
+ ( metaCSRFTag, hiddenCSRFTag ) where
+
+import Control.Monad.Trans.Class (lift)
+import Data.Text.Encoding as T
+
+import Snap.Auth
+import Snap.Extension.Session.CookieSession (MonadSession(..), sessionCSRFToken)
+
+import qualified Text.XmlHtml as X
+import Text.Templating.Heist
+
+
+metaCSRFTag
+ :: (MonadAuth m)
+ => Splice m
+metaCSRFTag = do
+ embeddedToken <- lift sessionCSRFToken
+ param <- lift authAuthenticityTokenParam
+ let metaToken = X.Element "meta"
+ [ ("name", "csrf-token")
+ , ("value", T.decodeUtf8 embeddedToken) ] []
+ let metaParam = X.Element "meta"
+ [ ("name", "csrf-param")
+ , ("value", T.decodeUtf8 param) ] []
+ return $ [metaParam, metaToken]
+
+
+hiddenCSRFTag
+ :: (MonadAuth m)
+ => Splice m
+hiddenCSRFTag = do
+ embeddedToken <- lift sessionCSRFToken
+ param <- lift authAuthenticityTokenParam
+ return . return $ X.Element "input"
+ [ ("type", "hidden")
+ , ("name", T.decodeUtf8 param)
+ , ("value", T.decodeUtf8 embeddedToken)
+ ] []

0 comments on commit 8fe1b4b

Please sign in to comment.