on master help sign in
multi-process db: report transaction head error only when commits are on same head
commit6d932ddce53dd49d6405d8ad434ed87a39a18fa9 authorAgentM <agentm@themactionfaction.com> dateSat 10 Jun 2017, 15:29 (9 years ago) parent57faeae
1 file changed+37−58
src/lib/ProjectM36/Client.hs+37−58
src/lib/ProjectM36/Client.hs+37−58
@@ -580,20 +580,17 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excMayb
580580 pure Nothing
581581executeDatabaseContextIOExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)
582582
583−executeGraphExprSTM_ :: TransactionId -> SessionId -> Sessions -> TransactionGraphOperator -> TVar TransactionGraph -> STM (Either RelationalError TransactionGraph)
584−executeGraphExprSTM_ freshId sessionId sessions graphExpr graphTvar = do
585− graph <- readTVar graphTvar
586− eSession <- sessionForSessionId sessionId sessions
587− case eSession of
588− Left err -> pure $ Left err
589− Right session -> case evalGraphOp freshId (Sess.disconnectedTransaction session) graph graphExpr of
590− Left err -> pure $ Left err
591− Right (discon', graph') -> do
592−
593− writeTVar graphTvar graph'
594− let newSession = Session discon' (Sess.schemaName session)
595− STMMap.insert newSession sessionId sessions
596− pure $ Right graph'
583+executeGraphExprSTM_ :: Bool -> TransactionId -> SessionId -> Session -> Sessions -> TransactionGraphOperator -> TransactionGraph -> TVar TransactionGraph -> STM (Either RelationalError TransactionGraph)
584+executeGraphExprSTM_ updateGraphOnError freshId sessionId session sessions graphExpr graph graphTVar= do
585+ case evalGraphOp freshId (Sess.disconnectedTransaction session) graph graphExpr of
586+ Left err -> do
587+ when updateGraphOnError (writeTVar graphTVar graph)
588+ pure $ Left err
589+ Right (discon', graph') -> do
590+ writeTVar graphTVar graph'
591+ let newSession = Session discon' (Sess.schemaName session)
592+ STMMap.insert newSession sessionId sessions
593+ pure $ Right graph'
597594
598595-- process notifications for commits
599596executeCommitExprSTM_ :: DatabaseContext -> DatabaseContext -> ClientNodes -> STM (EvaluatedNotifications, ClientNodes)
@@ -636,9 +633,6 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excMaybe $ do
636633 --if the database file has been updated since we wrote it last, load it before trying to sync our version done- this can result in TransactionNotAHeadErrors
637634 --read transaction data and compare to existing graph
638635 --in the future, we can detect if updated transaction graph can be safely merged (such as with a transaction on a separate head) (rebase-able commits should force the user to rebase from the client to confirm that the action makes sense)
639− if dbWrittenByOtherProcess then do
640− handleGraphFromDiskUpdate sessionId conf
641− else do
642636 manip <- atomically $ do
643637 eSession <- sessionForSessionId sessionId sessions
644638 --handle graph update by other process
@@ -646,20 +640,32 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excMaybe $ do
646640 case eSession of
647641 Left err -> pure (Left err)
648642 Right session -> do
649− eGraph <- executeGraphExprSTM_ freshId sessionId sessions graphExpr graphTvar
650− case eGraph of
651− Left err -> pure (Left err)
652− Right newGraph -> do
653− --handle commmit
654− if graphExpr == Commit then
655− case transactionForId (Sess.parentId session) oldGraph of
656− Left err -> pure $ Left err
657− Right previousTrans -> do
658− (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes
659− nodesToNotify <- toList (STMSet.stream nodes)
660− pure $ Right (evaldNots, nodesToNotify, newGraph)
661− else
662− pure $ Right (M.empty, [], newGraph)
643+ let mScriptSession = ipScriptSession conf
644+ dbdir = case strat of
645+ MinimalPersistence x -> x
646+ CrashSafePersistence x -> x
647+ _ -> error "accessing dbdir on non-persisted connection"
648+ eRefreshedGraph <- if dbWrittenByOtherProcess then
649+ unsafeIOToSTM (transactionGraphLoad dbdir oldGraph mScriptSession)
650+ else
651+ pure (Right oldGraph)
652+ case eRefreshedGraph of
653+ Left err -> pure (Left (DatabaseLoadError err))
654+ Right refreshedGraph -> do
655+ eGraph <- executeGraphExprSTM_ dbWrittenByOtherProcess freshId sessionId session sessions graphExpr refreshedGraph graphTvar
656+ case eGraph of
657+ Left err -> pure (Left err)
658+ Right newGraph -> do
659+ --handle commit
660+ if graphExpr == Commit then
661+ case transactionForId (Sess.parentId session) oldGraph of
662+ Left err -> pure $ Left err
663+ Right previousTrans -> do
664+ (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes
665+ nodesToNotify <- toList (STMSet.stream nodes)
666+ pure $ Right (evaldNots, nodesToNotify, newGraph)
667+ else
668+ pure $ Right (M.empty, [], newGraph)
663669 case manip of
664670 Left err -> return $ Just err
665671 Right (notsToFire, nodesToNotify, newGraph) -> do
@@ -669,33 +675,6 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excMaybe $ do
669675 pure Nothing
670676executeGraphExpr sessionId conn@(RemoteProcessConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)
671677
672−-- | Called when the transaction graph on disk has been updated by a secondary process. Reject the commit and update the graph
673−handleGraphFromDiskUpdate :: SessionId -> InProcessConnectionConf -> IO (Maybe RelationalError)
674−handleGraphFromDiskUpdate sessionId conf = do
675− let graphTVar = ipTransactionGraph conf
676− strat = ipPersistenceStrategy conf
677− sessions = ipSessions conf
678− mScriptSession = ipScriptSession conf
679− dbdir = case strat of
680− MinimalPersistence x -> x
681− CrashSafePersistence x -> x
682− _ -> error "handleGraphFromDiskUpdate on unpersisted database"
683− atomically $ do
684− eSession <- sessionForSessionId sessionId sessions
685− case eSession of
686− Left err -> pure (Just err)
687− Right session -> do
688− graph <- readTVar graphTVar
689− let parentTid = Discon.parentId (disconnectedTransaction session)
690− --this should be re-entrant because it only reads from the disk to create immutable structures
691− --BUG: here, we unsafely assume that the updated graph is based on the original- that might not be true- we should check that the graph is sound and consistence with the previous graph
692− eGraph <- unsafeIOToSTM (transactionGraphLoad dbdir graph mScriptSession)
693− case eGraph of
694− Left err -> pure (Just (DatabaseLoadError err))
695− Right updatedGraph -> do
696− writeTVar graphTVar updatedGraph
697− pure (Just (TransactionIsNotAHeadError parentTid))
698−
699678-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.
700679executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)
701680executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do