module Yesod.Session.Manager.Save
  ( saveSession
  ) where

import Internal.Prelude

import Comparison
import Control.Monad.State qualified as State
import Embedding
import Session.Freeze
import Session.KeyRotation
import Yesod.Core (SessionMap)
import Yesod.Session.Embedding.Options
import Yesod.Session.Manager
import Yesod.Session.Manager.Load
import Yesod.Session.Options
import Yesod.Session.SaveResult
import Yesod.Session.SessionType
import Yesod.Session.Storage.Operation
import Yesod.Session.Storage.Save qualified as Storage

-- | Save the session on the storage backend
--
-- A 'SessionLoad' given by 'loadSession' is expected besides
-- the new contents of the session.
--
-- Returns 'Nothing' if the session was empty and didn't need to be saved.
-- Note that this does /not/ necessarily means that nothing was done.
-- If you ask for a session key to be rotated and clear every other sesssion
-- variable, then 'saveSession' will delete the older session but will
-- avoid creating a new, empty one.
saveSession
  :: Monad tx
  => SessionManager tx m
  -> Load Session
  -> SessionMap
  -> m (SaveResult Session)
saveSession :: forall (tx :: * -> *) (m :: * -> *).
Monad tx =>
SessionManager tx m
-> Load Session -> SessionMap -> m (SaveResult Session)
saveSession 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, SessionKeyManager tx
keyManager :: SessionKeyManager tx
$sel:keyManager:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> SessionKeyManager tx
keyManager, 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} Load Session
load SessionMap
outputData =
  tx (SaveResult Session) -> m (SaveResult Session)
forall a. tx a -> m a
runDB
    (tx (SaveResult Session) -> m (SaveResult Session))
-> tx (SaveResult Session) -> m (SaveResult Session)
forall a b. (a -> b) -> a -> b
$ case Maybe SessionFreeze
freeze of
      Just SessionFreeze
FreezeSessionForCurrentRequest -> SaveResult Session -> tx (SaveResult Session)
forall a. a -> tx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SaveResult Session
forall a. SaveResult a
Frozen
      Maybe SessionFreeze
Nothing ->
        case (Load Session
load.got, Maybe KeyRotation
rotation) of
          (Just Session
s, Just KeyRotation
RotateSessionKey) -> do
            StorageOperation () -> tx ()
forall a. StorageOperation a -> tx a
storage (StorageOperation () -> tx ()) -> StorageOperation () -> tx ()
forall a b. (a -> b) -> a -> b
$ SessionKey -> StorageOperation ()
forall result.
(result ~ ()) =>
SessionKey -> StorageOperation result
DeleteSession Session
s.key
            SaveResult Session
-> (Session -> SaveResult Session)
-> Maybe Session
-> SaveResult Session
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SaveResult Session
forall a. SaveResult a
Deleted Session -> SaveResult Session
forall a. a -> SaveResult a
Saved (Maybe Session -> SaveResult Session)
-> tx (Maybe Session) -> tx (SaveResult Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Session -> tx (Maybe Session)
save Maybe Session
forall a. Maybe a
Nothing
          (Maybe Session, Maybe KeyRotation)
_ -> SaveResult Session
-> (Session -> SaveResult Session)
-> Maybe Session
-> SaveResult Session
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SaveResult Session
forall a. SaveResult a
NoChange Session -> SaveResult Session
forall a. a -> SaveResult a
Saved (Maybe Session -> SaveResult Session)
-> tx (Maybe Session) -> tx (SaveResult Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Session -> tx (Maybe Session)
save Load Session
load.got
 where
  ((Maybe KeyRotation
requestedRotation, Maybe SessionFreeze
freeze), SessionMap
newInfo) =
    (State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
 -> SessionMap
 -> ((Maybe KeyRotation, Maybe SessionFreeze), SessionMap))
-> SessionMap
-> State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
-> ((Maybe KeyRotation, Maybe SessionFreeze), SessionMap)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
-> SessionMap
-> ((Maybe KeyRotation, Maybe SessionFreeze), SessionMap)
forall s a. State s a -> s -> (a, s)
State.runState SessionMap
outputData
      (State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
 -> ((Maybe KeyRotation, Maybe SessionFreeze), SessionMap))
-> State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
-> ((Maybe KeyRotation, Maybe SessionFreeze), SessionMap)
forall a b. (a -> b) -> a -> b
$ (,)
      (Maybe KeyRotation
 -> Maybe SessionFreeze -> (Maybe KeyRotation, Maybe SessionFreeze))
-> StateT SessionMap Identity (Maybe KeyRotation)
-> StateT
     SessionMap
     Identity
     (Maybe SessionFreeze -> (Maybe KeyRotation, Maybe SessionFreeze))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Embedding (MapOperations Text ByteString) () KeyRotation
-> StateT SessionMap Identity (Maybe KeyRotation)
forall (m :: * -> *) (con :: (* -> *) -> Constraint) e a.
(Functor m, con m) =>
Embedding con e a -> m (Maybe a)
extractIgnoringError Options tx m
options.embedding.keyRotation
      StateT
  SessionMap
  Identity
  (Maybe SessionFreeze -> (Maybe KeyRotation, Maybe SessionFreeze))
-> StateT SessionMap Identity (Maybe SessionFreeze)
-> State SessionMap (Maybe KeyRotation, Maybe SessionFreeze)
forall a b.
StateT SessionMap Identity (a -> b)
-> StateT SessionMap Identity a -> StateT SessionMap Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Embedding (MapOperations Text ByteString) () SessionFreeze
-> StateT SessionMap Identity (Maybe SessionFreeze)
forall (m :: * -> *) (con :: (* -> *) -> Constraint) e a.
(Functor m, con m) =>
Embedding con e a -> m (Maybe a)
extractIgnoringError Options tx m
options.embedding.freeze

  autoRotation :: Maybe KeyRotation
autoRotation =
    Options tx m
options.keyRotationTrigger
      Comparison {$sel:old:Comparison :: SessionMap
old = Load Session -> SessionMap
loadedData Load Session
load, $sel:new:Comparison :: SessionMap
new = SessionMap
newInfo}

  rotation :: Maybe KeyRotation
rotation = Maybe KeyRotation
requestedRotation Maybe KeyRotation -> Maybe KeyRotation -> Maybe KeyRotation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe KeyRotation
autoRotation

  save :: Maybe Session -> tx (Maybe Session)
save Maybe Session
oldSessionMaybe =
    Options tx m
-> (forall a. StorageOperation a -> tx a)
-> SessionKeyManager tx
-> UTCTime
-> SessionMap
-> Maybe Session
-> tx (Maybe Session)
forall (tx :: * -> *) (m :: * -> *).
Monad tx =>
Options tx m
-> (forall a. StorageOperation a -> tx a)
-> SessionKeyManager tx
-> UTCTime
-> SessionMap
-> Maybe Session
-> tx (Maybe Session)
Storage.save Options tx m
options StorageOperation a -> tx a
forall a. StorageOperation a -> tx a
storage SessionKeyManager tx
keyManager Load Session
load.time SessionMap
newInfo Maybe Session
oldSessionMaybe