fix timing issue in forwarder initialization

bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -123,17 +124,19 @@ 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').
         let
           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

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

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

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