Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 106 lines (79 sloc) 2.72 kb
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
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
13 , csrfToken
14 , sessionToList
15 , resetSession
16 , touchSession
17
18 ) where
19
20 import Control.Monad.Reader
21 import Control.Monad.State
22 import Data.ByteString (ByteString)
23 import qualified Data.ByteString.Char8 as B
24 import Data.Record.Label
25 import Data.Serialize (Serialize)
26 import Data.Text (Text)
27
28 import Snap.Snaplet
29 import Snap.Snaplet.Session.SecureCookie
30 import Snap.Types
31
32 import Snap.Snaplet.Session.SessionManager
33 ( SessionManager(..), ISessionManager(..) )
34 import qualified Snap.Snaplet.Session.SessionManager as SM
35
36
37
38 -- | Wrap around a handler, committing any changes in the session at the end
39 withSession :: (b :-> Snaplet SessionManager) -> Handler b e a -> Handler b e a
40 withSession l h = do
41 a <- h
bab2579 @mightybyte Renamed withChild and withSibling, and removed withBase.
mightybyte authored
42 withTop l commitSession
b0fadff @mightybyte Alpha release of new snaplet infrastructure.
mightybyte authored
43 return a
44
45
46 -- | Commit changes to session within the current request cycle
47 commitSession :: Handler b SessionManager ()
48 commitSession = do
49 mgr@(SessionManager b) <- loadSession
50 liftSnap $ commit b
51
52
53 -- | Set a key-value pair in the current session
54 setInSession :: Text -> Text -> Handler b SessionManager ()
55 setInSession k v = do
56 mgr@(SessionManager r) <- loadSession
57 let r' = SM.insert k v r
58 put $ SessionManager r'
59
60
61 -- | Get a key from the current session
62 getFromSession :: Text -> Handler b SessionManager (Maybe Text)
63 getFromSession k = do
64 mgr@(SessionManager r) <- loadSession
65 return $ SM.lookup k r
66
67
68 -- | Returns a CSRF Token unique to the current session
69 csrfToken :: Handler b SessionManager Text
70 csrfToken = do
71 mgr@(SessionManager r) <- loadSession
72 put mgr
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
79 mgr@(SessionManager r) <- loadSession
80 return $ SM.toList r
81
82
83 -- | Deletes the session cookie, effectively resetting the session
84 resetSession :: Handler b SessionManager ()
85 resetSession = do
86 mgr@(SessionManager r) <- loadSession
87 r' <- liftSnap $ SM.reset r
88 put $ SessionManager r'
89
90
91 -- | Touch the session so the timeout gets refreshed
92 touchSession :: Handler b SessionManager ()
93 touchSession = do
94 mgr@(SessionManager r) <- loadSession
95 let r' = SM.touch r
96 put $ SessionManager r'
97
98
99 -- | Load the session into the manager
100 loadSession :: Handler b SessionManager SessionManager
101 loadSession = do
102 mgr@(SessionManager r) <- get
103 r' <- liftSnap $ load r
104 return $ SessionManager r'
105
Something went wrong with that request. Please try again.