Skip to content

HTTPS clone URL

Subversion checkout URL

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