module Snap.Snaplet.Session
  ( SessionManager
  , withSession
  , commitSession
  , setInSession
  , getFromSession
  , deleteFromSession
  , csrfToken
  , sessionToList
  , resetSession
  , touchSession

  -- * Utilities Exported For Convenience
  , 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
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Wrap around a handler, committing any changes in the session at the end
--
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


------------------------------------------------------------------------------
-- | Commit changes to session within the current request cycle
--
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


------------------------------------------------------------------------------
-- | Set a key-value pair in the current session
--
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'


------------------------------------------------------------------------------
-- | Get a key from the current session
--
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


------------------------------------------------------------------------------
-- | Remove a key from the current session
--
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'


------------------------------------------------------------------------------
-- | Returns a CSRF Token unique to the current session
--
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


------------------------------------------------------------------------------
-- | Return session contents as an association list
--
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


------------------------------------------------------------------------------
-- | Deletes the session cookie, effectively resetting the session
--
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'


------------------------------------------------------------------------------
-- | Touch the session so the timeout gets refreshed
--
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'


------------------------------------------------------------------------------
-- | Load the session into the manager
--
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'