{-# LANGUAGE MonoLocalBinds #-}
module ProjectM36.Server.EntryPoints where
import ProjectM36.Base hiding (inclusionDependencies)
import ProjectM36.IsomorphicSchema
import ProjectM36.HashSecurely
import ProjectM36.Client as C
import Data.Map
import Control.Concurrent (threadDelay)
import Network.RPC.Curryer.Server 
import System.Timeout hiding (Timeout)
import Network.Socket
import Control.Exception

timeoutOrDie :: Maybe Timeout -> IO a -> IO (Maybe a)
timeoutOrDie :: forall a. Maybe Timeout -> IO a -> IO (Maybe a)
timeoutOrDie Maybe Timeout
mMicros IO a
act = 
  case Maybe Timeout
mMicros of
    Maybe Timeout
Nothing -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act
    Just Timeout
micros ->
      forall a. Int -> IO a -> IO (Maybe a)
timeout (forall a b. (Integral a, Num b) => a -> b
fromIntegral Timeout
micros) IO a
act

timeoutRelErr :: Maybe Timeout -> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr :: forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
mMicros IO (Either RelationalError a)
act = do
  Maybe (Either RelationalError a)
ret <- forall a. Maybe Timeout -> IO a -> IO (Maybe a)
timeoutOrDie Maybe Timeout
mMicros IO (Either RelationalError a)
act
  case Maybe (Either RelationalError a)
ret of
    Maybe (Either RelationalError a)
Nothing -> forall a e. Exception e => e -> a
throw TimeoutException
TimeoutException
    Just Either RelationalError a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either RelationalError a
v
                                      

handleExecuteRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
handleExecuteRelationalExpr :: Maybe Timeout
-> SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
handleExecuteRelationalExpr Maybe Timeout
ti SessionId
sessionId Connection
conn RelationalExpr
expr = 
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
executeRelationalExpr SessionId
sessionId Connection
conn RelationalExpr
expr)

handleExecuteDataFrameExpr :: Maybe Timeout -> SessionId -> Connection -> DataFrameExpr -> IO (Either RelationalError DataFrame)
handleExecuteDataFrameExpr :: Maybe Timeout
-> SessionId
-> Connection
-> DataFrameExpr
-> IO (Either RelationalError DataFrame)
handleExecuteDataFrameExpr Maybe Timeout
ti SessionId
sessionId Connection
conn DataFrameExpr
expr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> DataFrameExpr
-> IO (Either RelationalError DataFrame)
executeDataFrameExpr SessionId
sessionId Connection
conn DataFrameExpr
expr)
  
handleExecuteDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())
handleExecuteDatabaseContextExpr :: Maybe Timeout
-> SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError ())
handleExecuteDatabaseContextExpr Maybe Timeout
ti SessionId
sessionId Connection
conn DatabaseContextExpr
dbexpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError ())
executeDatabaseContextExpr SessionId
sessionId Connection
conn DatabaseContextExpr
dbexpr)
  
handleExecuteDatabaseContextIOExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ())
handleExecuteDatabaseContextIOExpr :: Maybe Timeout
-> SessionId
-> Connection
-> DatabaseContextIOExpr
-> IO (Either RelationalError ())
handleExecuteDatabaseContextIOExpr Maybe Timeout
ti SessionId
sessionId Connection
conn DatabaseContextIOExpr
dbexpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> DatabaseContextIOExpr
-> IO (Either RelationalError ())
executeDatabaseContextIOExpr SessionId
sessionId Connection
conn DatabaseContextIOExpr
dbexpr)
  
handleExecuteHeadName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError HeadName)
handleExecuteHeadName :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError HeadName)
handleExecuteHeadName Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError HeadName)
headName SessionId
sessionId Connection
conn)
  
handleLogin :: Connection -> Locking Socket -> IO Bool
handleLogin :: Connection -> Locking Socket -> IO Bool
handleLogin Connection
conn Locking Socket
lockSock = do
  Connection -> Locking Socket -> IO ()
addClientNode Connection
conn Locking Socket
lockSock
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  
handleExecuteGraphExpr :: Maybe Timeout -> SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ())
handleExecuteGraphExpr :: Maybe Timeout
-> SessionId
-> Connection
-> TransactionGraphOperator
-> IO (Either RelationalError ())
handleExecuteGraphExpr Maybe Timeout
ti SessionId
sessionId Connection
conn TransactionGraphOperator
graphExpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> TransactionGraphOperator
-> IO (Either RelationalError ())
executeGraphExpr SessionId
sessionId Connection
conn TransactionGraphOperator
graphExpr)
  
handleExecuteTransGraphRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)
handleExecuteTransGraphRelationalExpr :: Maybe Timeout
-> SessionId
-> Connection
-> TransGraphRelationalExpr
-> IO (Either RelationalError Relation)
handleExecuteTransGraphRelationalExpr Maybe Timeout
ti SessionId
sessionId Connection
conn TransGraphRelationalExpr
graphExpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> TransGraphRelationalExpr
-> IO (Either RelationalError Relation)
executeTransGraphRelationalExpr SessionId
sessionId Connection
conn TransGraphRelationalExpr
graphExpr)

handleExecuteTypeForRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
handleExecuteTypeForRelationalExpr :: Maybe Timeout
-> SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
handleExecuteTypeForRelationalExpr Maybe Timeout
ti SessionId
sessionId Connection
conn RelationalExpr
relExpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
typeForRelationalExpr SessionId
sessionId Connection
conn RelationalExpr
relExpr)
  
handleRetrieveInclusionDependencies :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError (Map IncDepName InclusionDependency))
handleRetrieveInclusionDependencies :: Maybe Timeout
-> SessionId
-> Connection
-> IO (Either RelationalError (Map HeadName InclusionDependency))
handleRetrieveInclusionDependencies Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> IO (Either RelationalError (Map HeadName InclusionDependency))
inclusionDependencies SessionId
sessionId Connection
conn)
  
handleRetrievePlanForDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)
handleRetrievePlanForDatabaseContextExpr :: Maybe Timeout
-> SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
handleRetrievePlanForDatabaseContextExpr Maybe Timeout
ti SessionId
sessionId Connection
conn DatabaseContextExpr
dbExpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError GraphRefDatabaseContextExpr)
planForDatabaseContextExpr SessionId
sessionId Connection
conn DatabaseContextExpr
dbExpr)
  
handleRetrieveTransactionGraph :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation) 
handleRetrieveTransactionGraph :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveTransactionGraph Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
transactionGraphAsRelation SessionId
sessionId Connection
conn)
  
handleRetrieveHeadTransactionId :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TransactionId)
handleRetrieveHeadTransactionId :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError SessionId)
handleRetrieveHeadTransactionId Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError SessionId)
headTransactionId SessionId
sessionId Connection
conn)
  
handleCreateSessionAtCommit :: Maybe Timeout -> Connection -> TransactionId -> IO (Either RelationalError SessionId)
handleCreateSessionAtCommit :: Maybe Timeout
-> Connection -> SessionId -> IO (Either RelationalError SessionId)
handleCreateSessionAtCommit Maybe Timeout
ti Connection
conn SessionId
commitId =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (Connection -> SessionId -> IO (Either RelationalError SessionId)
createSessionAtCommit Connection
conn SessionId
commitId)
  
handleCreateSessionAtHead :: Maybe Timeout -> Connection -> HeadName -> IO (Either RelationalError SessionId)
handleCreateSessionAtHead :: Maybe Timeout
-> Connection -> HeadName -> IO (Either RelationalError SessionId)
handleCreateSessionAtHead Maybe Timeout
ti Connection
conn HeadName
headn = 
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (Connection -> HeadName -> IO (Either RelationalError SessionId)
createSessionAtHead Connection
conn HeadName
headn)
  
handleCloseSession :: SessionId -> Connection -> IO ()   
handleCloseSession :: SessionId -> Connection -> IO ()
handleCloseSession  =
  SessionId -> Connection -> IO ()
closeSession
  
handleRetrieveAtomTypesAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveAtomTypesAsRelation :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveAtomTypesAsRelation Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
atomTypesAsRelation SessionId
sessionId Connection
conn)
  
-- | Returns a relation which lists the names of relvars in the current session as well as  its types.  
handleRetrieveRelationVariableSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveRelationVariableSummary :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveRelationVariableSummary Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
relationVariablesAsRelation SessionId
sessionId Connection
conn)
  
handleRetrieveAtomFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveAtomFunctionSummary :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveAtomFunctionSummary Maybe Timeout
ti SessionId
sessionId Connection
conn = 
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
atomFunctionsAsRelation SessionId
sessionId Connection
conn)
  
handleRetrieveDatabaseContextFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveDatabaseContextFunctionSummary :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveDatabaseContextFunctionSummary Maybe Timeout
ti SessionId
sessionId Connection
conn = 
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
databaseContextFunctionsAsRelation SessionId
sessionId Connection
conn)
  
handleRetrieveCurrentSchemaName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SchemaName)
handleRetrieveCurrentSchemaName :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError HeadName)
handleRetrieveCurrentSchemaName Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError HeadName)
currentSchemaName SessionId
sessionId Connection
conn)

handleExecuteSchemaExpr :: Maybe Timeout -> SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ())
handleExecuteSchemaExpr :: Maybe Timeout
-> SessionId
-> Connection
-> SchemaExpr
-> IO (Either RelationalError ())
handleExecuteSchemaExpr Maybe Timeout
ti SessionId
sessionId Connection
conn SchemaExpr
schemaExpr =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection -> SchemaExpr -> IO (Either RelationalError ())
executeSchemaExpr SessionId
sessionId Connection
conn SchemaExpr
schemaExpr)
  
handleLogout :: Maybe Timeout -> Connection -> IO Bool
handleLogout :: Maybe Timeout -> Connection -> IO Bool
handleLogout Maybe Timeout
_ Connection
_ = 
  --liftIO $ closeRemote_ conn
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    
handleTestTimeout :: Maybe Timeout -> SessionId -> Connection -> IO Bool  
handleTestTimeout :: Maybe Timeout -> SessionId -> Connection -> IO Bool
handleTestTimeout Maybe Timeout
ti SessionId
_ Connection
_ = do
  Either RelationalError ()
ret <- forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (Int -> IO ()
threadDelay Int
100000 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ()))
  case Either RelationalError ()
ret of
    Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Left RelationalError
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

 

handleRetrieveSessionIsDirty :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Bool)
handleRetrieveSessionIsDirty :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Bool)
handleRetrieveSessionIsDirty Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Bool)
disconnectedTransactionIsDirty SessionId
sessionId Connection
conn)
  
handleExecuteAutoMergeToHead :: Maybe Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
handleExecuteAutoMergeToHead :: Maybe Timeout
-> SessionId
-> Connection
-> MergeStrategy
-> HeadName
-> IO (Either RelationalError ())
handleExecuteAutoMergeToHead Maybe Timeout
ti SessionId
sessionId Connection
conn MergeStrategy
strat HeadName
headName' =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection
-> MergeStrategy
-> HeadName
-> IO (Either RelationalError ())
autoMergeToHead SessionId
sessionId Connection
conn MergeStrategy
strat HeadName
headName')

handleRetrieveTypeConstructorMapping :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)  
handleRetrieveTypeConstructorMapping :: Maybe Timeout
-> SessionId
-> Connection
-> IO (Either RelationalError TypeConstructorMapping)
handleRetrieveTypeConstructorMapping Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId
-> Connection -> IO (Either RelationalError TypeConstructorMapping)
C.typeConstructorMapping SessionId
sessionId Connection
conn)
 
handleValidateMerkleHashes :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError ())
handleValidateMerkleHashes :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError ())
handleValidateMerkleHashes Maybe Timeout
ti SessionId
sessionId Connection
conn = 
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError ())
C.validateMerkleHashes SessionId
sessionId Connection
conn)

handleGetDDLHash :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SecureHash)
handleGetDDLHash :: Maybe Timeout
-> SessionId
-> Connection
-> IO (Either RelationalError SecureHash)
handleGetDDLHash Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError SecureHash)
C.getDDLHash SessionId
sessionId Connection
conn)

handleRetrieveDDLAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveDDLAsRelation :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveDDLAsRelation Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
C.ddlAsRelation SessionId
sessionId Connection
conn)

handleRetrieveRegisteredQueries :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveRegisteredQueries :: Maybe Timeout
-> SessionId -> Connection -> IO (Either RelationalError Relation)
handleRetrieveRegisteredQueries Maybe Timeout
ti SessionId
sessionId Connection
conn =
  forall a.
Maybe Timeout
-> IO (Either RelationalError a) -> IO (Either RelationalError a)
timeoutRelErr Maybe Timeout
ti (SessionId -> Connection -> IO (Either RelationalError Relation)
C.registeredQueriesAsRelation SessionId
sessionId Connection
conn)