Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

108 lines (80 sloc) 2.603 kb
module Snap.Snaplet.Session
(
SessionManager
, withSession
, commitSession
, setInSession
, getFromSession
, deleteFromSession
, csrfToken
, sessionToList
, resetSession
, touchSession
) where
import Control.Monad.State
import Data.Lens.Lazy
import Data.Text (Text)
import Snap.Snaplet
import Snap.Core
import Snap.Snaplet.Session.SessionManager
( SessionManager(..), ISessionManager(..) )
import qualified Snap.Snaplet.Session.SessionManager as SM
-- | Wrap around a handler, committing any changes in the session at the end
withSession :: (Lens b (Snaplet SessionManager))
-> Handler b v a
-> Handler b v a
withSession l h = do
a <- h
withTop l commitSession
return a
-- | Commit changes to session within the current request cycle
commitSession :: Handler b SessionManager ()
commitSession = do
SessionManager b <- loadSession
liftSnap $ commit b
-- | Set a key-value pair in the current session
setInSession :: Text -> Text -> Handler b SessionManager ()
setInSession k v = do
SessionManager r <- loadSession
let r' = SM.insert k v r
put $ SessionManager r'
-- | Get a key from the current session
getFromSession :: Text -> Handler b SessionManager (Maybe Text)
getFromSession k = do
SessionManager r <- loadSession
return $ SM.lookup k r
-- | Remove a key from the current session
deleteFromSession :: Text -> Handler b SessionManager ()
deleteFromSession k = do
SessionManager r <- loadSession
let r' = SM.delete k r
put $ SessionManager r'
-- | Returns a CSRF Token unique to the current session
csrfToken :: Handler b SessionManager Text
csrfToken = do
mgr@(SessionManager r) <- loadSession
put mgr
return $ SM.csrf r
-- | Return session contents as an association list
sessionToList :: Handler b SessionManager [(Text, Text)]
sessionToList = do
SessionManager r <- loadSession
return $ SM.toList r
-- | Deletes the session cookie, effectively resetting the session
resetSession :: Handler b SessionManager ()
resetSession = do
SessionManager r <- loadSession
r' <- liftSnap $ SM.reset r
put $ SessionManager r'
-- | Touch the session so the timeout gets refreshed
touchSession :: Handler b SessionManager ()
touchSession = do
SessionManager r <- loadSession
let r' = SM.touch r
put $ SessionManager r'
-- | Load the session into the manager
loadSession :: Handler b SessionManager SessionManager
loadSession = do
SessionManager r <- get
r' <- liftSnap $ load r
return $ SessionManager r'
Jump to Line
Something went wrong with that request. Please try again.