module Yesod.Session.Storage.Yesod
  ( -- * More general
    makeSessionBackend'
  , SessionConfiguration' (..)

    -- * Extra general
  , makeSessionBackend''

    -- * Reëxport
  , SessionBackend
  ) where

import Internal.Prelude

import Data.Text.Encoding (encodeUtf8)
import Session.Key
import Yesod.Core.Types (SessionBackend (..))
import Yesod.Session.Cookie.Logic
import Yesod.Session.Cookie.Reading
import Yesod.Session.Manager
import Yesod.Session.Manager.Load
import Yesod.Session.Manager.Save
import Yesod.Session.Options
import Yesod.Session.Storage.Operation

data SessionConfiguration' session = forall tx.
  Monad tx =>
  SessionConfiguration'
  { ()
storage :: forall a. StorageOperation a -> tx a
  , ()
options :: Options tx IO
  , ()
runDB :: forall a. tx a -> IO a
  }

makeSessionBackend' :: SessionConfiguration' session -> IO SessionBackend
makeSessionBackend' :: forall {k} (session :: k).
SessionConfiguration' session -> IO SessionBackend
makeSessionBackend' SessionConfiguration' {$sel:options:SessionConfiguration' :: ()
options = Options tx IO
options :: Options tx m, forall a. tx a -> IO a
forall a. StorageOperation a -> tx a
$sel:storage:SessionConfiguration' :: ()
$sel:runDB:SessionConfiguration' :: ()
storage :: forall a. StorageOperation a -> tx a
runDB :: forall a. tx a -> IO a
..} = do
  SessionKeyManager tx
keyManager :: SessionKeyManager tx <-
    Randomization tx -> SessionKeyManager tx
forall (m :: * -> *).
Monad m =>
Randomization m -> SessionKeyManager m
makeSessionKeyManager (Randomization tx -> SessionKeyManager tx)
-> IO (Randomization tx) -> IO (SessionKeyManager tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options tx IO
options.randomization
  let sessionManager :: SessionManager tx IO
sessionManager = SessionManager {SessionKeyManager tx
keyManager :: SessionKeyManager tx
$sel:keyManager:SessionManager :: SessionKeyManager tx
keyManager, StorageOperation a -> tx a
forall a. StorageOperation a -> tx a
storage :: forall a. StorageOperation a -> tx a
$sel:storage:SessionManager :: forall a. StorageOperation a -> tx a
storage, Options tx IO
options :: Options tx IO
$sel:options:SessionManager :: Options tx IO
options, tx a -> IO a
forall a. tx a -> IO a
runDB :: forall a. tx a -> IO a
$sel:runDB:SessionManager :: forall a. tx a -> IO a
runDB}
  SessionBackend -> IO SessionBackend
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionBackend -> IO SessionBackend)
-> SessionBackend -> IO SessionBackend
forall a b. (a -> b) -> a -> b
$ SessionManager tx IO -> SessionBackend
forall (tx :: * -> *).
Monad tx =>
SessionManager tx IO -> SessionBackend
makeSessionBackend'' SessionManager tx IO
sessionManager

makeSessionBackend'' :: Monad tx => SessionManager tx IO -> SessionBackend
makeSessionBackend'' :: forall (tx :: * -> *).
Monad tx =>
SessionManager tx IO -> SessionBackend
makeSessionBackend'' sessionManager :: SessionManager tx IO
sessionManager@SessionManager {Options tx IO
$sel:options:SessionManager :: forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> Options tx m
options :: Options tx IO
options} =
  SessionBackend
    { sbLoadSession :: Request -> IO (SessionMap, SaveSession)
sbLoadSession = \Request
req -> do
        let
          cookie :: Maybe ByteString
cookie = ByteString -> Request -> Maybe ByteString
findSessionKey (Text -> ByteString
encodeUtf8 Options tx IO
options.cookieName) Request
req
          sessionKeyMaybe :: Maybe SessionKey
sessionKeyMaybe = Maybe ByteString
cookie Maybe ByteString
-> (ByteString -> Maybe SessionKey) -> Maybe SessionKey
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SessionManager tx IO -> ByteString -> Maybe SessionKey
forall (tx :: * -> *) (m :: * -> *).
SessionManager tx m -> ByteString -> Maybe SessionKey
checkedSessionKeyFromCookieValue SessionManager tx IO
sessionManager

        Load Session
load <- SessionManager tx IO -> Maybe SessionKey -> IO (Load Session)
forall (m :: * -> *) (tx :: * -> *).
Monad m =>
SessionManager tx m -> Maybe SessionKey -> m (Load Session)
loadSessionMaybe SessionManager tx IO
sessionManager Maybe SessionKey
sessionKeyMaybe

        (SessionMap, SaveSession) -> IO (SessionMap, SaveSession)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( Load Session -> SessionMap
loadedData Load Session
load
          , \SessionMap
newData -> do
              SaveResult Session
save <- SessionManager tx IO
-> Load Session -> SessionMap -> IO (SaveResult Session)
forall (tx :: * -> *) (m :: * -> *).
Monad tx =>
SessionManager tx m
-> Load Session -> SessionMap -> m (SaveResult Session)
saveSession SessionManager tx IO
sessionManager Load Session
load SessionMap
newData
              [Header] -> IO [Header]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Header] -> IO [Header]) -> [Header] -> IO [Header]
forall a b. (a -> b) -> a -> b
$ Options tx IO -> CookieContext -> [Header]
forall (tx :: * -> *) (m :: * -> *).
Options tx m -> CookieContext -> [Header]
setCookie Options tx IO
options CookieContext {Maybe ByteString
cookie :: Maybe ByteString
$sel:cookie:CookieContext :: Maybe ByteString
cookie, $sel:load:CookieContext :: Maybe Session
load = Load Session
load.got, SaveResult Session
save :: SaveResult Session
$sel:save:CookieContext :: SaveResult Session
save}
          )
    }