module Yesod.Session.Persist.Storage
  ( persistentStorage
  , SessionPersistence (..)

    -- * Persistent reëxports
  , PersistEntity
  , PersistEntityBackend
  , SafeToInsert
  , ConnectionPool
  ) where

import Internal.Prelude

import Database.Persist (Key, PersistRecordBackend)
import Database.Persist qualified as Persist
import Database.Persist.Class
  ( PersistEntity
  , PersistEntityBackend
  , SafeToInsert
  )
import Database.Persist.Sql (ConnectionPool)
import Session.Key
import Yesod.Session.SessionType
import Yesod.Session.Storage.Exceptions
import Yesod.Session.Storage.Operation

-- | Mapping between 'Yesod.Session.Persist.Session' and
--   a Persistent entity of your choice
data SessionPersistence backend record m = ( PersistRecordBackend record backend
                                           , Persist.PersistStoreWrite backend
                                           , SafeToInsert record
                                           ) =>
  SessionPersistence
  { forall backend record (m :: * -> *).
SessionPersistence backend record m -> SessionKey -> Key record
databaseKey :: SessionKey -> Key record
  , forall backend record (m :: * -> *).
SessionPersistence backend record m -> Session -> record
toDatabase :: Session -> record
  , forall backend record (m :: * -> *).
SessionPersistence backend record m -> record -> Session
fromDatabase :: record -> Session
  , forall backend record (m :: * -> *).
SessionPersistence backend record m
-> forall a. ReaderT backend IO a -> m a
runDB :: forall a. ReaderT backend IO a -> m a
  }

persistentStorage
  :: forall record backend result m
   . (PersistRecordBackend record backend, Persist.PersistStoreWrite backend)
  => SessionPersistence backend record m
  -> StorageOperation result
  -> ReaderT backend IO result
persistentStorage :: forall record backend result (m :: * -> *).
(PersistRecordBackend record backend, PersistStoreWrite backend) =>
SessionPersistence backend record m
-> StorageOperation result -> ReaderT backend IO result
persistentStorage sp :: SessionPersistence backend record m
sp@SessionPersistence {} = \case
  GetSession SessionKey
sessionKey ->
    (record -> Session) -> Maybe record -> Maybe Session
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SessionPersistence backend record m
sp.fromDatabase (Maybe record -> Maybe Session)
-> ReaderT backend IO (Maybe record)
-> ReaderT backend IO (Maybe Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key record -> ReaderT backend IO (Maybe record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
Persist.get (SessionPersistence backend record m
sp.databaseKey SessionKey
sessionKey)
  DeleteSession SessionKey
sessionKey ->
    Key record -> ReaderT backend IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
Persist.delete (Key record -> ReaderT backend IO ())
-> Key record -> ReaderT backend IO ()
forall a b. (a -> b) -> a -> b
$ SessionPersistence backend record m
sp.databaseKey SessionKey
sessionKey
  InsertSession Session
session ->
    SessionPersistence backend record m
-> StorageOperation (Maybe Session)
-> ReaderT backend IO (Maybe Session)
forall record backend result (m :: * -> *).
(PersistRecordBackend record backend, PersistStoreWrite backend) =>
SessionPersistence backend record m
-> StorageOperation result -> ReaderT backend IO result
persistentStorage SessionPersistence backend record m
sp (SessionKey -> StorageOperation (Maybe Session)
forall result.
(result ~ Maybe Session) =>
SessionKey -> StorageOperation result
GetSession Session
session.key) ReaderT backend IO (Maybe Session)
-> (Maybe Session -> ReaderT backend IO result)
-> ReaderT backend IO result
forall a b.
ReaderT backend IO a
-> (a -> ReaderT backend IO b) -> ReaderT backend IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Session
Nothing -> ReaderT backend IO (Key record) -> ReaderT backend IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend IO (Key record) -> ReaderT backend IO ())
-> ReaderT backend IO (Key record) -> ReaderT backend IO ()
forall a b. (a -> b) -> a -> b
$ record -> ReaderT backend IO (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 SafeToInsert record) =>
record -> ReaderT backend m (Key record)
Persist.insert (record -> ReaderT backend IO (Key record))
-> record -> ReaderT backend IO (Key record)
forall a b. (a -> b) -> a -> b
$ SessionPersistence backend record m
sp.toDatabase Session
session
      Just Session
_ -> StorageException -> ReaderT backend IO result
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwWithCallStack StorageException
SessionAlreadyExists
  ReplaceSession Session
session ->
    let key :: Key record
key = SessionPersistence backend record m
sp.databaseKey Session
session.key
    in  Key record -> ReaderT backend IO (Maybe record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
Persist.get Key record
key ReaderT backend IO (Maybe record)
-> (Maybe record -> ReaderT backend IO result)
-> ReaderT backend IO result
forall a b.
ReaderT backend IO a
-> (a -> ReaderT backend IO b) -> ReaderT backend IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe record
Nothing -> StorageException -> ReaderT backend IO result
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwWithCallStack StorageException
SessionDoesNotExist
          Just record
_old -> ReaderT backend IO () -> ReaderT backend IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend IO () -> ReaderT backend IO ())
-> ReaderT backend IO () -> ReaderT backend IO ()
forall a b. (a -> b) -> a -> b
$ Key record -> record -> ReaderT backend IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
Persist.replace Key record
key (record -> ReaderT backend IO ())
-> record -> ReaderT backend IO ()
forall a b. (a -> b) -> a -> b
$ SessionPersistence backend record m
sp.toDatabase Session
session