{-# LANGUAGE DeriveGeneric, ScopedTypeVariables, MonoLocalBinds, DerivingVia #-}
{-|
Module: ProjectM36.Client

Client interface to local and remote Project:M36 databases. To get started, connect with 'connectProjectM36', then run some database changes with 'executeDatabaseContextExpr', and issue queries using 'executeRelationalExpr'.
-}
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) --defined in this module as well
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

-- | The type for notifications callbacks in the client. When a registered notification fires due to a changed relational expression evaluation, the server propagates the notifications to the clients in the form of the callback.
type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()

-- | The empty notification callback ignores all callbacks.
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

-- | Construct a 'ConnectionInfo' to describe how to make the 'Connection'. The database can be run within the current process or running remotely via RPC.
data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath] |
                      RemoteConnectionInfo DatabaseName Hostname ServiceName NotificationCallback
                      
type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification

-- | Used for callbacks from the server when monitored changes have been made.
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

-- | When a notification is fired, the 'reportOldExpr' is evaluated in the commit's pre-change context while the 'reportNewExpr' is evaluated in the post-change context and they are returned along with the original notification.
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
                      

-- | Use this for connecting to remote servers on the default port.
defaultServerPort :: Port
defaultServerPort :: Port
defaultServerPort = Port
6543

-- | Use this for connecting to remote servers with the default database name.
defaultDatabaseName :: DatabaseName
defaultDatabaseName :: String
defaultDatabaseName = String
"base"

-- | Use this for connecting to remote servers with the default head name.
defaultHeadName :: HeadName
defaultHeadName :: NotificationName
defaultHeadName = NotificationName
"master"

-- | Create a connection configuration which connects to the localhost on the default server port and default server database name. The configured notification callback is set to ignore all events.
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
                  
-- | There are several reasons why a connection can fail.
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 --not a fatal error, but the scripting feature must be disabled
    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)


-- | To create a 'Connection' to a remote or local database, create a 'ConnectionInfo' and call 'connectProjectM36'.
connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
--create a new in-memory database/transaction graph
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
    --create date examples graph for now- probably should be empty context in the future
    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
  --TODO- add notification callback thread
  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
      --supports IPv4 only for now
      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 ->
      --TODO handle connection errors!
              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)))

--convert RPC errors into exceptions
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)

--startup local async process to handle notification callbacks
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

-- | Create a new session at the transaction id and return the session's Id.
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"
  
-- | Call 'createSessionAtHead' with a transaction graph's head's name to create a new session pinned to that head. This function returns a 'SessionId' which can be used in other function calls to reference the point in the transaction graph.
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)

-- | Discards a session, eliminating any uncommitted changes present in the session.
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' cleans up the database access connection and closes any relevant sockets.
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

--used only by the server EntryPoints
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

  --we need to actually close the localNode's connection to the remote
--within the database server, we must catch and handle all exception lest they take down the database process- this handling might be different for other use-cases
--exceptions should generally *NOT* be thrown from any Project:M36 code paths, but third-party code such as AtomFunction scripts could conceivably throw undefined, etc.

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 [])) -- the main schema includes no transformations (but neither do empty schemas :/ )
    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))
  
-- | Returns the name of the currently selected isomorphic 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)

-- | Switch to the named isomorphic schema.
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)

-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.
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)) -- this is necessary so that any undefined/error exceptions are spit out here 
            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)

-- | Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.
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 --nothing dirtied, nothing to do
                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)

-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing). Alternatively, as an optimization, if a simple commit is possible (meaning that the head has not changed), then a fast-forward commit takes place instead.
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
            --attempt fast-forward commit, if possible
            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')
      
-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.
--this is almost completely identical to executeDatabaseContextExpr above
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 --potentially race condition due to interleaved IO?
  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)
         
-- process notifications for commits
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)
  
-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

-- OPTIMIZATION OPPORTUNITY: no locks are required to write new transaction data, only to update the transaction graph id file
-- if writing data is re-entrant, we may be able to use unsafeIOtoSTM
-- perhaps keep hash of data file instead of checking if our head was updated on every write
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
            --if freshId appears in the graph, then we need to pass it on
            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)

-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.
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)  

-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.
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
          --hm- maybe we should start using lenses
          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)          

-- | After modifying a 'DatabaseContext', 'commit' the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.
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

-- | Discard any changes made in the current 'Session' and 'DatabaseContext'. This resets the disconnected transaction to reference the original database context of the parent transaction and is a very cheap operation.
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)

-- | Write the transaction graph to disk. This function can be used to incrementally write new transactions to disk.
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 

-- | Return a relation whose type would match that of the relational expression if it were executed. This is useful for checking types and validating a relational expression's types.
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"

-- | Return a 'Map' of the database's constraints at the context of the session and 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
_) -> --warning, no schema support for typeconstructors
        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)
  
-- | Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.
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 -- don't show any optimization because the current optimization infrastructure relies on access to the base context- this probably underscores the need for each schema to have its own DatabaseContext, even if it is generated on-the-fly-}
          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)
             
-- | Return a relation which represents the current state of the global transaction graph. The attributes are 
--    * current- boolean attribute representing whether or not the current session references this transaction
--    * head- text attribute which is a non-empty 'HeadName' iff the transaction references a head.
--    * id- id attribute of the transaction
--    * parents- a relation-valued attribute which contains a relation of transaction ids which are parent transaction to the transaction
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) 

-- | Returns the names and types of the relation variables in the current 'Session'.
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)

-- | Returns the names and types of the atom functions in the current 'Session'.
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)        

-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.  
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')
  
-- | Returns Just the name of the head of the current disconnected transaction or Nothing.    
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)

-- | Returns a listing of all available atom types.
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)
        
--used only for testing- we expect this to throw an exception
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)

--used in tests only
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"

--used in tests only
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"

-- wrap a graph evaluation in file locking
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
                --still holding the lock- get the latest digest
                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
     --handle graph update by other process
     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"
        --this should also happen for non-commit expressions
        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', []))

      --handle notification firing                
  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
      --update filesystem database, if necessary
      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 ())

-- | Runs an IO monad, commits the result when the monad returns no errors, otherwise, rolls back the changes and the error.
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 -- no updates executed, so don't create a commit
                  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

-- internal structure specific to in-process connections
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), -- nothing when NoPersistence
  InProcessConnectionConf -> Async ()
ipCallbackAsync :: Async ()
  }

-- clients may connect associate one socket/mvar with the server to register for change callbacks
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)