cardano-node: threads with labels

Author: jutaro

cardano-node/src/Cardano/Node/Configuration/Logging.hs

@@ -255,7 +255,7 @@ createLoggingLayer ver nodeConfig' p = do
 
      when (ncLogMetrics nodeConfig) $
        -- Record node metrics, if configured
-       startCapturingMetrics (ncTraceConfig nodeConfig) trace
+       startCapturingResources (ncTraceConfig nodeConfig) trace
 
    mkLogLayer :: Configuration -> Switchboard Text -> Maybe EKGDirect -> Trace IO Text -> LoggingLayer
    mkLogLayer logConfig switchBoard mbEkgDirect trace =
@@ -278,14 +278,16 @@ createLoggingLayer ver nodeConfig' p = do
        , llEKGDirect = mbEkgDirect
        }
 
-   startCapturingMetrics :: TraceOptions
+   startCapturingResources :: TraceOptions
     -> Trace IO Text
     -> IO ()
-   startCapturingMetrics (TraceDispatcher _) _tr = do
+   startCapturingResources (TraceDispatcher _) _tr = do
       pure ()
 
-   startCapturingMetrics _ tr = do
-     void . Async.async . forever $ do
+   startCapturingResources _ tr = do
+     void . Async.async $ do
+      myThreadId >>= flip labelThread "Metrics capturing (cardano-node)"
+      forever $ do
        readResourceStats
          >>= maybe (pure ())
                    (traceResourceStats

cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs

@@ -15,7 +15,7 @@ import           Cardano.Node.Orphans ()
 import           Cardano.Node.Queries
 import           Ouroboros.Consensus.Block (Header)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (ChainSyncClientHandle,
-                   csCandidate, cschcMap, viewChainSyncState, )
+                   csCandidate, cschcMap, viewChainSyncState)
 import           Ouroboros.Consensus.Util.Orphans ()
 import qualified Ouroboros.Network.AnchoredFragment as Net
 import           Ouroboros.Network.Block (unSlotNo)
@@ -39,25 +39,35 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           GHC.Conc (labelThread, myThreadId)
 import           Text.Printf (printf)
 
 {- HLINT ignore "Use =<<" -}
 {- HLINT ignore "Use <=<" -}
 
+-- | Starts a background thread to periodically trace the current peer list.
+-- The thread is linked to the parent thread for proper error propagation
+-- and labeled for easier debugging and identification.
 startPeerTracer
-  :: Tracer IO [PeerT blk]
-  -> NodeKernelData blk
-  -> Int
+  :: Tracer IO [PeerT blk]  -- ^ Tracer for the peer list
+  -> NodeKernelData blk     -- ^ Node kernel containing peer data
+  -> Int                    -- ^ Delay in milliseconds between traces
   -> IO ()
-startPeerTracer tr nodeKern delayMilliseconds = do
-    as <- async peersThread
-    link as
+startPeerTracer tracer nodeKernel delayMilliseconds = do
+  thread <- async peersThread
+  -- Link the thread to the parent to propagate exceptions properly.
+  link thread
   where
+    -- | The background thread that periodically traces the peer list.
     peersThread :: IO ()
-    peersThread = forever $ do
-          peers <- getCurrentPeers nodeKern
-          traceWith tr peers
-          threadDelay (delayMilliseconds * 1000)
+    peersThread = do
+      -- Label the thread for easier debugging and identification.
+      myThreadId >>= flip labelThread "Peer Tracer"
+      forever $ do
+        peers <- getCurrentPeers nodeKernel
+        traceWith tracer peers
+        threadDelay (delayMilliseconds * 1000)
+
 
 data PeerT blk = PeerT
     RemoteConnectionId

cardano-node/src/Cardano/Node/Tracing/Tracers/Resources.hs

@@ -11,17 +11,24 @@ import           Control.Concurrent.Async (async)
 import           Control.Monad (forM_, forever)
 import           Control.Monad.Class.MonadAsync (link)
 import           "contra-tracer" Control.Tracer
+import           GHC.Conc (labelThread, myThreadId)
 
-startResourceTracer
-  :: Tracer IO ResourceStats
-  -> Int
-  -> IO ()
-startResourceTracer tr delayMilliseconds = do
-    as <- async resourceThread
-    link as
+-- | Starts a background thread to periodically trace resource statistics.
+-- The thread reads resource stats and traces them using the given tracer.
+-- It is linked to the parent thread to ensure proper error propagation.
+startResourceTracer :: Tracer IO ResourceStats -> Int -> IO ()
+startResourceTracer tracer delayMilliseconds = do
+  thread <- async resourceThread
+  -- Link the thread to the parent to propagate exceptions properly.
+  link thread
   where
+    -- | The background thread that periodically traces resource stats.
     resourceThread :: IO ()
-    resourceThread = forever $ do
-      mbrs <- readResourceStats
-      forM_ mbrs $ \rs -> traceWith tr rs
-      threadDelay (delayMilliseconds * 1000)
+    resourceThread = do
+      -- Label the thread for easier debugging and identification.
+      myThreadId >>= flip labelThread "Resource Stats Tracer"
+      forever $ do
+        maybeStats <- readResourceStats
+        -- If stats are available, trace them using the provided tracer.
+        forM_ maybeStats $ traceWith tracer
+        threadDelay (delayMilliseconds * 1000)