From 24d199f7c61e44f902832aeabe6775ff120cc2ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Baldur=20Bl=C3=B6ndal?= Date: Thu, 24 Jul 2025 08:35:12 +0100 Subject: [PATCH] cardano-tracer: Add functionality to run cardano-tracer as a library, with shut-down functionality and internal/user messaging. --- cardano-tracer/app/cardano-tracer.hs | 25 ++-- cardano-tracer/cardano-tracer.cabal | 4 +- .../src/Cardano/Tracer/Acceptors/Run.hs | 30 +++-- .../src/Cardano/Tracer/Environment.hs | 62 +++++++++- .../Cardano/Tracer/Handlers/Logs/Rotator.hs | 57 ++++----- .../Tracer/Handlers/Metrics/Monitoring.hs | 20 +++- .../Tracer/Handlers/Metrics/Prometheus.hs | 28 +++-- .../Tracer/Handlers/Notifications/Timer.hs | 2 + cardano-tracer/src/Cardano/Tracer/Run.hs | 110 +++++++++++------- .../test/Cardano/Tracer/Test/Acceptor.hs | 4 + .../test/Cardano/Tracer/Test/Logs/Tests.hs | 7 +- .../test/Cardano/Tracer/Test/Restart/Tests.hs | 3 +- nix/workbench/lib-cabal.sh | 6 +- nix/workbench/service/tracer.nix | 2 +- scripts/lite/mainnet.sh | 2 +- 15 files changed, 256 insertions(+), 106 deletions(-) diff --git a/cardano-tracer/app/cardano-tracer.hs b/cardano-tracer/app/cardano-tracer.hs index 63ba7678dae..ab37d40402a 100644 --- a/cardano-tracer/app/cardano-tracer.hs +++ b/cardano-tracer/app/cardano-tracer.hs @@ -1,14 +1,23 @@ -import Cardano.Tracer.CLI (TracerParams, parseTracerParams) +{-# LANGUAGE OverloadedRecordDot #-} + +import Cardano.Tracer.CLI (TracerParams(..), parseTracerParams) +import Cardano.Tracer.MetaTrace import Cardano.Tracer.Run (runCardanoTracer) +import Data.Functor (void) import Data.Version (showVersion) import Options.Applicative import Paths_cardano_tracer (version) main :: IO () -main = - runCardanoTracer =<< customExecParser (prefs showHelpOnEmpty) tracerInfo +main = void do + tracerParams :: TracerParams + <- customExecParser (prefs showHelpOnEmpty) tracerInfo + trace :: Trace IO TracerTrace <- + -- Default `Nothing' severity filter to Info. + mkTracerTracer $ SeverityF (tracerParams.logSeverity <|> Just Info) + runCardanoTracer trace tracerParams tracerInfo :: ParserInfo TracerParams tracerInfo = info @@ -21,7 +30,9 @@ tracerInfo = info versionOption :: Parser (a -> a) versionOption = infoOption - (showVersion version) - (long "version" <> - short 'v' <> - help "Show version") + do showVersion version + do mconcat + [ long "version" + , short 'v' + , help "Show version" + ] diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index e60e54546a6..4896c40193f 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -200,6 +200,7 @@ library , trace-dispatcher ^>= 2.10.0 , trace-forward ^>= 2.3.0 , trace-resources ^>= 0.2.3 + , unagi-chan , wai ^>= 3.2 , warp ^>= 3.4 , yaml @@ -294,6 +295,7 @@ library demo-acceptor-lib exposed-modules: Cardano.Tracer.Test.Acceptor build-depends: bytestring + , QuickCheck , cardano-tracer , containers , extra @@ -306,9 +308,9 @@ library demo-acceptor-lib , text , trace-dispatcher , trace-forward + , unagi-chan , vector , vector-algorithms - , QuickCheck executable demo-acceptor import: project-config diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs index 0c7574f2a26..85d15d86f9b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} @@ -14,6 +15,7 @@ import Cardano.Tracer.Utils import Cardano.Logging.Types (TraceObject) import qualified Cardano.Logging.Types as Net +import Control.Concurrent.Chan.Unagi (dupChan) import Control.Concurrent.Async (forConcurrently_) import "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer) import qualified Data.List.NonEmpty as NE @@ -33,20 +35,28 @@ import qualified Trace.Forward.Protocol.TraceObject.Type as TOF -- 1. Server mode, when the tracer accepts connections from any number of nodes. -- 2. Client mode, when the tracer initiates connections to specified number of nodes. runAcceptors :: TracerEnv -> TracerEnvRTView -> IO () -runAcceptors tracerEnv@TracerEnv{teTracer} tracerEnvRTView = do +runAcceptors tracerEnv@TracerEnv{teTracer, teInChan = inChan} tracerEnvRTView = do traceWith teTracer $ TracerStartedAcceptors network case network of - AcceptAt howToConnect -> + AcceptAt howToConnect -> let -- Run one server that accepts connections from the nodes. - runInLoop - (runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect)) - verbosity howToConnect initialPauseInSec - ConnectTo localSocks -> + + action :: IO () + action = do + dieOnShutdown =<< dupChan inChan + runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect) + + in runInLoop action verbosity howToConnect initialPauseInSec + ConnectTo localSocks -> do -- Run N clients that initiate connections to the nodes. - forConcurrently_ (NE.nub localSocks) \howToConnect -> - runInLoop - (runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect)) - verbosity howToConnect initialPauseInSec + forConcurrently_ (NE.nub localSocks) \howToConnect -> let + + action :: IO () + action = runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect) + + in do + dieOnShutdown =<< dupChan inChan + runInLoop action verbosity howToConnect initialPauseInSec where TracerConfig{network, ekgRequestFreq, verbosity, ekgRequestFull} = teConfig tracerEnv ekgUseFullRequests = fromMaybe False ekgRequestFull diff --git a/cardano-tracer/src/Cardano/Tracer/Environment.hs b/cardano-tracer/src/Cardano/Tracer/Environment.hs index 3daf1d0f4d3..ceb9e5ed72e 100644 --- a/cardano-tracer/src/Cardano/Tracer/Environment.hs +++ b/cardano-tracer/src/Cardano/Tracer/Environment.hs @@ -1,11 +1,24 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} module Cardano.Tracer.Environment ( TracerEnv (..) , TracerEnvRTView (..) + , RawMessage (..) + , InternalMessage (..) + , Tag (..) + , CardanoTracerMessage + , onRawMessage + , onInternal + , onUser + , delayUntilShutdown + , dieOnShutdown + , forever'tilShutdown ) where import Cardano.Logging.Types +import Cardano.Logging.Resources.Types (ResourceStats) import Cardano.Tracer.Configuration #if RTVIEW import Cardano.Tracer.Handlers.Notifications.Types @@ -16,10 +29,13 @@ import Cardano.Tracer.Handlers.State.TraceObjects import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types +import Control.Concurrent (myThreadId) +import Control.Exception (AsyncException(ThreadKilled), throwTo) +import Control.Concurrent.Chan.Unagi (InChan, OutChan, readChan) import Control.Concurrent.Extra (Lock) import Data.Text (Text) import Data.Text.Lazy.Builder (Builder) - +import Data.Kind (Type) -- | Environment for all functions. data TracerEnv = TracerEnv @@ -36,6 +52,7 @@ data TracerEnv = TracerEnv , teRegistry :: !HandleRegistry , teStateDir :: !(Maybe FilePath) , teMetricsHelp :: ![(Text, Builder)] + , teInChan :: !(InChan (CardanoTracerMessage ())) } #if RTVIEW @@ -51,3 +68,46 @@ data TracerEnvRTView = TracerEnvRTView #else data TracerEnvRTView = TracerEnvRTView #endif + +type CardanoTracerMessage userMsg = RawMessage InternalMessage userMsg + +type RawMessage :: Type -> Type -> Type +data RawMessage internal user + = Shutdown + | InternalMessage internal + | UserMessage user + +delayUntilShutdown :: OutChan (RawMessage internal user) -> IO () +delayUntilShutdown outChan = go where + go :: IO () + go = readChan outChan >>= \case + Shutdown -> pure () + _ -> go + +onRawMessage :: (internal -> IO ()) -> (user -> IO ()) -> OutChan (RawMessage internal user) -> IO () +onRawMessage internalAction userAction outChan = + readChan outChan >>= \case + Shutdown -> myThreadId >>= (`throwTo` ThreadKilled) + InternalMessage internal -> internalAction internal + UserMessage user -> userAction user + +onInternal :: (internal -> IO ()) -> OutChan (RawMessage internal user) -> IO () +onInternal = (`onRawMessage` mempty) + +onUser :: (user -> IO ()) -> OutChan (RawMessage internal user) -> IO () +onUser = (mempty `onRawMessage`) + +data InternalMessage where + ResourceMessage :: Tag ex -> (ex -> IO ()) -> InternalMessage + +data Tag a where + TagResource :: Tag (ResourceStats, Trace IO TracerTrace) + +dieOnShutdown :: OutChan (RawMessage internal user) -> IO () +dieOnShutdown = onRawMessage mempty mempty + +forever'tilShutdown :: OutChan (RawMessage internal user) -> IO () -> IO () +forever'tilShutdown outChan action = do + readChan outChan >>= \case + Shutdown -> pure () + _ -> action *> forever'tilShutdown outChan action diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs index 4e63baf87ed..85305b69348 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs @@ -6,7 +6,7 @@ module Cardano.Tracer.Handlers.Logs.Rotator ) where import Cardano.Tracer.Configuration -import Cardano.Tracer.Environment +import Cardano.Tracer.Environment (TracerEnv (..), forever'tilShutdown) import Cardano.Tracer.Handlers.Logs.Utils (createOrUpdateEmptyLog, getTimeStampFromLog, isItLog) import Cardano.Tracer.MetaTrace @@ -14,8 +14,9 @@ import Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, NodeNa import Cardano.Tracer.Utils (showProblemIfAny, readRegistry) import Control.Concurrent.Async (forConcurrently_) +import Control.Concurrent.Chan.Unagi (dupChan) import Control.Concurrent.Extra (Lock) -import Control.Monad (forM_, forever, unless, when) +import Control.Monad (forM_, unless, when) import Control.Monad.Extra (whenJust, whenM) import Data.Foldable (for_) import Data.List (nub, sort) @@ -33,38 +34,40 @@ import System.Time.Extra (sleep) -- | Runs rotation mechanism for the log files. runLogsRotator :: TracerEnv -> IO () -runLogsRotator TracerEnv - { teConfig = TracerConfig{rotation, verbosity, logging} - , teCurrentLogLock - , teTracer - , teRegistry - } = do - whenJust rotation \rotParams -> do +runLogsRotator tracerEnv@TracerEnv { teConfig = TracerConfig{rotation}, teTracer } = do + whenJust rotation \rot -> do traceWith teTracer TracerStartedLogRotator - launchRotator loggingParamsForFiles rotParams verbosity teRegistry teCurrentLogLock - where + launchRotator tracerEnv rot + +launchRotator + :: TracerEnv + -> RotationParams + -> IO () +launchRotator tracerEnv rot@RotationParams{rpFrequencySecs} = do + whenNonEmpty loggingParamsForFiles do + outChan <- dupChan teInChan + forever'tilShutdown outChan do + showProblemIfAny verbosity do + forM_ loggingParamsForFiles \loggingParam -> do + checkRootDir teCurrentLogLock teRegistry rot loggingParam + sleep (fromIntegral rpFrequencySecs) + where + whenNonEmpty :: Applicative f => [a] -> f () -> f () + whenNonEmpty = unless . null + + TracerEnv + { teConfig = TracerConfig{verbosity, logging} + , teCurrentLogLock + , teRegistry + , teInChan + } = tracerEnv + loggingParamsForFiles :: [LoggingParams] loggingParamsForFiles = nub (NE.filter filesOnly logging) filesOnly :: LoggingParams -> Bool filesOnly LoggingParams{logMode} = logMode == FileMode -launchRotator - :: [LoggingParams] - -> RotationParams - -> Maybe Verbosity - -> HandleRegistry - -> Lock - -> IO () -launchRotator [] _ _ _ _ = return () -launchRotator loggingParamsForFiles - rotParams@RotationParams{rpFrequencySecs} verb registry currentLogLock = - forever do - showProblemIfAny verb do - forM_ loggingParamsForFiles \loggingParam -> do - checkRootDir currentLogLock registry rotParams loggingParam - sleep $ fromIntegral rpFrequencySecs - -- | All the logs with 'TraceObject's received from particular node -- will be stored in a separate subdirectory in the root directory. -- diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs index 182cadff9f4..9a5386862fa 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,6 +15,8 @@ import Cardano.Tracer.Types import Prelude hiding (head) +import Control.Concurrent.Async (race_) +import Control.Concurrent.Chan.Unagi (OutChan, dupChan) import Data.ByteString as ByteString (ByteString, isInfixOf) import Data.ByteString.Builder (stringUtf8) import qualified Data.Text as T @@ -39,7 +42,7 @@ runMonitoringServer -> Endpoint -- ^ (web page with list of connected nodes, EKG web page). -> IO RouteDictionary -> IO () -runMonitoringServer TracerEnv{teTracer} endpoint computeRoutes_autoUpdate = do +runMonitoringServer TracerEnv{teTracer, teInChan = inChan} endpoint computeRoutes_autoUpdate = do -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.2 traceWith teTracer TracerStartedMonitoring @@ -47,11 +50,18 @@ runMonitoringServer TracerEnv{teTracer} endpoint computeRoutes_autoUpdate = do , ttMonitoringType = "list" } dummyStore <- EKG.newStore - runSettings (setEndpoint endpoint defaultSettings) do - renderEkg dummyStore computeRoutes_autoUpdate + outChan <- dupChan inChan + + let run :: IO () + run = runSettings (setEndpoint endpoint defaultSettings) $ + renderEkg dummyStore outChan computeRoutes_autoUpdate + + race_ run (delayUntilShutdown outChan) + +renderEkg :: EKG.Store -> OutChan (CardanoTracerMessage ()) -> IO RouteDictionary -> Application +renderEkg dummyStore outChan computeRoutes_autoUpdate request send = do + dieOnShutdown outChan -renderEkg :: EKG.Store -> IO RouteDictionary -> Application -renderEkg dummyStore computeRoutes_autoUpdate request send = do routeDictionary :: RouteDictionary <- computeRoutes_autoUpdate diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs index b60d5ad331c..816797887c4 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,6 +15,10 @@ import Cardano.Tracer.MetaTrace import Prelude hiding (head) +import Control.Concurrent (myThreadId) +import Control.Concurrent.Async (race_) +import Control.Concurrent.Chan.Unagi (OutChan, readChan, dupChan) +import Control.Exception (AsyncException(ThreadKilled), throwTo) import qualified Data.ByteString as ByteString import Data.ByteString.Builder (stringUtf8) import Data.Functor ((<&>)) @@ -67,26 +72,35 @@ runPrometheusServer tracerEnv endpoint computeRoutes_autoUpdate = do -- If everything is okay, the function 'simpleHttpServe' never returns. -- But if there is some problem, it never throws an exception, but just stops. -- So if it stopped - it will be re-started. - traceWith teTracer TracerStartedPrometheus + traceWith tracer TracerStartedPrometheus { ttPrometheusEndpoint = endpoint } - runSettings (setEndpoint endpoint defaultSettings) do - renderPrometheus computeRoutes_autoUpdate noSuffix teMetricsHelp + outChan <- dupChan inChan + let run :: IO () + run = runSettings (setEndpoint endpoint defaultSettings) $ + renderPrometheus computeRoutes_autoUpdate outChan noSuffix metricsHelp + race_ run (delayUntilShutdown outChan) where TracerEnv - { teTracer - , teConfig = TracerConfig { metricsNoSuffix } - , teMetricsHelp + { teTracer = tracer + , teConfig = TracerConfig { metricsNoSuffix } + , teMetricsHelp = metricsHelp + , teInChan = inChan } = tracerEnv noSuffix = or @Maybe metricsNoSuffix renderPrometheus :: IO RouteDictionary + -> OutChan (CardanoTracerMessage ()) -> Bool -> [(Text, Builder)] -> Application -renderPrometheus computeRoutes_autoUpdate noSuffix helpTextDict request send = do +renderPrometheus computeRoutes_autoUpdate outChan noSuffix helpTextDict request send = do + readChan outChan >>= \case + Shutdown -> myThreadId >>= (`throwTo` ThreadKilled) + _ -> pure () + routeDictionary :: RouteDictionary <- computeRoutes_autoUpdate diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs index 7369e6b7c67..b01f5053e3c 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs @@ -110,3 +110,5 @@ mkTimerOnFailure onFailure tracer io state callPeriod_sec = do , startTimer = modifyIORef' isRunning (const True) , stopTimer = modifyIORef' isRunning (const False) } + + -- TODO: Store last timestamp diff --git a/cardano-tracer/src/Cardano/Tracer/Run.hs b/cardano-tracer/src/Cardano/Tracer/Run.hs index 712ce1224ea..aee23b657ac 100644 --- a/cardano-tracer/src/Cardano/Tracer/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Run.hs @@ -2,11 +2,18 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecursiveDo #-} -- | This top-level module is used by 'cardano-tracer' app. module Cardano.Tracer.Run ( doRunCardanoTracer , runCardanoTracer + , CardanoTracerHandle (..) + -- , updateCallback + -- , extendCallback + , cleanupCardanoTracer ) where import Cardano.Logging.Resources @@ -26,42 +33,47 @@ import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils -import Control.Applicative import Control.Concurrent (threadDelay) +import Control.Concurrent.Chan.Unagi import Control.Concurrent.Async (async, link) import Control.Concurrent.Extra (newLock) #if RTVIEW import Control.Concurrent.STM.TVar (newTVarIO) #endif import Control.Exception (SomeException, try) -import Control.Monad import Data.Aeson (decodeFileStrict') import Data.Foldable (for_) -import Data.Maybe (fromMaybe) import qualified Data.Map.Strict as M (Map, empty, filter, toList) +import Data.Maybe (fromMaybe) import Data.Text as T (Text, null) import Data.Text.Lazy.Builder as TB (Builder, fromText) +data CardanoTracerHandle = CardanoTracerHandle + { inChan :: InChan (CardanoTracerMessage ()) + , outChan :: OutChan (CardanoTracerMessage ()) + } + +cleanupCardanoTracer :: CardanoTracerHandle -> IO () +cleanupCardanoTracer handle = + writeChan handle.inChan Shutdown -- | Top-level run function, called by 'cardano-tracer' app. -runCardanoTracer :: TracerParams -> IO () -runCardanoTracer TracerParams{tracerConfig, stateDir, logSeverity} = do - tr <- mkTracerTracer $ SeverityF $ logSeverity <|> Just Info -- default severity filter to Info - traceWith tr TracerBuildInfo +runCardanoTracer :: Trace IO TracerTrace -> TracerParams -> IO CardanoTracerHandle +runCardanoTracer tracer TracerParams{tracerConfig, stateDir, logSeverity} = mdo + traceWith tracer TracerBuildInfo #if RTVIEW - { ttBuiltWithRTView = True + { ttBuiltWithRTView = True } #else - { ttBuiltWithRTView = False + { ttBuiltWithRTView = False } #endif - } - traceWith tr TracerParamsAre + traceWith tracer TracerParamsAre { ttConfigPath = tracerConfig , ttStateDir = stateDir , ttMinLogSeverity = logSeverity } config <- readTracerConfig tracerConfig - traceWith tr TracerConfigIs + traceWith tracer TracerConfigIs { ttConfig = config #if RTVIEW , ttWarnRTViewMissing = False @@ -70,18 +82,12 @@ runCardanoTracer TracerParams{tracerConfig, stateDir, logSeverity} = do #endif } - for_ (resourceFreq config) \msInterval -> do - threadId <- async do - forever do - mbrs <- readResourceStats - for_ mbrs \resourceStat -> - traceWith tr (TracerResource resourceStat) - threadDelay (1_000 * msInterval) -- Delay in seconds, given milliseconds - link threadId + traceResourceStats inChan tracer (resourceFreq config) brake <- initProtocolsBrake dpRequestors <- initDataPointRequestors - doRunCardanoTracer config stateDir tr brake dpRequestors + cardanoTracerHandle@CardanoTracerHandle{inChan} <- doRunCardanoTracer config stateDir tracer brake dpRequestors + pure cardanoTracerHandle -- | Runs all internal services of the tracer. doRunCardanoTracer @@ -90,12 +96,12 @@ doRunCardanoTracer -> Trace IO TracerTrace -> ProtocolsBrake -- ^ The flag we use to stop all the protocols. -> DataPointRequestors -- ^ The DataPointRequestors to ask 'DataPoint's. - -> IO () -doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do - traceWith tr TracerInitStarted + -> IO CardanoTracerHandle +doRunCardanoTracer config rtViewStateDir tracer protocolsBrake dpRequestors = mdo + traceWith tracer TracerInitStarted connectedNodes <- initConnectedNodes connectedNodesNames <- initConnectedNodesNames - acceptedMetrics <- initAcceptedMetrics + acceptedMetrics <- initAcceptedMetrics mHelp <- loadMetricsHelp $ metricsHelp config #if RTVIEW @@ -109,13 +115,13 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do currentLogLock <- newLock currentDPLock <- newLock - traceWith tr TracerInitEventQueues + traceWith tracer TracerInitEventQueues #if RTVIEW - eventsQueues <- initEventsQueues tr rtViewStateDir connectedNodesNames dpRequestors currentDPLock + eventsQueues <- initEventsQueues tracer rtViewStateDir connectedNodesNames dpRequestors currentDPLock rtViewPageOpened <- newTVarIO False #endif - (reforwardTraceObject,_trDataPoint) <- initReForwarder config tr + (reforwardTraceObject, _trDataPoint) <- initReForwarder config tracer registry <- newRegistry @@ -130,11 +136,12 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do , teCurrentDPLock = currentDPLock , teDPRequestors = dpRequestors , teProtocolsBrake = protocolsBrake - , teTracer = tr + , teTracer = tracer , teReforwardTraceObjects = reforwardTraceObject , teRegistry = registry , teStateDir = rtViewStateDir , teMetricsHelp = mHelp + , teInChan = inChan } tracerEnvRTView :: TracerEnvRTView @@ -150,24 +157,35 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do #endif -- Specify what should be done before 'cardano-tracer' stops. - beforeProgramStops $ do - traceWith tr TracerShutdownInitiated + beforeProgramStops do + traceWith tracer TracerShutdownInitiated #if RTVIEW backupAllHistory tracerEnv tracerEnvRTView - traceWith tr TracerShutdownHistBackup + traceWith tracer TracerShutdownHistBackup #endif applyBrake (teProtocolsBrake tracerEnv) - traceWith tr TracerShutdownComplete + traceWith tracer TracerShutdownComplete + + traceWith tracer TracerInitDone - traceWith tr TracerInitDone - sequenceConcurrently_ - [ runLogsRotator tracerEnv - , runMetricsServers tracerEnv - , runAcceptors tracerEnv tracerEnvRTView + let runs :: [IO ()] + runs = + [ runLogsRotator tracerEnv + , runMetricsServers tracerEnv + , runAcceptors tracerEnv tracerEnvRTView #if RTVIEW - , runRTView tracerEnv tracerEnvRTView + , runRTView tracerEnv tracerEnvRTView #endif - ] + ] + + (inChan, outChan) <- newChan + + sequenceConcurrently_ runs + + pure CardanoTracerHandle + { inChan + , outChan + } -- NB. this fails silently if there's any read or decode error when an external JSON file is provided loadMetricsHelp :: Maybe FileOrMap -> IO [(Text, Builder)] @@ -181,3 +199,15 @@ loadMetricsHelp (Just (FOM x)) = do Right object -> pure object pure $ (M.toList . fmap TB.fromText . M.filter (not . T.null)) result + +traceResourceStats :: InChan (CardanoTracerMessage ()) -> Trace IO TracerTrace -> Maybe Int -> IO () +traceResourceStats inChan tracer freq = + for_ @Maybe freq \msInterval -> do + outChan <- dupChan inChan + asyncId <- async do + forever'tilShutdown outChan do + mbrs <- readResourceStats + for_ mbrs \resourceStat -> do + traceWith tracer (TracerResource resourceStat) + threadDelay (1_000 * msInterval) -- Delay in seconds, given milliseconds + link asyncId diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs index e998e2f6811..7e316901b09 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs @@ -19,6 +19,7 @@ import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils +import Control.Concurrent.Chan.Unagi (newChan) import Control.Concurrent.Extra (newLock) #if RTVIEW import Control.Concurrent.STM.TVar (newTVarIO, readTVarIO) @@ -67,6 +68,8 @@ launchAcceptorsSimple mode localSock dpName = do registry <- newRegistry + (inChan, _outChan) <- newChan + let tracerEnv :: TracerEnv tracerEnv = TracerEnv { teConfig = mkConfig @@ -82,6 +85,7 @@ launchAcceptorsSimple mode localSock dpName = do , teRegistry = registry , teStateDir = Nothing , teMetricsHelp = [] + , teInChan = inChan } tracerEnvRTView :: TracerEnvRTView diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Logs/Tests.hs b/cardano-tracer/test/Cardano/Tracer/Test/Logs/Tests.hs index 68f0abbac5b..d2edf96a6f9 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Logs/Tests.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Logs/Tests.hs @@ -11,13 +11,14 @@ import qualified Cardano.Logging.Types as Net import Cardano.Tracer.Configuration import Cardano.Tracer.Handlers.Logs.Utils (isItLog) import Cardano.Tracer.MetaTrace -import Cardano.Tracer.Run (doRunCardanoTracer) +import Cardano.Tracer.Run (doRunCardanoTracer, cleanupCardanoTracer) import Cardano.Tracer.Test.Forwarder import Cardano.Tracer.Test.TestSetup import Cardano.Tracer.Test.Utils import Cardano.Tracer.Utils (applyBrake, initDataPointRequestors, initProtocolsBrake) -import Control.Concurrent.Async (withAsync, link) +import Control.Concurrent.Async +-- import Control.Concurrent.Async (withAsync, link) import Data.List.Extra (notNull) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Traversable (for) @@ -37,9 +38,7 @@ tests ts = localOption (QuickCheckTests 1) $ testGroup "Test.Logs" , testProperty ".json" do propRunInLogsStructure ts (propLogs ts ForMachine 100 60) , testProperty "multi, initiator socket" do propRunInLogsStructureLocal2 ts (propMultiInit ts ForMachine) , testProperty "multi, responder socket" do propRunInLogsStructureLocal ts (propMultiResp ts ForMachine) - , testProperty "multi, initiator, port" do propRunInLogsStructurePort2 ts (propMultiInit ts ForMachine) - , testProperty "multi, responder, port" do propRunInLogsStructurePort ts (propMultiResp ts ForMachine) ] diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Restart/Tests.hs b/cardano-tracer/test/Cardano/Tracer/Test/Restart/Tests.hs index f0cee4208bb..e16a0cf55fe 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Restart/Tests.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Restart/Tests.hs @@ -20,6 +20,7 @@ import Ouroboros.Network.Magic (NetworkMagic (..)) import Control.Concurrent.Async (asyncBound, uninterruptibleCancel) import Control.Monad (forM_) import Control.Monad.Extra (ifM) +import Data.Functor (void) import qualified Data.List.NonEmpty as NE import System.Directory (removePathForcibly) import System.Directory.Extra (listDirectories) @@ -42,7 +43,7 @@ propNetworkForwarder ts rootDir localSock = do dpRequestors <- initDataPointRequestors propNetwork' ts rootDir ( launchForwardersSimple ts Initiator (Net.LocalPipe localSock) 1000 10000 - , doRunCardanoTracer config (Just $ rootDir <> "/../state") stderrShowTracer brake dpRequestors + , void $ doRunCardanoTracer config (Just $ rootDir <> "/../state") stderrShowTracer brake dpRequestors ) propNetwork' diff --git a/nix/workbench/lib-cabal.sh b/nix/workbench/lib-cabal.sh index 8ad4263d14f..864d469fe6d 100644 --- a/nix/workbench/lib-cabal.sh +++ b/nix/workbench/lib-cabal.sh @@ -62,6 +62,10 @@ function cardano-tracer() { cabal -v0 run ${WB_FLAGS_CABAL} exe:cardano-tracer -- ${WB_FLAGS_RTS} "$@" } +function cardano-baldur() { + cabal -v0 run ${WB_FLAGS_CABAL} exe:my-project -- ${WB_FLAGS_RTS} "$@" +} + function locli() { #cabal -v0 build ${WB_FLAGS_CABAL} exe:locli #set-git-rev \ @@ -78,4 +82,4 @@ function tx-generator() { export WB_MODE_CABAL=t -export -f cardano-node cardano-profile cardano-topology cardano-tracer locli tx-generator +export -f cardano-node cardano-baldur cardano-profile cardano-topology cardano-tracer locli tx-generator diff --git a/nix/workbench/service/tracer.nix b/nix/workbench/service/tracer.nix index 5d84268145b..f9f8ef27f77 100644 --- a/nix/workbench/service/tracer.nix +++ b/nix/workbench/service/tracer.nix @@ -28,7 +28,7 @@ let configFile = "config.json"; metricsHelp = "../../../cardano-tracer/configuration/metrics_help.json"; } // optionalAttrs backend.useCabalRun { - executable = "cardano-tracer"; + executable = "cardano-baldur"; } // optionalAttrs profile.tracer.rtview { RTView = { epHost = "127.0.0.1"; diff --git a/scripts/lite/mainnet.sh b/scripts/lite/mainnet.sh index f7c1af884ae..8722d5d2f66 100755 --- a/scripts/lite/mainnet.sh +++ b/scripts/lite/mainnet.sh @@ -18,7 +18,7 @@ cabal run exe:cardano-node -- run \ --topology "${configuration}/mainnet-topology.json" \ --database-path "${db_dir}" \ --socket-path "${socket_dir}/node-1-socket" \ - --tracer-socket-path-connect "${socket_dir}/tracer.socket" \ + --tracer-socket-path-connect "/tmp/tracer.socket" \ --host-addr "0.0.0.0" \ --port "3001"