Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
106 lines (78 sloc) 2.52 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'
Something went wrong with that request. Please try again.