diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index f52fe4db709..b6427c938da 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} @@ -123,8 +124,8 @@ initTxGenTracers mbForwarding = do prepareForwardingTracer = forM mbForwarding $ \(iomgr, networkId, tracerSocket) -> do let forwardingConf = fromMaybe defaultForwarder (tcForwarder initialTraceConfig) - (forwardSink :: ForwardSink TraceObject, dpStore) <- - initForwarding iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator) + (forwardSink :: ForwardSink TraceObject, dpStore, kickoffForwarder) <- + initForwardingDelayed iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (tracerSocket, Initiator) -- we need to provide NodeInfo DataPoint, to forward generator's name -- to the acceptor application (for example, 'cardano-tracer'). @@ -132,8 +133,10 @@ initTxGenTracers mbForwarding = do dpt :: Trace IO DataPoint dpt = dataPointTracer dpStore nodeInfoTracer <- mkDataPointTracer dpt - prepareGenInfo >>= traceWith nodeInfoTracer + !genInfo <- prepareGenInfo + traceWith nodeInfoTracer genInfo + kickoffForwarder pure $ forwardTracer forwardSink prepareGenInfo :: IO NodeInfo diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index cf8f182411b..34f6f853e9a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -33,6 +33,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress) import Prelude +import Control.DeepSeq (deepseq) import "contra-tracer" Control.Tracer (traceWith) import "trace-dispatcher" Control.Tracer (nullTracer) import Data.Bifunctor (first) @@ -61,7 +62,15 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do (unConfigPath $ ncConfigFile nc) defaultCardanoConfig - tracers <- mkTracers trConfig + (kickoffForwarder, tracers) <- mkTracers trConfig + + -- The NodeInfo DataPoint needs to be fully evaluated and stored + -- before it is queried for the first time by cardano-tracer. + -- Hence, we delay initiating the forwarding connection. + nodeInfo <- prepareNodeInfo nc p trConfig =<< getCurrentTime + nodeInfo `deepseq` traceWith (nodeInfoTracer tracers) nodeInfo + + kickoffForwarder traceWith (nodeStateTracer tracers) NodeTracingOnlineConfiguring @@ -74,8 +83,6 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do nodeKernel (fromMaybe 2000 (tcPeerFrequency trConfig)) - now <- getCurrentTime - prepareNodeInfo nc p trConfig now >>= traceWith (nodeInfoTracer tracers) pure tracers where @@ -88,21 +95,21 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do -- We should initialize forwarding only if 'Forwarder' backend -- is presented in the node's configuration. - (fwdTracer, dpTracer) <- + (fwdTracer, dpTracer, kickoffForwarder) <- if forwarderBackendEnabled then do -- TODO: check if this is the correct way to use withIOManager - (forwardSink, dpStore) <- withIOManager $ \iomgr -> do + (forwardSink, dpStore, kickoffForwarder) <- withIOManager $ \iomgr -> do let tracerSocketMode = Just . first unFile =<< ncTraceForwardSocket nc forwardingConf = fromMaybe defaultForwarder (tcForwarder trConfig) - initForwarding iomgr forwardingConf networkMagic (Just ekgStore) tracerSocketMode - pure (forwardTracer forwardSink, dataPointTracer dpStore) + initForwardingDelayed iomgr forwardingConf networkMagic (Just ekgStore) tracerSocketMode + pure (forwardTracer forwardSink, dataPointTracer dpStore, kickoffForwarder) else -- Since 'Forwarder' backend isn't enabled, there is no forwarding. -- So we use nullTracers to ignore 'TraceObject's and 'DataPoint's. - pure (Trace nullTracer, Trace nullTracer) + pure (Trace nullTracer, Trace nullTracer, pure ()) - mkDispatchTracers + (,) kickoffForwarder <$> mkDispatchTracers nodeKernel stdoutTrace fwdTracer @@ -111,6 +118,7 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do trConfig p2pMode p + where forwarderBackendEnabled = (any (any checkForwarder) . Map.elems) $ tcOptions trConfig diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index b7d0db78177..e4c0af37525 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} #if !defined(mingw32_HOST_OS) #define UNIX diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index 22927406140..b1367281f9a 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -12,6 +12,7 @@ module Cardano.Logging.Forwarding ( initForwarding + , initForwardingDelayed ) where import Cardano.Logging.Types @@ -65,20 +66,35 @@ initForwarding :: forall m. (MonadIO m) -> Maybe EKG.Store -> Maybe (FilePath, ForwarderMode) -> m (ForwardSink TraceObject, DataPointStore) -initForwarding iomgr config magic ekgStore tracerSocketMode = liftIO $ do +initForwarding iomgr config magic ekgStore tracerSocketMode = do + (a, b, kickoffForwarder) <- initForwardingDelayed iomgr config magic ekgStore tracerSocketMode + liftIO kickoffForwarder + pure (a, b) + +-- We allow for delayed initialization of the forwarding connection by +-- returning an IO action to do so. +initForwardingDelayed :: forall m. (MonadIO m) + => IOManager + -> TraceOptionForwarder + -> NetworkMagic + -> Maybe EKG.Store + -> Maybe (FilePath, ForwarderMode) + -> m (ForwardSink TraceObject, DataPointStore, IO ()) +initForwardingDelayed iomgr config magic ekgStore tracerSocketMode = liftIO $ do forwardSink <- initForwardSink tfConfig handleOverflow dpStore <- initDataPointStore - launchForwarders - iomgr - magic - ekgConfig - tfConfig - dpfConfig - ekgStore - forwardSink - dpStore - tracerSocketMode - pure (forwardSink, dpStore) + let + kickoffForwarder = launchForwarders + iomgr + magic + ekgConfig + tfConfig + dpfConfig + ekgStore + forwardSink + dpStore + tracerSocketMode + pure (forwardSink, dpStore, kickoffForwarder) where p = maybe "" fst tracerSocketMode connSize = tofConnQueueSize config