Remove V2 forkers from registry on close

Author: jasagredo

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

@@ -667,8 +667,8 @@ closeForkerEnv :: IOLike m => (LedgerDBEnv m l blk, ForkerEnv m l blk) -> m ()
 closeForkerEnv (LedgerDBEnv{ldbOpenHandlesLock}, frkEnv) =
   RAWLock.withWriteAccess ldbOpenHandlesLock $
     const $ do
-      id =<< readTVarIO (foeResourcesToRelease frkEnv)
-      atomically $ writeTVar (foeResourcesToRelease frkEnv) (pure ())
+      id =<< (atomically $ swapTVar (snd $ foeResourcesToRelease frkEnv) (pure ()))
+      _ <- release (fst (foeResourcesToRelease frkEnv))
       pure ((), LDBLock)
 
 getForkerEnv ::
@@ -753,14 +753,14 @@ newForker h ldbEnv rr st = do
   let tr = LedgerDBForkerEvent . TraceForkerEventWithKey forkerKey >$< ldbTracer ldbEnv
   traceWith tr ForkerOpen
   lseqVar <- newTVarIO . LedgerSeq . AS.Empty $ st
-  (_, toRelease) <- allocate rr (\_ -> newTVarIO (pure ())) (readTVarIO Monad.>=> id)
+  (k, toRelease) <- allocate rr (\_ -> newTVarIO (pure ())) (readTVarIO Monad.>=> id)
   let forkerEnv =
         ForkerEnv
           { foeLedgerSeq = lseqVar
           , foeSwitchVar = ldbSeq ldbEnv
           , foeSecurityParam = ledgerDbCfgSecParam $ ldbCfg ldbEnv
           , foeTracer = tr
-          , foeResourcesToRelease = toRelease
+          , foeResourcesToRelease = (k, toRelease)
           }
   atomically $ modifyTVar (ldbForkers ldbEnv) $ Map.insert forkerKey forkerEnv
   pure $

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

@@ -19,6 +19,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.Forker
   , module Ouroboros.Consensus.Storage.LedgerDB.Forker
   ) where
 
+import Control.ResourceRegistry
 import Control.Tracer
 import Data.Maybe (fromMaybe)
 import GHC.Generics
@@ -51,7 +52,7 @@ data ForkerEnv m l blk = ForkerEnv
   -- ^ Config
   , foeTracer :: !(Tracer m TraceForkerEvent)
   -- ^ Config
-  , foeResourcesToRelease :: !(StrictTVar m (m ()))
+  , foeResourcesToRelease :: !(ResourceKey m, StrictTVar m (m ()))
   -- ^ Release the resources
   }
   deriving Generic
@@ -132,7 +133,7 @@ implForkerPush env newState = do
         traceWith (foeTracer env) ForkerPushEnd
         atomically $ do
           writeTVar (foeLedgerSeq env) lseq'
-          modifyTVar (foeResourcesToRelease env) (>> close newtbs)
+          modifyTVar (snd $ foeResourcesToRelease env) (>> close newtbs)
     )
 
 implForkerCommit ::
@@ -171,7 +172,7 @@ implForkerCommit env = do
   -- actions for closing the states pushed to the forker. As we are committing
   -- those we have to close the ones discarded in this function and forget about
   -- those releasing actions.
-  writeTVar foeResourcesToRelease closeDiscarded
+  writeTVar (snd foeResourcesToRelease) closeDiscarded
  where
   ForkerEnv
     { foeLedgerSeq