@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables #-}
22module ProjectM36.Client
33 (ConnectionInfo(..),
44 Connection(..),
@@ -76,7 +76,7 @@ import Data.UUID.V4 (nextRandom)
7676import Control.Concurrent.STM
7777import Data.Word
7878import Control.Distributed.Process (ProcessId, Process, receiveWait, send, match)
79−import Control.Exception (IOException)
79+import Control.Exception (IOException, SomeException(..), handle)
8080import Control.Concurrent.MVar
8181import qualified Data.Map as M
8282import Control.Distributed.Process.Serializable (Serializable)
@@ -88,6 +88,7 @@ import ProjectM36.Sessions
8888import ListT
8989import Data.Binary (Binary)
9090import GHC.Generics (Generic)
91+import Control.DeepSeq (force)
9192--import Debug.Trace
9293
9394type Hostname = String
@@ -206,7 +207,7 @@ connectProjectM36 (RemoteProcessConnectionInfo databaseName serverNodeId notific
206207 eLocalNode <- commonLocalNode
207208 notificationListenerPid <- startNotificationListener notificationCallback
208209 let dbName = remoteDBLookupName databaseName
209− putStrLn $ show serverNodeId ++ " " ++ dbName
210+ --putStrLn $ show serverNodeId ++ " " ++ dbName
210211 case eLocalNode of
211212 Left err -> pure (Left err)
212213 Right localNode -> do
@@ -301,6 +302,19 @@ close (RemoteProcessConnection localNode serverProcessId) = do
301302 runProcessResult localNode $ do
302303 call serverProcessId Logout
303304
305+--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
306+--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.
307+
308+excMaybe :: IO (Maybe RelationalError) -> IO (Maybe RelationalError)
309+excMaybe m = handle handler m
310+ where
311+ handler (exc :: SomeException) = pure (Just (UnhandledExceptionError (show exc)))
312+
313+excEither :: IO (Either RelationalError a) -> IO (Either RelationalError a)
314+excEither m = handle handler m
315+ where
316+ handler (exc :: SomeException) = pure (Left (UnhandledExceptionError (show exc)))
317+
304318runProcessResult :: LocalNode -> Process a -> IO a
305319runProcessResult localNode proc = do
306320 ret <- newEmptyMVar
@@ -324,32 +338,36 @@ sessionForSessionId sessionId sessions = do
324338
325339-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.
326340executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
327−executeRelationalExpr sessionId (InProcessConnection _ _ sessions _ _) expr = atomically $ do
341+executeRelationalExpr sessionId (InProcessConnection _ _ sessions _ _) expr = excEither $ atomically $ do
328342 eSession <- sessionForSessionId sessionId sessions
329343 case eSession of
330344 Left err -> pure $ Left err
331− Right (Session (DisconnectedTransaction _ context)) -> pure $ evalState (RE.evalRelationalExpr expr) context
345+ Right (Session (DisconnectedTransaction _ context)) -> case evalState (RE.evalRelationalExpr expr) context of
346+ Left err -> pure (Left err)
347+ Right rel -> pure (force (Right rel)) -- this is necessary so that any undefined/error exceptions are spit out here
332348executeRelationalExpr sessionId conn@(RemoteProcessConnection _ _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)
333349
334350-- | 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.
335351executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Maybe RelationalError)
336−executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _ _) expr = atomically $ do
352+executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _ _) expr = excMaybe $ atomically $ do
337353 eSession <- sessionForSessionId sessionId sessions
338354 case eSession of
339355 Left err -> pure $ Just err
340− Right session -> case runState (RE.evalContextExpr expr) (sessionContext session) of
341− (Just err,_) -> return $ Just err
342− (Nothing, context') -> do
343− let newDiscon = DisconnectedTransaction (sessionParentId session) context'
344− newSession = Session newDiscon
345− STMMap.insert newSession sessionId sessions
346− return Nothing
356+ Right session -> do
357+ case runState (RE.evalContextExpr expr) (sessionContext session) of
358+ (Just err,_) -> return $ Just err
359+ (Nothing, context') -> do
360+ let newDiscon = DisconnectedTransaction (sessionParentId session) context'
361+ newSession = Session newDiscon
362+ STMMap.insert newSession sessionId sessions
363+ pure Nothing
364+
347365executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)
348366
349367-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr` modify the DatabaseContext but cannot be purely implemented.
350368--this is almost completely identical to executeDatabaseContextExpr above
351369executeDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> IO (Maybe RelationalError)
352−executeDatabaseContextIOExpr sessionId (InProcessConnection _ _ sessions _ scriptSession) expr = do
370+executeDatabaseContextIOExpr sessionId (InProcessConnection _ _ sessions _ scriptSession) expr = excMaybe $ do
353371 eSession <- atomically $ sessionForSessionId sessionId sessions --potentially race condition due to interleaved IO?
354372 case eSession of
355373 Left err -> pure $ Just err
@@ -390,7 +408,7 @@ executeCommitExprSTM_ oldContext newContext nodes = do
390408
391409-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.
392410executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Maybe RelationalError)
393−executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graphTvar _) graphExpr = do
411+executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graphTvar _) graphExpr = excMaybe $ do
394412 freshId <- nextRandom
395413 manip <- atomically $ do
396414 eSession <- sessionForSessionId sessionId sessions