Label lockfile thread

IntersectMBO · Jan 24, 2025 · 230a880 · 230a880
1 parent 193cb7b
commit 230a880
Showing 1 changed file with 4 additions and 1 deletion.
diff --git a/...-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/DbLock.hs b/...-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/DbLock.hs
@@ -12,6 +12,7 @@ module Ouroboros.Consensus.Node.DbLock (
   , withLockDB_
   ) where
 
+import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadTimer.SI
 import qualified Data.Time.Clock as Time
 import           Ouroboros.Consensus.Util.FileLock
@@ -70,7 +71,9 @@ withLockDB_ fileLock mountPoint lockFsPath lockTimeout action =
     -- lock, the whole process will soon die.
     acquireLock :: m (m ())
     acquireLock = do
-      lockFileAsync <- async (lockFile fileLock lockFilePath)
+      lockFileAsync <- async (do
+                                 labelThisThread "ChainDB lock"
+                                 lockFile fileLock lockFilePath)
       timeout lockTimeout (wait lockFileAsync) >>= \case
         -- We timed out while waiting on the lock. The db is still locked.
         Nothing     -> throwIO $ DbLocked lockFilePath