From 1093eb5dd3d9bcba67ca11f570f371b317bbd030 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <coot@coot.me>
Date: Fri, 26 May 2023 19:39:48 +0200
Subject: [PATCH] chainSyncServerHeaderTracer

---
 .../src/Cardano/Tracing/OrphanInstances/Consensus.hs      | 7 +++++++
 cardano-node/src/Cardano/Tracing/Tracers.hs               | 8 +++-----
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
index 88d984f33e0..5bea37684cd 100644
--- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
+++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
@@ -318,6 +318,13 @@ instance ConvertRawHash blk
       => Transformable Text IO (TraceChainSyncServerEvent blk) where
   trTransformer = trStructured
 
+instance (ToObject peer, ToObject (TraceChainSyncServerEvent blk))
+    => Transformable Text IO (TraceLabelPeer peer (TraceChainSyncServerEvent blk)) where
+  trTransformer = trStructured
+instance (StandardHash blk, Show peer)
+    => HasTextFormatter (TraceLabelPeer peer (TraceChainSyncServerEvent blk)) where
+  formatText a _ = pack $ show a
+
 
 instance ( ToObject (ApplyTxErr blk), ToObject (GenTx blk),
            ToJSON (GenTxId blk), LedgerSupportsMempool blk)
diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
index 3df5adb6837..f6d03bfce9c 100644
--- a/cardano-node/src/Cardano/Tracing/Tracers.hs
+++ b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -697,11 +697,9 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
   pure Consensus.Tracers
     { Consensus.chainSyncClientTracer = tracerOnOff (traceChainSyncClient trSel) verb "ChainSyncClient" tr
     , Consensus.chainSyncServerHeaderTracer =
-        contramap (\(TraceLabelPeer _peer a) -> a) $
-          Tracer $ \ev -> do
-            traceWith (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer"
-                        (tracerOnOff' (traceChainSyncHeaderServer trSel) tr)) ev
-            traceServedCount mbEKGDirect ev
+           tracerOnOff' (traceChainSyncHeaderServer trSel)
+                        (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer" tr)
+        <> (\(TraceLabelPeer _ ev) -> ev) `contramap` Tracer (traceServedCount mbEKGDirect)
     , Consensus.chainSyncServerBlockTracer = tracerOnOff (traceChainSyncBlockServer trSel) verb "ChainSyncBlockServer" tr
     , Consensus.blockFetchDecisionTracer = tracerOnOff' (traceBlockFetchDecisions trSel) $
         annotateSeverity $ teeTraceBlockFetchDecision verb elidedFetchDecision tr