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