diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs index caf41dbb8db..ae5bad37313 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Logging.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Logging.hs @@ -28,28 +28,6 @@ module Cardano.Node.Configuration.Logging import Cardano.Api (textShow) import qualified Cardano.Api as Api -import qualified Control.Concurrent as Conc -import qualified Control.Concurrent.Async as Async -import Control.Concurrent.MVar (MVar, newMVar) -import Control.Concurrent.STM (STM) -import Control.Exception (IOException) -import Control.Exception.Safe (MonadCatch) -import Control.Monad (forM_, forever, void, when) -import Control.Monad.Except (ExceptT) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except.Extra (catchIOExceptT) -import "contra-tracer" Control.Tracer -import Data.List (nub) -import qualified Data.Map.Strict as Map -import Data.Maybe (isJust) -import Data.Text (Text, pack) -import Data.Time.Clock (UTCTime, getCurrentTime) -import Data.Version (showVersion) -import System.Metrics.Counter (Counter) -import System.Metrics.Gauge (Gauge) -import System.Metrics.Label (Label) -import qualified System.Remote.Monitoring.Wai as EKG - import Cardano.BM.Backend.Aggregation (plugin) import Cardano.BM.Backend.EKGView (plugin) import Cardano.BM.Backend.Monitoring (plugin) @@ -65,7 +43,7 @@ import Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..), LoggerNam import qualified Cardano.BM.Observer.Monadic as Monadic import qualified Cardano.BM.Observer.STM as Stm import Cardano.BM.Plugin (loadPlugin) -#if defined(SYSTEMD) +#ifdef SYSTEMD import Cardano.BM.Scribe.Systemd (plugin) #endif import Cardano.BM.Setup (setupTrace_, shutdown) @@ -73,9 +51,15 @@ import Cardano.BM.Stats import Cardano.BM.Stats.Resources import qualified Cardano.BM.Trace as Trace import Cardano.BM.Tracing - import qualified Cardano.Chain.Genesis as Gen +import Cardano.Git.Rev (gitRev) import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol) +import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) +import Cardano.Node.Types +import Cardano.Slotting.Slot (EpochSize (..)) +import Cardano.Tracing.Config (TraceOptions (..)) +import Cardano.Tracing.OrphanInstances.Common () import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT import Ouroboros.Consensus.Byron.Ledger.Conversions import Ouroboros.Consensus.Cardano.Block @@ -86,13 +70,28 @@ import Ouroboros.Consensus.HardFork.Combinator.Degenerate import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Shelley.Ledger.Ledger -import Cardano.Git.Rev (gitRev) -import Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol) -import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..)) -import Cardano.Node.Types -import Cardano.Slotting.Slot (EpochSize (..)) -import Cardano.Tracing.Config (TraceOptions (..)) -import Cardano.Tracing.OrphanInstances.Common () +import qualified Control.Concurrent as Conc +import qualified Control.Concurrent.Async as Async +import Control.Concurrent.MVar (MVar, newMVar) +import Control.Concurrent.STM (STM) +import Control.Exception (IOException) +import Control.Exception.Safe (MonadCatch) +import Control.Monad (forM_, forever, void, when) +import Control.Monad.Except (ExceptT) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Except.Extra (catchIOExceptT) +import Data.List (nub) +import qualified Data.Map.Strict as Map +import Data.Maybe (isJust) +import Data.Text (Text, pack) +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Version (showVersion) +import GHC.Conc (labelThread, myThreadId) +import System.Metrics.Counter (Counter) +import System.Metrics.Gauge (Gauge) +import System.Metrics.Label (Label) +import qualified System.Remote.Monitoring.Wai as EKG + import Paths_cardano_node (version) -------------------------------- @@ -255,7 +254,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 +277,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 "Resource capturing (old tracing)" + forever $ do readResourceStats >>= maybe (pure ()) (traceResourceStats diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index 0c7964cc834..e751a067f3e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Resources.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Resources.hs index a978a468003..8418fdc8c18 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Resources.hs +++ b/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)