[WORK IN PROGRESS] Add db cleanup logic for checkpointer

src/Chainweb/Pact/Backend/InMemoryCheckpointer.hs

@@ -83,6 +83,7 @@ initInMemoryCheckpointEnv loggers logger ver cid = do
                     , _cpLookupProcessedTx = doLookupSuccessful inmem
                     , _cpGetBlockHistory = \_ _ -> error "unimplemented"
                     , _cpGetHistoricalLookup = \_ _ _ -> error "unimplemented"
+                    , _cpCleanupDb = doDiscard inmem
                 }
             , _cpeLogger = logger
             })

src/Chainweb/Pact/Backend/RelationalCheckpointer.hs

@@ -102,12 +102,20 @@ initRelationalCheckpointer' bstate sqlenv loggr v cid = do
               , _cpLookupProcessedTx = doLookupSuccessful db
               , _cpGetBlockHistory = doGetBlockHistory db
               , _cpGetHistoricalLookup = doGetHistoricalLookup db
+              , _cpCleanupDb = doCleanupDb db
               }
         , _cpeLogger = loggr
         })
 
 type Db = MVar (BlockEnv SQLiteEnv)
 
+-- | Rollback any open transaction or safepoint in the db. Usually this should
+-- be executed in masked state from within a handler.
+--
+doCleanupDb :: Db -> IO ()
+doCleanupDb dbenv = runBlockEnv dbenv $ do
+    clearPendingTxState
+    rollbackAll
 
 doRestore :: ChainwebVersion -> ChainId -> Db -> Maybe (BlockHeight, ParentHash) -> IO PactDbEnv'
 doRestore v cid dbenv (Just (bh, hash)) = runBlockEnv dbenv $ do

src/Chainweb/Pact/Backend/Types.hs

@@ -299,6 +299,7 @@ data Checkpointer = Checkpointer
         forall k v . (FromJSON v) => BlockHeader -> Domain k v -> IO BlockTxHistory)
     , _cpGetHistoricalLookup :: !(
         forall k v . (FromJSON v) => BlockHeader -> Domain k v -> RowKey -> IO (Maybe (TxLog Value)))
+    , _cpCleanupDb :: IO ()
     }
 
 data CheckpointEnv = CheckpointEnv

src/Chainweb/Pact/Backend/Utils.hs

@@ -115,6 +115,9 @@ rollbackSavepoint :: SavepointName -> BlockHandler SQLiteEnv ()
 rollbackSavepoint name =
   callDb "rollbackSavepoint" $ \db -> exec_ db $ "ROLLBACK TRANSACTION TO SAVEPOINT [" <> toS (asString name) <> "];"
 
+rollbackAll :: BlockHandler SQLiteEnv ()
+rollbackAll = callDb "rollback all open transactions" $ \db -> exec_ db "ROLLBACK;"
+
 data SavepointName = BatchSavepoint | Block | DbTransaction |  PreBlock
   deriving (Eq, Ord, Enum)
 

src/Chainweb/Pact/PactService.hs

@@ -437,7 +437,11 @@ serviceRequests logFn memPoolAccess reqQ = do
                     ]
                 liftIO $ void $ tryPutMVar mvar $! toPactInternalError e
            ]
+        `finally`
+            -- Rolls back all open transactions and safepoints
+            getCheckpointer >>= liftIO . _cpCleanupDb
       where
+
         -- Pact turns AsyncExceptions into textual exceptions within
         -- PactInternalError. So there is no easy way for us to distinguish
         -- whether an exception originates from within pact or from the outside.