Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

115 lines (86 sloc) 2.912 kB
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Snap.Snaplet.Session
(
SessionManager
, withSession
, commitSession
, setInSession
, getFromSession
, deleteFromSession
, csrfToken
, sessionToList
, resetSession
, touchSession
) where
import Control.Monad.Reader
import Control.Monad.State
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Record.Label
import Data.Serialize (Serialize)
import Data.Text (Text)
import Snap.Snaplet
import Snap.Snaplet.Session.SecureCookie
import Snap.Types
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 :: (b :-> Snaplet SessionManager) -> Handler b e a -> Handler b e 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.