{-# OPTIONS_GHC -fno-warn-orphans #-}
module Web.ServerSession.Backend.Acid.Internal
( SessionIdToSession
, AuthIdToSessionId
, ServerSessionAcidState(..)
, emptyState
, removeSessionFromAuthId
, insertSessionForAuthId
, getSession
, deleteSession
, deleteAllSessionsOfAuthId
, insertSession
, replaceSession
, GetSession
, DeleteSession
, DeleteAllSessionsOfAuthId
, InsertSession
, ReplaceSession
, AcidStorage(..)
) where
import Control.Applicative as A
import Control.Monad.Reader (ask)
import Control.Monad.State (get, modify, put)
import Data.Acid
import Data.Acid.Advanced
import Data.SafeCopy
import Data.Typeable (Typeable)
import qualified Control.Exception as E
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Web.ServerSession.Core as SS
import qualified Web.ServerSession.Core.Internal as SSI
type SessionIdToSession sess = HM.HashMap (SS.SessionId sess) (SS.Session sess)
type AuthIdToSessionId sess = HM.HashMap SS.AuthId (S.Set (SS.SessionId sess))
data ServerSessionAcidState sess =
ServerSessionAcidState
{ ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession :: !(SessionIdToSession sess)
, ServerSessionAcidState sess -> AuthIdToSessionId sess
authIdToSessionId :: !(AuthIdToSessionId sess)
} deriving (Typeable)
emptyState :: ServerSessionAcidState sess
emptyState :: ServerSessionAcidState sess
emptyState = SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState SessionIdToSession sess
forall k v. HashMap k v
HM.empty AuthIdToSessionId sess
forall k v. HashMap k v
HM.empty
removeSessionFromAuthId
:: SS.SessionId sess
-> Maybe SS.AuthId
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
removeSessionFromAuthId :: SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
removeSessionFromAuthId SessionId sess
sid = (AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> (AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> Maybe AuthId
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthIdToSessionId sess -> AuthIdToSessionId sess
forall a. a -> a
id AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
removeIt
where
removeIt :: AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
removeIt AuthId
authId AuthIdToSessionId sess
aits
| Set (SessionId sess) -> Bool
forall a. Set a -> Bool
S.null Set (SessionId sess)
newSet = AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete AuthId
authId AuthIdToSessionId sess
aits
| Bool
otherwise = AuthId
-> Set (SessionId sess)
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert AuthId
authId Set (SessionId sess)
newSet AuthIdToSessionId sess
aits
where newSet :: Set (SessionId sess)
newSet = Set (SessionId sess)
-> (Set (SessionId sess) -> Set (SessionId sess))
-> Maybe (Set (SessionId sess))
-> Set (SessionId sess)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (SessionId sess)
forall a. Set a
S.empty (SessionId sess -> Set (SessionId sess) -> Set (SessionId sess)
forall a. Ord a => a -> Set a -> Set a
S.delete SessionId sess
sid) (AuthId -> AuthIdToSessionId sess -> Maybe (Set (SessionId sess))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup AuthId
authId AuthIdToSessionId sess
aits)
insertSessionForAuthId
:: SS.SessionId sess
-> Maybe SS.AuthId
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
insertSessionForAuthId :: SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
insertSessionForAuthId SessionId sess
sid = (AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> (AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> Maybe AuthId
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AuthIdToSessionId sess -> AuthIdToSessionId sess
forall a. a -> a
id ((AuthId
-> Set (SessionId sess)
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess)
-> Set (SessionId sess)
-> AuthId
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Set (SessionId sess)
-> Set (SessionId sess) -> Set (SessionId sess))
-> AuthId
-> Set (SessionId sess)
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith Set (SessionId sess)
-> Set (SessionId sess) -> Set (SessionId sess)
forall a. Ord a => Set a -> Set a -> Set a
S.union) (SessionId sess -> Set (SessionId sess)
forall a. a -> Set a
S.singleton SessionId sess
sid))
instance SafeCopy SS.SessionMap where
putCopy :: SessionMap -> Contained Put
putCopy = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put)
-> (SessionMap -> Put) -> SessionMap -> Contained Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, AuthId)] -> Put
forall a. SafeCopy a => a -> Put
safePut ([(Text, AuthId)] -> Put)
-> (SessionMap -> [(Text, AuthId)]) -> SessionMap -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text AuthId -> [(Text, AuthId)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text AuthId -> [(Text, AuthId)])
-> (SessionMap -> HashMap Text AuthId)
-> SessionMap
-> [(Text, AuthId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionMap -> HashMap Text AuthId
SS.unSessionMap
getCopy :: Contained (Get SessionMap)
getCopy = Get SessionMap -> Contained (Get SessionMap)
forall a. a -> Contained a
contain (Get SessionMap -> Contained (Get SessionMap))
-> Get SessionMap -> Contained (Get SessionMap)
forall a b. (a -> b) -> a -> b
$ HashMap Text AuthId -> SessionMap
SS.SessionMap (HashMap Text AuthId -> SessionMap)
-> ([(Text, AuthId)] -> HashMap Text AuthId)
-> [(Text, AuthId)]
-> SessionMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, AuthId)] -> HashMap Text AuthId
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, AuthId)] -> SessionMap)
-> Get [(Text, AuthId)] -> Get SessionMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> Get [(Text, AuthId)]
forall a. SafeCopy a => Get a
safeGet
instance Typeable sess => SafeCopy (SS.SessionId sess) where
putCopy :: SessionId sess -> Contained Put
putCopy = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put)
-> (SessionId sess -> Put) -> SessionId sess -> Contained Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Put
forall a. SafeCopy a => a -> Put
safePut (Text -> Put) -> (SessionId sess -> Text) -> SessionId sess -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> Text
forall sess. SessionId sess -> Text
SSI.unS
getCopy :: Contained (Get (SessionId sess))
getCopy = Get (SessionId sess) -> Contained (Get (SessionId sess))
forall a. a -> Contained a
contain (Get (SessionId sess) -> Contained (Get (SessionId sess)))
-> Get (SessionId sess) -> Contained (Get (SessionId sess))
forall a b. (a -> b) -> a -> b
$ Text -> SessionId sess
forall sess. Text -> SessionId sess
SSI.S (Text -> SessionId sess) -> Get Text -> Get (SessionId sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall a. SafeCopy a => Get a
safeGet
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (SS.Session sess) where
putCopy :: Session sess -> Contained Put
putCopy (SS.Session SessionId sess
key Maybe AuthId
authId Decomposed sess
data_ UTCTime
createdAt UTCTime
accessedAt) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ do
UTCTime -> Put
put_t <- PutM (UTCTime -> Put)
forall a. SafeCopy a => PutM (a -> Put)
getSafePut
SessionId sess -> Put
forall a. SafeCopy a => a -> Put
safePut SessionId sess
key
Maybe AuthId -> Put
forall a. SafeCopy a => a -> Put
safePut Maybe AuthId
authId
Decomposed sess -> Put
forall a. SafeCopy a => a -> Put
safePut Decomposed sess
data_
UTCTime -> Put
put_t UTCTime
createdAt
UTCTime -> Put
put_t UTCTime
accessedAt
getCopy :: Contained (Get (Session sess))
getCopy = Get (Session sess) -> Contained (Get (Session sess))
forall a. a -> Contained a
contain (Get (Session sess) -> Contained (Get (Session sess)))
-> Get (Session sess) -> Contained (Get (Session sess))
forall a b. (a -> b) -> a -> b
$ do
Get UTCTime
get_t <- Get (Get UTCTime)
forall a. SafeCopy a => Get (Get a)
getSafeGet
SessionId sess
-> Maybe AuthId
-> Decomposed sess
-> UTCTime
-> UTCTime
-> Session sess
forall sess.
SessionId sess
-> Maybe AuthId
-> Decomposed sess
-> UTCTime
-> UTCTime
-> Session sess
SS.Session
(SessionId sess
-> Maybe AuthId
-> Decomposed sess
-> UTCTime
-> UTCTime
-> Session sess)
-> Get (SessionId sess)
-> Get
(Maybe AuthId
-> Decomposed sess -> UTCTime -> UTCTime -> Session sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (SessionId sess)
forall a. SafeCopy a => Get a
safeGet
Get
(Maybe AuthId
-> Decomposed sess -> UTCTime -> UTCTime -> Session sess)
-> Get (Maybe AuthId)
-> Get (Decomposed sess -> UTCTime -> UTCTime -> Session sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe AuthId)
forall a. SafeCopy a => Get a
safeGet
Get (Decomposed sess -> UTCTime -> UTCTime -> Session sess)
-> Get (Decomposed sess)
-> Get (UTCTime -> UTCTime -> Session sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Decomposed sess)
forall a. SafeCopy a => Get a
safeGet
Get (UTCTime -> UTCTime -> Session sess)
-> Get UTCTime -> Get (UTCTime -> Session sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get UTCTime
get_t
Get (UTCTime -> Session sess) -> Get UTCTime -> Get (Session sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get UTCTime
get_t
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ServerSessionAcidState sess) where
putCopy :: ServerSessionAcidState sess -> Contained Put
putCopy (ServerSessionAcidState SessionIdToSession sess
sits AuthIdToSessionId sess
aits) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ do
[(SessionId sess, Session sess)] -> Put
forall a. SafeCopy a => a -> Put
safePut (SessionIdToSession sess -> [(SessionId sess, Session sess)]
forall k v. HashMap k v -> [(k, v)]
HM.toList SessionIdToSession sess
sits)
[(AuthId, Set (SessionId sess))] -> Put
forall a. SafeCopy a => a -> Put
safePut (AuthIdToSessionId sess -> [(AuthId, Set (SessionId sess))]
forall k v. HashMap k v -> [(k, v)]
HM.toList AuthIdToSessionId sess
aits)
getCopy :: Contained (Get (ServerSessionAcidState sess))
getCopy = Get (ServerSessionAcidState sess)
-> Contained (Get (ServerSessionAcidState sess))
forall a. a -> Contained a
contain (Get (ServerSessionAcidState sess)
-> Contained (Get (ServerSessionAcidState sess)))
-> Get (ServerSessionAcidState sess)
-> Contained (Get (ServerSessionAcidState sess))
forall a b. (a -> b) -> a -> b
$
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState
(SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess)
-> Get (SessionIdToSession sess)
-> Get (AuthIdToSessionId sess -> ServerSessionAcidState sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(SessionId sess, Session sess)] -> SessionIdToSession sess
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(SessionId sess, Session sess)] -> SessionIdToSession sess)
-> Get [(SessionId sess, Session sess)]
-> Get (SessionIdToSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(SessionId sess, Session sess)]
forall a. SafeCopy a => Get a
safeGet)
Get (AuthIdToSessionId sess -> ServerSessionAcidState sess)
-> Get (AuthIdToSessionId sess)
-> Get (ServerSessionAcidState sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(AuthId, Set (SessionId sess))] -> AuthIdToSessionId sess
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AuthId, Set (SessionId sess))] -> AuthIdToSessionId sess)
-> Get [(AuthId, Set (SessionId sess))]
-> Get (AuthIdToSessionId sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(AuthId, Set (SessionId sess))]
forall a. SafeCopy a => Get a
safeGet)
getSession
:: SS.Storage (AcidStorage sess)
=> SS.SessionId sess
-> Query (ServerSessionAcidState sess) (Maybe (SS.Session sess))
getSession :: SessionId sess
-> Query (ServerSessionAcidState sess) (Maybe (Session sess))
getSession SessionId sess
sid = SessionId sess
-> HashMap (SessionId sess) (Session sess) -> Maybe (Session sess)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SessionId sess
sid (HashMap (SessionId sess) (Session sess) -> Maybe (Session sess))
-> (ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess))
-> ServerSessionAcidState sess
-> Maybe (Session sess)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess)
forall sess. ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession (ServerSessionAcidState sess -> Maybe (Session sess))
-> Query
(ServerSessionAcidState sess) (ServerSessionAcidState sess)
-> Query (ServerSessionAcidState sess) (Maybe (Session sess))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query (ServerSessionAcidState sess) (ServerSessionAcidState sess)
forall r (m :: * -> *). MonadReader r m => m r
ask
deleteSession
:: SS.Storage (AcidStorage sess)
=> SS.SessionId sess
-> Update (ServerSessionAcidState sess) ()
deleteSession :: SessionId sess -> Update (ServerSessionAcidState sess) ()
deleteSession SessionId sess
sid =
(ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ())
-> (ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall a b. (a -> b) -> a -> b
$ \ServerSessionAcidState sess
state ->
let oldSession :: Maybe (Session sess)
oldSession = SessionId sess
-> HashMap (SessionId sess) (Session sess) -> Maybe (Session sess)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SessionId sess
sid (ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess)
forall sess. ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession ServerSessionAcidState sess
state)
newSessionIdToSession :: HashMap (SessionId sess) (Session sess)
newSessionIdToSession = SessionId sess
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete SessionId sess
sid (ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess)
forall sess. ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession ServerSessionAcidState sess
state)
newAuthIdToSessionId :: AuthIdToSessionId sess
newAuthIdToSessionId = SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall sess.
SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
removeSessionFromAuthId SessionId sess
sid Maybe AuthId
mauthId (AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall a b. (a -> b) -> a -> b
$ ServerSessionAcidState sess -> AuthIdToSessionId sess
forall sess. ServerSessionAcidState sess -> AuthIdToSessionId sess
authIdToSessionId ServerSessionAcidState sess
state
where mauthId :: Maybe AuthId
mauthId = Maybe (Session sess)
oldSession Maybe (Session sess)
-> (Session sess -> Maybe AuthId) -> Maybe AuthId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session sess -> Maybe AuthId
forall sess. Session sess -> Maybe AuthId
SS.sessionAuthId
in HashMap (SessionId sess) (Session sess)
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState HashMap (SessionId sess) (Session sess)
newSessionIdToSession AuthIdToSessionId sess
newAuthIdToSessionId
deleteAllSessionsOfAuthId
:: SS.Storage (AcidStorage sess)
=> SS.AuthId
-> Update (ServerSessionAcidState sess) ()
deleteAllSessionsOfAuthId :: AuthId -> Update (ServerSessionAcidState sess) ()
deleteAllSessionsOfAuthId AuthId
authId =
(ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ())
-> (ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall a b. (a -> b) -> a -> b
$ \ServerSessionAcidState sess
state ->
let sessionIds :: Maybe (Set (SessionId sess))
sessionIds = AuthId
-> HashMap AuthId (Set (SessionId sess))
-> Maybe (Set (SessionId sess))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup AuthId
authId (ServerSessionAcidState sess
-> HashMap AuthId (Set (SessionId sess))
forall sess. ServerSessionAcidState sess -> AuthIdToSessionId sess
authIdToSessionId ServerSessionAcidState sess
state)
newAuthIdToSessionId :: HashMap AuthId (Set (SessionId sess))
newAuthIdToSessionId = AuthId
-> HashMap AuthId (Set (SessionId sess))
-> HashMap AuthId (Set (SessionId sess))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete AuthId
authId (ServerSessionAcidState sess
-> HashMap AuthId (Set (SessionId sess))
forall sess. ServerSessionAcidState sess -> AuthIdToSessionId sess
authIdToSessionId ServerSessionAcidState sess
state)
newSessionIdToSession :: HashMap (SessionId sess) (Session sess)
newSessionIdToSession = (HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess))
-> (Set (SessionId sess)
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess))
-> Maybe (Set (SessionId sess))
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall a. a -> a
id Set (SessionId sess)
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall v.
Set (SessionId sess)
-> HashMap (SessionId sess) v -> HashMap (SessionId sess) v
removeSession Maybe (Set (SessionId sess))
sessionIds (HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess))
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall a b. (a -> b) -> a -> b
$ ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess)
forall sess. ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession ServerSessionAcidState sess
state
where removeSession :: Set (SessionId sess)
-> HashMap (SessionId sess) v -> HashMap (SessionId sess) v
removeSession = (HashMap (SessionId sess) v
-> HashMap (SessionId sess) () -> HashMap (SessionId sess) v)
-> HashMap (SessionId sess) ()
-> HashMap (SessionId sess) v
-> HashMap (SessionId sess) v
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap (SessionId sess) v
-> HashMap (SessionId sess) () -> HashMap (SessionId sess) v
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference (HashMap (SessionId sess) ()
-> HashMap (SessionId sess) v -> HashMap (SessionId sess) v)
-> (Set (SessionId sess) -> HashMap (SessionId sess) ())
-> Set (SessionId sess)
-> HashMap (SessionId sess) v
-> HashMap (SessionId sess) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SessionId sess, ())] -> HashMap (SessionId sess) ()
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(SessionId sess, ())] -> HashMap (SessionId sess) ())
-> (Set (SessionId sess) -> [(SessionId sess, ())])
-> Set (SessionId sess)
-> HashMap (SessionId sess) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SessionId sess -> (SessionId sess, ()))
-> [SessionId sess] -> [(SessionId sess, ())]
forall a b. (a -> b) -> [a] -> [b]
map ((SessionId sess -> () -> (SessionId sess, ()))
-> () -> SessionId sess -> (SessionId sess, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ()) ([SessionId sess] -> [(SessionId sess, ())])
-> (Set (SessionId sess) -> [SessionId sess])
-> Set (SessionId sess)
-> [(SessionId sess, ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (SessionId sess) -> [SessionId sess]
forall a. Set a -> [a]
S.toList
in HashMap (SessionId sess) (Session sess)
-> HashMap AuthId (Set (SessionId sess))
-> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState HashMap (SessionId sess) (Session sess)
newSessionIdToSession HashMap AuthId (Set (SessionId sess))
newAuthIdToSessionId
insertSession
:: SS.Storage (AcidStorage sess)
=> SS.Session sess
-> Update (ServerSessionAcidState sess) ()
insertSession :: Session sess -> Update (ServerSessionAcidState sess) ()
insertSession Session sess
session = do
let insertSess :: HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
insertSess HashMap (SessionId sess) (Session sess)
sits =
case SessionId sess
-> HashMap (SessionId sess) (Session sess) -> Maybe (Session sess)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SessionId sess
sid HashMap (SessionId sess) (Session sess)
sits of
Maybe (Session sess)
Nothing -> SessionId sess
-> Session sess
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert SessionId sess
sid Session sess
session HashMap (SessionId sess) (Session sess)
sits
Just Session sess
old -> StorageException (AcidStorage sess)
-> HashMap (SessionId sess) (Session sess)
forall sess a.
Storage (AcidStorage sess) =>
StorageException (AcidStorage sess) -> a
throwAS (StorageException (AcidStorage sess)
-> HashMap (SessionId sess) (Session sess))
-> StorageException (AcidStorage sess)
-> HashMap (SessionId sess) (Session sess)
forall a b. (a -> b) -> a -> b
$ Session (SessionData (AcidStorage sess))
-> Session (SessionData (AcidStorage sess))
-> StorageException (AcidStorage sess)
forall sto.
Session (SessionData sto)
-> Session (SessionData sto) -> StorageException sto
SS.SessionAlreadyExists Session sess
Session (SessionData (AcidStorage sess))
old Session sess
Session (SessionData (AcidStorage sess))
session
insertAuth :: AuthIdToSessionId sess -> AuthIdToSessionId sess
insertAuth = SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall sess.
SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
insertSessionForAuthId SessionId sess
sid (Session sess -> Maybe AuthId
forall sess. Session sess -> Maybe AuthId
SS.sessionAuthId Session sess
session)
sid :: SessionId sess
sid = Session sess -> SessionId sess
forall sess. Session sess -> SessionId sess
SS.sessionKey Session sess
session
(ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ())
-> (ServerSessionAcidState sess -> ServerSessionAcidState sess)
-> Update (ServerSessionAcidState sess) ()
forall a b. (a -> b) -> a -> b
$ \ServerSessionAcidState sess
state ->
HashMap (SessionId sess) (Session sess)
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState
(HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
insertSess (HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess))
-> HashMap (SessionId sess) (Session sess)
-> HashMap (SessionId sess) (Session sess)
forall a b. (a -> b) -> a -> b
$ ServerSessionAcidState sess
-> HashMap (SessionId sess) (Session sess)
forall sess. ServerSessionAcidState sess -> SessionIdToSession sess
sessionIdToSession ServerSessionAcidState sess
state)
(AuthIdToSessionId sess -> AuthIdToSessionId sess
insertAuth (AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall a b. (a -> b) -> a -> b
$ ServerSessionAcidState sess -> AuthIdToSessionId sess
forall sess. ServerSessionAcidState sess -> AuthIdToSessionId sess
authIdToSessionId ServerSessionAcidState sess
state)
replaceSession
:: SS.Storage (AcidStorage sess)
=> SS.Session sess
-> Update (ServerSessionAcidState sess) ()
replaceSession :: Session sess -> Update (ServerSessionAcidState sess) ()
replaceSession Session sess
session = do
ServerSessionAcidState SessionIdToSession sess
sits AuthIdToSessionId sess
aits <- Update (ServerSessionAcidState sess) (ServerSessionAcidState sess)
forall s (m :: * -> *). MonadState s m => m s
get
let sid :: SessionId sess
sid = Session sess -> SessionId sess
forall sess. Session sess -> SessionId sess
SS.sessionKey Session sess
session
case SessionId sess -> SessionIdToSession sess -> Maybe (Session sess)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SessionId sess
sid SessionIdToSession sess
sits of
Maybe (Session sess)
Nothing -> StorageException (AcidStorage sess)
-> Update (ServerSessionAcidState sess) ()
forall sess a.
Storage (AcidStorage sess) =>
StorageException (AcidStorage sess) -> a
throwAS (StorageException (AcidStorage sess)
-> Update (ServerSessionAcidState sess) ())
-> StorageException (AcidStorage sess)
-> Update (ServerSessionAcidState sess) ()
forall a b. (a -> b) -> a -> b
$ Session (SessionData (AcidStorage sess))
-> StorageException (AcidStorage sess)
forall sto. Session (SessionData sto) -> StorageException sto
SS.SessionDoesNotExist Session sess
Session (SessionData (AcidStorage sess))
session
Just Session sess
oldSession -> do
let modAits :: AuthIdToSessionId sess -> AuthIdToSessionId sess
modAits | Maybe AuthId
oldAuthId Maybe AuthId -> Maybe AuthId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe AuthId
newAuthId = AuthIdToSessionId sess -> AuthIdToSessionId sess
forall a. a -> a
id
| Bool
otherwise = SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall sess.
SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
insertSessionForAuthId SessionId sess
sid Maybe AuthId
newAuthId
(AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> (AuthIdToSessionId sess -> AuthIdToSessionId sess)
-> AuthIdToSessionId sess
-> AuthIdToSessionId sess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
forall sess.
SessionId sess
-> Maybe AuthId -> AuthIdToSessionId sess -> AuthIdToSessionId sess
removeSessionFromAuthId SessionId sess
sid Maybe AuthId
oldAuthId
where oldAuthId :: Maybe AuthId
oldAuthId = Session sess -> Maybe AuthId
forall sess. Session sess -> Maybe AuthId
SS.sessionAuthId Session sess
oldSession
newAuthId :: Maybe AuthId
newAuthId = Session sess -> Maybe AuthId
forall sess. Session sess -> Maybe AuthId
SS.sessionAuthId Session sess
session
aits' :: AuthIdToSessionId sess
aits' = AuthIdToSessionId sess -> AuthIdToSessionId sess
modAits AuthIdToSessionId sess
aits
sits' :: SessionIdToSession sess
sits' = SessionId sess
-> Session sess
-> SessionIdToSession sess
-> SessionIdToSession sess
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert SessionId sess
sid Session sess
session SessionIdToSession sess
sits
ServerSessionAcidState sess
-> Update (ServerSessionAcidState sess) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
forall sess.
SessionIdToSession sess
-> AuthIdToSessionId sess -> ServerSessionAcidState sess
ServerSessionAcidState SessionIdToSession sess
sits' AuthIdToSessionId sess
aits')
throwAS
:: SS.Storage (AcidStorage sess)
=> SS.StorageException (AcidStorage sess)
-> a
throwAS :: StorageException (AcidStorage sess) -> a
throwAS = StorageException (AcidStorage sess) -> a
forall a e. Exception e => e -> a
E.throw
newtype AcidStorage sess =
AcidStorage
{ AcidStorage sess -> AcidState (ServerSessionAcidState sess)
acidState :: AcidState (ServerSessionAcidState sess)
} deriving (Typeable)
instance ( SS.IsSessionData sess
, SafeCopy sess
, SafeCopy (SS.Decomposed sess)
) => SS.Storage (AcidStorage sess) where
type SessionData (AcidStorage sess) = sess
type TransactionM (AcidStorage sess) = IO
runTransactionM :: AcidStorage sess -> TransactionM (AcidStorage sess) a -> IO a
runTransactionM = (IO a -> IO a) -> AcidStorage sess -> IO a -> IO a
forall a b. a -> b -> a
const IO a -> IO a
forall a. a -> a
id
getSession :: AcidStorage sess
-> SessionId (SessionData (AcidStorage sess))
-> TransactionM
(AcidStorage sess)
(Maybe (Session (SessionData (AcidStorage sess))))
getSession (AcidStorage AcidState (ServerSessionAcidState sess)
s) = AcidState (EventState (GetSession sess))
-> GetSession sess -> IO (EventResult (GetSession sess))
forall event.
QueryEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
query AcidState (EventState (GetSession sess))
AcidState (ServerSessionAcidState sess)
s (GetSession sess -> IO (Maybe (Session sess)))
-> (SessionId sess -> GetSession sess)
-> SessionId sess
-> IO (Maybe (Session sess))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> GetSession sess
forall sess. SessionId sess -> GetSession sess
GetSession
deleteSession :: AcidStorage sess
-> SessionId (SessionData (AcidStorage sess))
-> TransactionM (AcidStorage sess) ()
deleteSession (AcidStorage AcidState (ServerSessionAcidState sess)
s) = AcidState (EventState (DeleteSession sess))
-> DeleteSession sess -> IO (EventResult (DeleteSession sess))
forall event.
UpdateEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
update AcidState (EventState (DeleteSession sess))
AcidState (ServerSessionAcidState sess)
s (DeleteSession sess -> IO ())
-> (SessionId sess -> DeleteSession sess)
-> SessionId sess
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> DeleteSession sess
forall sess. SessionId sess -> DeleteSession sess
DeleteSession
deleteAllSessionsOfAuthId :: AcidStorage sess -> AuthId -> TransactionM (AcidStorage sess) ()
deleteAllSessionsOfAuthId (AcidStorage AcidState (ServerSessionAcidState sess)
s) = AcidState (EventState (DeleteAllSessionsOfAuthId sess))
-> DeleteAllSessionsOfAuthId sess
-> IO (EventResult (DeleteAllSessionsOfAuthId sess))
forall event.
UpdateEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
update AcidState (EventState (DeleteAllSessionsOfAuthId sess))
AcidState (ServerSessionAcidState sess)
s (DeleteAllSessionsOfAuthId sess -> IO ())
-> (AuthId -> DeleteAllSessionsOfAuthId sess) -> AuthId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthId -> DeleteAllSessionsOfAuthId sess
forall sess. AuthId -> DeleteAllSessionsOfAuthId sess
DeleteAllSessionsOfAuthId
insertSession :: AcidStorage sess
-> Session (SessionData (AcidStorage sess))
-> TransactionM (AcidStorage sess) ()
insertSession (AcidStorage AcidState (ServerSessionAcidState sess)
s) = AcidState (EventState (InsertSession sess))
-> InsertSession sess -> IO (EventResult (InsertSession sess))
forall event.
UpdateEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
update AcidState (EventState (InsertSession sess))
AcidState (ServerSessionAcidState sess)
s (InsertSession sess -> IO ())
-> (Session sess -> InsertSession sess) -> Session sess -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session sess -> InsertSession sess
forall sess. Session sess -> InsertSession sess
InsertSession
replaceSession :: AcidStorage sess
-> Session (SessionData (AcidStorage sess))
-> TransactionM (AcidStorage sess) ()
replaceSession (AcidStorage AcidState (ServerSessionAcidState sess)
s) = AcidState (EventState (ReplaceSession sess))
-> ReplaceSession sess -> IO (EventResult (ReplaceSession sess))
forall event.
UpdateEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
update AcidState (EventState (ReplaceSession sess))
AcidState (ServerSessionAcidState sess)
s (ReplaceSession sess -> IO ())
-> (Session sess -> ReplaceSession sess) -> Session sess -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session sess -> ReplaceSession sess
forall sess. Session sess -> ReplaceSession sess
ReplaceSession
data GetSession sess = GetSession (SS.SessionId sess) deriving (Typeable)
data DeleteSession sess = DeleteSession (SS.SessionId sess) deriving (Typeable)
data DeleteAllSessionsOfAuthId sess = DeleteAllSessionsOfAuthId SS.AuthId deriving (Typeable)
data InsertSession sess = InsertSession (SS.Session sess) deriving (Typeable)
data ReplaceSession sess = ReplaceSession (SS.Session sess) deriving (Typeable)
instance Typeable sess => SafeCopy (GetSession sess) where
putCopy :: GetSession sess -> Contained Put
putCopy (GetSession SessionId sess
v) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ SessionId sess -> Put
forall a. SafeCopy a => a -> Put
safePut SessionId sess
v
getCopy :: Contained (Get (GetSession sess))
getCopy = Get (GetSession sess) -> Contained (Get (GetSession sess))
forall a. a -> Contained a
contain (Get (GetSession sess) -> Contained (Get (GetSession sess)))
-> Get (GetSession sess) -> Contained (Get (GetSession sess))
forall a b. (a -> b) -> a -> b
$ SessionId sess -> GetSession sess
forall sess. SessionId sess -> GetSession sess
GetSession (SessionId sess -> GetSession sess)
-> Get (SessionId sess) -> Get (GetSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (SessionId sess)
forall a. SafeCopy a => Get a
safeGet
instance Typeable sess => SafeCopy (DeleteSession sess) where
putCopy :: DeleteSession sess -> Contained Put
putCopy (DeleteSession SessionId sess
v) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ SessionId sess -> Put
forall a. SafeCopy a => a -> Put
safePut SessionId sess
v
getCopy :: Contained (Get (DeleteSession sess))
getCopy = Get (DeleteSession sess) -> Contained (Get (DeleteSession sess))
forall a. a -> Contained a
contain (Get (DeleteSession sess) -> Contained (Get (DeleteSession sess)))
-> Get (DeleteSession sess) -> Contained (Get (DeleteSession sess))
forall a b. (a -> b) -> a -> b
$ SessionId sess -> DeleteSession sess
forall sess. SessionId sess -> DeleteSession sess
DeleteSession (SessionId sess -> DeleteSession sess)
-> Get (SessionId sess) -> Get (DeleteSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (SessionId sess)
forall a. SafeCopy a => Get a
safeGet
instance Typeable sess => SafeCopy (DeleteAllSessionsOfAuthId sess) where
putCopy :: DeleteAllSessionsOfAuthId sess -> Contained Put
putCopy (DeleteAllSessionsOfAuthId AuthId
v) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ AuthId -> Put
forall a. SafeCopy a => a -> Put
safePut AuthId
v
getCopy :: Contained (Get (DeleteAllSessionsOfAuthId sess))
getCopy = Get (DeleteAllSessionsOfAuthId sess)
-> Contained (Get (DeleteAllSessionsOfAuthId sess))
forall a. a -> Contained a
contain (Get (DeleteAllSessionsOfAuthId sess)
-> Contained (Get (DeleteAllSessionsOfAuthId sess)))
-> Get (DeleteAllSessionsOfAuthId sess)
-> Contained (Get (DeleteAllSessionsOfAuthId sess))
forall a b. (a -> b) -> a -> b
$ AuthId -> DeleteAllSessionsOfAuthId sess
forall sess. AuthId -> DeleteAllSessionsOfAuthId sess
DeleteAllSessionsOfAuthId (AuthId -> DeleteAllSessionsOfAuthId sess)
-> Get AuthId -> Get (DeleteAllSessionsOfAuthId sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get AuthId
forall a. SafeCopy a => Get a
safeGet
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (InsertSession sess) where
putCopy :: InsertSession sess -> Contained Put
putCopy (InsertSession Session sess
v) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ Session sess -> Put
forall a. SafeCopy a => a -> Put
safePut Session sess
v
getCopy :: Contained (Get (InsertSession sess))
getCopy = Get (InsertSession sess) -> Contained (Get (InsertSession sess))
forall a. a -> Contained a
contain (Get (InsertSession sess) -> Contained (Get (InsertSession sess)))
-> Get (InsertSession sess) -> Contained (Get (InsertSession sess))
forall a b. (a -> b) -> a -> b
$ Session sess -> InsertSession sess
forall sess. Session sess -> InsertSession sess
InsertSession (Session sess -> InsertSession sess)
-> Get (Session sess) -> Get (InsertSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Session sess)
forall a. SafeCopy a => Get a
safeGet
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ReplaceSession sess) where
putCopy :: ReplaceSession sess -> Contained Put
putCopy (ReplaceSession Session sess
v) = Put -> Contained Put
forall a. a -> Contained a
contain (Put -> Contained Put) -> Put -> Contained Put
forall a b. (a -> b) -> a -> b
$ Session sess -> Put
forall a. SafeCopy a => a -> Put
safePut Session sess
v
getCopy :: Contained (Get (ReplaceSession sess))
getCopy = Get (ReplaceSession sess) -> Contained (Get (ReplaceSession sess))
forall a. a -> Contained a
contain (Get (ReplaceSession sess)
-> Contained (Get (ReplaceSession sess)))
-> Get (ReplaceSession sess)
-> Contained (Get (ReplaceSession sess))
forall a b. (a -> b) -> a -> b
$ Session sess -> ReplaceSession sess
forall sess. Session sess -> ReplaceSession sess
ReplaceSession (Session sess -> ReplaceSession sess)
-> Get (Session sess) -> Get (ReplaceSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Session sess)
forall a. SafeCopy a => Get a
safeGet
type AcidContext sess =
( SS.IsSessionData sess
, SafeCopy sess
, SafeCopy (SS.Decomposed sess) )
instance AcidContext sess => QueryEvent (GetSession sess)
instance AcidContext sess => UpdateEvent (DeleteSession sess)
instance AcidContext sess => UpdateEvent (DeleteAllSessionsOfAuthId sess)
instance AcidContext sess => UpdateEvent (InsertSession sess)
instance AcidContext sess => UpdateEvent (ReplaceSession sess)
instance AcidContext sess => Method (GetSession sess) where
type MethodResult (GetSession sess) = Maybe (SS.Session sess)
type MethodState (GetSession sess) = ServerSessionAcidState sess
instance AcidContext sess => Method (DeleteSession sess) where
type MethodResult (DeleteSession sess) = ()
type MethodState (DeleteSession sess) = ServerSessionAcidState sess
instance AcidContext sess => Method (DeleteAllSessionsOfAuthId sess) where
type MethodResult (DeleteAllSessionsOfAuthId sess) = ()
type MethodState (DeleteAllSessionsOfAuthId sess) = ServerSessionAcidState sess
instance AcidContext sess => Method (InsertSession sess) where
type MethodResult (InsertSession sess) = ()
type MethodState (InsertSession sess) = ServerSessionAcidState sess
instance AcidContext sess => Method (ReplaceSession sess) where
type MethodResult (ReplaceSession sess) = ()
type MethodState (ReplaceSession sess) = ServerSessionAcidState sess
instance AcidContext sess => IsAcidic (ServerSessionAcidState sess) where
acidEvents :: [Event (ServerSessionAcidState sess)]
acidEvents =
[ (GetSession sess
-> Query
(EventState (GetSession sess)) (EventResult (GetSession sess)))
-> MethodSerialiser (GetSession sess)
-> Event (EventState (GetSession sess))
forall ev.
QueryEvent ev =>
(ev -> Query (EventState ev) (EventResult ev))
-> MethodSerialiser ev -> Event (EventState ev)
QueryEvent (\(GetSession SessionId sess
sid) -> SessionId sess
-> Query (ServerSessionAcidState sess) (Maybe (Session sess))
forall sess.
Storage (AcidStorage sess) =>
SessionId sess
-> Query (ServerSessionAcidState sess) (Maybe (Session sess))
getSession SessionId sess
sid) MethodSerialiser (GetSession sess)
forall method.
(SafeCopy method, SafeCopy (MethodResult method)) =>
MethodSerialiser method
safeCopyMethodSerialiser
, (DeleteSession sess
-> Update
(EventState (DeleteSession sess))
(EventResult (DeleteSession sess)))
-> MethodSerialiser (DeleteSession sess)
-> Event (EventState (DeleteSession sess))
forall ev.
UpdateEvent ev =>
(ev -> Update (EventState ev) (EventResult ev))
-> MethodSerialiser ev -> Event (EventState ev)
UpdateEvent (\(DeleteSession SessionId sess
sid) -> SessionId sess -> Update (ServerSessionAcidState sess) ()
forall sess.
Storage (AcidStorage sess) =>
SessionId sess -> Update (ServerSessionAcidState sess) ()
deleteSession SessionId sess
sid) MethodSerialiser (DeleteSession sess)
forall method.
(SafeCopy method, SafeCopy (MethodResult method)) =>
MethodSerialiser method
safeCopyMethodSerialiser
, (DeleteAllSessionsOfAuthId sess
-> Update
(EventState (DeleteAllSessionsOfAuthId sess))
(EventResult (DeleteAllSessionsOfAuthId sess)))
-> MethodSerialiser (DeleteAllSessionsOfAuthId sess)
-> Event (EventState (DeleteAllSessionsOfAuthId sess))
forall ev.
UpdateEvent ev =>
(ev -> Update (EventState ev) (EventResult ev))
-> MethodSerialiser ev -> Event (EventState ev)
UpdateEvent (\(DeleteAllSessionsOfAuthId AuthId
authId) -> AuthId -> Update (ServerSessionAcidState sess) ()
forall sess.
Storage (AcidStorage sess) =>
AuthId -> Update (ServerSessionAcidState sess) ()
deleteAllSessionsOfAuthId AuthId
authId) MethodSerialiser (DeleteAllSessionsOfAuthId sess)
forall method.
(SafeCopy method, SafeCopy (MethodResult method)) =>
MethodSerialiser method
safeCopyMethodSerialiser
, (InsertSession sess
-> Update
(EventState (InsertSession sess))
(EventResult (InsertSession sess)))
-> MethodSerialiser (InsertSession sess)
-> Event (EventState (InsertSession sess))
forall ev.
UpdateEvent ev =>
(ev -> Update (EventState ev) (EventResult ev))
-> MethodSerialiser ev -> Event (EventState ev)
UpdateEvent (\(InsertSession Session sess
session) -> Session sess -> Update (ServerSessionAcidState sess) ()
forall sess.
Storage (AcidStorage sess) =>
Session sess -> Update (ServerSessionAcidState sess) ()
insertSession Session sess
session) MethodSerialiser (InsertSession sess)
forall method.
(SafeCopy method, SafeCopy (MethodResult method)) =>
MethodSerialiser method
safeCopyMethodSerialiser
, (ReplaceSession sess
-> Update
(EventState (ReplaceSession sess))
(EventResult (ReplaceSession sess)))
-> MethodSerialiser (ReplaceSession sess)
-> Event (EventState (ReplaceSession sess))
forall ev.
UpdateEvent ev =>
(ev -> Update (EventState ev) (EventResult ev))
-> MethodSerialiser ev -> Event (EventState ev)
UpdateEvent (\(ReplaceSession Session sess
session) -> Session sess -> Update (ServerSessionAcidState sess) ()
forall sess.
Storage (AcidStorage sess) =>
Session sess -> Update (ServerSessionAcidState sess) ()
replaceSession Session sess
session) MethodSerialiser (ReplaceSession sess)
forall method.
(SafeCopy method, SafeCopy (MethodResult method)) =>
MethodSerialiser method
safeCopyMethodSerialiser ]