module Yesod.Session.Embedding.Options
  ( SessionEmbeddings (..)
  , HasSessionEmbeddings (..)
  ) where

import Internal.Prelude

import Session.Freeze
import Session.KeyRotation
import Yesod.Session.Embedding.Map

data SessionEmbeddings = SessionEmbeddings
  { SessionEmbeddings -> SessionMapEmbedding KeyRotation
keyRotation :: SessionMapEmbedding KeyRotation
  -- ^ How to represent a key rotation instruction in the session data;
  --   see 'Yesod.Session.Persist.assignSessionKeyRotation'
  , SessionEmbeddings -> SessionMapEmbedding SessionFreeze
freeze :: SessionMapEmbedding SessionFreeze
  -- ^ How to represent a freeze instruction in the session data;
  --   see 'Yesod.Session.Persist.assignSessionFreeze'
  }

class HasSessionEmbeddings a where
  getSessionEmbeddings :: a -> Maybe SessionEmbeddings

instance HasSessionEmbeddings SessionEmbeddings where
  getSessionEmbeddings :: SessionEmbeddings -> Maybe SessionEmbeddings
getSessionEmbeddings SessionEmbeddings
x = SessionEmbeddings -> Maybe SessionEmbeddings
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionEmbeddings
x