@@ -7,8 +7,8 @@ module ProjectM36.Client
77 DatabaseName,
88 ConnectionError,
99 connectProjectM36,
10− disconnectedTransaction,
11− transactionGraph,
10+-- disconnectedTransaction,
11+-- transactionGraph,
1212 close,
1313 executeRelationalExpr,
1414 executeDatabaseContextExpr,
@@ -34,25 +34,48 @@ import ProjectM36.TransactionGraph
3434import ProjectM36.TransactionGraph.Persist
3535import ProjectM36.Attribute
3636import ProjectM36.Persist (DiskSync(..))
37+import ProjectM36.Daemon.RemoteCallTypes (RemoteExecution(..))
38+import Network.Transport.TCP (createTransport, defaultTCPParameters)
39+import Control.Distributed.Process.Node (newLocalNode, initRemoteTable, runProcess, LocalNode)
40+import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)
41+import Control.Distributed.Process.ManagedProcess.Client (call)
42+import Control.Distributed.Process (NodeId(..))
43+
3744import Data.UUID.V4 (nextRandom)
3845import Control.Concurrent.STM
3946import Data.Word
40−
41−type DatabaseName = StringType
47+import Control.Distributed.Process (ProcessId)
48+import Control.Exception (IOException)
49+import Control.Concurrent.MVar
4250
4351type Hostname = StringType
4452
4553type Port = Word16
4654
47−data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy
48− --TCPRemoteConnectionInfo HeadName DatabaseName Hostname Port
55+type DatabaseName = String
56+
57+data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy |
58+ RemoteProcessConnectionInfo DatabaseName NodeId
4959
50−data Connection = InProcessConnection PersistenceStrategy (TVar (DisconnectedTransaction, TransactionGraph))
51− -- TCPRemoteConnection
60+data Connection = InProcessConnection PersistenceStrategy (TVar (DisconnectedTransaction, TransactionGraph)) |
61+ RemoteProcessConnection ProcessId
5262
53−data ConnectionError = SetupDatabaseDirectoryError PersistenceError
54− deriving (Show, Eq)
63+data ConnectionError = SetupDatabaseDirectoryError PersistenceError |
64+ IOExceptionError IOException |
65+ NoSuchDatabaseByNameError DatabaseName |
66+ LoginError
67+ deriving (Show, Eq)
5568
69+remoteDBLookupName :: DatabaseName -> String
70+remoteDBLookupName = (++) "db-"
71+
72+commonLocalNode :: IO (Either ConnectionError LocalNode)
73+commonLocalNode = do
74+ eLocalTransport <- createTransport "127.0.0.1" "0" defaultTCPParameters
75+ case eLocalTransport of
76+ Left err -> pure (Left $ IOExceptionError err)
77+ Right localTransport -> newLocalNode localTransport initRemoteTable >>= pure . Right
78+
5679-- connect to an in-process database
5780connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
5881--create a new in-memory database/transaction graph
@@ -68,6 +91,25 @@ connectProjectM36 (InProcessConnectionInfo strat) = do
6891 return $ Right $ InProcessConnection strat tvar
6992 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshDiscon freshGraph
7093 CrashSafePersistence dbdir -> connectPersistentProjectM36 strat FsyncDiskSync dbdir freshDiscon freshGraph
94+
95+connectProjectM36 (RemoteProcessConnectionInfo databaseName serverNodeId) = do
96+ connStatus <- newEmptyMVar
97+ eLocalNode <- commonLocalNode
98+ case eLocalNode of
99+ Left err -> pure (Left err)
100+ Right localNode -> do
101+ runProcess localNode $ do
102+ mServerProcessId <- whereisRemote serverNodeId (remoteDBLookupName databaseName)
103+ case mServerProcessId of
104+ Nothing -> liftIO $ putMVar connStatus $ Left (NoSuchDatabaseByNameError databaseName)
105+ Just serverProcessId -> do
106+ loginConfirmation <- call serverProcessId Login
107+ if not loginConfirmation then
108+ liftIO $ putMVar connStatus (Left LoginError)
109+ else do
110+ liftIO $ putMVar connStatus (Right $ RemoteProcessConnection serverProcessId)
111+ status <- takeMVar connStatus
112+ pure status
71113
72114connectPersistentProjectM36 :: PersistenceStrategy ->
73115 DiskSync ->
@@ -87,14 +129,25 @@ connectPersistentProjectM36 strat sync dbdir freshDiscon freshGraph = do
87129 tvar <- newTVarIO (freshDiscon, graph')
88130 return $ Right $ InProcessConnection strat tvar
89131
132+{-
133+-- if these are operated remotely, they are too expensive- keep the working space (discon) on the server
90134disconnectedTransaction :: Connection -> IO (DisconnectedTransaction)
91135disconnectedTransaction (InProcessConnection _ tvar) = liftM fst (readTVarIO tvar)
92136
93137transactionGraph :: Connection -> IO (TransactionGraph)
94138transactionGraph (InProcessConnection _ tvar) = liftM snd (readTVarIO tvar)
139+-}
95140
96141close :: Connection -> IO ()
97−close (InProcessConnection _ _) = return ()
142+close (InProcessConnection _ _) = pure ()
143+close (RemoteProcessConnection serverProcessId) = do
144+ eLocalNode <- commonLocalNode
145+ case eLocalNode of
146+ Left _ -> pure () --consider returning an error or exception
147+ Right localNode -> do
148+ runProcess localNode $ do
149+ call serverProcessId Logout
150+ pure ()
98151
99152executeRelationalExpr :: Connection -> RelationalExpr -> IO (Either RelationalError Relation)
100153executeRelationalExpr (InProcessConnection _ tvar) expr = atomically $ do