{-# LANGUAGE RankNTypes #-}

-- | Operations requiring server-side session storage. Client-cookie and
-- disabled backends do not provide this capability.
module Web.Spock.SessionActions.Server
  ( ServerSessionManager, getServerSessionManager, requireServerSessionManager,
    clearAllSessions, mapAllSessions
  ) where

import Control.Exception (throwIO)
import Control.Monad.IO.Class (liftIO)
import Web.Spock.Action (runInContext)
import Web.Spock.Internal.Monad ()
import Web.Spock.Internal.Types

-- | Inspect whether the configured, enabled backend provides server storage.
-- This does not load or allocate a visitor session.
getServerSessionManager :: SpockActionCtx ctx conn sess st
  (Maybe (ServerSessionManager (SpockActionCtx () conn sess st) sess))
getServerSessionManager :: forall ctx conn sess st.
SpockActionCtx
  ctx
  conn
  sess
  st
  (Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess))
getServerSessionManager = SessionManager (SpockActionCtx () conn sess st) conn sess st
-> Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st
-> Maybe (ServerSessionManager m sess)
sm_serverSessions (SessionManager (SpockActionCtx () conn sess st) conn sess st
 -> Maybe
      (ServerSessionManager (SpockActionCtx () conn sess st) sess))
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (SessionManager (SpockActionCtx () conn sess st) conn sess st)
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (Maybe
        (ServerSessionManager (SpockActionCtx () conn sess st) sess))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SessionManager (SpockActionCtx () conn sess st) conn sess st)
ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SpockSessionManager
     (SpockConn (ActionCtxT ctx (WebStateM conn sess st)))
     (SpockSession (ActionCtxT ctx (WebStateM conn sess st)))
     (SpockState (ActionCtxT ctx (WebStateM conn sess st))))
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr

-- | Require server storage, throwing 'ServerSessionsRequired' if unavailable.
requireServerSessionManager :: SpockActionCtx ctx conn sess st
  (ServerSessionManager (SpockActionCtx () conn sess st) sess)
requireServerSessionManager :: forall ctx conn sess st.
SpockActionCtx
  ctx
  conn
  sess
  st
  (ServerSessionManager (SpockActionCtx () conn sess st) sess)
requireServerSessionManager = SpockActionCtx
  ctx
  conn
  sess
  st
  (Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess))
forall ctx conn sess st.
SpockActionCtx
  ctx
  conn
  sess
  st
  (Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess))
getServerSessionManager SpockActionCtx
  ctx
  conn
  sess
  st
  (Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess))
-> (Maybe
      (ServerSessionManager (SpockActionCtx () conn sess st) sess)
    -> ActionCtxT
         ctx
         (WebStateM conn sess st)
         (ServerSessionManager (SpockActionCtx () conn sess st) sess))
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall a b.
ActionCtxT ctx (WebStateM conn sess st) a
-> (a -> ActionCtxT ctx (WebStateM conn sess st) b)
-> ActionCtxT ctx (WebStateM conn sess st) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionCtxT
  ctx
  (WebStateM conn sess st)
  (ServerSessionManager (SpockActionCtx () conn sess st) sess)
-> (ServerSessionManager (SpockActionCtx () conn sess st) sess
    -> ActionCtxT
         ctx
         (WebStateM conn sess st)
         (ServerSessionManager (SpockActionCtx () conn sess st) sess))
-> Maybe
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO (ServerSessionManager (SpockActionCtx () conn sess st) sess)
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall a. IO a -> ActionCtxT ctx (WebStateM conn sess st) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ServerSessionManager (SpockActionCtx () conn sess st) sess)
 -> ActionCtxT
      ctx
      (WebStateM conn sess st)
      (ServerSessionManager (SpockActionCtx () conn sess st) sess))
-> IO (ServerSessionManager (SpockActionCtx () conn sess st) sess)
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall a b. (a -> b) -> a -> b
$ SessionError
-> IO (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO SessionError
ServerSessionsRequired) ServerSessionManager (SpockActionCtx () conn sess st) sess
-> ActionCtxT
     ctx
     (WebStateM conn sess st)
     (ServerSessionManager (SpockActionCtx () conn sess st) sess)
forall a. a -> ActionCtxT ctx (WebStateM conn sess st) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Delete every session from this server backend.
clearAllSessions :: ServerSessionManager (SpockActionCtx () conn sess st) sess -> SpockActionCtx ctx conn sess st ()
clearAllSessions :: forall conn sess st ctx.
ServerSessionManager (SpockActionCtx () conn sess st) sess
-> SpockActionCtx ctx conn sess st ()
clearAllSessions ServerSessionManager (SpockActionCtx () conn sess st) sess
manager = ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> ActionCtxT ctx (WebStateM 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) ()
 -> ActionCtxT ctx (WebStateM conn sess st) ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> ActionCtxT ctx (WebStateM conn sess st) ()
forall a b. (a -> b) -> a -> b
$ ServerSessionManager (SpockActionCtx () conn sess st) sess
-> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) sess. ServerSessionManager m sess -> m ()
ssm_clearAllSessions ServerSessionManager (SpockActionCtx () conn sess st) sess
manager

-- | Atomically transform stored sessions. Transaction callbacks may be retried.
mapAllSessions :: ServerSessionManager (SpockActionCtx () conn sess st) sess ->
  (forall m. Monad m => sess -> m sess) -> SpockActionCtx ctx conn sess st ()
mapAllSessions :: forall conn sess st ctx.
ServerSessionManager (SpockActionCtx () conn sess st) sess
-> (forall (m :: * -> *). Monad m => sess -> m sess)
-> SpockActionCtx ctx conn sess st ()
mapAllSessions ServerSessionManager (SpockActionCtx () conn sess st) sess
manager forall (m :: * -> *). Monad m => sess -> m sess
f = ()
-> ActionCtxT () (WebStateM conn sess st) ()
-> ActionCtxT ctx (WebStateM 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) ()
 -> ActionCtxT ctx (WebStateM conn sess st) ())
-> ActionCtxT () (WebStateM conn sess st) ()
-> ActionCtxT ctx (WebStateM conn sess st) ()
forall a b. (a -> b) -> a -> b
$ ServerSessionManager (SpockActionCtx () conn sess st) sess
-> (forall (m :: * -> *). Monad m => sess -> m sess)
-> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) sess.
ServerSessionManager m sess
-> (forall (n :: * -> *). Monad n => sess -> n sess) -> m ()
ssm_mapSessions ServerSessionManager (SpockActionCtx () conn sess st) sess
manager sess -> n sess
forall (m :: * -> *). Monad m => sess -> m sess
f