cardano-node: startup code

IntersectMBO · May 23, 2022 · 6b4fc9c · 6b4fc9c
1 parent 0f6a20d
commit 6b4fc9c
Show file tree

Hide file tree

Showing 2 changed files with 71 additions and 62 deletions.
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
@@ -192,59 +192,63 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do
       let fp = maybe  "No file path found!"
                       unConfigPath
                       (getLast (pncConfigFile cmdPc))
-      (tracers, mLoggingLayer) <-
-        case ncTraceConfig nc of
-          TraceDispatcher{} -> do
-            (, Nothing) <$>
-              initTraceDispatcher
-                nc
-                p
-                networkMagic
-                nodeKernelData
-                p2pMode
-          _ -> do
-            eLoggingLayer <- runExceptT $ createLoggingLayer
-              (Text.pack (showVersion version))
+      case ncTraceConfig nc of
+        TraceDispatcher{} -> do
+          tracers <-
+            initTraceDispatcher
               nc
               p
-
-            loggingLayer <- case eLoggingLayer of
-              Left err  -> putTextLn (Text.pack $ show err) >> exitFailure
-              Right res -> return res
-            !trace <- setupTrace loggingLayer
-            let tracer = contramap pack $ toLogObject trace
-            logTracingVerbosity nc tracer
-
-            -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'.
-            startTime <- getCurrentTime
-            traceCounter "nodeStartTime" trace (ceiling $ utcTimeToPOSIXSeconds startTime)
-            nbi <- nodeBasicInfo nc p startTime
-            forM_ nbi $ \(LogObject nm mt content) ->
-              traceNamedObject (appendName nm trace) (mt, content)
-
-            (,Just loggingLayer) <$>
-              mkTracers
-                (Consensus.configBlock cfg)
-                (ncTraceConfig nc)
-                trace
-                nodeKernelData
-                (llEKGDirect loggingLayer)
-                p2pMode
-
-      getStartupInfo nc p fp
-        >>= mapM_ (traceWith $ startupTracer tracers)
-
-      Async.withAsync (handlePeersListSimple (error "Implement Tracer IO [Peer blk]") nodeKernelData)
-          $ \_peerLoggingThread ->
-            -- We ignore peer logging thread if it dies, but it will be killed
-            -- when 'handleSimpleNode' terminates.
-                handleSimpleNode runP p2pMode tracers nc
-                  (\nk -> do
-                      setNodeKernel nodeKernelData nk
-                      traceWith (nodeStateTracer tracers) NodeKernelOnline)
-                `finally`
-                forM_ mLoggingLayer
-                  shutdownLoggingLayer
+              networkMagic
+              nodeKernelData
+              p2pMode
+          handleSimpleNode runP p2pMode tracers nc
+            (\nk -> do
+                setNodeKernel nodeKernelData nk
+                traceWith (nodeStateTracer tracers) NodeKernelOnline)
+
+        _ -> do
+          eLoggingLayer <- runExceptT $ createLoggingLayer
+            (Text.pack (showVersion version))
+            nc
+            p
+
+          loggingLayer <- case eLoggingLayer of
+            Left err  -> putTextLn (Text.pack $ show err) >> exitFailure
+            Right res -> return res
+          !trace <- setupTrace loggingLayer
+          let tracer = contramap pack $ toLogObject trace
+          logTracingVerbosity nc tracer
+
+          -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'.
+          startTime <- getCurrentTime
+          traceCounter "nodeStartTime" trace (ceiling $ utcTimeToPOSIXSeconds startTime)
+          nbi <- nodeBasicInfo nc p startTime
+          forM_ nbi $ \(LogObject nm mt content) ->
+            traceNamedObject (appendName nm trace) (mt, content)
+
+          tracers <-
+            mkTracers
+              (Consensus.configBlock cfg)
+              (ncTraceConfig nc)
+              trace
+              nodeKernelData
+              (llEKGDirect loggingLayer)
+              p2pMode
+
+          getStartupInfo nc p fp
+            >>= mapM_ (traceWith $ startupTracer tracers)
+
+          Async.withAsync (handlePeersListSimple (error "Implement Tracer IO [Peer blk]") nodeKernelData)
+              $ \_peerLoggingThread ->
+                -- We ignore peer logging thread if it dies, but it will be killed
+                -- when 'handleSimpleNode' terminates.
+                    handleSimpleNode runP p2pMode tracers nc
+                      (\nk -> do
+                          setNodeKernel nodeKernelData nk
+                          traceWith (nodeStateTracer tracers) NodeKernelOnline)
+                    `finally`
+                    forM_ eLoggingLayer
+                      shutdownLoggingLayer
 
 
 logTracingVerbosity :: NodeConfiguration -> Tracer IO String -> IO ()

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs
@@ -89,12 +89,12 @@ mkDispatchTracers
 mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enableP2P p = do
     -- Some special tracers
     -- NodeInfo tracer
-    nodeInfoTr <- mkDataPointTracer
+    nodeInfoDP <- mkDataPointTracer
                 trDataPoint
                 (const ["NodeInfo"])
-    configureTracers trConfig docNodeInfoTraceEvent [nodeInfoTr]
+    configureTracers trConfig docNodeInfoTraceEvent [nodeInfoDP]
 
-    nodeStateTr <- mkDataPointTracer
+    nodeStateDP <- mkDataPointTracer
                 trDataPoint
                 (const ["NodeState"])
 
@@ -107,7 +107,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
                 allPublic
     configureTracers trConfig SR.docNodeState [stateTr]
 
-    nodePeersTr <- mkDataPointTracer
+    nodePeersDP <- mkDataPointTracer
                 trDataPoint
                 (const ["NodePeers"])
 
@@ -204,19 +204,24 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
     diffusionTrExtra :: Diffusion.ExtraTracers p2p <-
       mkDiffusionTracersExtra trBase trForward mbTrEKG trDataPoint trConfig enableP2P
     pure Tracers
-      { chainDBTracer = Tracer (\x -> traceWith chainDBTr' x >> SR.traceNodeStateChainDB p nodeStateTr x)
-                     <> Tracer (\x -> traceWith replayBlockTr' x >> SR.traceNodeStateChainDB p nodeStateTr x)
+      { chainDBTracer = Tracer (traceWith chainDBTr')
+                     <> Tracer (traceWith replayBlockTr')
+                     <> Tracer (SR.traceNodeStateChainDB p nodeStateDP)
       , consensusTracers = consensusTr
       , nodeToClientTracers = nodeToClientTr
       , nodeToNodeTracers = nodeToNodeTr
       , diffusionTracers = diffusionTr
       , diffusionTracersExtra = diffusionTrExtra
-      , startupTracer = Tracer $ \x -> traceWith startupTr x >> SR.traceNodeStateStartup nodeStateTr x
-      , shutdownTracer = Tracer $ \x -> traceWith shutdownTr x >> SR.traceNodeStateShutdown nodeStateTr x
-      , nodeInfoTracer = Tracer (traceWith nodeInfoTr)
-      , nodeStateTracer = Tracer (traceWith stateTr) <> Tracer (traceWith nodeStateTr)
+      , startupTracer   = Tracer (traceWith startupTr)
+                        <> Tracer (SR.traceNodeStateStartup nodeStateDP)
+      , shutdownTracer  = Tracer (traceWith shutdownTr)
+                        <> Tracer (SR.traceNodeStateShutdown nodeStateDP)
+      , nodeInfoTracer  = Tracer (traceWith nodeInfoDP)
+      , nodeStateTracer = Tracer (traceWith stateTr)
+                        <> Tracer (traceWith nodeStateDP)
       , resourcesTracer = Tracer (traceWith resourcesTr)
-      , peersTracer = Tracer $ \x -> traceWith peersTr x >> traceNodePeers nodePeersTr x
+      , peersTracer     = Tracer (traceWith peersTr)
+                        <> Tracer (traceNodePeers nodePeersDP)
     }
 
 mkConsensusTracers :: forall blk.