Trace a warning when closing dangling forkers

Author: jasagredo

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Forker.hs

@@ -628,4 +628,5 @@ data TraceForkerEvent
   | ForkerReadStatistics
   | ForkerPushStart
   | ForkerPushEnd
+  | DanglingForkerClosed
   deriving (Show, Eq)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1.hs

@@ -827,11 +827,15 @@ implForkerClose ::
   ForkerEnv m l blk ->
   m ()
 implForkerClose (LDBHandle varState) forkerKey env = do
-  atomically $
-    readTVar varState >>= \case
-      LedgerDBClosed -> pure ()
-      LedgerDBOpen ldbEnv -> do
-        modifyTVar
-          (ldbForkers ldbEnv)
-          (Map.delete forkerKey)
+  frk <-
+    atomically $
+      readTVar varState >>= \case
+        LedgerDBClosed -> pure Nothing
+        LedgerDBOpen ldbEnv -> do
+          stateTVar
+            (ldbForkers ldbEnv)
+            (\m -> Map.updateLookupWithKey (\_ _ -> Nothing) forkerKey m)
+  case frk of
+    Nothing -> pure ()
+    Just e -> traceWith (foeTracer e) DanglingForkerClosed
   closeForkerEnv env

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs

@@ -724,13 +724,18 @@ implForkerClose ::
   ForkerEnv m l blk ->
   m ()
 implForkerClose (LDBHandle varState) forkerKey forkerEnv = do
-  atomically $
-    readTVar varState >>= \case
-      LedgerDBClosed -> pure ()
-      LedgerDBOpen ldbEnv -> do
-        modifyTVar
-          (ldbForkers ldbEnv)
-          (Map.delete forkerKey)
+  frk <-
+    atomically $
+      readTVar varState >>= \case
+        LedgerDBClosed -> pure Nothing
+        LedgerDBOpen ldbEnv -> do
+          stateTVar
+            (ldbForkers ldbEnv)
+            (\m -> Map.updateLookupWithKey (\_ _ -> Nothing) forkerKey m)
+
+  case frk of
+    Nothing -> pure ()
+    Just e -> traceWith (foeTracer e) DanglingForkerClosed
 
   closeForkerEnv forkerEnv