cardano-node: Started LedgerQuery tracer replaces StartLeadershipPlus

IntersectMBO · Jan 13, 2025 · 8d1ed12 · 8d1ed12
1 parent 9a87bdf
commit 8d1ed12
Show file tree

Hide file tree

Showing 9 changed files with 122 additions and 273 deletions.
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -111,6 +111,7 @@ library
                         Cardano.Node.Tracing.Tracers.Diffusion
                         Cardano.Node.Tracing.Tracers.ForgingThreadStats
                         Cardano.Node.Tracing.Tracers.KESInfo
+                        Cardano.Node.Tracing.Tracers.LedgerQuery
                         Cardano.Node.Tracing.Tracers.NodeToClient
                         Cardano.Node.Tracing.Tracers.NodeToNode
                         Cardano.Node.Tracing.Tracers.NodeVersion
@@ -119,7 +120,6 @@ library
                         Cardano.Node.Tracing.Tracers.Peer
                         Cardano.Node.Tracing.Tracers.Resources
                         Cardano.Node.Tracing.Tracers.Shutdown
-                        Cardano.Node.Tracing.Tracers.StartLeadershipCheck
                         Cardano.Node.Tracing.Tracers.Startup
                         Cardano.Node.Types
                         Cardano.Tracing.Config

diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs
@@ -22,13 +22,11 @@ import           Cardano.Node.Tracing.Documentation (docTracersFirstPhase)
 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.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
@@ -179,8 +177,8 @@ getAllNamespaces =
                           (TraceLocalTxSubmissionServerEvent blk)])
         mempoolNS = map (nsGetTuple . nsReplacePrefix ["Mempool"])
                         (allNamespaces :: [Namespace (TraceEventMempool blk)])
-        forgeNS = map (nsGetTuple . nsReplacePrefix ["Forge", "Loop"])
-                        (allNamespaces :: [Namespace (ForgeTracerType blk)])
+        -- forgeNS = map (nsGetTuple . nsReplacePrefix ["Forge", "Loop"])
+        --                 (allNamespaces :: [Namespace (ForgeTracerType blk)]) TODO YUP
 
         blockchainTimeNS = map (nsGetTuple . nsReplacePrefix  ["BlockchainTime"])
                         (allNamespaces :: [Namespace (TraceBlockchainTimeEvent RelativeTime)])
@@ -388,7 +386,7 @@ getAllNamespaces =
             <> txOutboundNS
             <> localTxSubmissionServerNS
             <> mempoolNS
-            <> forgeNS
+--            <> forgeNS TODO YUP
             <> blockchainTimeNS
 -- NodeToClient
             <> keepAliveClientNS

diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs
@@ -355,12 +355,12 @@ docTracersFirstPhase condConfigFileName = do
     mempoolTrDoc <- documentTracer (mempoolTr ::
       Trace IO (TraceEventMempool blk))
 
-    forgeTr <-  mkCardanoTracer
-                trBase trForward mbTrEKG
-                ["Forge", "Loop"]
-    configureTracers configReflection trConfig [forgeTr]
-    forgeTrDoc <- documentTracer (forgeTr ::
-      Trace IO (ForgeTracerType blk))
+    -- forgeTr <-  mkCardanoTracer
+    --             trBase trForward mbTrEKG
+    --             ["Forge", "Loop"]
+    -- configureTracers configReflection trConfig [forgeTr]
+    -- -- forgeTrDoc <- documentTracer (forgeTr ::
+    -- --   Trace IO (ForgeTracerType blk)) TODO YUP
 
 
     forgeTr' <-  mkCardanoTracer
@@ -718,7 +718,7 @@ docTracersFirstPhase condConfigFileName = do
             <> txOutboundTrDoc
             <> localTxSubmissionServerTrDoc
             <> mempoolTrDoc
-            <> forgeTrDoc
+--            <> forgeTrDoc TODO YUP
             <> forgeThreadStatsTrDoc
             <> blockchainTimeTrDoc
 -- NodeToClient

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs
@@ -217,7 +217,7 @@ mkConsensusTracers :: forall blk.
   -> TraceConfig
   -> NodeKernelData blk
   -> IO (Consensus.Tracers IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk)
-mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = do
+mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig _nodeKernel = do
     !chainSyncClientTr  <- mkCardanoTracer
                 trBase trForward mbTrEKG
                  ["ChainSync", "Client"]
@@ -303,11 +303,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                 ["Mempool"]
     configureTracers configReflection trConfig [mempoolTr]
 
-    !forgeTr    <- mkCardanoTracer'
-                trBase trForward mbTrEKG
-                ["Forge", "Loop"]
-                (forgeTracerTransform nodeKernel)
-    configureTracers configReflection trConfig [forgeTr]
+    -- !forgeTr    <- mkCardanoTracer'
+    --             trBase trForward mbTrEKG
+    --             ["Forge", "Loop"]
+    --             (forgeTracerTransform nodeKernel)
+    -- configureTracers configReflection trConfig [forgeTr] TODO YUP
 
     !forgeThreadStatsTr <- mkCardanoTracer'
                 trBase trForward mbTrEKG
@@ -365,10 +365,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
           traceWith localTxSubmissionServerTr
       , Consensus.mempoolTracer = Tracer $
           traceWith mempoolTr
-      , Consensus.forgeTracer =
-           Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith (contramap Left forgeTr) x)
-           <>
-           Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith (contramap Left forgeThreadStatsTr) x)
+      , Consensus.forgeTracer = mempty
+      -- , Consensus.forgeTracer =
+      --      Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith forgeTr x) //TODO YUP
+      --      <>
+      --      Tracer (\(Consensus.TraceLabelCreds _ x) -> traceWith forgeThreadStatsTr x)
       , Consensus.blockchainTimeTracer = Tracer $
           traceWith blockchainTimeTr
       , Consensus.keepAliveClientTracer = Tracer $

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs
@@ -11,6 +11,7 @@
 
 module Cardano.Node.Tracing.Tracers.ChainDB
    ( withAddedToCurrentChainEmptyLimited
+   , fragmentChainDensity
    ) where
 
 import           Cardano.Logging

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs
@@ -14,10 +14,7 @@
 
 module Cardano.Node.Tracing.Tracers.Consensus
   (
-    TraceStartLeadershipCheckPlus (..)
-  , ForgeTracerType
-  , forgeTracerTransform
-  , initialClientMetrics
+    initialClientMetrics
   , calculateBlockFetchClientMetrics
   , servedBlockLatest
   , ClientMetrics
@@ -31,7 +28,6 @@ import           Cardano.Node.Tracing.Era.Shelley ()
 import           Cardano.Node.Tracing.Formatting ()
 import           Cardano.Node.Tracing.Render
 import           Cardano.Node.Tracing.Tracers.ConsensusStartupException ()
-import           Cardano.Node.Tracing.Tracers.StartLeadershipCheck
 import           Cardano.Protocol.TPraos.OCert (KESPeriod (..))
 import           Cardano.Slotting.Slot (WithOrigin (..))
 import           Ouroboros.Consensus.Block
@@ -1359,100 +1355,6 @@ instance MetaTrace (TraceEventMempool blk) where
       , Namespace [] ["Synced"]
       ]
 
---------------------------------------------------------------------------------
--- ForgeTracerType
---------------------------------------------------------------------------------
-
-instance ( tx ~ GenTx blk
-         , ConvertRawHash blk
-         , GetHeader blk
-         , HasHeader blk
-         , HasKESInfo blk
-         , LedgerSupportsProtocol blk
-         , LedgerSupportsMempool blk
-         , SerialiseNodeToNodeConstraints blk
-         , HasTxId (GenTx blk)
-         , Show (ForgeStateUpdateError blk)
-         , Show (CannotForge blk)
-         , LogFormatting (InvalidBlockReason blk)
-         , LogFormatting (CannotForge blk)
-         , LogFormatting (ForgeStateUpdateError blk))
-         => LogFormatting (ForgeTracerType blk) where
-  forMachine dtal (Left i)  = forMachine dtal i
-  forMachine dtal (Right i) = forMachine dtal i
-  forHuman (Left i)  = forHumanOrMachine i
-  forHuman (Right i) = forHumanOrMachine i
-  asMetrics (Left i)  = asMetrics i
-  asMetrics (Right i) = asMetrics i
-
-instance MetaTrace  (ForgeTracerType blk) where
-  namespaceFor (Left ev) =
-    nsCast (namespaceFor ev)
-  namespaceFor (Right _ev) =
-    Namespace [] ["StartLeadershipCheckPlus"]
-
-  severityFor (Namespace _ ["StartLeadershipCheckPlus"]) _ = Just
-    Info
-  severityFor ns (Just (Left ev')) =
-    severityFor (nsCast ns) (Just ev')
-  severityFor ns Nothing =
-    severityFor (nsCast ns :: Namespace (TraceForgeEvent blk)) Nothing
-  severityFor _ _ = Nothing
-
-  detailsFor (Namespace _ ["StartLeadershipCheckPlus"]) _ = Just
-    DNormal
-  detailsFor ns (Just (Left ev')) =
-    detailsFor (nsCast ns) (Just ev')
-  detailsFor ns Nothing =
-    detailsFor (nsCast ns :: Namespace (TraceForgeEvent blk)) Nothing
-  detailsFor _ _ = Nothing
-
-  privacyFor (Namespace _ ["StartLeadershipCheckPlus"]) _ = Just
-    Public
-  privacyFor ns (Just (Left ev')) =
-    privacyFor (nsCast ns) (Just ev')
-  privacyFor ns Nothing =
-    privacyFor (nsCast ns :: Namespace (TraceForgeEvent blk)) Nothing
-  privacyFor _ _ = Nothing
-
-  metricsDocFor (Namespace _ ["StartLeadershipCheckPlus"]) =
-      [ ("Forge.UtxoSize", "UTxO set size")
-      , ("Forge.DelegMapSize", "Delegation map size")
-      ]
-  metricsDocFor ns =
-    metricsDocFor (nsCast ns :: Namespace (TraceForgeEvent blk))
-
-  documentFor (Namespace _ ["StartLeadershipCheckPlus"]) = Just $ mconcat
-    [ "We adopted the block we produced, we also trace the transactions"
-    , "  that were adopted."
-    ]
-  documentFor ns =
-    documentFor (nsCast ns :: Namespace (TraceForgeEvent blk))
-
-  allNamespaces =
-    Namespace [] ["StartLeadershipCheckPlus"]
-    : map nsCast (allNamespaces :: [Namespace (TraceForgeEvent blk)])
-
---------------------------------------------------------------------------------
--- TraceStartLeadershipCheck
---------------------------------------------------------------------------------
-
-instance LogFormatting TraceStartLeadershipCheckPlus where
-  forMachine _dtal TraceStartLeadershipCheckPlus {..} =
-        mconcat [ "kind" .= String "TraceStartLeadershipCheck"
-                , "slot" .= toJSON (unSlotNo tsSlotNo)
-                , "utxoSize" .= Number (fromIntegral tsUtxoSize)
-                , "delegMapSize" .= Number (fromIntegral tsDelegMapSize)
-                , "chainDensity" .= Number (fromRational (toRational tsChainDensity))
-                ]
-  forHuman TraceStartLeadershipCheckPlus {..} =
-      "Checking for leadership in slot " <> showT (unSlotNo tsSlotNo)
-      <> " utxoSize "     <> showT tsUtxoSize
-      <> " delegMapSize " <> showT tsDelegMapSize
-      <> " chainDensity " <> showT tsChainDensity
-  asMetrics TraceStartLeadershipCheckPlus {..} =
-    [IntM "utxoSize"     (fromIntegral tsUtxoSize),
-     IntM "delegMapSize" (fromIntegral tsDelegMapSize)]
 
 
 --------------------------------------------------------------------------------

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs
@@ -10,7 +10,6 @@ module Cardano.Node.Tracing.Tracers.ForgingThreadStats
   ) where
 
 import           Cardano.Logging
-import           Cardano.Node.Tracing.Tracers.StartLeadershipCheck (ForgeTracerType)
 import           Cardano.Slotting.Slot (SlotNo (..))
 import           Ouroboros.Consensus.Node.Tracers
 import qualified Ouroboros.Consensus.Node.Tracers as Consensus
@@ -155,46 +154,45 @@ emptyForgingStats :: ForgingStats
 emptyForgingStats = ForgingStats mempty 0 0 0 0
 
 forgeThreadStats :: Trace IO ForgingStats
-  -> IO (Trace IO (ForgeTracerType blk))
+   -> IO (Trace IO (TraceForgeEvent blk))
 forgeThreadStats tr =
-  let tr' = contramap unfold tr
-  in foldCondTraceM calculateThreadStats emptyForgingStats
-      (\case
-          Left Consensus.TraceStartLeadershipCheck{} -> True
-          Left _ -> False
-          Right _  -> True
-          )
-      tr'
+    let tr' = contramap unfold tr
+    in foldCondTraceM calculateThreadStats emptyForgingStats
+        (\case
+            Consensus.TraceStartLeadershipCheck{} -> True
+            _ -> False
+            )
+        tr'
 
 calculateThreadStats :: MonadIO m
   => ForgingStats
   -> LoggingContext
-  -> ForgeTracerType blk
+  -> TraceForgeEvent blk
   -> m ForgingStats
 calculateThreadStats stats _context
-    (Left TraceNodeCannotForge {}) = do
+    (TraceNodeCannotForge {}) = do
       mapThreadStats
         stats
         (\fts -> (fts { ftsNodeCannotForgeNum = ftsNodeCannotForgeNum fts + 1}
                       , Nothing))
         (\fs _ ->  (fs  { fsNodeCannotForgeNum  = fsNodeCannotForgeNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left (TraceNodeIsLeader (SlotNo slot'))) = do
+    (TraceNodeIsLeader (SlotNo slot')) = do
       let slot = fromIntegral slot'
       mapThreadStats
         stats
         (\fts -> (fts { ftsNodeIsLeaderNum = ftsNodeIsLeaderNum fts + 1
                    , ftsLastSlot = slot}, Nothing))
         (\fs _ ->  (fs  { fsNodeIsLeaderNum  = fsNodeIsLeaderNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left TraceForgedBlock {}) = do
+    (TraceForgedBlock {}) = do
       mapThreadStats
         stats
         (\fts -> (fts { ftsBlocksForgedNum = ftsBlocksForgedNum fts + 1}
                       , Nothing))
         (\fs _ ->  (fs  { fsBlocksForgedNum  = fsBlocksForgedNum fs + 1 }))
 calculateThreadStats stats _context
-    (Left (TraceNodeNotLeader (SlotNo slot'))) = do
+    (TraceNodeNotLeader (SlotNo slot')) = do
       let slot = fromIntegral slot'
       mapThreadStats
         stats