module Yesod.Session.KeyRotation
  ( rotateSessionKey
  , assignSessionKeyRotation
  ) where

import Internal.Prelude

import Embedding
import Session.KeyRotation
import Yesod.Core (HandlerSite, MonadHandler (liftHandler), getYesod)
import Yesod.Session.Embedding.Options

-- | Indicate whether the current session key should be rotated
--
-- The key rotation does not occur immediately;
-- this action only places a value into the session map.
--
-- Later calls to 'assignSessionKeyRotation' on the same handler will
-- override earlier calls.
--
-- At the end of the request handler, if the value is 'Just',
-- the session key will be rotated.
--
-- The session variable set by this function is then discarded
-- and is not persisted across requests.
assignSessionKeyRotation
  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m))
  => Maybe KeyRotation
  -- ^ 'Just' to rotate, or 'Nothing' to cancel any previous
  --   request for rotation and restore the default behavior
  -> m ()
assignSessionKeyRotation :: forall (m :: * -> *).
(MonadHandler m, HasSessionEmbeddings (HandlerSite m)) =>
Maybe KeyRotation -> m ()
assignSessionKeyRotation Maybe KeyRotation
kr = do
  Maybe SessionEmbeddings
mEmbedding <- HandlerSite m -> Maybe SessionEmbeddings
forall a. HasSessionEmbeddings a => a -> Maybe SessionEmbeddings
getSessionEmbeddings (HandlerSite m -> Maybe SessionEmbeddings)
-> m (HandlerSite m) -> m (Maybe SessionEmbeddings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
  case Maybe SessionEmbeddings
mEmbedding of
    Maybe SessionEmbeddings
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just SessionEmbeddings
embedding -> HandlerFor (HandlerSite m) () -> m ()
forall a. HandlerFor (HandlerSite m) a -> m a
forall (m :: * -> *) a.
MonadHandler m =>
HandlerFor (HandlerSite m) a -> m a
liftHandler (HandlerFor (HandlerSite m) () -> m ())
-> HandlerFor (HandlerSite m) () -> m ()
forall a b. (a -> b) -> a -> b
$ Embedding (MapOperations Text ByteString) () KeyRotation
-> Maybe KeyRotation -> HandlerFor (HandlerSite m) ()
forall (con :: (* -> *) -> Constraint) (m :: * -> *) e a.
con m =>
Embedding con e a -> Maybe a -> m ()
embed SessionEmbeddings
embedding.keyRotation Maybe KeyRotation
kr

rotateSessionKey
  :: (MonadHandler m, HasSessionEmbeddings (HandlerSite m)) => m ()
rotateSessionKey :: forall (m :: * -> *).
(MonadHandler m, HasSessionEmbeddings (HandlerSite m)) =>
m ()
rotateSessionKey = Maybe KeyRotation -> m ()
forall (m :: * -> *).
(MonadHandler m, HasSessionEmbeddings (HandlerSite m)) =>
Maybe KeyRotation -> m ()
assignSessionKeyRotation (KeyRotation -> Maybe KeyRotation
forall a. a -> Maybe a
Just KeyRotation
RotateSessionKey)