Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 106 lines (78 sloc) 2.584 kB
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
1 module Snap.Snaplet.Session
2
3 (
4 SessionManager
5 , withSession
6 , commitSession
7 , setInSession
8 , getFromSession
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
9 , deleteFromSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
10 , csrfToken
11 , sessionToList
12 , resetSession
13 , touchSession
14
15 ) where
16
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
17 import Control.Monad.State
c28c4b4 @mightybyte Switched from fclabels to data-lens.
mightybyte authored
18 import Data.Lens.Lazy
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
19 import Data.Text (Text)
20
21 import Snap.Snaplet
f14faee @gregorycollins Rename Snap.Types to Snap.Core
gregorycollins authored
22 import Snap.Core
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
23
24 import Snap.Snaplet.Session.SessionManager
25 ( SessionManager(..), ISessionManager(..) )
26 import qualified Snap.Snaplet.Session.SessionManager as SM
27
28
29
30 -- | Wrap around a handler, committing any changes in the session at the end
c28c4b4 @mightybyte Switched from fclabels to data-lens.
mightybyte authored
31 withSession :: (Lens b (Snaplet SessionManager)) -> Handler b v a -> Handler b v a
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
32 withSession l h = do
33 a <- h
bab2579 @mightybyte Renamed withChild and withSibling, and removed withBase.
mightybyte authored
34 withTop l commitSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
35 return a
36
37
38 -- | Commit changes to session within the current request cycle
39 commitSession :: Handler b SessionManager ()
40 commitSession = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
41 SessionManager b <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
42 liftSnap $ commit b
43
44
45 -- | Set a key-value pair in the current session
46 setInSession :: Text -> Text -> Handler b SessionManager ()
47 setInSession k v = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
48 SessionManager r <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
49 let r' = SM.insert k v r
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
50 put $ SessionManager r'
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
51
52
53 -- | Get a key from the current session
54 getFromSession :: Text -> Handler b SessionManager (Maybe Text)
55 getFromSession k = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
56 SessionManager r <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
57 return $ SM.lookup k r
58
59
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
60 -- | Remove a key from the current session
61 deleteFromSession :: Text -> Handler b SessionManager ()
62 deleteFromSession k = do
63 SessionManager r <- loadSession
64 let r' = SM.delete k r
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
65 put $ SessionManager r'
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
66
67
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
68 -- | Returns a CSRF Token unique to the current session
69 csrfToken :: Handler b SessionManager Text
70 csrfToken = do
71 mgr@(SessionManager r) <- loadSession
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
72 put mgr
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
73 return $ SM.csrf r
74
75
76 -- | Return session contents as an association list
77 sessionToList :: Handler b SessionManager [(Text, Text)]
78 sessionToList = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
79 SessionManager r <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
80 return $ SM.toList r
81
82
83 -- | Deletes the session cookie, effectively resetting the session
84 resetSession :: Handler b SessionManager ()
85 resetSession = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
86 SessionManager r <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
87 r' <- liftSnap $ SM.reset r
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
88 put $ SessionManager r'
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
89
90
91 -- | Touch the session so the timeout gets refreshed
92 touchSession :: Handler b SessionManager ()
93 touchSession = do
21cf4fd @ozataman Add deleteFromSession to Snaplet.Session
ozataman authored
94 SessionManager r <- loadSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
95 let r' = SM.touch r
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
96 put $ SessionManager r'
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
97
98
99 -- | Load the session into the manager
100 loadSession :: Handler b SessionManager SessionManager
101 loadSession = do
d787344 @mightybyte Change Handler's MonadState instance to use state of v rather than Sn…
mightybyte authored
102 SessionManager r <- get
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
103 r' <- liftSnap $ load r
104 return $ SessionManager r'
105
Something went wrong with that request. Please try again.