Merge pull request #6104 from IntersectMBO/bench-master

bench: small fixes for tracing in node and workbench

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

@@ -46,7 +46,7 @@ import           Prelude
 import           Control.DeepSeq (NFData)
 import           Data.Aeson (FromJSON, ToJSON)
 import           Data.Map.Strict (Map)
-import           Data.Monoid (Last (..), getLast)
+import           Data.Monoid (Last (..))
 import           Data.Text (Text, pack)
 import           Data.Time.Clock (NominalDiffTime, UTCTime)
 import           Data.Version (showVersion)
@@ -250,9 +250,16 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do
         -- In this case we should form node's name as "host_port",
         -- where 'host' is the machine's host name and 'port' is taken
         -- from the '--port' CLI-parameter.
-        let SocketConfig{ncNodePortNumber = port} = ncSocketConfig nc
+
+        let suffix :: String
+            suffix
+              | SocketConfig{ncNodePortNumber = Last (Just port)} <- ncSocketConfig nc
+              = "_" <> show port
+              | otherwise
+              = ""
+
         hostName <- getHostName
-        return . pack $ hostName <> "_" <> show (getLast port)
+        return (pack (hostName <> suffix))
 
 -- | This information is taken from 'BasicInfoShelleyBased'. It is required for
 --   'cardano-tracer' service (particularly, for RTView).

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

@@ -12,6 +12,7 @@ module Cardano.Node.Tracing.Consistency
   , checkNodeTraceConfiguration'
   ) where
 
+
 import           Cardano.Logging
 import           Cardano.Logging.Resources
 import           Cardano.Logging.Resources.Types ()
@@ -23,29 +24,33 @@ import           Cardano.Node.Tracing.Formatting ()
 import qualified Cardano.Node.Tracing.StateRep as SR
 import           Cardano.Node.Tracing.Tracers.BlockReplayProgress
 import           Cardano.Node.Tracing.Tracers.Consensus
+import           Cardano.Node.Tracing.Tracers.ConsensusStartupException
 import           Cardano.Node.Tracing.Tracers.Diffusion ()
 import           Cardano.Node.Tracing.Tracers.KESInfo ()
 import           Cardano.Node.Tracing.Tracers.NodeToClient ()
 import           Cardano.Node.Tracing.Tracers.NodeToNode ()
 import           Cardano.Node.Tracing.Tracers.NodeVersion (NodeVersionTrace)
-
 import           Cardano.Node.Tracing.Tracers.NonP2P ()
 import           Cardano.Node.Tracing.Tracers.P2P ()
 import           Cardano.Node.Tracing.Tracers.Peer
 import           Cardano.Node.Tracing.Tracers.Shutdown ()
 import           Cardano.Node.Tracing.Tracers.Startup ()
+import           Ouroboros.Consensus.Block.SupportsSanityCheck (SanityCheckIssue)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
 import           Ouroboros.Consensus.Cardano.Block
+import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent (..))
 import           Ouroboros.Consensus.Ledger.Query (Query)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId)
 import           Ouroboros.Consensus.Mempool (TraceEventMempool (..))
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                    (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent)
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Jumping
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                    (TraceLocalTxSubmissionServerEvent (..))
+import           Ouroboros.Consensus.Node.GSM (TraceGsmEvent)
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Network.Block (Point (..), SlotNo, Tip)
@@ -139,12 +144,12 @@ getAllNamespaces =
         replayBlockNS = map (nsGetTuple . nsReplacePrefix ["ChainDB", "ReplayBlock"])
                         (allNamespaces :: [Namespace ReplayBlockStats])
 -- Consensus tracers
+
         chainSyncClientNS = map
                               (nsGetTuple . nsReplacePrefix  ["ChainSync", "Client"])
                               (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer
                                                            (ConnectionId RemoteAddress)
                                                            (TraceChainSyncClientEvent blk))])
-
         chainSyncServerHeaderNS = map (nsGetTuple . nsReplacePrefix ["ChainSync", "ServerHeader"])
                         (allNamespaces :: [Namespace (TraceChainSyncServerEvent blk)])
         chainSyncServerBlockNS = map (nsGetTuple . nsReplacePrefix ["ChainSync", "ServerBlock"])
@@ -157,7 +162,6 @@ getAllNamespaces =
                         (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer
                                                       remotePeer
                                                       (BlockFetch.TraceFetchClientState (Header blk)))])
-
         blockFetchServerNS = map (nsGetTuple . nsReplacePrefix ["BlockFetch", "Server"])
                     (allNamespaces :: [Namespace (TraceBlockFetchServerEvent blk)])
 
@@ -172,6 +176,8 @@ getAllNamespaces =
                         (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer
                   remotePeer
                   (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))])
+        consensusSanityCheckNS = map (nsGetTuple . nsReplacePrefix ["Consensus", "SanityCheck"])
+                        (allNamespaces :: [Namespace SanityCheckIssue])
         localTxSubmissionServerNS = map (nsGetTuple . nsReplacePrefix
                                             ["TxSubmission", "LocalServer"])
                         (allNamespaces :: [Namespace
@@ -183,6 +189,14 @@ getAllNamespaces =
 
         blockchainTimeNS = map (nsGetTuple . nsReplacePrefix  ["BlockchainTime"])
                         (allNamespaces :: [Namespace (TraceBlockchainTimeEvent RelativeTime)])
+        gddNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "GDD"])
+                        (allNamespaces :: [Namespace (TraceGDDEvent peer blk)])
+        consensusStartupErrorNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "Startup"])
+                        (allNamespaces :: [Namespace ConsensusStartupException])
+        gsmNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "GSM"])
+                        (allNamespaces :: [Namespace (TraceGsmEvent (Tip blk))])
+        csjNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "CSJ"])
+                        (allNamespaces :: [Namespace (Jumping.TraceEvent peer)])
 
 -- Node to client
         keepAliveClientNS = map (nsGetTuple . nsReplacePrefix ["Net"])
@@ -380,6 +394,7 @@ getAllNamespaces =
             <> chainSyncServerHeaderNS
             <> chainSyncServerBlockNS
             <> blockFetchDecisionNS
+            <> consensusSanityCheckNS
             <> blockFetchClientNS
             <> blockFetchServerNS
             <> forgeKESInfoNS
@@ -389,6 +404,10 @@ getAllNamespaces =
             <> mempoolNS
             <> forgeNS
             <> blockchainTimeNS
+            <> gddNS
+            <> consensusStartupErrorNS
+            <> gsmNS
+            <> csjNS
 -- NodeToClient
             <> keepAliveClientNS
             <> chainSyncNS

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

@@ -18,6 +18,7 @@ module Cardano.Node.Tracing.Documentation
   , docTracersFirstPhase
   ) where
 
+
 import           Cardano.Logging as Logging
 import           Cardano.Logging.Resources
 import           Cardano.Logging.Resources.Types ()
@@ -30,6 +31,7 @@ import qualified Cardano.Node.Tracing.StateRep as SR
 import           Cardano.Node.Tracing.Tracers.BlockReplayProgress
 import           Cardano.Node.Tracing.Tracers.ChainDB
 import           Cardano.Node.Tracing.Tracers.Consensus
+import           Cardano.Node.Tracing.Tracers.ConsensusStartupException
 import           Cardano.Node.Tracing.Tracers.Diffusion ()
 import           Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats)
 import           Cardano.Node.Tracing.Tracers.KESInfo ()
@@ -41,18 +43,22 @@ import           Cardano.Node.Tracing.Tracers.P2P ()
 import           Cardano.Node.Tracing.Tracers.Peer
 import           Cardano.Node.Tracing.Tracers.Shutdown ()
 import           Cardano.Node.Tracing.Tracers.Startup ()
+import           Ouroboros.Consensus.Block.SupportsSanityCheck (SanityCheckIssue)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
 import           Ouroboros.Consensus.Cardano.Block
+import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent (..))
 import           Ouroboros.Consensus.Ledger.Query (Query)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId)
 import           Ouroboros.Consensus.Mempool (TraceEventMempool (..))
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                    (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent)
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Jumping
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                    (TraceLocalTxSubmissionServerEvent (..))
+import           Ouroboros.Consensus.Node.GSM (TraceGsmEvent)
 import qualified Ouroboros.Consensus.Node.Tracers as Consensus
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
@@ -376,6 +382,43 @@ docTracersFirstPhase condConfigFileName = do
     blockchainTimeTrDoc <- documentTracer (blockchainTimeTr ::
       Logging.Trace IO (TraceBlockchainTimeEvent RelativeTime))
 
+
+    consensusSanityCheckTr <- mkCardanoTracer
+                 trBase trForward mbTrEKG
+                 ["Consensus", "SanityCheck"]
+    configureTracers configReflection trConfig [consensusSanityCheckTr]
+    consensusSanityCheckTrDoc <- documentTracer (consensusSanityCheckTr ::
+      Logging.Trace IO SanityCheckIssue)
+
+    consensusStartupErrorTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "Startup"]
+    configureTracers configReflection trConfig [consensusStartupErrorTr]
+    consensusStartupErrorTrDoc <- documentTracer (consensusStartupErrorTr ::
+      Logging.Trace IO ConsensusStartupException)
+
+    consensusGddTr <- mkCardanoTracer
+                 trBase trForward mbTrEKG
+                 ["Consensus", "GDD"]
+    configureTracers configReflection trConfig [consensusGddTr]
+    consensusGddTrDoc <- documentTracer (consensusGddTr ::
+      Logging.Trace IO (TraceGDDEvent peer blk))
+
+    consensusGsmTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "GSM"]
+    configureTracers configReflection trConfig [consensusGsmTr]
+    consensusGsmTrDoc <- documentTracer (consensusGsmTr ::
+      Logging.Trace IO (TraceGsmEvent (Tip blk)))
+
+    consensusCsjTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "CSJ"]
+    configureTracers configReflection trConfig [consensusCsjTr]
+    consensusCsjTrDoc <- documentTracer (consensusCsjTr ::
+      Logging.Trace IO (Jumping.TraceEvent peer))
+
+
 -- Node to client
 
     keepAliveClientTr <- mkCardanoTracer
@@ -720,6 +763,11 @@ docTracersFirstPhase condConfigFileName = do
             <> forgeTrDoc
             <> forgeThreadStatsTrDoc
             <> blockchainTimeTrDoc
+            <> consensusSanityCheckTrDoc
+            <> consensusStartupErrorTrDoc
+            <> consensusGddTrDoc
+            <> consensusGsmTrDoc
+            <> consensusCsjTrDoc
 -- NodeToClient
             <> keepAliveClientTrDoc
             <> chainSyncTrDoc

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

@@ -246,11 +246,6 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                  ["Consensus", "SanityCheck"]
     configureTracers configReflection trConfig [consensusSanityCheckTr]
 
-    !gddTr <- mkCardanoTracer
-                 trBase trForward mbTrEKG
-                 ["Consensus", "GDD"]
-    configureTracers configReflection trConfig [gddTr]
-
     !blockFetchDecisionTr  <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["BlockFetch", "Decision"]
@@ -330,6 +325,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                 ["Consensus", "Startup"]
     configureTracers configReflection trConfig [consensusStartupErrorTr]
 
+    !consensusGddTr <- mkCardanoTracer
+                 trBase trForward mbTrEKG
+                 ["Consensus", "GDD"]
+    configureTracers configReflection trConfig [consensusGddTr]
+
     !consensusGsmTr <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["Consensus", "GSM"]
@@ -361,7 +361,7 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
       , Consensus.forgeStateInfoTracer = Tracer $
           traceWith (traceAsKESInfo (Proxy @blk) forgeKESInfoTr)
       , Consensus.gddTracer = Tracer $
-          traceWith gddTr
+          traceWith consensusGddTr
       , Consensus.txInboundTracer = Tracer $
            traceWith txInboundTr
       , Consensus.txOutboundTracer = Tracer $