From 230a880f07015d919f0c865544228e915bb90801 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 24 Jan 2025 15:33:35 +0100 Subject: [PATCH] Label lockfile thread --- .../Ouroboros/Consensus/Node/DbLock.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/DbLock.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/DbLock.hs index f7541bcb1c..ce3e31c6b7 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/DbLock.hs +++ b/ouroboros-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