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
    forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b SessionManager
l forall b. Handler b SessionManager ()
commitSession
    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 <- forall b. Handler b SessionManager SessionManager
loadSession
    forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    let r' :: a
r' = forall r. ISessionManager r => Text -> Text -> r -> r
SM.insert Text
k Text
v a
r
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    let r' :: a
r' = forall r. ISessionManager r => Text -> r -> r
SM.delete Text
k a
r
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ 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) <- forall b. Handler b SessionManager SessionManager
loadSession
    forall s (m :: * -> *). MonadState s m => s -> m ()
put SessionManager
mgr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    a
r' <- forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap forall a b. (a -> b) -> a -> b
$ forall r. ISessionManager r => r -> Snap r
SM.reset a
r
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ 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 <- forall b. Handler b SessionManager SessionManager
loadSession
    let r' :: a
r' = forall r. ISessionManager r => r -> r
SM.touch a
r
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *). MonadState s m => m s
get
    a
r' <- forall (m :: * -> *) a. MonadSnap m => Snap a -> m a
liftSnap forall a b. (a -> b) -> a -> b
$ forall r. ISessionManager r => r -> Snap r
load a
r
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ISessionManager a => a -> SessionManager
SessionManager a
r'