module Yesod.Session.Manager.Load
  ( loadSessionMaybe
  , loadSession
  , loadNothing
  , Load (..)
  , didSessionLoad
  , loadedData
  ) where

import Internal.Prelude

import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Map.Strict qualified as Map
import Session.Key
import Session.Timing.Math
import Session.Timing.Options
import Time
import Yesod.Core (SessionMap)
import Yesod.Session.Manager
import Yesod.Session.Options
import Yesod.Session.SessionType
import Yesod.Session.Storage.Operation

data Load a = Load
  { forall a. Load a -> Maybe a
got :: Maybe a
  -- ^ The original session that was loaded from the database, if any
  , forall a. Load a -> UTCTime
time :: UTCTime
  -- ^ The time at which the session was loaded
  }
  deriving stock (Load a -> Load a -> Bool
(Load a -> Load a -> Bool)
-> (Load a -> Load a -> Bool) -> Eq (Load a)
forall a. Eq a => Load a -> Load a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Load a -> Load a -> Bool
== :: Load a -> Load a -> Bool
$c/= :: forall a. Eq a => Load a -> Load a -> Bool
/= :: Load a -> Load a -> Bool
Eq, Int -> Load a -> ShowS
[Load a] -> ShowS
Load a -> String
(Int -> Load a -> ShowS)
-> (Load a -> String) -> ([Load a] -> ShowS) -> Show (Load a)
forall a. Show a => Int -> Load a -> ShowS
forall a. Show a => [Load a] -> ShowS
forall a. Show a => Load a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Load a -> ShowS
showsPrec :: Int -> Load a -> ShowS
$cshow :: forall a. Show a => Load a -> String
show :: Load a -> String
$cshowList :: forall a. Show a => [Load a] -> ShowS
showList :: [Load a] -> ShowS
Show)

didSessionLoad :: Load a -> Bool
didSessionLoad :: forall a. Load a -> Bool
didSessionLoad = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (Load a -> Maybe a) -> Load a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.got)

loadedData :: Load Session -> SessionMap
loadedData :: Load Session -> SessionMap
loadedData Load Session
load =
  SessionMap
-> (Session -> SessionMap) -> Maybe Session -> SessionMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SessionMap
forall k a. Map k a
Map.empty (.map) Load Session
load.got

loadSession :: Monad m => SessionManager tx m -> SessionKey -> m (Load Session)
loadSession :: forall (m :: * -> *) (tx :: * -> *).
Monad m =>
SessionManager tx m -> SessionKey -> m (Load Session)
loadSession SessionManager {Options tx m
options :: Options tx m
$sel:options:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> Options tx m
options, forall a. StorageOperation a -> tx a
storage :: forall a. StorageOperation a -> tx a
$sel:storage:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> forall a. StorageOperation a -> tx a
storage, forall a. tx a -> m a
runDB :: forall a. tx a -> m a
$sel:runDB:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> forall a. tx a -> m a
runDB} SessionKey
sessionKey = do
  UTCTime
now <- Options tx m
options.clock
  Maybe Session
got <-
    MaybeT m Session -> m (Maybe Session)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Session -> m (Maybe Session))
-> MaybeT m Session -> m (Maybe Session)
forall a b. (a -> b) -> a -> b
$ do
      Session
session <-
        m (Maybe Session) -> MaybeT m Session
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Session) -> MaybeT m Session)
-> m (Maybe Session) -> MaybeT m Session
forall a b. (a -> b) -> a -> b
$ tx (Maybe Session) -> m (Maybe Session)
forall a. tx a -> m a
runDB (tx (Maybe Session) -> m (Maybe Session))
-> tx (Maybe Session) -> m (Maybe Session)
forall a b. (a -> b) -> a -> b
$ StorageOperation (Maybe Session) -> tx (Maybe Session)
forall a. StorageOperation a -> tx a
storage (StorageOperation (Maybe Session) -> tx (Maybe Session))
-> StorageOperation (Maybe Session) -> tx (Maybe Session)
forall a b. (a -> b) -> a -> b
$ SessionKey -> StorageOperation (Maybe Session)
forall result.
(result ~ Maybe Session) =>
SessionKey -> StorageOperation result
GetSession SessionKey
sessionKey
      m (Maybe ()) -> MaybeT m ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ()) -> MaybeT m ()) -> m (Maybe ()) -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> m (Maybe ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe () -> m (Maybe ())) -> Maybe () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Timeout NominalDiffTime -> UTCTime -> Time UTCTime -> Bool
isExpired Options tx m
options.timing.timeout UTCTime
now Session
session.time
      Session -> MaybeT m Session
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Session
session
  Load Session -> m (Load Session)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Load {Maybe Session
$sel:got:Load :: Maybe Session
got :: Maybe Session
got, $sel:time:Load :: UTCTime
time = UTCTime
now}

loadNothing :: Monad m => SessionManager tx m -> m (Load a)
loadNothing :: forall (m :: * -> *) (tx :: * -> *) a.
Monad m =>
SessionManager tx m -> m (Load a)
loadNothing SessionManager {Options tx m
$sel:options:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> Options tx m
options :: Options tx m
options} = do
  UTCTime
now <- Options tx m
options.clock
  Load a -> m (Load a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Load {$sel:got:Load :: Maybe a
got = Maybe a
forall a. Maybe a
Nothing, $sel:time:Load :: UTCTime
time = UTCTime
now}

loadSessionMaybe
  :: Monad m => SessionManager tx m -> Maybe SessionKey -> m (Load Session)
loadSessionMaybe :: forall (m :: * -> *) (tx :: * -> *).
Monad m =>
SessionManager tx m -> Maybe SessionKey -> m (Load Session)
loadSessionMaybe SessionManager tx m
sm = m (Load Session)
-> (SessionKey -> m (Load Session))
-> Maybe SessionKey
-> m (Load Session)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SessionManager tx m -> m (Load Session)
forall (m :: * -> *) (tx :: * -> *) a.
Monad m =>
SessionManager tx m -> m (Load a)
loadNothing SessionManager tx m
sm) (SessionManager tx m -> SessionKey -> m (Load Session)
forall (m :: * -> *) (tx :: * -> *).
Monad m =>
SessionManager tx m -> SessionKey -> m (Load Session)
loadSession SessionManager tx m
sm)