node | new tracing: add trace for NodeState

cardano-node/src/Cardano/Node/Run.hs

@@ -63,6 +63,7 @@ import           Cardano.Node.Configuration.POM (NodeConfiguration (..),
                    defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP)
 import           Cardano.Node.Startup
 import           Cardano.Node.Tracing.API
+import           Cardano.Node.Tracing.StateRep
 import           Cardano.Node.Tracing.Tracers.Startup (getStartupInfo)
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
@@ -238,7 +239,9 @@ handleNodeWithTracers  cmdPc nc p networkMagic runP = do
             -- We ignore peer logging thread if it dies, but it will be killed
             -- when 'handleSimpleNode' terminates.
                 handleSimpleNode runP p2pMode tracers nc
-                  (setNodeKernel nodeKernelData)
+                  (\nk -> do
+                      setNodeKernel nodeKernelData nk
+                      traceWith (nodeStateTracer tracers) NodeKernelOnline)
                 `finally`
                 forM_ mLoggingLayer
                   shutdownLoggingLayer

cardano-node/src/Cardano/Node/Tracing/StateRep.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -11,6 +12,9 @@ module Cardano.Node.Tracing.StateRep
   , traceNodeStateChainDB
   , traceNodeStateStartup
   , traceNodeStateShutdown
+  , namesNodeState
+  , severityNodeState
+  , docNodeState
   ) where
 
 import           Cardano.Prelude
@@ -94,11 +98,63 @@ data NodeState
   | NodeOpeningDbs OpeningDbs
   | NodeReplays Replays
   | NodeInitChainSelection InitChainSelection
+  | NodeKernelOnline
   | NodeAddBlock AddedToCurrentChain
   | NodeStartup StartupState
   | NodeShutdown ShutdownTrace
   deriving (Generic, FromJSON, ToJSON)
 
+instance LogFormatting NodeState where
+  forMachine _ = \case
+    NodeOpeningDbs x -> mconcat
+      [ "kind" .= String "NodeOpeningDbs",         "openingDb" .= toJSON x]
+    NodeReplays x -> mconcat
+      [ "kind" .= String "NodeReplays",            "replays"   .= toJSON x]
+    NodeInitChainSelection x -> mconcat
+      [ "kind" .= String "NodeInitChainSelection", "chainSel"  .= toJSON x]
+    NodeAddBlock x -> mconcat
+      [ "kind" .= String "NodeAddBlock",           "addBlock"  .= toJSON x]
+    NodeStartup x -> mconcat
+      [ "kind" .= String "NodeStartup",            "startup"   .= toJSON x]
+    NodeShutdown x -> mconcat
+      [ "kind" .= String "NodeShutdown",           "shutdown"  .= toJSON x]
+    _ -> mempty
+
+docNodeState :: Documented NodeState
+docNodeState = addDocumentedNamespace  [] $
+  Documented
+  [ DocMsg ["NodeTracingOnlineConfiguring"] [] "Tracing system came online, system configuring now"
+  , DocMsg ["NodeOpeningDbs"]               [] "ChainDB components being opened"
+  , DocMsg ["NodeReplays"]                  [] "Replaying chain"
+  , DocMsg ["NodeInitChainSelection"]       [] "Performing initial chain selection"
+  , DocMsg ["NodeKernelOnline"]             [] "Node kernel online"
+  , DocMsg ["NodeAddBlock"]                 [] "Applying block"
+  , DocMsg ["NodeStartup"]                  [] "Node startup"
+  , DocMsg ["NodeShutdown"]                 [] "Node shutting down"
+  ]
+
+namesNodeState :: NodeState -> [Text]
+namesNodeState = \case
+  NodeTracingOnlineConfiguring -> ["TracingOnlineConfiguring"]
+  NodeOpeningDbs _x -> ["OpeningDbs"] -- : namesOpeninDbs x
+  NodeReplays _x -> ["Replays"] -- : namesReplays x
+  NodeInitChainSelection _x -> ["InitChainSelection"] -- : namesInitChainSelection -- Worth it?
+  NodeKernelOnline -> ["NodeKernelOnline"]
+  NodeAddBlock _x -> ["AddBlock"] -- : namesAddBlock x
+  NodeStartup _x -> ["Startup"] -- : namesForStartup x -- Worth it?
+  NodeShutdown _x -> ["Shutdown"] -- : namesShutdown x
+
+severityNodeState :: NodeState -> SeverityS
+severityNodeState = \case
+  NodeTracingOnlineConfiguring -> Info
+  NodeOpeningDbs _x -> Info
+  NodeReplays _x -> Notice
+  NodeInitChainSelection _x -> Notice
+  NodeKernelOnline -> Info
+  NodeAddBlock _x -> Notice
+  NodeStartup _x -> Info
+  NodeShutdown _x -> Warning
+
 traceNodeStateChainDB
   :: SomeConsensusProtocol
   -> Trace IO NodeState

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -95,10 +95,28 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
                 trDataPoint
                 (const ["NodeState"])
 
+    -- State tracer
+    stateTr   <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                "State"
+                SR.namesNodeState
+                SR.severityNodeState
+                allPublic
+    configureTracers trConfig SR.docNodeState [stateTr]
+
     nodePeersTr <- mkDataPointTracer
                 trDataPoint
                 (const ["NodePeers"])
 
+    -- Peers tracer
+    peersTr   <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                "Peers"
+                namesForPeers
+                severityPeers
+                allPublic
+    configureTracers trConfig docPeers [peersTr]
+
     -- Resource tracer
     resourcesTr <- mkCardanoTracer
                 trBase trForward mbTrEKG
@@ -125,15 +143,6 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
                 allPublic
     configureTracers trConfig docShutdown [shutdownTr]
 
-    -- Peers tracer
-    peersTr   <- mkCardanoTracer
-                trBase trForward mbTrEKG
-                "Peers"
-                namesForPeers
-                severityPeers
-                allPublic
-    configureTracers trConfig docPeers [peersTr]
-
     chainDBTr <- mkCardanoTracer'
                 trBase trForward mbTrEKG
                 "ChainDB"
@@ -202,7 +211,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
       , 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 nodeStateTr)
+      , nodeStateTracer = Tracer $ \x -> traceWith stateTr x >> traceWith nodeStateTr x
       , resourcesTracer = Tracer (traceWith resourcesTr)
       , peersTracer = Tracer $ \x -> traceWith peersTr x >> traceNodePeers nodePeersTr x
     }
@@ -352,7 +361,8 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d
           traceWith mempoolTr
       , Consensus.forgeTracer =
           Tracer (traceWith (contramap Left forgeTr))
-          <> Tracer (traceWith (contramap Left forgeThreadStatsTr))
+          <> -- TODO: add the forge-thread-stats as a datapoint
+          Tracer (traceWith (contramap Left forgeThreadStatsTr))
       , Consensus.blockchainTimeTracer = Tracer $
           traceWith blockchainTimeTr
       , Consensus.keepAliveClientTracer = Tracer $

cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs

@@ -1142,7 +1142,7 @@ instance ( StandardHash blk
     mconcat [ "kind" .= String "DeletedSnapshot"
              , "snapshot" .= forMachine dtals snap ]
   forMachine dtals (LedgerDB.InvalidSnapshot snap failure) =
-    mconcat [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot"
+    mconcat [ "kind" .= String "InvalidSnapshot"
              , "snapshot" .= forMachine dtals snap
              , "failure" .= show failure ]
 

cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs

@@ -123,11 +123,11 @@ namesForPeers :: [PeerT blk] -> [Text]
 namesForPeers _ = []
 
 severityPeers :: [PeerT blk] -> SeverityS
+severityPeers [] = Debug
 severityPeers _ = Notice
 
 instance LogFormatting [PeerT blk] where
-  forMachine DMinimal _ = mconcat [ "kind"  .= String "NodeKernelPeers"]
-  forMachine _ []       = mconcat [ "kind"  .= String "NodeKernelPeers"]
+  forMachine _ []       = mempty
   forMachine dtal xs    = mconcat
     [ "kind"  .= String "NodeKernelPeers"
     , "peers" .= toJSON (foldl' (\acc x -> forMachine dtal x : acc) [] xs)