Merge #2710

2710: CAD-2907 Tracing: more details r=deepfire a=deepfire This adds more details to some of the traces: 1. `TraceBlockFetchServerSendBlock` is now a specific message (instead of the non-descript `TraceBlockFetchServerEvent`), and begets the hash of the block sent 2. `TraceForgedBlock` begets hashes of the new/previous blocks, as well as the block no 3. `CompletedBlockFetch` in the blockfetch client begets the hash of the received block 4. The chainsync server begets a trace of its events Co-authored-by: Kosyrev Serge <serge.kosyrev@iohk.io>
IntersectMBO · May 19, 2021 · 220e0f5 · 220e0f5
2 parents 2a6dbeb + e5b6efe
commit 220e0f5
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 13 deletions.
diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
@@ -30,7 +30,7 @@ import           Cardano.Slotting.Slot (fromWithOrigin)
 
 import           Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ConvertRawHash (..),
                    ForgeStateUpdateError, Header, RealPoint, getHeader, headerPoint, realPointHash,
-                   realPointSlot)
+                   realPointSlot, blockNo, blockPrevHash, pointHash)
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
@@ -40,7 +40,7 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx,
                    LedgerSupportsMempool, TxId, txForgetValidated, txId)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..))
-import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent)
+import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
@@ -216,7 +216,8 @@ instance (LedgerSupportsProtocol blk)
   formatText _ = pack . show . toList
 
 
-instance Transformable Text IO (TraceBlockFetchServerEvent blk) where
+instance ConvertRawHash blk
+      => Transformable Text IO (TraceBlockFetchServerEvent blk) where
   trTransformer = trStructuredText
 
 
@@ -963,9 +964,11 @@ instance ( ConvertRawHash blk
                , "files" .= String (Text.pack . show $ map show fsPaths)
                ]
 
-instance ToObject (TraceBlockFetchServerEvent blk) where
-  toObject _verb _ =
-    mkObject [ "kind" .= String "TraceBlockFetchServerEvent" ]
+instance ConvertRawHash blk => ToObject (TraceBlockFetchServerEvent blk) where
+  toObject _verb (TraceBlockFetchServerSendBlock blk) =
+    mkObject [ "kind"  .= String "TraceBlockFetchServerSendBlock"
+             , "block" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) $ pointHash blk)
+             ]
 
 
 instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
@@ -1141,10 +1144,13 @@ instance ( tx ~ GenTx blk
       [ "kind" .= String "TraceNodeIsLeader"
       , "slot" .= toJSON (unSlotNo slotNo)
       ]
-  toObject _verb (TraceForgedBlock slotNo _ _ _) =
+  toObject _verb (TraceForgedBlock slotNo _ blk _) =
     mkObject
-      [ "kind" .= String "TraceForgedBlock"
-      , "slot" .= toJSON (unSlotNo slotNo)
+      [ "kind"      .= String "TraceForgedBlock"
+      , "slot"      .= toJSON (unSlotNo slotNo)
+      , "block"     .= String (renderHeaderHash (Proxy @blk) $ blockHash blk)
+      , "blockNo"   .= toJSON (unBlockNo $ blockNo blk)
+      , "blockPrev" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) $ blockPrevHash blk)
       ]
   toObject _verb (TraceDidntAdoptBlock slotNo _) =
     mkObject

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
@@ -712,13 +712,18 @@ instance ToObject SlotNo where
              , "slot" .= toJSON (unSlotNo slot) ]
 
 
-instance ToObject (TraceFetchClientState header) where
+instance ConvertRawHash header => ToObject (TraceFetchClientState header) where
   toObject _verb BlockFetch.AddedFetchRequest {} =
     mkObject [ "kind" .= String "AddedFetchRequest" ]
   toObject _verb BlockFetch.AcknowledgedFetchRequest {} =
     mkObject [ "kind" .= String "AcknowledgedFetchRequest" ]
-  toObject _verb BlockFetch.CompletedBlockFetch {} =
-    mkObject [ "kind" .= String "CompletedBlockFetch" ]
+  toObject _verb (BlockFetch.CompletedBlockFetch pt _ _ _ _) =
+    mkObject [ "kind"  .= String "CompletedBlockFetch"
+             , "block" .= String
+               (case pt of
+                  GenesisPoint -> "Genesis"
+                  BlockPoint _ h -> renderHeaderHash (Proxy @header) h)
+             ]
   toObject _verb BlockFetch.CompletedFetchBatch {} =
     mkObject [ "kind" .= String "CompletedFetchBatch" ]
   toObject _verb BlockFetch.StartedFetchBatch {} =

diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -537,7 +537,10 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
 
   pure Consensus.Tracers
     { Consensus.chainSyncClientTracer = tracerOnOff (traceChainSyncClient trSel) verb "ChainSyncClient" tr
-    , Consensus.chainSyncServerHeaderTracer = Tracer $ \ev -> traceServedCount mbEKGDirect ev
+    , Consensus.chainSyncServerHeaderTracer =
+      Tracer $ \ev -> do
+        traceWith (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer" tr) ev
+        traceServedCount mbEKGDirect ev
     , Consensus.chainSyncServerBlockTracer = tracerOnOff (traceChainSyncBlockServer trSel) verb "ChainSyncBlockServer" tr
     , Consensus.blockFetchDecisionTracer = tracerOnOff' (traceBlockFetchDecisions trSel) $
         annotateSeverity $ teeTraceBlockFetchDecision verb elidedFetchDecision tr