Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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