Permalink
Browse files

Add deleteFromSession to Snaplet.Session

  • Loading branch information...
1 parent 3257efa commit 21cf4fd95a478c732c5981016b42e37372b7e3b5 @ozataman ozataman committed Jul 31, 2011
Showing with 16 additions and 7 deletions.
  1. +16 −7 src/Snap/Snaplet/Session.hs
@@ -10,6 +10,7 @@ module Snap.Snaplet.Session
, commitSession
, setInSession
, getFromSession
+ , deleteFromSession
, csrfToken
, sessionToList
, resetSession
@@ -46,25 +47,33 @@ withSession l h = do
-- | Commit changes to session within the current request cycle
commitSession :: Handler b SessionManager ()
commitSession = do
- mgr@(SessionManager b) <- loadSession
+ 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
- mgr@(SessionManager r) <- loadSession
+ 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
- mgr@(SessionManager r) <- loadSession
+ 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
@@ -76,30 +85,30 @@ csrfToken = do
-- | Return session contents as an association list
sessionToList :: Handler b SessionManager [(Text, Text)]
sessionToList = do
- mgr@(SessionManager r) <- loadSession
+ SessionManager r <- loadSession
return $ SM.toList r
-- | Deletes the session cookie, effectively resetting the session
resetSession :: Handler b SessionManager ()
resetSession = do
- mgr@(SessionManager r) <- loadSession
+ 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
- mgr@(SessionManager r) <- loadSession
+ SessionManager r <- loadSession
let r' = SM.touch r
put $ SessionManager r'
-- | Load the session into the manager
loadSession :: Handler b SessionManager SessionManager
loadSession = do
- mgr@(SessionManager r) <- get
+ SessionManager r <- get
r' <- liftSnap $ load r
return $ SessionManager r'

0 comments on commit 21cf4fd

Please sign in to comment.