Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

131 lines (107 sloc) 3.916 kB
module Snap.Snaplet.Session
( SessionManager(..)
, ISessionManager(..)
, withSession
, commitSession
, setInSession
, getFromSession
, deleteFromSession
, csrfToken
, sessionToList
, resetSession
, touchSession
, module Snap.Snaplet.Session.Common
, module Snap.Snaplet.Session.SecureCookie
) where
------------------------------------------------------------------------------
import Control.Monad.State
import Data.Lens.Lazy
import Data.Text (Text)
import Snap.Core
------------------------------------------------------------------------------
import Snap.Snaplet
import Snap.Snaplet.Session.Common
import Snap.Snaplet.Session.SecureCookie
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.