module Snap.Snaplet.Session
( SessionManager
, withSession
, commitSession
, setInSession
, getFromSession
, deleteFromSession
, csrfToken
, sessionToList
, resetSession
, touchSession
, module Snap.Snaplet.Session.Common
, module Snap.Snaplet.Session.SecureCookie
) where
import Control.Monad.State
import Data.Text (Text)
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Session.Common
import Snap.Snaplet.Session.SecureCookie
import Snap.Snaplet.Session.SessionManager
( ISessionManager(..), SessionManager(..) )
import qualified Snap.Snaplet.Session.SessionManager as SM
withSession :: SnapletLens b SessionManager
-> Handler b v a
-> Handler b v a
withSession :: forall b v a.
SnapletLens b SessionManager -> Handler b v a -> Handler b v a
withSession SnapletLens b SessionManager
l Handler b v a
h = do
a
a <- Handler b v a
h
SnapletLens b SessionManager
-> Handler b SessionManager () -> Handler b v ()
forall b v' a v.
SnapletLens b v' -> Handler b v' a -> Handler b v a
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b SessionManager
l Handler b SessionManager ()
forall b. Handler b SessionManager ()
commitSession
a -> Handler b v a
forall a. a -> Handler b v a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
commitSession :: Handler b SessionManager ()
commitSession :: forall b. Handler b SessionManager ()
commitSession = do
SessionManager a
b <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
Snap () -> Handler b SessionManager ()
forall a. Snap a -> Handler b SessionManager a
forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap (Snap () -> Handler b SessionManager ())
-> Snap () -> Handler b SessionManager ()
forall a b. (a -> b) -> a -> b
$ a -> Snap ()
forall r. ISessionManager r => r -> Snap ()
commit a
b
setInSession :: Text -> Text -> Handler b SessionManager ()
setInSession :: forall b. Text -> Text -> Handler b SessionManager ()
setInSession Text
k Text
v = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
let r' :: a
r' = Text -> Text -> a -> a
forall r. ISessionManager r => Text -> Text -> r -> r
SM.insert Text
k Text
v a
r
SessionManager -> Handler b SessionManager ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SessionManager -> Handler b SessionManager ())
-> SessionManager -> Handler b SessionManager ()
forall a b. (a -> b) -> a -> b
$ a -> SessionManager
forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'
getFromSession :: Text -> Handler b SessionManager (Maybe Text)
getFromSession :: forall b. Text -> Handler b SessionManager (Maybe Text)
getFromSession Text
k = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
Maybe Text -> Handler b SessionManager (Maybe Text)
forall a. a -> Handler b SessionManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Handler b SessionManager (Maybe Text))
-> Maybe Text -> Handler b SessionManager (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> a -> Maybe Text
forall r. ISessionManager r => Text -> r -> Maybe Text
SM.lookup Text
k a
r
deleteFromSession :: Text -> Handler b SessionManager ()
deleteFromSession :: forall b. Text -> Handler b SessionManager ()
deleteFromSession Text
k = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
let r' :: a
r' = Text -> a -> a
forall r. ISessionManager r => Text -> r -> r
SM.delete Text
k a
r
SessionManager -> Handler b SessionManager ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SessionManager -> Handler b SessionManager ())
-> SessionManager -> Handler b SessionManager ()
forall a b. (a -> b) -> a -> b
$ a -> SessionManager
forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'
csrfToken :: Handler b SessionManager Text
csrfToken :: forall b. Handler b SessionManager Text
csrfToken = do
mgr :: SessionManager
mgr@(SessionManager a
r) <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
SessionManager -> Handler b SessionManager ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SessionManager
mgr
Text -> Handler b SessionManager Text
forall a. a -> Handler b SessionManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Handler b SessionManager Text)
-> Text -> Handler b SessionManager Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall r. ISessionManager r => r -> Text
SM.csrf a
r
sessionToList :: Handler b SessionManager [(Text, Text)]
sessionToList :: forall b. Handler b SessionManager [(Text, Text)]
sessionToList = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
[(Text, Text)] -> Handler b SessionManager [(Text, Text)]
forall a. a -> Handler b SessionManager a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Text)] -> Handler b SessionManager [(Text, Text)])
-> [(Text, Text)] -> Handler b SessionManager [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ a -> [(Text, Text)]
forall r. ISessionManager r => r -> [(Text, Text)]
SM.toList a
r
resetSession :: Handler b SessionManager ()
resetSession :: forall b. Handler b SessionManager ()
resetSession = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
a
r' <- Snap a -> Handler b SessionManager a
forall a. Snap a -> Handler b SessionManager a
forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap (Snap a -> Handler b SessionManager a)
-> Snap a -> Handler b SessionManager a
forall a b. (a -> b) -> a -> b
$ a -> Snap a
forall r. ISessionManager r => r -> Snap r
SM.reset a
r
SessionManager -> Handler b SessionManager ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SessionManager -> Handler b SessionManager ())
-> SessionManager -> Handler b SessionManager ()
forall a b. (a -> b) -> a -> b
$ a -> SessionManager
forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'
touchSession :: Handler b SessionManager ()
touchSession :: forall b. Handler b SessionManager ()
touchSession = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall b. Handler b SessionManager SessionManager
loadSession
let r' :: a
r' = a -> a
forall r. ISessionManager r => r -> r
SM.touch a
r
SessionManager -> Handler b SessionManager ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SessionManager -> Handler b SessionManager ())
-> SessionManager -> Handler b SessionManager ()
forall a b. (a -> b) -> a -> b
$ a -> SessionManager
forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'
loadSession :: Handler b SessionManager SessionManager
loadSession :: forall b. Handler b SessionManager SessionManager
loadSession = do
SessionManager a
r <- Handler b SessionManager SessionManager
forall s (m :: * -> *). MonadState s m => m s
get
a
r' <- Snap a -> Handler b SessionManager a
forall a. Snap a -> Handler b SessionManager a
forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap (Snap a -> Handler b SessionManager a)
-> Snap a -> Handler b SessionManager a
forall a b. (a -> b) -> a -> b
$ a -> Snap a
forall r. ISessionManager r => r -> Snap r
load a
r
SessionManager -> Handler b SessionManager SessionManager
forall a. a -> Handler b SessionManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionManager -> Handler b SessionManager SessionManager)
-> SessionManager -> Handler b SessionManager SessionManager
forall a b. (a -> b) -> a -> b
$ a -> SessionManager
forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'