Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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