Make keepalive and blockfetch cleanup uninterruptible

If keepalive or blockfetch's unregister function is interrupted it will
cause some state to be left. This will result in a space leak and an
assertion failure the next time the node attempt to talk to that peer.

Change their unregister functions to run inside uninterruptibleMask_.

ouroboros-network/src/Ouroboros/Network/BlockFetch/ClientRegistry.hs

@@ -68,7 +68,8 @@ newFetchClientRegistry = FetchClientRegistry <$> newEmptyTMVarIO
 -- It also manages synchronisation with the corresponding chain sync client.
 --
 bracketFetchClient :: forall m a peer header block.
-                      (MonadThrow m, MonadSTM m, MonadFork m, Ord peer)
+                      (MonadThrow m, MonadSTM m, MonadFork m, MonadMask m,
+                       Ord peer)
                    => FetchClientRegistry peer header block m
                    -> peer
                    -> (FetchClientContext header block m -> m a)
@@ -116,7 +117,7 @@ bracketFetchClient (FetchClientRegistry ctxVar
                -> (ThreadId m, StrictTMVar m ())
                -> m ()
     unregister ksVar FetchClientContext { fetchClientCtxStateVars = stateVars }
-               (tid, doneVar)  = do
+               (tid, doneVar)  = uninterruptibleMask_ $ do
       -- Signal we are shutting down
       atomically $
         writeTVar (fetchClientStatusVar stateVars) PeerFetchStatusShutdown
@@ -181,7 +182,8 @@ bracketSyncWithFetchClient (FetchClientRegistry _ctxVar
           Map.delete peer m
 
 bracketKeepAliveClient :: forall m a peer header block.
-                              (MonadThrow m, MonadSTM m, MonadFork m, Ord peer)
+                              (MonadThrow m, MonadSTM m, MonadFork m,
+                               MonadMask m, Ord peer)
                        => FetchClientRegistry peer header block m
                        -> peer
                        -> ((StrictTVar  m (Map peer PeerGSV)) -> m a)
@@ -201,7 +203,7 @@ bracketKeepAliveClient(FetchClientRegistry _ctxVar
     -- It is possible for the keepAlive client to keep running even without a fetch client, but
     -- a fetch client shouldn't run without a keepAlive client.
     unregister :: m ()
-    unregister = do
+    unregister = uninterruptibleMask_ $ do
       fetchclient_m <- atomically $ do
         fetchclients <- readTVar keepRegistry
         case Map.lookup peer fetchclients of

ouroboros-network/test/Test/Ouroboros/Network/BlockFetch.hs

@@ -547,8 +547,8 @@ _unit_bracketSyncWithFetchClient step = do
     checkResult _                 = assertFailure "unexpected result"
 
     testSkeleton :: forall m a b.
-                    (MonadAsync m, MonadFork m, MonadSTM m, MonadTimer m,
-                     MonadThrow m, MonadThrow (STM m))
+                    (MonadAsync m, MonadFork m, MonadMask m, MonadSTM m,
+                     MonadTimer m, MonadThrow m, MonadThrow (STM m))
                  => ((forall c. m c -> m c) -> m a)
                  -> ((forall c. m c -> m c) -> m b)
                  -> m (Either (Either SomeException a)