logs ip addresses for the server side

Log ip addresses for the server side blockfetch and chainsync application.
IntersectMBO · May 29, 2023 · a6858eb · a6858eb
1 parent 3d13e4d
commit a6858eb
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 15 deletions.
diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
@@ -300,12 +300,12 @@ instance (LedgerSupportsProtocol blk)
   formatText _ = pack . show . toList
 
 
-instance ConvertRawHash blk
-      => Transformable Text IO (TraceBlockFetchServerEvent blk) where
+instance (ToObject peer, ConvertRawHash blk)
+      => Transformable Text IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk)) where
   trTransformer = trStructuredText
 
 
-instance HasTextFormatter (TraceBlockFetchServerEvent blk) where
+instance HasTextFormatter (TraceLabelPeer peer (TraceBlockFetchServerEvent blk)) where
   formatText _ = pack . show . toList
 
 

diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -697,19 +697,18 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
   pure Consensus.Tracers
     { Consensus.chainSyncClientTracer = tracerOnOff (traceChainSyncClient trSel) verb "ChainSyncClient" tr
     , Consensus.chainSyncServerHeaderTracer =
-           tracerOnOff' (traceChainSyncHeaderServer trSel)
-                        (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer" tr)
-        <> (\(TraceLabelPeer _ ev) -> ev) `contramap` Tracer (traceServedCount mbEKGDirect)
+      Tracer $ \ct@(TraceLabelPeer _p ev) -> do
+        traceWith (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer"
+                    (tracerOnOff' (traceChainSyncHeaderServer trSel) tr)) ct
+        traceServedCount mbEKGDirect ev
     , Consensus.chainSyncServerBlockTracer = tracerOnOff (traceChainSyncBlockServer trSel) verb "ChainSyncBlockServer" tr
     , Consensus.blockFetchDecisionTracer = tracerOnOff' (traceBlockFetchDecisions trSel) $
         annotateSeverity $ teeTraceBlockFetchDecision verb elidedFetchDecision tr
     , Consensus.blockFetchClientTracer = traceBlockFetchClientMetrics mbEKGDirect tBlockDelayM
         tBlockDelayCDF1s tBlockDelayCDF3s tBlockDelayCDF5s $
             tracerOnOff (traceBlockFetchClient trSel) verb "BlockFetchClient" tr
-    , Consensus.blockFetchServerTracer =
-        contramap (\(TraceLabelPeer _peer a) -> a) $
-          traceBlockFetchServerMetrics trmet meta tBlocksServed
-            tLocalUp tMaxSlotNo $ tracerOnOff (traceBlockFetchServer trSel) verb "BlockFetchServer" tr
+    , Consensus.blockFetchServerTracer = traceBlockFetchServerMetrics trmet meta tBlocksServed
+        tLocalUp tMaxSlotNo $ tracerOnOff (traceBlockFetchServer trSel) verb "BlockFetchServer" tr
     , Consensus.keepAliveClientTracer = tracerOnOff (traceKeepAliveClient trSel) verb "KeepAliveClient" tr
     , Consensus.forgeStateInfoTracer = tracerOnOff' (traceForgeStateInfo trSel) $
         forgeStateInfoTracer (Proxy @blk) trSel tr
@@ -775,19 +774,19 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
 
 
 traceBlockFetchServerMetrics
-  :: forall blk. ()
+  :: forall blk peer. ()
   => Tracer IO (LoggerName, LogObject Text)
   -> LOMeta
   -> STM.TVar Int64
   -> STM.TVar Int64
   -> STM.TVar SlotNo
-  -> Tracer IO (TraceBlockFetchServerEvent blk)
-  -> Tracer IO (TraceBlockFetchServerEvent blk)
+  -> Tracer IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk))
+  -> Tracer IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk))
 traceBlockFetchServerMetrics trMeta meta tBlocksServed tLocalUp tMaxSlotNo tracer = Tracer bsTracer
 
   where
-    bsTracer :: TraceBlockFetchServerEvent blk -> IO ()
-    bsTracer e@(TraceBlockFetchServerSendBlock p) = do
+    bsTracer :: TraceLabelPeer peer (TraceBlockFetchServerEvent blk) -> IO ()
+    bsTracer e@(TraceLabelPeer _p (TraceBlockFetchServerSendBlock p)) = do
       traceWith tracer e
 
       (served, mbLocalUpstreamyness) <- atomically $ do