module Yesod.Session.Storage.Yesod
(
makeSessionBackend'
, SessionConfiguration' (..)
, makeSessionBackend''
, 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}
)
}