{-# LANGUAGE DeriveGeneric, ScopedTypeVariables, MonoLocalBinds, DerivingVia #-}
module ProjectM36.Client
(ConnectionInfo(..),
Connection(..),
Port,
Hostname,
ServiceName,
DatabaseName,
ConnectionError(..),
connectProjectM36,
close,
closeRemote_,
executeRelationalExpr,
executeDatabaseContextExpr,
executeDatabaseContextIOExpr,
executeDataFrameExpr,
executeGraphExpr,
executeSchemaExpr,
executeTransGraphRelationalExpr,
commit,
rollback,
typeForRelationalExpr,
inclusionDependencies,
ProjectM36.Client.typeConstructorMapping,
ProjectM36.Client.databaseContextFunctionsAsRelation,
planForDatabaseContextExpr,
currentSchemaName,
SchemaName,
HeadName,
setCurrentSchemaName,
transactionGraphAsRelation,
relationVariablesAsRelation,
ProjectM36.Client.atomFunctionsAsRelation,
disconnectedTransactionIsDirty,
headName,
remoteDBLookupName,
defaultServerPort,
headTransactionId,
defaultDatabaseName,
defaultRemoteConnectionInfo,
defaultHeadName,
addClientNode,
PersistenceStrategy(..),
RelationalExpr,
RelationalExprBase(..),
DatabaseContextExprBase(..),
DatabaseContextExpr,
DatabaseContextIOExprBase(..),
DatabaseContextIOExpr,
Attribute(..),
MergeStrategy(..),
attributesFromList,
createSessionAtCommit,
createSessionAtHead,
closeSession,
callTestTimeout_,
RelationCardinality(..),
TransactionGraphOperator(..),
ProjectM36.Client.autoMergeToHead,
transactionGraph_,
disconnectedTransaction_,
TransGraphRelationalExpr,
TransactionIdLookup(..),
TransactionIdHeadBacktrack(..),
Atom(..),
Session,
SessionId,
NotificationCallback,
emptyNotificationCallback,
EvaluatedNotification(..),
atomTypesAsRelation,
AttributeExpr,
inclusionDependencyForKey,
databaseContextExprForUniqueKey,
databaseContextExprForForeignKey,
createScriptedAtomFunction,
ProjectM36.Client.validateMerkleHashes,
AttributeExprBase(..),
TypeConstructorBase(..),
TypeConstructorDef(..),
DataConstructorDef(..),
AttributeNamesBase(..),
RelVarName,
IncDepName,
InclusionDependency(..),
AttributeName,
DF.DataFrame,
DF.DataFrameExpr,
DF.AttributeOrderExpr,
DF.Order(..),
RelationalError(..),
RequestTimeoutException(..),
RemoteProcessDiedException(..),
AtomType(..),
Atomable(..),
TupleExprBase(..),
TupleExprsBase(..),
AtomExprBase(..),
RestrictionPredicateExprBase(..),
withTransaction
) where
import ProjectM36.Base hiding (inclusionDependencies)
import qualified ProjectM36.Base as B
import ProjectM36.Serialise.Error ()
import ProjectM36.Error
import ProjectM36.Atomable
import ProjectM36.AtomFunction as AF
import ProjectM36.StaticOptimizer
import ProjectM36.Key
import qualified ProjectM36.DataFrame as DF
import ProjectM36.DatabaseContextFunction as DCF
import qualified ProjectM36.IsomorphicSchema as Schema
import Control.Monad.State
import qualified ProjectM36.RelationalExpression as RE
import ProjectM36.DatabaseContext (basicDatabaseContext)
import qualified ProjectM36.TransactionGraph as Graph
import ProjectM36.TransactionGraph as TG
import qualified ProjectM36.Transaction as Trans
import ProjectM36.TransactionGraph.Persist
import ProjectM36.Attribute
import ProjectM36.TransGraphRelationalExpression as TGRE (TransGraphRelationalExpr)
import ProjectM36.Persist (DiskSync(..))
import ProjectM36.FileLock
import ProjectM36.NormalizeExpr
import ProjectM36.Notifications
import ProjectM36.Server.RemoteCallTypes
import qualified ProjectM36.DisconnectedTransaction as Discon
import ProjectM36.Relation (typesAsRelation)
import ProjectM36.ScriptSession (initScriptSession, ScriptSession)
import qualified ProjectM36.Relation as R
import Control.Exception.Base
import Control.Concurrent.STM
import Control.Concurrent.Async
import Data.Either (isRight)
import Data.UUID.V4 (nextRandom)
import Data.Word
import Data.Hashable
import Control.Concurrent.MVar
import Codec.Winery hiding (Schema, schema)
import qualified Data.Map as M
#if MIN_VERSION_stm_containers(1,0,0)
import qualified StmContainers.Map as StmMap
import qualified StmContainers.Set as StmSet
#else
import qualified STMContainers.Map as StmMap
import qualified STMContainers.Set as StmSet
#endif
import qualified ProjectM36.Session as Sess
import ProjectM36.Session
import ProjectM36.Sessions
import GHC.Generics (Generic)
import Control.DeepSeq (force)
import System.IO
import Data.Time.Clock
import qualified Network.RPC.Curryer.Client as RPC
import qualified Network.RPC.Curryer.Server as RPC
import Network.Socket (Socket, AddrInfo(..), getAddrInfo, defaultHints, AddrInfoFlag(..), SocketType(..), ServiceName, hostAddressToTuple, SockAddr(..))
import GHC.Conc (unsafeIOToSTM)
type Hostname = String
type Port = Word16
type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()
emptyNotificationCallback :: NotificationCallback
emptyNotificationCallback :: NotificationCallback
emptyNotificationCallback NotificationName
_ EvaluatedNotification
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
type GhcPkgPath = String
data RemoteProcessDiedException = RemoteProcessDiedException
deriving (Int -> RemoteProcessDiedException -> ShowS
[RemoteProcessDiedException] -> ShowS
RemoteProcessDiedException -> String
(Int -> RemoteProcessDiedException -> ShowS)
-> (RemoteProcessDiedException -> String)
-> ([RemoteProcessDiedException] -> ShowS)
-> Show RemoteProcessDiedException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteProcessDiedException] -> ShowS
$cshowList :: [RemoteProcessDiedException] -> ShowS
show :: RemoteProcessDiedException -> String
$cshow :: RemoteProcessDiedException -> String
showsPrec :: Int -> RemoteProcessDiedException -> ShowS
$cshowsPrec :: Int -> RemoteProcessDiedException -> ShowS
Show, RemoteProcessDiedException -> RemoteProcessDiedException -> Bool
(RemoteProcessDiedException -> RemoteProcessDiedException -> Bool)
-> (RemoteProcessDiedException
-> RemoteProcessDiedException -> Bool)
-> Eq RemoteProcessDiedException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteProcessDiedException -> RemoteProcessDiedException -> Bool
$c/= :: RemoteProcessDiedException -> RemoteProcessDiedException -> Bool
== :: RemoteProcessDiedException -> RemoteProcessDiedException -> Bool
$c== :: RemoteProcessDiedException -> RemoteProcessDiedException -> Bool
Eq)
instance Exception RemoteProcessDiedException
data RequestTimeoutException = RequestTimeoutException
deriving (Int -> RequestTimeoutException -> ShowS
[RequestTimeoutException] -> ShowS
RequestTimeoutException -> String
(Int -> RequestTimeoutException -> ShowS)
-> (RequestTimeoutException -> String)
-> ([RequestTimeoutException] -> ShowS)
-> Show RequestTimeoutException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestTimeoutException] -> ShowS
$cshowList :: [RequestTimeoutException] -> ShowS
show :: RequestTimeoutException -> String
$cshow :: RequestTimeoutException -> String
showsPrec :: Int -> RequestTimeoutException -> ShowS
$cshowsPrec :: Int -> RequestTimeoutException -> ShowS
Show, RequestTimeoutException -> RequestTimeoutException -> Bool
(RequestTimeoutException -> RequestTimeoutException -> Bool)
-> (RequestTimeoutException -> RequestTimeoutException -> Bool)
-> Eq RequestTimeoutException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestTimeoutException -> RequestTimeoutException -> Bool
$c/= :: RequestTimeoutException -> RequestTimeoutException -> Bool
== :: RequestTimeoutException -> RequestTimeoutException -> Bool
$c== :: RequestTimeoutException -> RequestTimeoutException -> Bool
Eq)
instance Exception RequestTimeoutException
data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath] |
RemoteConnectionInfo DatabaseName Hostname ServiceName NotificationCallback
type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification
newtype NotificationMessage = NotificationMessage EvaluatedNotifications
deriving (NotificationMessage -> NotificationMessage -> Bool
(NotificationMessage -> NotificationMessage -> Bool)
-> (NotificationMessage -> NotificationMessage -> Bool)
-> Eq NotificationMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationMessage -> NotificationMessage -> Bool
$c/= :: NotificationMessage -> NotificationMessage -> Bool
== :: NotificationMessage -> NotificationMessage -> Bool
$c== :: NotificationMessage -> NotificationMessage -> Bool
Eq, Int -> NotificationMessage -> ShowS
[NotificationMessage] -> ShowS
NotificationMessage -> String
(Int -> NotificationMessage -> ShowS)
-> (NotificationMessage -> String)
-> ([NotificationMessage] -> ShowS)
-> Show NotificationMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationMessage] -> ShowS
$cshowList :: [NotificationMessage] -> ShowS
show :: NotificationMessage -> String
$cshow :: NotificationMessage -> String
showsPrec :: Int -> NotificationMessage -> ShowS
$cshowsPrec :: Int -> NotificationMessage -> ShowS
Show, (forall x. NotificationMessage -> Rep NotificationMessage x)
-> (forall x. Rep NotificationMessage x -> NotificationMessage)
-> Generic NotificationMessage
forall x. Rep NotificationMessage x -> NotificationMessage
forall x. NotificationMessage -> Rep NotificationMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotificationMessage x -> NotificationMessage
$cfrom :: forall x. NotificationMessage -> Rep NotificationMessage x
Generic)
deriving Typeable NotificationMessage
BundleSerialise NotificationMessage
Extractor NotificationMessage
Decoder NotificationMessage
Typeable NotificationMessage
-> (Proxy NotificationMessage -> SchemaGen Schema)
-> (NotificationMessage -> Builder)
-> Extractor NotificationMessage
-> Decoder NotificationMessage
-> BundleSerialise NotificationMessage
-> Serialise NotificationMessage
Proxy NotificationMessage -> SchemaGen Schema
NotificationMessage -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise NotificationMessage
$cbundleSerialise :: BundleSerialise NotificationMessage
decodeCurrent :: Decoder NotificationMessage
$cdecodeCurrent :: Decoder NotificationMessage
extractor :: Extractor NotificationMessage
$cextractor :: Extractor NotificationMessage
toBuilder :: NotificationMessage -> Builder
$ctoBuilder :: NotificationMessage -> Builder
schemaGen :: Proxy NotificationMessage -> SchemaGen Schema
$cschemaGen :: Proxy NotificationMessage -> SchemaGen Schema
$cp1Serialise :: Typeable NotificationMessage
Serialise via WineryVariant NotificationMessage
data EvaluatedNotification = EvaluatedNotification {
EvaluatedNotification -> Notification
notification :: Notification,
EvaluatedNotification -> Either RelationalError Relation
reportOldRelation :: Either RelationalError Relation,
EvaluatedNotification -> Either RelationalError Relation
reportNewRelation :: Either RelationalError Relation
}
deriving (EvaluatedNotification -> EvaluatedNotification -> Bool
(EvaluatedNotification -> EvaluatedNotification -> Bool)
-> (EvaluatedNotification -> EvaluatedNotification -> Bool)
-> Eq EvaluatedNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluatedNotification -> EvaluatedNotification -> Bool
$c/= :: EvaluatedNotification -> EvaluatedNotification -> Bool
== :: EvaluatedNotification -> EvaluatedNotification -> Bool
$c== :: EvaluatedNotification -> EvaluatedNotification -> Bool
Eq, Int -> EvaluatedNotification -> ShowS
[EvaluatedNotification] -> ShowS
EvaluatedNotification -> String
(Int -> EvaluatedNotification -> ShowS)
-> (EvaluatedNotification -> String)
-> ([EvaluatedNotification] -> ShowS)
-> Show EvaluatedNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluatedNotification] -> ShowS
$cshowList :: [EvaluatedNotification] -> ShowS
show :: EvaluatedNotification -> String
$cshow :: EvaluatedNotification -> String
showsPrec :: Int -> EvaluatedNotification -> ShowS
$cshowsPrec :: Int -> EvaluatedNotification -> ShowS
Show, (forall x. EvaluatedNotification -> Rep EvaluatedNotification x)
-> (forall x. Rep EvaluatedNotification x -> EvaluatedNotification)
-> Generic EvaluatedNotification
forall x. Rep EvaluatedNotification x -> EvaluatedNotification
forall x. EvaluatedNotification -> Rep EvaluatedNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluatedNotification x -> EvaluatedNotification
$cfrom :: forall x. EvaluatedNotification -> Rep EvaluatedNotification x
Generic)
deriving Typeable EvaluatedNotification
BundleSerialise EvaluatedNotification
Extractor EvaluatedNotification
Decoder EvaluatedNotification
Typeable EvaluatedNotification
-> (Proxy EvaluatedNotification -> SchemaGen Schema)
-> (EvaluatedNotification -> Builder)
-> Extractor EvaluatedNotification
-> Decoder EvaluatedNotification
-> BundleSerialise EvaluatedNotification
-> Serialise EvaluatedNotification
Proxy EvaluatedNotification -> SchemaGen Schema
EvaluatedNotification -> Builder
forall a.
Typeable a
-> (Proxy a -> SchemaGen Schema)
-> (a -> Builder)
-> Extractor a
-> Decoder a
-> BundleSerialise a
-> Serialise a
bundleSerialise :: BundleSerialise EvaluatedNotification
$cbundleSerialise :: BundleSerialise EvaluatedNotification
decodeCurrent :: Decoder EvaluatedNotification
$cdecodeCurrent :: Decoder EvaluatedNotification
extractor :: Extractor EvaluatedNotification
$cextractor :: Extractor EvaluatedNotification
toBuilder :: EvaluatedNotification -> Builder
$ctoBuilder :: EvaluatedNotification -> Builder
schemaGen :: Proxy EvaluatedNotification -> SchemaGen Schema
$cschemaGen :: Proxy EvaluatedNotification -> SchemaGen Schema
$cp1Serialise :: Typeable EvaluatedNotification
Serialise via WineryRecord EvaluatedNotification
defaultServerPort :: Port
defaultServerPort :: Port
defaultServerPort = Port
6543
defaultDatabaseName :: DatabaseName
defaultDatabaseName :: String
defaultDatabaseName = String
"base"
defaultHeadName :: HeadName
defaultHeadName :: NotificationName
defaultHeadName = NotificationName
"master"
defaultRemoteConnectionInfo :: ConnectionInfo
defaultRemoteConnectionInfo :: ConnectionInfo
defaultRemoteConnectionInfo =
String
-> String -> String -> NotificationCallback -> ConnectionInfo
RemoteConnectionInfo String
defaultDatabaseName String
defaultServerHostname (Port -> String
forall a. Show a => a -> String
show Port
defaultServerPort) NotificationCallback
emptyNotificationCallback
defaultServerHostname :: Hostname
defaultServerHostname :: String
defaultServerHostname = String
"localhost"
newtype RemoteConnectionConf = RemoteConnectionConf RPC.Connection
data Connection = InProcessConnection InProcessConnectionConf |
RemoteConnection RemoteConnectionConf
data ConnectionError = SetupDatabaseDirectoryError PersistenceError |
IOExceptionError IOException |
NoSuchDatabaseByNameError DatabaseName |
DatabaseValidationError [MerkleValidationError] |
LoginError
deriving (Int -> ConnectionError -> ShowS
[ConnectionError] -> ShowS
ConnectionError -> String
(Int -> ConnectionError -> ShowS)
-> (ConnectionError -> String)
-> ([ConnectionError] -> ShowS)
-> Show ConnectionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionError] -> ShowS
$cshowList :: [ConnectionError] -> ShowS
show :: ConnectionError -> String
$cshow :: ConnectionError -> String
showsPrec :: Int -> ConnectionError -> ShowS
$cshowsPrec :: Int -> ConnectionError -> ShowS
Show, ConnectionError -> ConnectionError -> Bool
(ConnectionError -> ConnectionError -> Bool)
-> (ConnectionError -> ConnectionError -> Bool)
-> Eq ConnectionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionError -> ConnectionError -> Bool
$c/= :: ConnectionError -> ConnectionError -> Bool
== :: ConnectionError -> ConnectionError -> Bool
$c== :: ConnectionError -> ConnectionError -> Bool
Eq, (forall x. ConnectionError -> Rep ConnectionError x)
-> (forall x. Rep ConnectionError x -> ConnectionError)
-> Generic ConnectionError
forall x. Rep ConnectionError x -> ConnectionError
forall x. ConnectionError -> Rep ConnectionError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectionError x -> ConnectionError
$cfrom :: forall x. ConnectionError -> Rep ConnectionError x
Generic)
remoteDBLookupName :: DatabaseName -> String
remoteDBLookupName :: ShowS
remoteDBLookupName = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"db-"
createScriptSession :: [String] -> IO (Maybe ScriptSession)
createScriptSession :: [String] -> IO (Maybe ScriptSession)
createScriptSession [String]
ghcPkgPaths = do
Either ScriptSessionError ScriptSession
eScriptSession <- [String] -> IO (Either ScriptSessionError ScriptSession)
initScriptSession [String]
ghcPkgPaths
case Either ScriptSessionError ScriptSession
eScriptSession of
Left ScriptSessionError
err -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: Haskell scripting disabled: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScriptSessionError -> String
forall a. Show a => a -> String
show ScriptSessionError
err) IO () -> IO (Maybe ScriptSession) -> IO (Maybe ScriptSession)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ScriptSession -> IO (Maybe ScriptSession)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScriptSession
forall a. Maybe a
Nothing
Right ScriptSession
s -> Maybe ScriptSession -> IO (Maybe ScriptSession)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptSession -> Maybe ScriptSession
forall a. a -> Maybe a
Just ScriptSession
s)
connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
connectProjectM36 (InProcessConnectionInfo PersistenceStrategy
strat NotificationCallback
notificationCallback [String]
ghcPkgPaths) = do
UUID
freshId <- IO UUID
nextRandom
UTCTime
tstamp <- IO UTCTime
getCurrentTime
let bootstrapContext :: DatabaseContext
bootstrapContext = DatabaseContext
basicDatabaseContext
freshGraph :: TransactionGraph
freshGraph = UTCTime -> UUID -> DatabaseContext -> TransactionGraph
bootstrapTransactionGraph UTCTime
tstamp UUID
freshId DatabaseContext
bootstrapContext
case PersistenceStrategy
strat of
PersistenceStrategy
NoPersistence -> do
TVar TransactionGraph
graphTvar <- TransactionGraph -> IO (TVar TransactionGraph)
forall a. a -> IO (TVar a)
newTVarIO TransactionGraph
freshGraph
Set ClientInfo
clientNodes <- IO (Set ClientInfo)
forall item. IO (Set item)
StmSet.newIO
Map UUID Session
sessions <- IO (Map UUID Session)
forall key value. IO (Map key value)
StmMap.newIO
Maybe ScriptSession
mScriptSession <- [String] -> IO (Maybe ScriptSession)
createScriptSession [String]
ghcPkgPaths
Async ()
notifAsync <- Set ClientInfo -> NotificationCallback -> IO (Async ())
startNotificationListener Set ClientInfo
clientNodes NotificationCallback
notificationCallback
let conn :: Connection
conn = InProcessConnectionConf -> Connection
InProcessConnection InProcessConnectionConf :: PersistenceStrategy
-> Set ClientInfo
-> Map UUID Session
-> TVar TransactionGraph
-> Maybe ScriptSession
-> Maybe (LockFile, MVar LockFileHash)
-> Async ()
-> InProcessConnectionConf
InProcessConnectionConf {
ipPersistenceStrategy :: PersistenceStrategy
ipPersistenceStrategy = PersistenceStrategy
strat,
ipClientNodes :: Set ClientInfo
ipClientNodes = Set ClientInfo
clientNodes,
ipSessions :: Map UUID Session
ipSessions = Map UUID Session
sessions,
ipTransactionGraph :: TVar TransactionGraph
ipTransactionGraph = TVar TransactionGraph
graphTvar,
ipScriptSession :: Maybe ScriptSession
ipScriptSession = Maybe ScriptSession
mScriptSession,
ipLocks :: Maybe (LockFile, MVar LockFileHash)
ipLocks = Maybe (LockFile, MVar LockFileHash)
forall a. Maybe a
Nothing,
ipCallbackAsync :: Async ()
ipCallbackAsync = Async ()
notifAsync
}
Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection -> Either ConnectionError Connection
forall a b. b -> Either a b
Right Connection
conn)
MinimalPersistence String
dbdir -> PersistenceStrategy
-> DiskSync
-> String
-> TransactionGraph
-> NotificationCallback
-> [String]
-> IO (Either ConnectionError Connection)
connectPersistentProjectM36 PersistenceStrategy
strat DiskSync
NoDiskSync String
dbdir TransactionGraph
freshGraph NotificationCallback
notificationCallback [String]
ghcPkgPaths
CrashSafePersistence String
dbdir -> PersistenceStrategy
-> DiskSync
-> String
-> TransactionGraph
-> NotificationCallback
-> [String]
-> IO (Either ConnectionError Connection)
connectPersistentProjectM36 PersistenceStrategy
strat DiskSync
FsyncDiskSync String
dbdir TransactionGraph
freshGraph NotificationCallback
notificationCallback [String]
ghcPkgPaths
connectProjectM36 (RemoteConnectionInfo String
dbName String
hostName String
servicePort NotificationCallback
notificationCallback) = do
let resolutionHints :: AddrInfo
resolutionHints = AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_NUMERICHOST, AddrInfoFlag
AI_NUMERICSERV],
addrSocketType :: SocketType
addrSocketType = SocketType
Stream
}
[AddrInfo]
resolved <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
resolutionHints) (String -> Maybe String
forall a. a -> Maybe a
Just String
hostName) (String -> Maybe String
forall a. a -> Maybe a
Just String
servicePort)
case [AddrInfo]
resolved of
[] -> String -> IO (Either ConnectionError Connection)
forall a. HasCallStack => String -> a
error (String
"DNS resolution failed for" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
hostName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
servicePort)
AddrInfo
addrInfo:[AddrInfo]
_ -> do
let (SockAddrInet PortNumber
port HostAddress
addr) = AddrInfo -> SockAddr
addrAddress AddrInfo
addrInfo
notificationHandlers :: [ClientAsyncRequestHandler]
notificationHandlers =
[(NotificationMessage -> IO ()) -> ClientAsyncRequestHandler
forall a. Serialise a => (a -> IO ()) -> ClientAsyncRequestHandler
RPC.ClientAsyncRequestHandler ((NotificationMessage -> IO ()) -> ClientAsyncRequestHandler)
-> (NotificationMessage -> IO ()) -> ClientAsyncRequestHandler
forall a b. (a -> b) -> a -> b
$
\(NotificationMessage EvaluatedNotifications
notifications') ->
[(NotificationName, EvaluatedNotification)]
-> ((NotificationName, EvaluatedNotification) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EvaluatedNotifications
-> [(NotificationName, EvaluatedNotification)]
forall k a. Map k a -> [(k, a)]
M.toList EvaluatedNotifications
notifications') (NotificationCallback
-> (NotificationName, EvaluatedNotification) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NotificationCallback
notificationCallback)
]
let connectExcHandler :: IOException -> f (Either ConnectionError b)
connectExcHandler (IOException
e :: IOException) = Either ConnectionError b -> f (Either ConnectionError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConnectionError b -> f (Either ConnectionError b))
-> Either ConnectionError b -> f (Either ConnectionError b)
forall a b. (a -> b) -> a -> b
$ ConnectionError -> Either ConnectionError b
forall a b. a -> Either a b
Left (IOException -> ConnectionError
IOExceptionError IOException
e)
Either ConnectionError Connection
eConn <- (Connection -> Either ConnectionError Connection
forall a b. b -> Either a b
Right (Connection -> Either ConnectionError Connection)
-> IO Connection -> IO (Either ConnectionError Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClientAsyncRequestHandler]
-> HostAddr -> PortNumber -> IO Connection
RPC.connect [ClientAsyncRequestHandler]
notificationHandlers (HostAddress -> HostAddr
hostAddressToTuple HostAddress
addr) PortNumber
port) IO (Either ConnectionError Connection)
-> (IOException -> IO (Either ConnectionError Connection))
-> IO (Either ConnectionError Connection)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO (Either ConnectionError Connection)
forall (f :: * -> *) b.
Applicative f =>
IOException -> f (Either ConnectionError b)
connectExcHandler
case Either ConnectionError Connection
eConn of
Left ConnectionError
err -> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionError -> Either ConnectionError Connection
forall a b. a -> Either a b
Left ConnectionError
err)
Right Connection
conn -> do
Either ConnectionError Bool
eRet <- Connection -> Login -> IO (Either ConnectionError Bool)
forall request response.
(Serialise request, Serialise response) =>
Connection -> request -> IO (Either ConnectionError response)
RPC.call Connection
conn (String -> Login
Login String
dbName)
case Either ConnectionError Bool
eRet of
Left ConnectionError
err -> String -> IO (Either ConnectionError Connection)
forall a. HasCallStack => String -> a
error (ConnectionError -> String
forall a. Show a => a -> String
show ConnectionError
err)
Right Bool
False -> String -> IO (Either ConnectionError Connection)
forall a. HasCallStack => String -> a
error String
"wtf"
Right Bool
True ->
Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection -> Either ConnectionError Connection
forall a b. b -> Either a b
Right (RemoteConnectionConf -> Connection
RemoteConnection (Connection -> RemoteConnectionConf
RemoteConnectionConf Connection
conn)))
convertRPCErrors :: RPC.ConnectionError -> IO a
convertRPCErrors :: ConnectionError -> IO a
convertRPCErrors ConnectionError
err =
case ConnectionError
err of
ConnectionError
RPC.TimeoutError -> RequestTimeoutException -> IO a
forall a e. Exception e => e -> a
throw RequestTimeoutException
RequestTimeoutException
RPC.CodecError String
msg -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"decoding message failed on server: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
RPC.ExceptionError String
msg -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"server threw exception: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
addClientNode :: Connection -> RPC.Locking Socket -> IO ()
addClientNode :: Connection -> Locking Socket -> IO ()
addClientNode (RemoteConnection RemoteConnectionConf
_) Locking Socket
_ = String -> IO ()
forall a. HasCallStack => String -> a
error String
"addClientNode called on remote connection"
addClientNode (InProcessConnection InProcessConnectionConf
conf) Locking Socket
lockSock = STM () -> IO ()
forall a. STM a -> IO a
atomically (ClientInfo -> Set ClientInfo -> STM ()
forall item. (Eq item, Hashable item) => item -> Set item -> STM ()
StmSet.insert ClientInfo
clientInfo (InProcessConnectionConf -> Set ClientInfo
ipClientNodes InProcessConnectionConf
conf))
where
clientInfo :: ClientInfo
clientInfo = Locking Socket -> ClientInfo
RemoteClientInfo Locking Socket
lockSock
connectPersistentProjectM36 :: PersistenceStrategy ->
DiskSync ->
FilePath ->
TransactionGraph ->
NotificationCallback ->
[GhcPkgPath] ->
IO (Either ConnectionError Connection)
connectPersistentProjectM36 :: PersistenceStrategy
-> DiskSync
-> String
-> TransactionGraph
-> NotificationCallback
-> [String]
-> IO (Either ConnectionError Connection)
connectPersistentProjectM36 PersistenceStrategy
strat DiskSync
sync String
dbdir TransactionGraph
freshGraph NotificationCallback
notificationCallback [String]
ghcPkgPaths = do
Either PersistenceError (LockFile, LockFileHash)
err <- DiskSync
-> String
-> TransactionGraph
-> IO (Either PersistenceError (LockFile, LockFileHash))
setupDatabaseDir DiskSync
sync String
dbdir TransactionGraph
freshGraph
case Either PersistenceError (LockFile, LockFileHash)
err of
Left PersistenceError
err' -> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ConnectionError Connection
-> IO (Either ConnectionError Connection))
-> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall a b. (a -> b) -> a -> b
$ ConnectionError -> Either ConnectionError Connection
forall a b. a -> Either a b
Left (PersistenceError -> ConnectionError
SetupDatabaseDirectoryError PersistenceError
err')
Right (LockFile
lockFileH, LockFileHash
digest) -> do
Maybe ScriptSession
mScriptSession <- [String] -> IO (Maybe ScriptSession)
createScriptSession [String]
ghcPkgPaths
Either PersistenceError TransactionGraph
graph <- String
-> TransactionGraph
-> Maybe ScriptSession
-> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad String
dbdir TransactionGraph
emptyTransactionGraph Maybe ScriptSession
mScriptSession
case Either PersistenceError TransactionGraph
graph of
Left PersistenceError
err' -> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ConnectionError Connection
-> IO (Either ConnectionError Connection))
-> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall a b. (a -> b) -> a -> b
$ ConnectionError -> Either ConnectionError Connection
forall a b. a -> Either a b
Left (PersistenceError -> ConnectionError
SetupDatabaseDirectoryError PersistenceError
err')
Right TransactionGraph
graph' -> do
case TransactionGraph -> Either [MerkleValidationError] ()
TG.validateMerkleHashes TransactionGraph
graph' of
Left [MerkleValidationError]
merkleErrs -> Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionError -> Either ConnectionError Connection
forall a b. a -> Either a b
Left ([MerkleValidationError] -> ConnectionError
DatabaseValidationError [MerkleValidationError]
merkleErrs))
Right ()
_ -> do
TVar TransactionGraph
tvarGraph <- TransactionGraph -> IO (TVar TransactionGraph)
forall a. a -> IO (TVar a)
newTVarIO TransactionGraph
graph'
Map UUID Session
sessions <- IO (Map UUID Session)
forall key value. IO (Map key value)
StmMap.newIO
Set ClientInfo
clientNodes <- IO (Set ClientInfo)
forall item. IO (Set item)
StmSet.newIO
MVar LockFileHash
lockMVar <- LockFileHash -> IO (MVar LockFileHash)
forall a. a -> IO (MVar a)
newMVar LockFileHash
digest
Async ()
notifAsync <- Set ClientInfo -> NotificationCallback -> IO (Async ())
startNotificationListener Set ClientInfo
clientNodes NotificationCallback
notificationCallback
let conn :: Connection
conn = InProcessConnectionConf -> Connection
InProcessConnection InProcessConnectionConf :: PersistenceStrategy
-> Set ClientInfo
-> Map UUID Session
-> TVar TransactionGraph
-> Maybe ScriptSession
-> Maybe (LockFile, MVar LockFileHash)
-> Async ()
-> InProcessConnectionConf
InProcessConnectionConf {
ipPersistenceStrategy :: PersistenceStrategy
ipPersistenceStrategy = PersistenceStrategy
strat,
ipClientNodes :: Set ClientInfo
ipClientNodes = Set ClientInfo
clientNodes,
ipSessions :: Map UUID Session
ipSessions = Map UUID Session
sessions,
ipTransactionGraph :: TVar TransactionGraph
ipTransactionGraph = TVar TransactionGraph
tvarGraph,
ipScriptSession :: Maybe ScriptSession
ipScriptSession = Maybe ScriptSession
mScriptSession,
ipLocks :: Maybe (LockFile, MVar LockFileHash)
ipLocks = (LockFile, MVar LockFileHash)
-> Maybe (LockFile, MVar LockFileHash)
forall a. a -> Maybe a
Just (LockFile
lockFileH, MVar LockFileHash
lockMVar),
ipCallbackAsync :: Async ()
ipCallbackAsync = Async ()
notifAsync
}
Either ConnectionError Connection
-> IO (Either ConnectionError Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection -> Either ConnectionError Connection
forall a b. b -> Either a b
Right Connection
conn)
startNotificationListener :: ClientNodes -> NotificationCallback -> IO (Async ())
startNotificationListener :: Set ClientInfo -> NotificationCallback -> IO (Async ())
startNotificationListener Set ClientInfo
cNodes NotificationCallback
notificationCallback = do
inProcessClientInfo :: ClientInfo
inProcessClientInfo@(InProcessClientInfo MVar EvaluatedNotifications
notifMVar) <- MVar EvaluatedNotifications -> ClientInfo
InProcessClientInfo (MVar EvaluatedNotifications -> ClientInfo)
-> IO (MVar EvaluatedNotifications) -> IO ClientInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (MVar EvaluatedNotifications)
forall a. IO (MVar a)
newEmptyMVar
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ClientInfo -> Set ClientInfo -> STM ()
forall item. (Eq item, Hashable item) => item -> Set item -> STM ()
StmSet.insert ClientInfo
inProcessClientInfo Set ClientInfo
cNodes
IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
EvaluatedNotifications
notifs <- MVar EvaluatedNotifications -> IO EvaluatedNotifications
forall a. MVar a -> IO a
takeMVar MVar EvaluatedNotifications
notifMVar
[(NotificationName, EvaluatedNotification)]
-> ((NotificationName, EvaluatedNotification) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EvaluatedNotifications
-> [(NotificationName, EvaluatedNotification)]
forall k a. Map k a -> [(k, a)]
M.toList EvaluatedNotifications
notifs) (((NotificationName, EvaluatedNotification) -> IO ()) -> IO ())
-> ((NotificationName, EvaluatedNotification) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ NotificationCallback
-> (NotificationName, EvaluatedNotification) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NotificationCallback
notificationCallback
createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId)
createSessionAtCommit :: Connection -> UUID -> IO (Either RelationalError UUID)
createSessionAtCommit conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
_) UUID
commitId = do
UUID
newSessionId <- IO UUID
nextRandom
STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a. STM a -> IO a
atomically (STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID))
-> STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ UUID -> UUID -> Connection -> STM (Either RelationalError UUID)
createSessionAtCommit_ UUID
commitId UUID
newSessionId Connection
conn
createSessionAtCommit conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) UUID
uuid = Connection
-> CreateSessionAtCommit -> IO (Either RelationalError UUID)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> CreateSessionAtCommit
CreateSessionAtCommit UUID
uuid)
createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)
createSessionAtCommit_ :: UUID -> UUID -> Connection -> STM (Either RelationalError UUID)
createSessionAtCommit_ UUID
commitId UUID
newSessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
case UUID -> TransactionGraph -> Either RelationalError Transaction
RE.transactionForId UUID
commitId TransactionGraph
graph of
Left RelationalError
err -> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError UUID
forall a b. a -> Either a b
Left RelationalError
err)
Right Transaction
transaction -> do
let freshDiscon :: DisconnectedTransaction
freshDiscon = UUID -> Schemas -> Bool -> DisconnectedTransaction
DisconnectedTransaction UUID
commitId (UUID -> Schemas -> Schemas
Discon.loadGraphRefRelVarsOnly UUID
commitId (Transaction -> Schemas
Trans.schemas Transaction
transaction)) Bool
False
Maybe Session
keyDuplication <- UUID -> Map UUID Session -> STM (Maybe Session)
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
StmMap.lookup UUID
newSessionId Map UUID Session
sessions
case Maybe Session
keyDuplication of
Just Session
_ -> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError UUID -> STM (Either RelationalError UUID))
-> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError UUID
forall a b. a -> Either a b
Left (UUID -> RelationalError
SessionIdInUseError UUID
newSessionId)
Maybe Session
Nothing -> do
Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert (DisconnectedTransaction -> NotificationName -> Session
Session DisconnectedTransaction
freshDiscon NotificationName
defaultSchemaName) UUID
newSessionId Map UUID Session
sessions
Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError UUID -> STM (Either RelationalError UUID))
-> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ UUID -> Either RelationalError UUID
forall a b. b -> Either a b
Right UUID
newSessionId
createSessionAtCommit_ UUID
_ UUID
_ (RemoteConnection RemoteConnectionConf
_) = String -> STM (Either RelationalError UUID)
forall a. HasCallStack => String -> a
error String
"createSessionAtCommit_ called on remote connection"
createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId)
createSessionAtHead :: Connection -> NotificationName -> IO (Either RelationalError UUID)
createSessionAtHead conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
conf) NotificationName
headn = do
let graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
UUID
newSessionId <- IO UUID
nextRandom
STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a. STM a -> IO a
atomically (STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID))
-> STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
case NotificationName -> TransactionGraph -> Maybe Transaction
transactionForHead NotificationName
headn TransactionGraph
graph of
Maybe Transaction
Nothing -> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError UUID -> STM (Either RelationalError UUID))
-> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError UUID
forall a b. a -> Either a b
Left (NotificationName -> RelationalError
NoSuchHeadNameError NotificationName
headn)
Just Transaction
trans -> UUID -> UUID -> Connection -> STM (Either RelationalError UUID)
createSessionAtCommit_ (Transaction -> UUID
transactionId Transaction
trans) UUID
newSessionId Connection
conn
createSessionAtHead conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) NotificationName
headn = Connection
-> CreateSessionAtHead -> IO (Either RelationalError UUID)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (NotificationName -> CreateSessionAtHead
CreateSessionAtHead NotificationName
headn)
closeSession :: SessionId -> Connection -> IO ()
closeSession :: UUID -> Connection -> IO ()
closeSession UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) =
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM ()
StmMap.delete UUID
sessionId (InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf)
closeSession UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection -> CloseSession -> IO ()
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> CloseSession
CloseSession UUID
sessionId)
close :: Connection -> IO ()
close :: Connection -> IO ()
close (InProcessConnection InProcessConnectionConf
conf) = do
Async () -> IO ()
forall a. Async a -> IO ()
cancel (InProcessConnectionConf -> Async ()
ipCallbackAsync InProcessConnectionConf
conf)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
#if MIN_VERSION_stm_containers(1,0,0)
Map UUID Session -> STM ()
forall key value. Map key value -> STM ()
StmMap.reset Map UUID Session
sessions
#else
StmMap.deleteAll sessions
#endif
() -> STM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let mLocks :: Maybe (LockFile, MVar LockFileHash)
mLocks = InProcessConnectionConf -> Maybe (LockFile, MVar LockFileHash)
ipLocks InProcessConnectionConf
conf
case Maybe (LockFile, MVar LockFileHash)
mLocks of
Maybe (LockFile, MVar LockFileHash)
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (LockFile
lockFileH, MVar LockFileHash
_) -> LockFile -> IO ()
closeLockFile LockFile
lockFileH
close (RemoteConnection (RemoteConnectionConf Connection
conn)) =
Connection -> IO ()
RPC.close Connection
conn
closeRemote_ :: Connection -> IO ()
closeRemote_ :: Connection -> IO ()
closeRemote_ (InProcessConnection InProcessConnectionConf
_) = String -> IO ()
forall a. HasCallStack => String -> a
error String
"invalid call of closeRemote_ on InProcessConnection"
closeRemote_ (RemoteConnection (RemoteConnectionConf Connection
conn)) = Connection -> IO ()
RPC.close Connection
conn
excEither :: IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither :: IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither = (SomeException -> IO (Either RelationalError a))
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO (Either RelationalError a)
forall b. SomeException -> IO (Either RelationalError b)
handler
where
handler :: SomeException -> IO (Either RelationalError b)
handler SomeException
exc | Just (AsyncException
_ :: AsyncException) <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exc = SomeException -> IO (Either RelationalError b)
forall e a. Exception e => e -> IO a
throwIO SomeException
exc
| Bool
otherwise = Either RelationalError b -> IO (Either RelationalError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError b
forall a b. a -> Either a b
Left (String -> RelationalError
UnhandledExceptionError (SomeException -> String
forall a. Show a => a -> String
show SomeException
exc)))
remoteCall :: (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall :: Connection -> a -> IO b
remoteCall (InProcessConnection InProcessConnectionConf
_ ) a
_ = String -> IO b
forall a. HasCallStack => String -> a
error String
"remoteCall called on local connection"
remoteCall (RemoteConnection (RemoteConnectionConf Connection
rpcConn)) a
arg = do
Either ConnectionError b
eRet <- Connection -> a -> IO (Either ConnectionError b)
forall request response.
(Serialise request, Serialise response) =>
Connection -> request -> IO (Either ConnectionError response)
RPC.call Connection
rpcConn a
arg
case Either ConnectionError b
eRet of
Left ConnectionError
err -> ConnectionError -> IO b
forall a. ConnectionError -> IO a
convertRPCErrors ConnectionError
err
Right b
val -> b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
val
sessionForSessionId :: SessionId -> Sessions -> STM (Either RelationalError Session)
sessionForSessionId :: UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions =
Either RelationalError Session
-> (Session -> Either RelationalError Session)
-> Maybe Session
-> Either RelationalError Session
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RelationalError -> Either RelationalError Session
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError Session)
-> RelationalError -> Either RelationalError Session
forall a b. (a -> b) -> a -> b
$ UUID -> RelationalError
NoSuchSessionError UUID
sessionId) Session -> Either RelationalError Session
forall a b. b -> Either a b
Right (Maybe Session -> Either RelationalError Session)
-> STM (Maybe Session) -> STM (Either RelationalError Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UUID -> Map UUID Session -> STM (Maybe Session)
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
StmMap.lookup UUID
sessionId Map UUID Session
sessions
schemaForSessionId :: Session -> STM (Either RelationalError Schema)
schemaForSessionId :: Session -> STM (Either RelationalError Schema)
schemaForSessionId Session
session = do
let sname :: NotificationName
sname = Session -> NotificationName
schemaName Session
session
if NotificationName
sname NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then
Either RelationalError Schema
-> STM (Either RelationalError Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either RelationalError Schema
forall a b. b -> Either a b
Right (SchemaIsomorphs -> Schema
Schema []))
else
case NotificationName -> Map NotificationName Schema -> Maybe Schema
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NotificationName
sname (Session -> Map NotificationName Schema
subschemas Session
session) of
Maybe Schema
Nothing -> Either RelationalError Schema
-> STM (Either RelationalError Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Schema
forall a b. a -> Either a b
Left (NotificationName -> RelationalError
SubschemaNameNotInUseError NotificationName
sname))
Just Schema
schema -> Either RelationalError Schema
-> STM (Either RelationalError Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Either RelationalError Schema
forall a b. b -> Either a b
Right Schema
schema)
sessionAndSchema :: SessionId -> Sessions -> STM (Either RelationalError (Session, Schema))
sessionAndSchema :: UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions = do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError (Session, Schema)
-> STM (Either RelationalError (Session, Schema))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError (Session, Schema)
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> do
Either RelationalError Schema
eSchema <- Session -> STM (Either RelationalError Schema)
schemaForSessionId Session
session
case Either RelationalError Schema
eSchema of
Left RelationalError
err -> Either RelationalError (Session, Schema)
-> STM (Either RelationalError (Session, Schema))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError (Session, Schema)
forall a b. a -> Either a b
Left RelationalError
err)
Right Schema
schema -> Either RelationalError (Session, Schema)
-> STM (Either RelationalError (Session, Schema))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Session, Schema) -> Either RelationalError (Session, Schema)
forall a b. b -> Either a b
Right (Session
session, Schema
schema))
currentSchemaName :: SessionId -> Connection -> IO (Either RelationalError SchemaName)
currentSchemaName :: UUID -> Connection -> IO (Either RelationalError NotificationName)
currentSchemaName UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = STM (Either RelationalError NotificationName)
-> IO (Either RelationalError NotificationName)
forall a. STM a -> IO a
atomically (STM (Either RelationalError NotificationName)
-> IO (Either RelationalError NotificationName))
-> STM (Either RelationalError NotificationName)
-> IO (Either RelationalError NotificationName)
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError NotificationName
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NotificationName -> Either RelationalError NotificationName
forall a b. b -> Either a b
Right (Session -> NotificationName
Sess.schemaName Session
session))
currentSchemaName UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveCurrentSchemaName
-> IO (Either RelationalError NotificationName)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveCurrentSchemaName
RetrieveCurrentSchemaName UUID
sessionId)
setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())
setCurrentSchemaName :: UUID
-> Connection -> NotificationName -> IO (Either RelationalError ())
setCurrentSchemaName UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) NotificationName
sname = STM (Either RelationalError ()) -> IO (Either RelationalError ())
forall a. STM a -> IO a
atomically (STM (Either RelationalError ()) -> IO (Either RelationalError ()))
-> STM (Either RelationalError ())
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> case NotificationName -> Session -> Either RelationalError Session
Sess.setSchemaName NotificationName
sname Session
session of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
newSession -> Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert Session
newSession UUID
sessionId Map UUID Session
sessions STM ()
-> STM (Either RelationalError ())
-> STM (Either RelationalError ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
setCurrentSchemaName UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) NotificationName
sname = Connection
-> ExecuteSetCurrentSchema -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> NotificationName -> ExecuteSetCurrentSchema
ExecuteSetCurrentSchema UUID
sessionId NotificationName
sname)
executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
executeRelationalExpr :: UUID
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
executeRelationalExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) RelationalExpr
expr = IO (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a.
IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither (IO (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> IO (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err
Right (Session
session, Schema
schema) -> do
let expr' :: Either RelationalError RelationalExpr
expr' = if Session -> NotificationName
schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
/= NotificationName
defaultSchemaName then
Schema -> RelationalExpr -> Either RelationalError RelationalExpr
Schema.processRelationalExprInSchema Schema
schema RelationalExpr
expr
else
RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
expr
case Either RelationalError RelationalExpr
expr' of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right RelationalExpr
expr'' -> do
let graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
let reEnv :: RelationalExprEnv
reEnv = DatabaseContext -> TransactionGraph -> RelationalExprEnv
RE.mkRelationalExprEnv (Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session) TransactionGraph
graph
case RelationalExprEnv
-> RelationalExpr -> Either RelationalError Relation
optimizeAndEvalRelationalExpr RelationalExprEnv
reEnv RelationalExpr
expr'' of
Right Relation
rel -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation -> Either RelationalError Relation
forall a. NFData a => a -> a
force (Relation -> Either RelationalError Relation
forall a b. b -> Either a b
Right Relation
rel))
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
executeRelationalExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) RelationalExpr
relExpr = Connection
-> ExecuteRelationalExpr -> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RelationalExpr -> ExecuteRelationalExpr
ExecuteRelationalExpr UUID
sessionId RelationalExpr
relExpr)
executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())
executeDatabaseContextExpr :: UUID
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError ())
executeDatabaseContextExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) DatabaseContextExpr
expr = IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a.
IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither (IO (Either RelationalError ()) -> IO (Either RelationalError ()))
-> IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ STM (Either RelationalError ()) -> IO (Either RelationalError ())
forall a. STM a -> IO a
atomically (STM (Either RelationalError ()) -> IO (Either RelationalError ()))
-> STM (Either RelationalError ())
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right (Session
session, Schema
schema) -> do
let expr' :: Either RelationalError DatabaseContextExpr
expr' = if Session -> NotificationName
schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then
DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
forall a b. b -> Either a b
Right DatabaseContextExpr
expr
else
Schema
-> DatabaseContextExpr
-> Either RelationalError DatabaseContextExpr
Schema.processDatabaseContextExprInSchema Schema
schema DatabaseContextExpr
expr
case Either RelationalError DatabaseContextExpr
expr' of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right DatabaseContextExpr
expr'' -> do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
let ctx :: DatabaseContext
ctx = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
env :: DatabaseContextEvalEnv
env = UUID -> TransactionGraph -> DatabaseContextEvalEnv
RE.mkDatabaseContextEvalEnv UUID
transId TransactionGraph
graph
transId :: UUID
transId = Session -> UUID
Sess.parentId Session
session
case DatabaseContext
-> DatabaseContextEvalEnv
-> DatabaseContextEvalMonad ()
-> Either RelationalError DatabaseContextEvalState
RE.runDatabaseContextEvalMonad DatabaseContext
ctx DatabaseContextEvalEnv
env (Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad ()
optimizeAndEvalDatabaseContextExpr Bool
True DatabaseContextExpr
expr'') of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right DatabaseContextEvalState
newState ->
if Bool -> Bool
not (DatabaseContextEvalState -> Bool
RE.dbc_dirty DatabaseContextEvalState
newState) then
Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
else do
let newDiscon :: DisconnectedTransaction
newDiscon = UUID -> Schemas -> Bool -> DisconnectedTransaction
DisconnectedTransaction (Session -> UUID
Sess.parentId Session
session) Schemas
newSchemas Bool
True
context' :: DatabaseContext
context' = DatabaseContextEvalState -> DatabaseContext
RE.dbc_context DatabaseContextEvalState
newState
newSubschemas :: Map NotificationName Schema
newSubschemas = Map NotificationName Schema
-> DatabaseContextExpr -> Map NotificationName Schema
Schema.processDatabaseContextExprSchemasUpdate (Session -> Map NotificationName Schema
Sess.subschemas Session
session) DatabaseContextExpr
expr
newSchemas :: Schemas
newSchemas = DatabaseContext -> Map NotificationName Schema -> Schemas
Schemas DatabaseContext
context' Map NotificationName Schema
newSubschemas
newSession :: Session
newSession = DisconnectedTransaction -> NotificationName -> Session
Session DisconnectedTransaction
newDiscon (Session -> NotificationName
Sess.schemaName Session
session)
Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert Session
newSession UUID
sessionId Map UUID Session
sessions
Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
executeDatabaseContextExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) DatabaseContextExpr
dbExpr = Connection
-> ExecuteDatabaseContextExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> DatabaseContextExpr -> ExecuteDatabaseContextExpr
ExecuteDatabaseContextExpr UUID
sessionId DatabaseContextExpr
dbExpr)
autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
autoMergeToHead :: UUID
-> Connection
-> MergeStrategy
-> NotificationName
-> IO (Either RelationalError ())
autoMergeToHead UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) MergeStrategy
strat NotificationName
headName' = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
UUID
id1 <- IO UUID
nextRandom
UUID
id2 <- IO UUID
nextRandom
UUID
id3 <- IO UUID
nextRandom
UTCTime
tstamp <- IO UTCTime
getCurrentTime
UUID
-> InProcessConnectionConf
-> (TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ())
commitLock_ UUID
sessionId InProcessConnectionConf
conf ((TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ()))
-> (TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ \TransactionGraph
graph -> do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session ->
case NotificationName -> TransactionGraph -> Maybe Transaction
Graph.transactionForHead NotificationName
headName' TransactionGraph
graph of
Maybe Transaction
Nothing -> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. a -> Either a b
Left (NotificationName -> RelationalError
NoSuchHeadNameError NotificationName
headName'))
Just Transaction
headTrans -> do
let graphInfo :: Either
RelationalError
((DisconnectedTransaction, TransactionGraph), [UUID])
graphInfo = if Session -> UUID
Sess.parentId Session
session UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== Transaction -> UUID
transactionId Transaction
headTrans then do
(DisconnectedTransaction, TransactionGraph)
ret <- UTCTime
-> UUID
-> DisconnectedTransaction
-> TransactionGraph
-> TransactionGraphOperator
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph)
Graph.evalGraphOp UTCTime
tstamp UUID
id1 (Session -> DisconnectedTransaction
Sess.disconnectedTransaction Session
session) TransactionGraph
graph TransactionGraphOperator
Commit
((DisconnectedTransaction, TransactionGraph), [UUID])
-> Either
RelationalError
((DisconnectedTransaction, TransactionGraph), [UUID])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DisconnectedTransaction, TransactionGraph)
ret, [UUID
id1])
else do
(DisconnectedTransaction, TransactionGraph)
ret <- UTCTime
-> (UUID, UUID, UUID)
-> DisconnectedTransaction
-> NotificationName
-> MergeStrategy
-> TransactionGraph
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph)
Graph.autoMergeToHead UTCTime
tstamp (UUID
id1, UUID
id2, UUID
id3) (Session -> DisconnectedTransaction
Sess.disconnectedTransaction Session
session) NotificationName
headName' MergeStrategy
strat TransactionGraph
graph
((DisconnectedTransaction, TransactionGraph), [UUID])
-> Either
RelationalError
((DisconnectedTransaction, TransactionGraph), [UUID])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DisconnectedTransaction, TransactionGraph)
ret, [UUID
id1,UUID
id2,UUID
id3])
case Either
RelationalError
((DisconnectedTransaction, TransactionGraph), [UUID])
graphInfo of
Left RelationalError
err -> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right ((DisconnectedTransaction
discon', TransactionGraph
graph'), [UUID]
transactionIdsAdded) ->
Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DisconnectedTransaction, TransactionGraph, [UUID])
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. b -> Either a b
Right (DisconnectedTransaction
discon', TransactionGraph
graph', [UUID]
transactionIdsAdded))
autoMergeToHead UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) MergeStrategy
strat NotificationName
headName' = Connection
-> ExecuteAutoMergeToHead -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> MergeStrategy -> NotificationName -> ExecuteAutoMergeToHead
ExecuteAutoMergeToHead UUID
sessionId MergeStrategy
strat NotificationName
headName')
executeDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ())
executeDatabaseContextIOExpr :: UUID
-> Connection
-> DatabaseContextIOExpr
-> IO (Either RelationalError ())
executeDatabaseContextIOExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) DatabaseContextIOExpr
expr = IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a.
IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither (IO (Either RelationalError ()) -> IO (Either RelationalError ()))
-> IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
scriptSession :: Maybe ScriptSession
scriptSession = InProcessConnectionConf -> Maybe ScriptSession
ipScriptSession InProcessConnectionConf
conf
Either RelationalError Session
eSession <- STM (Either RelationalError Session)
-> IO (Either RelationalError Session)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Session)
-> IO (Either RelationalError Session))
-> STM (Either RelationalError Session)
-> IO (Either RelationalError Session)
forall a b. (a -> b) -> a -> b
$ UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError () -> IO (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> do
TransactionGraph
graph <- TVar TransactionGraph -> IO TransactionGraph
forall a. TVar a -> IO a
readTVarIO (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
let env :: DatabaseContextIOEvalEnv
env = UUID
-> TransactionGraph
-> Maybe ScriptSession
-> Maybe String
-> DatabaseContextIOEvalEnv
RE.DatabaseContextIOEvalEnv UUID
transId TransactionGraph
graph Maybe ScriptSession
scriptSession Maybe String
objFilesPath
objFilesPath :: Maybe String
objFilesPath = ShowS
objectFilesPath ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistenceStrategy -> Maybe String
persistenceDirectory (InProcessConnectionConf -> PersistenceStrategy
ipPersistenceStrategy InProcessConnectionConf
conf)
transId :: UUID
transId = Session -> UUID
Sess.parentId Session
session
context :: DatabaseContext
context = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
Either RelationalError DatabaseContextEvalState
res <- DatabaseContextIOEvalEnv
-> DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
-> IO (Either RelationalError DatabaseContextEvalState)
RE.runDatabaseContextIOEvalMonad DatabaseContextIOEvalEnv
env DatabaseContext
context (DatabaseContextIOExpr
-> DatabaseContextIOEvalMonad (Either RelationalError ())
optimizeAndEvalDatabaseContextIOExpr DatabaseContextIOExpr
expr)
case Either RelationalError DatabaseContextEvalState
res of
Left RelationalError
err -> Either RelationalError () -> IO (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right DatabaseContextEvalState
newState -> do
let newDiscon :: DisconnectedTransaction
newDiscon = UUID -> Schemas -> Bool -> DisconnectedTransaction
DisconnectedTransaction (Session -> UUID
Sess.parentId Session
session) Schemas
newSchemas Bool
False
newSchemas :: Schemas
newSchemas = DatabaseContext -> Map NotificationName Schema -> Schemas
Schemas DatabaseContext
context' (Session -> Map NotificationName Schema
Sess.subschemas Session
session)
newSession :: Session
newSession = DisconnectedTransaction -> NotificationName -> Session
Session DisconnectedTransaction
newDiscon (Session -> NotificationName
Sess.schemaName Session
session)
context' :: DatabaseContext
context' = DatabaseContextEvalState -> DatabaseContext
RE.dbc_context DatabaseContextEvalState
newState
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert Session
newSession UUID
sessionId Map UUID Session
sessions
Either RelationalError () -> IO (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
executeDatabaseContextIOExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) DatabaseContextIOExpr
dbExpr = Connection
-> ExecuteDatabaseContextIOExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> DatabaseContextIOExpr -> ExecuteDatabaseContextIOExpr
ExecuteDatabaseContextIOExpr UUID
sessionId DatabaseContextIOExpr
dbExpr)
executeCommitExprSTM_
:: TransactionGraph
-> DatabaseContext
-> DatabaseContext
-> ClientNodes
-> STM (EvaluatedNotifications, ClientNodes)
executeCommitExprSTM_ :: TransactionGraph
-> DatabaseContext
-> DatabaseContext
-> Set ClientInfo
-> STM (EvaluatedNotifications, Set ClientInfo)
executeCommitExprSTM_ TransactionGraph
graph DatabaseContext
oldContext DatabaseContext
newContext Set ClientInfo
nodes = do
let nots :: Notifications
nots = DatabaseContext -> Notifications
notifications DatabaseContext
oldContext
fireNots :: Notifications
fireNots = Notifications
-> TransactionGraph
-> DatabaseContext
-> DatabaseContext
-> Notifications
notificationChanges Notifications
nots TransactionGraph
graph DatabaseContext
oldContext DatabaseContext
newContext
evaldNots :: EvaluatedNotifications
evaldNots = (Notification -> EvaluatedNotification)
-> Notifications -> EvaluatedNotifications
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Notification -> EvaluatedNotification
mkEvaldNot Notifications
fireNots
evalInContext :: RelationalExpr
-> DatabaseContext -> Either RelationalError Relation
evalInContext RelationalExpr
expr DatabaseContext
ctx = RelationalExprEnv
-> RelationalExpr -> Either RelationalError Relation
optimizeAndEvalRelationalExpr (DatabaseContext -> TransactionGraph -> RelationalExprEnv
RE.mkRelationalExprEnv DatabaseContext
ctx TransactionGraph
graph) RelationalExpr
expr
mkEvaldNot :: Notification -> EvaluatedNotification
mkEvaldNot Notification
notif = EvaluatedNotification :: Notification
-> Either RelationalError Relation
-> Either RelationalError Relation
-> EvaluatedNotification
EvaluatedNotification { notification :: Notification
notification = Notification
notif,
reportOldRelation :: Either RelationalError Relation
reportOldRelation = RelationalExpr
-> DatabaseContext -> Either RelationalError Relation
evalInContext (Notification -> RelationalExpr
reportOldExpr Notification
notif) DatabaseContext
oldContext,
reportNewRelation :: Either RelationalError Relation
reportNewRelation = RelationalExpr
-> DatabaseContext -> Either RelationalError Relation
evalInContext (Notification -> RelationalExpr
reportNewExpr Notification
notif) DatabaseContext
newContext}
(EvaluatedNotifications, Set ClientInfo)
-> STM (EvaluatedNotifications, Set ClientInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvaluatedNotifications
evaldNots, Set ClientInfo
nodes)
executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ())
executeGraphExpr :: UUID
-> Connection
-> TransactionGraphOperator
-> IO (Either RelationalError ())
executeGraphExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) TransactionGraphOperator
graphExpr = IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a.
IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither (IO (Either RelationalError ()) -> IO (Either RelationalError ()))
-> IO (Either RelationalError ()) -> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
UUID
freshId <- IO UUID
nextRandom
UTCTime
tstamp <- IO UTCTime
getCurrentTime
UUID
-> InProcessConnectionConf
-> (TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ())
commitLock_ UUID
sessionId InProcessConnectionConf
conf ((TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ()))
-> (TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ \TransactionGraph
updatedGraph -> do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> do
let discon :: DisconnectedTransaction
discon = Session -> DisconnectedTransaction
Sess.disconnectedTransaction Session
session
case UTCTime
-> UUID
-> DisconnectedTransaction
-> TransactionGraph
-> TransactionGraphOperator
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph)
evalGraphOp UTCTime
tstamp UUID
freshId DisconnectedTransaction
discon TransactionGraph
updatedGraph TransactionGraphOperator
graphExpr of
Left RelationalError
err -> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right (DisconnectedTransaction
discon', TransactionGraph
graph') -> do
let transIds :: [UUID]
transIds = [UUID
freshId | Either RelationalError Transaction -> Bool
forall a b. Either a b -> Bool
isRight (UUID -> TransactionGraph -> Either RelationalError Transaction
RE.transactionForId UUID
freshId TransactionGraph
graph')]
Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DisconnectedTransaction, TransactionGraph, [UUID])
-> Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
forall a b. b -> Either a b
Right (DisconnectedTransaction
discon', TransactionGraph
graph', [UUID]
transIds))
executeGraphExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) TransactionGraphOperator
graphExpr = Connection -> ExecuteGraphExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> TransactionGraphOperator -> ExecuteGraphExpr
ExecuteGraphExpr UUID
sessionId TransactionGraphOperator
graphExpr)
executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)
executeTransGraphRelationalExpr :: UUID
-> Connection
-> TransGraphRelationalExpr
-> IO (Either RelationalError Relation)
executeTransGraphRelationalExpr UUID
_ (InProcessConnection InProcessConnectionConf
conf) TransGraphRelationalExpr
tgraphExpr = IO (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a.
IO (Either RelationalError a) -> IO (Either RelationalError a)
excEither (IO (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
let graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation -> Either RelationalError Relation
forall a. NFData a => a -> a
force (Either RelationalError Relation
-> Either RelationalError Relation)
-> Either RelationalError Relation
-> Either RelationalError Relation
forall a b. (a -> b) -> a -> b
$ TransactionGraph
-> TransGraphRelationalExpr -> Either RelationalError Relation
optimizeAndEvalTransGraphRelationalExpr TransactionGraph
graph TransGraphRelationalExpr
tgraphExpr
executeTransGraphRelationalExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) TransGraphRelationalExpr
tgraphExpr = Connection
-> ExecuteTransGraphRelationalExpr
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> TransGraphRelationalExpr -> ExecuteTransGraphRelationalExpr
ExecuteTransGraphRelationalExpr UUID
sessionId TransGraphRelationalExpr
tgraphExpr)
executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())
executeSchemaExpr :: UUID -> Connection -> SchemaExpr -> IO (Either RelationalError ())
executeSchemaExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) SchemaExpr
schemaExpr = STM (Either RelationalError ()) -> IO (Either RelationalError ())
forall a. STM a -> IO a
atomically (STM (Either RelationalError ()) -> IO (Either RelationalError ()))
-> STM (Either RelationalError ())
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right (Session
session, Schema
_) -> do
let subschemas' :: Map NotificationName Schema
subschemas' = Session -> Map NotificationName Schema
subschemas Session
session
transId :: UUID
transId = Session -> UUID
Sess.parentId Session
session
context :: DatabaseContext
context = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
case SchemaExpr
-> DatabaseContext
-> UUID
-> TransactionGraph
-> Map NotificationName Schema
-> Either
RelationalError (Map NotificationName Schema, DatabaseContext)
Schema.evalSchemaExpr SchemaExpr
schemaExpr DatabaseContext
context UUID
transId TransactionGraph
graph Map NotificationName Schema
subschemas' of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right (Map NotificationName Schema
newSubschemas, DatabaseContext
newContext) -> do
let discon :: DisconnectedTransaction
discon = Session -> DisconnectedTransaction
Sess.disconnectedTransaction Session
session
newSchemas :: Schemas
newSchemas = DatabaseContext -> Map NotificationName Schema -> Schemas
Schemas DatabaseContext
newContext Map NotificationName Schema
newSubschemas
newSession :: Session
newSession = DisconnectedTransaction -> NotificationName -> Session
Session (UUID -> Schemas -> Bool -> DisconnectedTransaction
DisconnectedTransaction (DisconnectedTransaction -> UUID
Discon.parentId DisconnectedTransaction
discon) Schemas
newSchemas Bool
False) (Session -> NotificationName
Sess.schemaName Session
session)
Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert Session
newSession UUID
sessionId Map UUID Session
sessions
Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
executeSchemaExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) SchemaExpr
schemaExpr = Connection -> ExecuteSchemaExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> SchemaExpr -> ExecuteSchemaExpr
ExecuteSchemaExpr UUID
sessionId SchemaExpr
schemaExpr)
commit :: SessionId -> Connection -> IO (Either RelationalError ())
commit :: UUID -> Connection -> IO (Either RelationalError ())
commit UUID
sessionId conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
_) = UUID
-> Connection
-> TransactionGraphOperator
-> IO (Either RelationalError ())
executeGraphExpr UUID
sessionId Connection
conn TransactionGraphOperator
Commit
commit UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection -> ExecuteGraphExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> TransactionGraphOperator -> ExecuteGraphExpr
ExecuteGraphExpr UUID
sessionId TransactionGraphOperator
Commit)
sendNotifications :: [ClientInfo] -> EvaluatedNotifications -> IO ()
sendNotifications :: [ClientInfo] -> EvaluatedNotifications -> IO ()
sendNotifications [ClientInfo]
clients EvaluatedNotifications
notifs =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (EvaluatedNotifications -> Bool
forall k a. Map k a -> Bool
M.null EvaluatedNotifications
notifs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [ClientInfo] -> (ClientInfo -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ClientInfo]
clients ClientInfo -> IO ()
sender
where
sender :: ClientInfo -> IO ()
sender (RemoteClientInfo Locking Socket
sock) = Locking Socket -> NotificationMessage -> IO ()
forall a. Serialise a => Locking Socket -> a -> IO ()
RPC.sendMessage Locking Socket
sock (EvaluatedNotifications -> NotificationMessage
NotificationMessage EvaluatedNotifications
notifs)
sender (InProcessClientInfo MVar EvaluatedNotifications
tvar) = MVar EvaluatedNotifications -> EvaluatedNotifications -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar EvaluatedNotifications
tvar EvaluatedNotifications
notifs
rollback :: SessionId -> Connection -> IO (Either RelationalError ())
rollback :: UUID -> Connection -> IO (Either RelationalError ())
rollback UUID
sessionId conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
_) = UUID
-> Connection
-> TransactionGraphOperator
-> IO (Either RelationalError ())
executeGraphExpr UUID
sessionId Connection
conn TransactionGraphOperator
Rollback
rollback UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection -> ExecuteGraphExpr -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> TransactionGraphOperator -> ExecuteGraphExpr
ExecuteGraphExpr UUID
sessionId TransactionGraphOperator
Rollback)
processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()
processTransactionGraphPersistence :: PersistenceStrategy -> [UUID] -> TransactionGraph -> IO ()
processTransactionGraphPersistence PersistenceStrategy
NoPersistence [UUID]
_ TransactionGraph
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
processTransactionGraphPersistence (MinimalPersistence String
dbdir) [UUID]
transIds TransactionGraph
graph = DiskSync -> String -> [UUID] -> TransactionGraph -> IO LockFileHash
transactionGraphPersist DiskSync
NoDiskSync String
dbdir [UUID]
transIds TransactionGraph
graph IO LockFileHash -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
processTransactionGraphPersistence (CrashSafePersistence String
dbdir) [UUID]
transIds TransactionGraph
graph = DiskSync -> String -> [UUID] -> TransactionGraph -> IO LockFileHash
transactionGraphPersist DiskSync
FsyncDiskSync String
dbdir [UUID]
transIds TransactionGraph
graph IO LockFileHash -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
readGraphTransactionIdDigest :: PersistenceStrategy -> IO LockFileHash
readGraphTransactionIdDigest :: PersistenceStrategy -> IO LockFileHash
readGraphTransactionIdDigest PersistenceStrategy
NoPersistence = String -> IO LockFileHash
forall a. HasCallStack => String -> a
error String
"attempt to read digest from transaction log without persistence enabled"
readGraphTransactionIdDigest (MinimalPersistence String
dbdir) = String -> IO LockFileHash
readGraphTransactionIdFileDigest String
dbdir
readGraphTransactionIdDigest (CrashSafePersistence String
dbdir) = String -> IO LockFileHash
readGraphTransactionIdFileDigest String
dbdir
typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
typeForRelationalExpr :: UUID
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
typeForRelationalExpr UUID
sessionId conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
_) RelationalExpr
relExpr = STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ UUID
-> Connection
-> RelationalExpr
-> STM (Either RelationalError Relation)
typeForRelationalExprSTM UUID
sessionId Connection
conn RelationalExpr
relExpr
typeForRelationalExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) RelationalExpr
relExpr = Connection
-> ExecuteTypeForRelationalExpr
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RelationalExpr -> ExecuteTypeForRelationalExpr
ExecuteTypeForRelationalExpr UUID
sessionId RelationalExpr
relExpr)
typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)
typeForRelationalExprSTM :: UUID
-> Connection
-> RelationalExpr
-> STM (Either RelationalError Relation)
typeForRelationalExprSTM UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) RelationalExpr
relExpr = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err
Right (Session
session, Schema
schema) -> do
let processed :: Either RelationalError RelationalExpr
processed = if Session -> NotificationName
schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then
RelationalExpr -> Either RelationalError RelationalExpr
forall a b. b -> Either a b
Right RelationalExpr
relExpr
else
Schema -> RelationalExpr -> Either RelationalError RelationalExpr
Schema.processRelationalExprInSchema Schema
schema RelationalExpr
relExpr
case Either RelationalError RelationalExpr
processed of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right RelationalExpr
relExpr' -> do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
let reEnv :: RelationalExprEnv
reEnv = DatabaseContext -> TransactionGraph -> RelationalExprEnv
RE.mkRelationalExprEnv (Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session) TransactionGraph
graph
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ RelationalExprEnv
-> RelationalExprM Relation -> Either RelationalError Relation
forall a.
RelationalExprEnv -> RelationalExprM a -> Either RelationalError a
RE.runRelationalExprM RelationalExprEnv
reEnv (RelationalExpr -> RelationalExprM Relation
RE.typeForRelationalExpr RelationalExpr
relExpr')
typeForRelationalExprSTM UUID
_ Connection
_ RelationalExpr
_ = String -> STM (Either RelationalError Relation)
forall a. HasCallStack => String -> a
error String
"typeForRelationalExprSTM called on non-local connection"
inclusionDependencies :: SessionId -> Connection -> IO (Either RelationalError InclusionDependencies)
inclusionDependencies :: UUID
-> Connection -> IO (Either RelationalError InclusionDependencies)
inclusionDependencies UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError InclusionDependencies)
-> IO (Either RelationalError InclusionDependencies)
forall a. STM a -> IO a
atomically (STM (Either RelationalError InclusionDependencies)
-> IO (Either RelationalError InclusionDependencies))
-> STM (Either RelationalError InclusionDependencies)
-> IO (Either RelationalError InclusionDependencies)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies))
-> Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError InclusionDependencies
forall a b. a -> Either a b
Left RelationalError
err
Right (Session
session, Schema
schema) -> do
let context :: DatabaseContext
context = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
if Session -> NotificationName
schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then
Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies))
-> Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies)
forall a b. (a -> b) -> a -> b
$ InclusionDependencies
-> Either RelationalError InclusionDependencies
forall a b. b -> Either a b
Right (DatabaseContext -> InclusionDependencies
B.inclusionDependencies DatabaseContext
context)
else
Either RelationalError InclusionDependencies
-> STM (Either RelationalError InclusionDependencies)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema
-> InclusionDependencies
-> Either RelationalError InclusionDependencies
Schema.inclusionDependenciesInSchema Schema
schema (DatabaseContext -> InclusionDependencies
B.inclusionDependencies DatabaseContext
context))
inclusionDependencies UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveInclusionDependencies
-> IO (Either RelationalError InclusionDependencies)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveInclusionDependencies
RetrieveInclusionDependencies UUID
sessionId)
typeConstructorMapping :: SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)
typeConstructorMapping :: UUID
-> Connection -> IO (Either RelationalError TypeConstructorMapping)
typeConstructorMapping UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError TypeConstructorMapping)
-> IO (Either RelationalError TypeConstructorMapping)
forall a. STM a -> IO a
atomically (STM (Either RelationalError TypeConstructorMapping)
-> IO (Either RelationalError TypeConstructorMapping))
-> STM (Either RelationalError TypeConstructorMapping)
-> IO (Either RelationalError TypeConstructorMapping)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError TypeConstructorMapping
-> STM (Either RelationalError TypeConstructorMapping)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError TypeConstructorMapping
-> STM (Either RelationalError TypeConstructorMapping))
-> Either RelationalError TypeConstructorMapping
-> STM (Either RelationalError TypeConstructorMapping)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError TypeConstructorMapping
forall a b. a -> Either a b
Left RelationalError
err
Right (Session
session, Schema
_) ->
Either RelationalError TypeConstructorMapping
-> STM (Either RelationalError TypeConstructorMapping)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeConstructorMapping
-> Either RelationalError TypeConstructorMapping
forall a b. b -> Either a b
Right (DatabaseContext -> TypeConstructorMapping
B.typeConstructorMapping (Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session)))
typeConstructorMapping UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveTypeConstructorMapping
-> IO (Either RelationalError TypeConstructorMapping)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveTypeConstructorMapping
RetrieveTypeConstructorMapping UUID
sessionId)
planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)
planForDatabaseContextExpr :: UUID
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
planForDatabaseContextExpr UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) DatabaseContextExpr
dbExpr = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError GraphRefDatabaseContextExpr)
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
forall a. STM a -> IO a
atomically (STM (Either RelationalError GraphRefDatabaseContextExpr)
-> IO (Either RelationalError GraphRefDatabaseContextExpr))
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
forall a b. (a -> b) -> a -> b
$ do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr))
-> Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
forall a b. (a -> b) -> a -> b
$ RelationalError
-> Either RelationalError GraphRefDatabaseContextExpr
forall a b. a -> Either a b
Left RelationalError
err
Right (Session
session, Schema
_) ->
if Session -> NotificationName
schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then do
let ctx :: DatabaseContext
ctx = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
transId :: UUID
transId = Session -> UUID
Sess.parentId Session
session
gfExpr :: GraphRefDatabaseContextExpr
gfExpr = GraphRefTransactionMarker
-> ProcessExprM GraphRefDatabaseContextExpr
-> GraphRefDatabaseContextExpr
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker (DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr
processDatabaseContextExpr DatabaseContextExpr
dbExpr)
Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr))
-> Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
forall a b. (a -> b) -> a -> b
$ UUID
-> DatabaseContext
-> TransactionGraph
-> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
-> Either RelationalError GraphRefDatabaseContextExpr
forall a.
UUID
-> DatabaseContext
-> TransactionGraph
-> GraphRefSOptDatabaseContextExprM a
-> Either RelationalError a
runGraphRefSOptDatabaseContextExprM UUID
transId DatabaseContext
ctx TransactionGraph
graph (GraphRefDatabaseContextExpr
-> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
optimizeGraphRefDatabaseContextExpr GraphRefDatabaseContextExpr
gfExpr)
else
Either RelationalError GraphRefDatabaseContextExpr
-> STM (Either RelationalError GraphRefDatabaseContextExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either RelationalError GraphRefDatabaseContextExpr
forall a b. a -> Either a b
Left RelationalError
NonConcreteSchemaPlanError)
planForDatabaseContextExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) DatabaseContextExpr
dbExpr = Connection
-> RetrievePlanForDatabaseContextExpr
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> DatabaseContextExpr -> RetrievePlanForDatabaseContextExpr
RetrievePlanForDatabaseContextExpr UUID
sessionId DatabaseContextExpr
dbExpr)
transactionGraphAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
transactionGraphAsRelation :: UUID -> Connection -> IO (Either RelationalError Relation)
transactionGraphAsRelation UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
tvar :: TVar TransactionGraph
tvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err
Right Session
session ->
DisconnectedTransaction
-> TransactionGraph -> Either RelationalError Relation
graphAsRelation (Session -> DisconnectedTransaction
Sess.disconnectedTransaction Session
session) (TransactionGraph -> Either RelationalError Relation)
-> STM TransactionGraph -> STM (Either RelationalError Relation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
tvar
transactionGraphAsRelation UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveTransactionGraph -> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveTransactionGraph
RetrieveTransactionGraph UUID
sessionId)
relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
relationVariablesAsRelation :: UUID -> Connection -> IO (Either RelationalError Relation)
relationVariablesAsRelation UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right (Session
session, Schema
schema) -> do
let context :: DatabaseContext
context = Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session
if Session -> NotificationName
Sess.schemaName Session
session NotificationName -> NotificationName -> Bool
forall a. Eq a => a -> a -> Bool
== NotificationName
defaultSchemaName then
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ DatabaseContext
-> TransactionGraph -> Either RelationalError Relation
RE.relationVariablesAsRelation DatabaseContext
context TransactionGraph
graph
else
case Schema -> Either RelationalError RelationVariables
Schema.relationVariablesInSchema Schema
schema of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right RelationVariables
relvars -> do
let schemaContext :: DatabaseContext
schemaContext = DatabaseContext
context {relationVariables :: RelationVariables
relationVariables = RelationVariables
relvars }
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
-> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ DatabaseContext
-> TransactionGraph -> Either RelationalError Relation
RE.relationVariablesAsRelation DatabaseContext
schemaContext TransactionGraph
graph
relationVariablesAsRelation UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveRelationVariableSummary
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveRelationVariableSummary
RetrieveRelationVariableSummary UUID
sessionId)
atomFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
atomFunctionsAsRelation :: UUID -> Connection -> IO (Either RelationalError Relation)
atomFunctionsAsRelation UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right (Session
session, Schema
_) ->
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomFunctions -> Either RelationalError Relation
AF.atomFunctionsAsRelation (DatabaseContext -> AtomFunctions
atomFunctions (Session -> DatabaseContext
concreteDatabaseContext Session
session)))
atomFunctionsAsRelation UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveAtomFunctionSummary
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveAtomFunctionSummary
RetrieveAtomFunctionSummary UUID
sessionId)
databaseContextFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
databaseContextFunctionsAsRelation :: UUID -> Connection -> IO (Either RelationalError Relation)
databaseContextFunctionsAsRelation UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError (Session, Schema)
eSession <- UUID
-> Map UUID Session
-> STM (Either RelationalError (Session, Schema))
sessionAndSchema UUID
sessionId Map UUID Session
sessions
case Either RelationalError (Session, Schema)
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right (Session
session, Schema
_) ->
Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextFunctions -> Either RelationalError Relation
DCF.databaseContextFunctionsAsRelation (DatabaseContext -> DatabaseContextFunctions
dbcFunctions (Session -> DatabaseContext
concreteDatabaseContext Session
session)))
databaseContextFunctionsAsRelation UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveDatabaseContextFunctionSummary
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveDatabaseContextFunctionSummary
RetrieveDatabaseContextFunctionSummary UUID
sessionId)
headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)
headTransactionId :: UUID -> Connection -> IO (Either RelationalError UUID)
headTransactionId UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a. STM a -> IO a
atomically (STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID))
-> STM (Either RelationalError UUID)
-> IO (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError UUID
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError UUID -> STM (Either RelationalError UUID))
-> Either RelationalError UUID -> STM (Either RelationalError UUID)
forall a b. (a -> b) -> a -> b
$ UUID -> Either RelationalError UUID
forall a b. b -> Either a b
Right (Session -> UUID
Sess.parentId Session
session)
headTransactionId UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveHeadTransactionId -> IO (Either RelationalError UUID)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveHeadTransactionId
RetrieveHeadTransactionId UUID
sessionId)
headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)
headNameSTM_ :: UUID
-> Map UUID Session
-> TVar TransactionGraph
-> STM (Either RelationalError NotificationName)
headNameSTM_ UUID
sessionId Map UUID Session
sessions TVar TransactionGraph
graphTvar = do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError NotificationName
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> case UUID -> TransactionGraph -> Either RelationalError Transaction
RE.transactionForId (Session -> UUID
Sess.parentId Session
session) TransactionGraph
graph of
Left RelationalError
err -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError NotificationName
forall a b. a -> Either a b
Left RelationalError
err)
Right Transaction
parentTrans -> case Transaction -> TransactionGraph -> Maybe NotificationName
headNameForTransaction Transaction
parentTrans TransactionGraph
graph of
Maybe NotificationName
Nothing -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError NotificationName
forall a b. a -> Either a b
Left RelationalError
UnknownHeadError)
Just NotificationName
headName' -> Either RelationalError NotificationName
-> STM (Either RelationalError NotificationName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NotificationName -> Either RelationalError NotificationName
forall a b. b -> Either a b
Right NotificationName
headName')
headName :: SessionId -> Connection -> IO (Either RelationalError HeadName)
headName :: UUID -> Connection -> IO (Either RelationalError NotificationName)
headName UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
STM (Either RelationalError NotificationName)
-> IO (Either RelationalError NotificationName)
forall a. STM a -> IO a
atomically (UUID
-> Map UUID Session
-> TVar TransactionGraph
-> STM (Either RelationalError NotificationName)
headNameSTM_ UUID
sessionId Map UUID Session
sessions TVar TransactionGraph
graphTvar)
headName UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> ExecuteHeadName -> IO (Either RelationalError NotificationName)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> ExecuteHeadName
ExecuteHeadName UUID
sessionId)
atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
atomTypesAsRelation :: UUID -> Connection -> IO (Either RelationalError Relation)
atomTypesAsRelation UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation))
-> STM (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session ->
case TypeConstructorMapping -> Either RelationalError Relation
typesAsRelation (DatabaseContext -> TypeConstructorMapping
B.typeConstructorMapping (Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session)) of
Left RelationalError
err -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err)
Right Relation
rel -> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> Either RelationalError Relation
forall a b. b -> Either a b
Right Relation
rel)
atomTypesAsRelation UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveAtomTypesAsRelation
-> IO (Either RelationalError Relation)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveAtomTypesAsRelation
RetrieveAtomTypesAsRelation UUID
sessionId)
disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)
disconnectedTransactionIsDirty :: UUID -> Connection -> IO (Either RelationalError Bool)
disconnectedTransactionIsDirty UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError Bool)
-> IO (Either RelationalError Bool)
forall a. STM a -> IO a
atomically (STM (Either RelationalError Bool)
-> IO (Either RelationalError Bool))
-> STM (Either RelationalError Bool)
-> IO (Either RelationalError Bool)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError Bool -> STM (Either RelationalError Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Bool
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session ->
Either RelationalError Bool -> STM (Either RelationalError Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either RelationalError Bool
forall a b. b -> Either a b
Right (Session -> Bool
isDirty Session
session))
disconnectedTransactionIsDirty UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection
-> RetrieveSessionIsDirty -> IO (Either RelationalError Bool)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> RetrieveSessionIsDirty
RetrieveSessionIsDirty UUID
sessionId)
callTestTimeout_ :: SessionId -> Connection -> IO Bool
callTestTimeout_ :: UUID -> Connection -> IO Bool
callTestTimeout_ UUID
_ (InProcessConnection InProcessConnectionConf
_) = String -> IO Bool
forall a. HasCallStack => String -> a
error String
"bad testing call"
callTestTimeout_ UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) = Connection -> TestTimeout -> IO Bool
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> TestTimeout
TestTimeout UUID
sessionId)
transactionGraph_ :: Connection -> IO TransactionGraph
transactionGraph_ :: Connection -> IO TransactionGraph
transactionGraph_ (InProcessConnection InProcessConnectionConf
conf) = TVar TransactionGraph -> IO TransactionGraph
forall a. TVar a -> IO a
readTVarIO (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
transactionGraph_ Connection
_ = String -> IO TransactionGraph
forall a. HasCallStack => String -> a
error String
"remote connection used"
disconnectedTransaction_ :: SessionId -> Connection -> IO DisconnectedTransaction
disconnectedTransaction_ :: UUID -> Connection -> IO DisconnectedTransaction
disconnectedTransaction_ UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
Maybe Session
mSession <- STM (Maybe Session) -> IO (Maybe Session)
forall a. STM a -> IO a
atomically (STM (Maybe Session) -> IO (Maybe Session))
-> STM (Maybe Session) -> IO (Maybe Session)
forall a b. (a -> b) -> a -> b
$ UUID -> Map UUID Session -> STM (Maybe Session)
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
StmMap.lookup UUID
sessionId Map UUID Session
sessions
case Maybe Session
mSession of
Maybe Session
Nothing -> String -> IO DisconnectedTransaction
forall a. HasCallStack => String -> a
error String
"No such session"
Just (Sess.Session DisconnectedTransaction
discon NotificationName
_) -> DisconnectedTransaction -> IO DisconnectedTransaction
forall (f :: * -> *) a. Applicative f => a -> f a
pure DisconnectedTransaction
discon
disconnectedTransaction_ UUID
_ Connection
_= String -> IO DisconnectedTransaction
forall a. HasCallStack => String -> a
error String
"remote connection used"
commitLock_ :: SessionId ->
InProcessConnectionConf ->
(TransactionGraph ->
STM (Either RelationalError (DisconnectedTransaction, TransactionGraph, [TransactionId]))) ->
IO (Either RelationalError ())
commitLock_ :: UUID
-> InProcessConnectionConf
-> (TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID])))
-> IO (Either RelationalError ())
commitLock_ UUID
sessionId InProcessConnectionConf
conf TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
stmBlock = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
strat :: PersistenceStrategy
strat = InProcessConnectionConf -> PersistenceStrategy
ipPersistenceStrategy InProcessConnectionConf
conf
mScriptSession :: Maybe ScriptSession
mScriptSession = InProcessConnectionConf -> Maybe ScriptSession
ipScriptSession InProcessConnectionConf
conf
graphTvar :: TVar TransactionGraph
graphTvar = InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf
clientNodes :: Set ClientInfo
clientNodes = InProcessConnectionConf -> Set ClientInfo
ipClientNodes InProcessConnectionConf
conf
mLockFileH :: Maybe (LockFile, MVar LockFileHash)
mLockFileH = InProcessConnectionConf -> Maybe (LockFile, MVar LockFileHash)
ipLocks InProcessConnectionConf
conf
lockHandler :: (Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
lockHandler Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
body = case Maybe (LockFile, MVar LockFileHash)
mLockFileH of
Maybe (LockFile, MVar LockFileHash)
Nothing -> Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
body Bool
False
Just (LockFile
lockFileH, MVar LockFileHash
lockMVar) ->
let acquireLocks :: IO Bool
acquireLocks = do
LockFileHash
lastWrittenDigest <- MVar LockFileHash -> IO LockFileHash
forall a. MVar a -> IO a
takeMVar MVar LockFileHash
lockMVar
LockFile -> LockType -> IO ()
lockFile LockFile
lockFileH LockType
WriteLock
LockFileHash
latestDigest <- PersistenceStrategy -> IO LockFileHash
readGraphTransactionIdDigest PersistenceStrategy
strat
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockFileHash
latestDigest LockFileHash -> LockFileHash -> Bool
forall a. Eq a => a -> a -> Bool
/= LockFileHash
lastWrittenDigest)
releaseLocks :: Bool -> IO ()
releaseLocks Bool
_ = do
LockFileHash
gDigest <- PersistenceStrategy -> IO LockFileHash
readGraphTransactionIdDigest PersistenceStrategy
strat
LockFile -> IO ()
unlockFile LockFile
lockFileH
MVar LockFileHash -> LockFileHash -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar LockFileHash
lockMVar LockFileHash
gDigest
in IO Bool
-> (Bool -> IO ())
-> (Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Bool
acquireLocks Bool -> IO ()
releaseLocks Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
body
Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
manip <- (Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
lockHandler ((Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> (Bool
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a b. (a -> b) -> a -> b
$ \Bool
dbWrittenByOtherProcess -> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a. STM a -> IO a
atomically (STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
-> IO
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
TransactionGraph
oldGraph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar TVar TransactionGraph
graphTvar
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
session -> do
let dbdir :: String
dbdir = case PersistenceStrategy
strat of
MinimalPersistence String
x -> String
x
CrashSafePersistence String
x -> String
x
PersistenceStrategy
_ -> ShowS
forall a. HasCallStack => String -> a
error String
"accessing dbdir on non-persisted connection"
Either PersistenceError TransactionGraph
eRefreshedGraph <- if Bool
dbWrittenByOtherProcess then
IO (Either PersistenceError TransactionGraph)
-> STM (Either PersistenceError TransactionGraph)
forall a. IO a -> STM a
unsafeIOToSTM (String
-> TransactionGraph
-> Maybe ScriptSession
-> IO (Either PersistenceError TransactionGraph)
transactionGraphLoad String
dbdir TransactionGraph
oldGraph Maybe ScriptSession
mScriptSession)
else
Either PersistenceError TransactionGraph
-> STM (Either PersistenceError TransactionGraph)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransactionGraph -> Either PersistenceError TransactionGraph
forall a b. b -> Either a b
Right TransactionGraph
oldGraph)
case Either PersistenceError TransactionGraph
eRefreshedGraph of
Left PersistenceError
err -> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. a -> Either a b
Left (PersistenceError -> RelationalError
DatabaseLoadError PersistenceError
err))
Right TransactionGraph
refreshedGraph -> do
Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
eGraph <- TransactionGraph
-> STM
(Either
RelationalError
(DisconnectedTransaction, TransactionGraph, [UUID]))
stmBlock TransactionGraph
refreshedGraph
case Either
RelationalError (DisconnectedTransaction, TransactionGraph, [UUID])
eGraph of
Left RelationalError
err -> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err)
Right (DisconnectedTransaction
discon', TransactionGraph
graph', [UUID]
transactionIdsToPersist) -> do
TVar TransactionGraph -> TransactionGraph -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar TransactionGraph
graphTvar TransactionGraph
graph'
let newSession :: Session
newSession = DisconnectedTransaction -> NotificationName -> Session
Session DisconnectedTransaction
discon' (Session -> NotificationName
Sess.schemaName Session
session)
Session -> UUID -> Map UUID Session -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
StmMap.insert Session
newSession UUID
sessionId Map UUID Session
sessions
case UUID -> TransactionGraph -> Either RelationalError Transaction
RE.transactionForId (Session -> UUID
Sess.parentId Session
session) TransactionGraph
oldGraph of
Left RelationalError
err -> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a b. (a -> b) -> a -> b
$ RelationalError
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. a -> Either a b
Left RelationalError
err
Right Transaction
previousTrans ->
if Bool -> Bool
not ([UUID] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [UUID]
transactionIdsToPersist) then do
(EvaluatedNotifications
evaldNots, Set ClientInfo
nodes) <- TransactionGraph
-> DatabaseContext
-> DatabaseContext
-> Set ClientInfo
-> STM (EvaluatedNotifications, Set ClientInfo)
executeCommitExprSTM_ TransactionGraph
graph' (Transaction -> DatabaseContext
Trans.concreteDatabaseContext Transaction
previousTrans) (Session -> DatabaseContext
Sess.concreteDatabaseContext Session
session) Set ClientInfo
clientNodes
[ClientInfo]
nodesToNotify <- Set ClientInfo -> STM [ClientInfo]
forall v. Set v -> STM [v]
stmSetToList Set ClientInfo
nodes
Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])))
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall a b. (a -> b) -> a -> b
$ (EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. b -> Either a b
Right (EvaluatedNotifications
evaldNots, [ClientInfo]
nodesToNotify, TransactionGraph
graph', [UUID]
transactionIdsToPersist)
else Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> STM
(Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
-> Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
forall a b. b -> Either a b
Right (EvaluatedNotifications
forall k a. Map k a
M.empty, [], TransactionGraph
graph', []))
case Either
RelationalError
(EvaluatedNotifications, [ClientInfo], TransactionGraph, [UUID])
manip of
Left RelationalError
err -> Either RelationalError () -> IO (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right (EvaluatedNotifications
notsToFire, [ClientInfo]
nodesToNotify, TransactionGraph
newGraph, [UUID]
transactionIdsToPersist) -> do
PersistenceStrategy -> [UUID] -> TransactionGraph -> IO ()
processTransactionGraphPersistence PersistenceStrategy
strat [UUID]
transactionIdsToPersist TransactionGraph
newGraph
[ClientInfo] -> EvaluatedNotifications -> IO ()
sendNotifications [ClientInfo]
nodesToNotify EvaluatedNotifications
notsToFire
Either RelationalError () -> IO (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a)
withTransaction :: UUID
-> Connection
-> IO (Either RelationalError a)
-> IO (Either RelationalError ())
-> IO (Either RelationalError a)
withTransaction UUID
sessionId Connection
conn IO (Either RelationalError a)
io IO (Either RelationalError ())
successFunc = IO ()
-> (() -> IO (Either RelationalError ()))
-> (() -> IO (Either RelationalError a))
-> IO (Either RelationalError a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO (Either RelationalError ())
-> () -> IO (Either RelationalError ())
forall a b. a -> b -> a
const IO (Either RelationalError ())
do_rollback) () -> IO (Either RelationalError a)
block
where
do_rollback :: IO (Either RelationalError ())
do_rollback = UUID -> Connection -> IO (Either RelationalError ())
rollback UUID
sessionId Connection
conn
block :: () -> IO (Either RelationalError a)
block ()
_ = do
Either RelationalError a
eErr <- IO (Either RelationalError a)
io
case Either RelationalError a
eErr of
Left RelationalError
err -> do
Either RelationalError ()
_ <- IO (Either RelationalError ())
do_rollback
Either RelationalError a -> IO (Either RelationalError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError a
forall a b. a -> Either a b
Left RelationalError
err)
Right a
val -> do
Either RelationalError Bool
eIsDirty <- UUID -> Connection -> IO (Either RelationalError Bool)
disconnectedTransactionIsDirty UUID
sessionId Connection
conn
case Either RelationalError Bool
eIsDirty of
Left RelationalError
err -> Either RelationalError a -> IO (Either RelationalError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError a
forall a b. a -> Either a b
Left RelationalError
err)
Right Bool
dirty ->
if Bool
dirty then do
Either RelationalError ()
res <- IO (Either RelationalError ())
successFunc
case Either RelationalError ()
res of
Left RelationalError
err -> Either RelationalError a -> IO (Either RelationalError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError a
forall a b. a -> Either a b
Left RelationalError
err)
Right ()
_ -> Either RelationalError a -> IO (Either RelationalError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either RelationalError a
forall a b. b -> Either a b
Right a
val)
else
Either RelationalError a -> IO (Either RelationalError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either RelationalError a
forall a b. b -> Either a b
Right a
val)
executeDataFrameExpr :: SessionId -> Connection -> DF.DataFrameExpr -> IO (Either RelationalError DF.DataFrame)
executeDataFrameExpr :: UUID
-> Connection
-> DataFrameExpr
-> IO (Either RelationalError DataFrame)
executeDataFrameExpr UUID
sessionId conn :: Connection
conn@(InProcessConnection InProcessConnectionConf
_) DataFrameExpr
dfExpr = do
Either RelationalError Relation
eRel <- UUID
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
executeRelationalExpr UUID
sessionId Connection
conn (DataFrameExpr -> RelationalExpr
DF.convertExpr DataFrameExpr
dfExpr)
case Either RelationalError Relation
eRel of
Left RelationalError
err -> Either RelationalError DataFrame
-> IO (Either RelationalError DataFrame)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError DataFrame
forall a b. a -> Either a b
Left RelationalError
err)
Right Relation
rel -> do
let relAttrs :: Attributes
relAttrs = Relation -> Attributes
R.attributes Relation
rel
attrName :: AttributeOrderExpr -> NotificationName
attrName (DF.AttributeOrderExpr NotificationName
name Order
_) = NotificationName
name
order :: AttributeOrderExpr -> Order
order (DF.AttributeOrderExpr NotificationName
_ Order
ord) = Order
ord
orders :: [Order]
orders = (AttributeOrderExpr -> Order) -> [AttributeOrderExpr] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map AttributeOrderExpr -> Order
order (DataFrameExpr -> [AttributeOrderExpr]
DF.orderExprs DataFrameExpr
dfExpr)
attributeForName' :: NotificationName -> Either RelationalError Attribute
attributeForName' = (NotificationName
-> Attributes -> Either RelationalError Attribute)
-> Attributes
-> NotificationName
-> Either RelationalError Attribute
forall a b c. (a -> b -> c) -> b -> a -> c
flip NotificationName -> Attributes -> Either RelationalError Attribute
attributeForName Attributes
relAttrs
attrNames :: [NotificationName]
attrNames = (AttributeOrderExpr -> NotificationName)
-> [AttributeOrderExpr] -> [NotificationName]
forall a b. (a -> b) -> [a] -> [b]
map AttributeOrderExpr -> NotificationName
attrName (DataFrameExpr -> [AttributeOrderExpr]
DF.orderExprs DataFrameExpr
dfExpr)
verified :: Either RelationalError [Attribute]
verified = [NotificationName]
-> (NotificationName -> Either RelationalError Attribute)
-> Either RelationalError [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [NotificationName]
attrNames NotificationName -> Either RelationalError Attribute
attributeForName'
case Either RelationalError [Attribute]
verified of
Left RelationalError
err -> Either RelationalError DataFrame
-> IO (Either RelationalError DataFrame)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError DataFrame
forall a b. a -> Either a b
Left RelationalError
err)
Right [Attribute]
attrs -> do
let attrOrders :: [AttributeOrder]
attrOrders = (Attribute -> Order -> AttributeOrder)
-> [Attribute] -> [Order] -> [AttributeOrder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(NotificationName -> Order -> AttributeOrder
DF.AttributeOrder (NotificationName -> Order -> AttributeOrder)
-> (Attribute -> NotificationName)
-> Attribute
-> Order
-> AttributeOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> NotificationName
attributeName)
[Attribute]
attrs
[Order]
orders
case [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
DF.sortDataFrameBy [AttributeOrder]
attrOrders (DataFrame -> Either RelationalError DataFrame)
-> (Relation -> DataFrame)
-> Relation
-> Either RelationalError DataFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation -> DataFrame
DF.toDataFrame (Relation -> Either RelationalError DataFrame)
-> Relation -> Either RelationalError DataFrame
forall a b. (a -> b) -> a -> b
$ Relation
rel of
Left RelationalError
err -> Either RelationalError DataFrame
-> IO (Either RelationalError DataFrame)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError DataFrame
forall a b. a -> Either a b
Left RelationalError
err)
Right DataFrame
dFrame -> do
let dFrame' :: DataFrame
dFrame' = DataFrame -> (Integer -> DataFrame) -> Maybe Integer -> DataFrame
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DataFrame
dFrame (Integer -> DataFrame -> DataFrame
`DF.drop'` DataFrame
dFrame) (DataFrameExpr -> Maybe Integer
DF.offset DataFrameExpr
dfExpr)
dFrame'' :: DataFrame
dFrame'' = DataFrame -> (Integer -> DataFrame) -> Maybe Integer -> DataFrame
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DataFrame
dFrame' (Integer -> DataFrame -> DataFrame
`DF.take'` DataFrame
dFrame') (DataFrameExpr -> Maybe Integer
DF.limit DataFrameExpr
dfExpr)
Either RelationalError DataFrame
-> IO (Either RelationalError DataFrame)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrame -> Either RelationalError DataFrame
forall a b. b -> Either a b
Right DataFrame
dFrame'')
executeDataFrameExpr UUID
sessionId conn :: Connection
conn@(RemoteConnection RemoteConnectionConf
_) DataFrameExpr
dfExpr = Connection
-> ExecuteDataFrameExpr -> IO (Either RelationalError DataFrame)
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> DataFrameExpr -> ExecuteDataFrameExpr
ExecuteDataFrameExpr UUID
sessionId DataFrameExpr
dfExpr)
validateMerkleHashes :: SessionId -> Connection -> IO (Either RelationalError ())
validateMerkleHashes :: UUID -> Connection -> IO (Either RelationalError ())
validateMerkleHashes UUID
sessionId (InProcessConnection InProcessConnectionConf
conf) = do
let sessions :: Map UUID Session
sessions = InProcessConnectionConf -> Map UUID Session
ipSessions InProcessConnectionConf
conf
STM (Either RelationalError ()) -> IO (Either RelationalError ())
forall a. STM a -> IO a
atomically (STM (Either RelationalError ()) -> IO (Either RelationalError ()))
-> STM (Either RelationalError ())
-> IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError Session
eSession <- UUID -> Map UUID Session -> STM (Either RelationalError Session)
sessionForSessionId UUID
sessionId Map UUID Session
sessions
case Either RelationalError Session
eSession of
Left RelationalError
err -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
Right Session
_ -> do
TransactionGraph
graph <- TVar TransactionGraph -> STM TransactionGraph
forall a. TVar a -> STM a
readTVar (InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph InProcessConnectionConf
conf)
case TransactionGraph -> Either [MerkleValidationError] ()
Graph.validateMerkleHashes TransactionGraph
graph of
Left [MerkleValidationError]
merkleErrs -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError () -> STM (Either RelationalError ()))
-> Either RelationalError () -> STM (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError ())
-> RelationalError -> Either RelationalError ()
forall a b. (a -> b) -> a -> b
$ [RelationalError] -> RelationalError
someErrors ((MerkleValidationError -> RelationalError)
-> [MerkleValidationError] -> [RelationalError]
forall a b. (a -> b) -> [a] -> [b]
map (\(MerkleValidationError UUID
tid MerkleHash
expected MerkleHash
actual) -> UUID -> MerkleHash -> MerkleHash -> RelationalError
MerkleHashValidationError UUID
tid MerkleHash
expected MerkleHash
actual) [MerkleValidationError]
merkleErrs)
Right () -> Either RelationalError () -> STM (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())
validateMerkleHashes UUID
sessionId conn :: Connection
conn@RemoteConnection{} = Connection
-> ExecuteValidateMerkleHashes -> IO (Either RelationalError ())
forall a b. (Serialise a, Serialise b) => Connection -> a -> IO b
remoteCall Connection
conn (UUID -> ExecuteValidateMerkleHashes
ExecuteValidateMerkleHashes UUID
sessionId)
type ClientNodes = StmSet.Set ClientInfo
data InProcessConnectionConf = InProcessConnectionConf {
InProcessConnectionConf -> PersistenceStrategy
ipPersistenceStrategy :: PersistenceStrategy,
InProcessConnectionConf -> Set ClientInfo
ipClientNodes :: ClientNodes,
InProcessConnectionConf -> Map UUID Session
ipSessions :: Sessions,
InProcessConnectionConf -> TVar TransactionGraph
ipTransactionGraph :: TVar TransactionGraph,
InProcessConnectionConf -> Maybe ScriptSession
ipScriptSession :: Maybe ScriptSession,
InProcessConnectionConf -> Maybe (LockFile, MVar LockFileHash)
ipLocks :: Maybe (LockFile, MVar LockFileHash),
InProcessConnectionConf -> Async ()
ipCallbackAsync :: Async ()
}
data ClientInfo = RemoteClientInfo (RPC.Locking Socket) |
InProcessClientInfo (MVar EvaluatedNotifications)
instance Eq ClientInfo where
(RemoteClientInfo Locking Socket
a) == :: ClientInfo -> ClientInfo -> Bool
== (RemoteClientInfo Locking Socket
b) = Locking Socket -> Socket
forall a. Locking a -> a
RPC.lockless Locking Socket
a Socket -> Socket -> Bool
forall a. Eq a => a -> a -> Bool
== Locking Socket -> Socket
forall a. Locking a -> a
RPC.lockless Locking Socket
b
(InProcessClientInfo MVar EvaluatedNotifications
a) == (InProcessClientInfo MVar EvaluatedNotifications
b) = MVar EvaluatedNotifications
a MVar EvaluatedNotifications -> MVar EvaluatedNotifications -> Bool
forall a. Eq a => a -> a -> Bool
== MVar EvaluatedNotifications
b
ClientInfo
_ == ClientInfo
_ = Bool
False
instance Hashable ClientInfo where
hashWithSalt :: Int -> ClientInfo -> Int
hashWithSalt Int
salt (RemoteClientInfo Locking Socket
sock) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Socket -> String
forall a. Show a => a -> String
show (Locking Socket -> Socket
forall a. Locking a -> a
RPC.lockless Locking Socket
sock))
hashWithSalt Int
salt (InProcessClientInfo MVar EvaluatedNotifications
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int
1::Int)