fix: make ctrl-C work for replays (and perhaps more generally)

I don't understand why this fixes the issue, but it is actually a
correct thing to do; this PR just makes sure that we are masked when
we fork off the Pact task thread.

Change-Id: I98ac853da9efd086be749d388a5eb559f7866af0

changes/2024-06-19T182722-0400.txt

@@ -0,0 +1,2 @@
+Small fixes to exception safety result in Ctrl-C now working properly
+during read-only replay (and other scenarios)

src/Chainweb/Mempool/InMem.hs

@@ -191,9 +191,7 @@ withInMemoryMempool_ l cfg _v f = do
         logFunctionText l Debug "Initialized Mempool Monitor"
         runForeverThrottled lf "Chainweb.Mempool.InMem.withInMemoryMempool_.monitor" 10 (10 * mega) $ do
             stats <- getMempoolStats m
-            logFunctionText l Debug "got stats"
             logFunctionJson l Info stats
-            logFunctionText l Debug "logged stats"
             approximateThreadDelay 60_000_000 {- 1 minute -}
 
 ------------------------------------------------------------------------------

src/Chainweb/Pact/PactService.hs

@@ -393,7 +393,7 @@ serviceRequests memPoolAccess reqQ = go
                 finishedLock <- newEmptyMVar
                 -- fork a thread to service the request
                 bracket
-                    (forkIO $
+                    (mask_ $ forkIOWithUnmask $ \restore ->
                         -- We wrap this whole block in `tryAsync` because we
                         -- want to ignore `RequestCancelled` exceptions that
                         -- occur while we are waiting on `takeMVar goLock`.
@@ -411,7 +411,7 @@ serviceRequests memPoolAccess reqQ = go
                             takeMVar goLock
 
                             -- run and report the answer.
-                            tryAny (run act) >>= \case
+                            restore (tryAny (run act)) >>= \case
                                 Left ex -> atomically $ writeTVar statusRef (RequestFailed ex)
                                 Right r -> atomically $ writeTVar statusRef (RequestDone r)
                     )
@@ -422,12 +422,9 @@ serviceRequests memPoolAccess reqQ = go
                         -- starting work on it
                         beforeStarting <- atomically $ do
                             readTVar statusRef >>= \case
-                                RequestInProgress ->
-                                    error "PactService internal error: request in progress before starting"
-                                RequestDone _ ->
-                                    error "PactService internal error: request finished before starting"
-                                RequestFailed e ->
-                                    return (Left e)
+                                RequestInProgress -> internalError "request in progress before starting"
+                                RequestDone _ -> internalError "request finished before starting"
+                                RequestFailed e -> return (Left e)
                                 RequestNotStarted -> do
                                     writeTVar statusRef RequestInProgress
                                     return (Right ())
@@ -443,7 +440,7 @@ serviceRequests memPoolAccess reqQ = go
                                     RequestInProgress -> retry
                                     RequestDone _ -> return (Right ())
                                     RequestFailed e -> return (Left e)
-                                    RequestNotStarted -> error "PactService internal error: request not started after starting"
+                                    RequestNotStarted -> internalError "request not started after starting"
                     )
             case maybeException of
               Left (fromException -> Just AsyncCancelled) ->

src/Chainweb/Pact/Service/PactQueue.hs

@@ -124,9 +124,9 @@ waitForSubmittedRequest statusRef = atomically $ do
 -- When the continuation terminates, *cancel the request*.
 --
 submitRequestAnd :: PactQueue -> RequestMsg r -> (TVar (RequestStatus r) -> IO a) -> IO a
-submitRequestAnd q msg k = mask $ \restore -> do
+submitRequestAnd q msg k = uninterruptibleMask $ \restore -> do
     status <- addRequest q msg
-    restore (k status) `finally`
+    restore (k status) `onException`
         uninterruptibleMask_ (cancelSubmittedRequest status)
 
 -- | Submit a request and wait for it to finish; if interrupted by an