{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Spock.SessionActions
    ( SessionId
    , sessionRegenerateId, getSessionId, readSession, writeSession
    , modifySession, modifySession', modifyReadSession, mapAllSessions, clearAllSessions
    )
where

import Web.Spock.Action
import Web.Spock.Internal.Monad ()
import Web.Spock.Internal.SessionManager
import Web.Spock.Internal.Types

-- | Regenerate the users sessionId. This preserves all stored data. Call this prior
-- to logging in a user to prevent session fixation attacks.
sessionRegenerateId :: SpockActionCtx ctx conn sess st ()
sessionRegenerateId :: SpockActionCtx ctx conn sess st ()
sessionRegenerateId =
    ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) ()
 -> SpockActionCtx ctx conn sess st ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$
    ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
-> (SessionManager
      (ActionCtxT () (WebStateM conn sess st)) conn sess st
    -> ActionCtxT () (WebStateM conn sess st) ())
-> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> m ()
sm_regenerateSessionId

-- | Get the current users sessionId. Note that this ID should only be
-- shown to it's owner as otherwise sessions can be hijacked.
getSessionId :: SpockActionCtx ctx conn sess st SessionId
getSessionId :: SpockActionCtx ctx conn sess st SessionId
getSessionId =
    ()
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> SpockActionCtx ctx conn sess st SessionId
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) SessionId
 -> SpockActionCtx ctx conn sess st SessionId)
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> SpockActionCtx ctx conn sess st SessionId
forall a b. (a -> b) -> a -> b
$
    ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
-> (SessionManager
      (ActionCtxT () (WebStateM conn sess st)) conn sess st
    -> ActionCtxT () (WebStateM conn sess st) SessionId)
-> ActionCtxT () (WebStateM conn sess st) SessionId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> ActionCtxT () (WebStateM conn sess st) SessionId
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> m SessionId
sm_getSessionId

-- | Write to the current session. Note that all data is stored on the server.
-- The user only reciedes a sessionId to be identified.
writeSession :: forall sess ctx conn st. sess -> SpockActionCtx ctx conn sess st ()
writeSession :: sess -> SpockActionCtx ctx conn sess st ()
writeSession sess
d =
    do SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr <- ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
       ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) ()
 -> SpockActionCtx ctx conn sess st ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$ SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> sess -> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> sess -> m ()
sm_writeSession SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr sess
d

-- | Modify the stored session
modifySession :: (sess -> sess) -> SpockActionCtx ctx conn sess st ()
modifySession :: (sess -> sess) -> SpockActionCtx ctx conn sess st ()
modifySession sess -> sess
f =
    (sess -> (sess, ())) -> SpockActionCtx ctx conn sess st ()
forall sess a ctx conn st.
(sess -> (sess, a)) -> SpockActionCtx ctx conn sess st a
modifySession' ((sess -> (sess, ())) -> SpockActionCtx ctx conn sess st ())
-> (sess -> (sess, ())) -> SpockActionCtx ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$ \sess
sess -> (sess -> sess
f sess
sess, ())

-- | Modify the stored session and return a value
modifySession' :: (sess -> (sess, a)) -> SpockActionCtx ctx conn sess st a
modifySession' :: (sess -> (sess, a)) -> SpockActionCtx ctx conn sess st a
modifySession' sess -> (sess, a)
f =
    do SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr <- ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
       ()
-> ActionCtxT () (WebStateM conn sess st) a
-> SpockActionCtx ctx conn sess st a
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) a
 -> SpockActionCtx ctx conn sess st a)
-> ActionCtxT () (WebStateM conn sess st) a
-> SpockActionCtx ctx conn sess st a
forall a b. (a -> b) -> a -> b
$ SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> (sess -> (sess, a)) -> ActionCtxT () (WebStateM conn sess st) a
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st
-> forall a. (sess -> (sess, a)) -> m a
sm_modifySession SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr sess -> (sess, a)
f

-- | Modify the stored session and return the new value after modification
modifyReadSession :: (sess -> sess) -> SpockActionCtx ctx conn sess st sess
modifyReadSession :: (sess -> sess) -> SpockActionCtx ctx conn sess st sess
modifyReadSession sess -> sess
f =
    (sess -> (sess, sess)) -> SpockActionCtx ctx conn sess st sess
forall sess a ctx conn st.
(sess -> (sess, a)) -> SpockActionCtx ctx conn sess st a
modifySession' ((sess -> (sess, sess)) -> SpockActionCtx ctx conn sess st sess)
-> (sess -> (sess, sess)) -> SpockActionCtx ctx conn sess st sess
forall a b. (a -> b) -> a -> b
$ \sess
sess ->
        let x :: sess
x = sess -> sess
f sess
sess
        in (sess
x, sess
x)

-- | Read the stored session
readSession :: SpockActionCtx ctx conn sess st sess
readSession :: SpockActionCtx ctx conn sess st sess
readSession =
    ()
-> ActionCtxT () (WebStateM conn sess st) sess
-> SpockActionCtx ctx conn sess st sess
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) sess
 -> SpockActionCtx ctx conn sess st sess)
-> ActionCtxT () (WebStateM conn sess st) sess
-> SpockActionCtx ctx conn sess st sess
forall a b. (a -> b) -> a -> b
$
    do SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr <- ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
       SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> ActionCtxT () (WebStateM conn sess st) sess
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> m sess
sm_readSession SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr

-- | Globally delete all existing sessions. This is useful for example if you want
-- to require all users to relogin
clearAllSessions :: SpockActionCtx ctx conn sess st ()
clearAllSessions :: SpockActionCtx ctx conn sess st ()
clearAllSessions =
    do SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr <- ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
       ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) ()
 -> SpockActionCtx ctx conn sess st ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$ SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> MonadIO (ActionCtxT () (WebStateM conn sess st)) =>
   ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> MonadIO m => m ()
sm_clearAllSessions SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr

-- | Apply a transformation to all sessions. Be careful with this, as this
-- may cause many STM transaction retries.
mapAllSessions :: (forall m. Monad m => sess -> m sess) -> SpockActionCtx ctx conn sess st ()
mapAllSessions :: (forall (m :: * -> *). Monad m => sess -> m sess)
-> SpockActionCtx ctx conn sess st ()
mapAllSessions forall (m :: * -> *). Monad m => sess -> m sess
f =
    do SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr <- ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
       ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) ()
 -> SpockActionCtx ctx conn sess st ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> SpockActionCtx ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$ SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> (forall (m :: * -> *). Monad m => sess -> m sess)
-> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st
-> (forall (n :: * -> *). Monad n => sess -> n sess) -> m ()
sm_mapSessions SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
mgr forall (m :: * -> *). Monad m => sess -> m sess
f