diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index fd356af9509..2b2ea634158 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -6,7 +6,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} #if !defined(mingw32_HOST_OS) @@ -192,59 +191,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 index 0fa8f47e8c3..aa0d2df8824 100644 --- 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.