module Yesod.Session.Options
  ( Options (..)
  , defaultOptions
  , hoistOptions
  ) where

import Internal.Prelude

import Comparison
import Data.Time qualified as Time
import Randomization
import Session.KeyRotation
import Session.Timing.Options
import Session.TransportSecurity
import Time
import Yesod.Core (SessionMap)
import Yesod.Session.Embedding.Map
import Yesod.Session.Embedding.Options

-- | Settings that have defaults
--
-- See 'defaultOptions'.
data Options tx m = Options
  { forall (tx :: * -> *) (m :: * -> *). Options tx m -> Text
cookieName :: Text
  -- ^ The name of cookie where the session key will be saved
  , forall (tx :: * -> *) (m :: * -> *).
Options tx m -> TimingOptions NominalDiffTime
timing :: TimingOptions NominalDiffTime
  -- ^ Various time duration settings
  , forall (tx :: * -> *) (m :: * -> *).
Options tx m -> TransportSecurity
transportSecurity :: TransportSecurity
  -- ^ Whether cookies require HTTPS
  , forall (tx :: * -> *) (m :: * -> *).
Options tx m -> SessionEmbeddings
embedding :: SessionEmbeddings
  -- ^ How special session management indicators get smuggled through a 'SessionMap'
  , forall (tx :: * -> *) (m :: * -> *). Options tx m -> m UTCTime
clock :: m UTCTime
  -- ^ How to determine the current time;
  --   you can change this to a fake for testing
  , forall (tx :: * -> *) (m :: * -> *).
Options tx m -> m (Randomization tx)
randomization :: m (Randomization tx)
  -- ^ Generator of random byte strings, used to contrive session keys
  , forall (tx :: * -> *) (m :: * -> *).
Options tx m -> Comparison SessionMap -> Maybe KeyRotation
keyRotationTrigger :: Comparison SessionMap -> Maybe KeyRotation
  -- ^ At the end of request handling, compare old session data to new
  --   session data to determine whether a key rotation should be performed
  }

-- | Default options
--
--   - cookieName = @"session-key"@
--   - timing = 'defaultTimingOptions'
--   - transportSecurity = 'AllowPlaintextTranport' (change this in production)
--   - embedding.keyRotation = @'showReadKeyEmbedding' "session-key-rotation"@
--   - embedding.freeze = @'showReadKeyEmbedding' "session-freeze"@
--   - clock = 'Time.getCurrentTime'
--   - randomization = 'defaultRandomization'
--   - keyRotationTrigger = 'const' 'Nothing'
defaultOptions :: Options IO IO
defaultOptions :: Options IO IO
defaultOptions =
  Options
    { $sel:cookieName:Options :: Text
cookieName = Text
"session-key"
    , $sel:timing:Options :: TimingOptions NominalDiffTime
timing = TimingOptions NominalDiffTime
defaultTimingOptions
    , $sel:transportSecurity:Options :: TransportSecurity
transportSecurity = TransportSecurity
AllowPlaintextTranport
    , $sel:clock:Options :: IO UTCTime
clock = IO UTCTime
Time.getCurrentTime
    , $sel:randomization:Options :: IO (Randomization IO)
randomization = IO (Randomization IO)
defaultRandomization
    , $sel:embedding:Options :: SessionEmbeddings
embedding =
        SessionEmbeddings
          { $sel:keyRotation:SessionEmbeddings :: SessionMapEmbedding KeyRotation
keyRotation = Text -> SessionMapEmbedding KeyRotation
forall a k.
(Read a, Show a) =>
k -> Embedding (MapOperations k ByteString) () a
showReadKeyEmbedding Text
"session-key-rotation"
          , $sel:freeze:SessionEmbeddings :: SessionMapEmbedding SessionFreeze
freeze = Text -> SessionMapEmbedding SessionFreeze
forall a k.
(Read a, Show a) =>
k -> Embedding (MapOperations k ByteString) () a
showReadKeyEmbedding Text
"session-freeze"
          }
    , $sel:keyRotationTrigger:Options :: Comparison SessionMap -> Maybe KeyRotation
keyRotationTrigger = Maybe KeyRotation -> Comparison SessionMap -> Maybe KeyRotation
forall a b. a -> b -> a
const Maybe KeyRotation
forall a. Maybe a
Nothing
    }

hoistOptions
  :: Functor m2
  => (forall a. tx1 a -> tx2 a)
  -> (forall a. m1 a -> m2 a)
  -> Options tx1 m1
  -> Options tx2 m2
hoistOptions :: forall (m2 :: * -> *) (tx1 :: * -> *) (tx2 :: * -> *)
       (m1 :: * -> *).
Functor m2 =>
(forall a. tx1 a -> tx2 a)
-> (forall a. m1 a -> m2 a) -> Options tx1 m1 -> Options tx2 m2
hoistOptions forall a. tx1 a -> tx2 a
f forall a. m1 a -> m2 a
g Options {m1 UTCTime
m1 (Randomization tx1)
Text
TransportSecurity
TimingOptions NominalDiffTime
SessionEmbeddings
Comparison SessionMap -> Maybe KeyRotation
$sel:cookieName:Options :: forall (tx :: * -> *) (m :: * -> *). Options tx m -> Text
$sel:timing:Options :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> TimingOptions NominalDiffTime
$sel:transportSecurity:Options :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> TransportSecurity
$sel:embedding:Options :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> SessionEmbeddings
$sel:clock:Options :: forall (tx :: * -> *) (m :: * -> *). Options tx m -> m UTCTime
$sel:randomization:Options :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> m (Randomization tx)
$sel:keyRotationTrigger:Options :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> Comparison SessionMap -> Maybe KeyRotation
cookieName :: Text
timing :: TimingOptions NominalDiffTime
transportSecurity :: TransportSecurity
embedding :: SessionEmbeddings
clock :: m1 UTCTime
randomization :: m1 (Randomization tx1)
keyRotationTrigger :: Comparison SessionMap -> Maybe KeyRotation
..} =
  Options
    { $sel:clock:Options :: m2 UTCTime
clock = m1 UTCTime -> m2 UTCTime
forall a. m1 a -> m2 a
g m1 UTCTime
clock
    , $sel:randomization:Options :: m2 (Randomization tx2)
randomization = (forall a. tx1 a -> tx2 a)
-> Randomization tx1 -> Randomization tx2
forall (m :: * -> *) (m' :: * -> *).
(forall a. m a -> m' a) -> Randomization m -> Randomization m'
hoistRandomization tx1 a -> tx2 a
forall a. tx1 a -> tx2 a
f (Randomization tx1 -> Randomization tx2)
-> m2 (Randomization tx1) -> m2 (Randomization tx2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m1 (Randomization tx1) -> m2 (Randomization tx1)
forall a. m1 a -> m2 a
g m1 (Randomization tx1)
randomization
    , Text
TransportSecurity
TimingOptions NominalDiffTime
SessionEmbeddings
Comparison SessionMap -> Maybe KeyRotation
$sel:cookieName:Options :: Text
$sel:timing:Options :: TimingOptions NominalDiffTime
$sel:transportSecurity:Options :: TransportSecurity
$sel:embedding:Options :: SessionEmbeddings
$sel:keyRotationTrigger:Options :: Comparison SessionMap -> Maybe KeyRotation
cookieName :: Text
timing :: TimingOptions NominalDiffTime
transportSecurity :: TransportSecurity
embedding :: SessionEmbeddings
keyRotationTrigger :: Comparison SessionMap -> Maybe KeyRotation
..
    }