Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

file 104 lines (78 sloc) 2.584 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
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.