Throw away peer informatio in tracing to get node to compile

IntersectMBO · May 29, 2023 · 8260e91 · 8260e91
1 parent b28bba7
commit 8260e91
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 26 deletions.
diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -697,38 +697,41 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
   pure Consensus.Tracers
     { Consensus.chainSyncClientTracer = tracerOnOff (traceChainSyncClient trSel) verb "ChainSyncClient" tr
     , Consensus.chainSyncServerHeaderTracer =
-      Tracer $ \ev -> do
-        traceWith (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer"
-                    (tracerOnOff' (traceChainSyncHeaderServer trSel) tr)) ev
-        traceServedCount mbEKGDirect ev
+        contramap (\(TraceLabelPeer _peer a) -> a) $
+          Tracer $ \ev -> do
+            traceWith (annotateSeverity . toLogObject' verb $ appendName "ChainSyncHeaderServer"
+                        (tracerOnOff' (traceChainSyncHeaderServer trSel) tr)) ev
+            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 = traceBlockFetchServerMetrics trmet meta tBlocksServed
-        tLocalUp tMaxSlotNo $ tracerOnOff (traceBlockFetchServer trSel) verb "BlockFetchServer" tr
+    , Consensus.blockFetchServerTracer =
+        contramap (\(TraceLabelPeer _peer a) -> a) $
+          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
     , Consensus.txInboundTracer = tracerOnOff' (traceTxInbound trSel) $
-        Tracer $ \ev -> do
-          traceWith (annotateSeverity . toLogObject' verb $ appendName "TxInbound" tr) ev
-          case ev of
-            TraceLabelPeer _ (TraceTxSubmissionCollected collected) ->
-              traceI trmet meta "submissions.submitted.count" =<<
-                STM.modifyReadTVarIO tSubmissionsCollected (+ collected)
-
-            TraceLabelPeer _ (TraceTxSubmissionProcessed processed) -> do
-              traceI trmet meta "submissions.accepted.count" =<<
-                STM.modifyReadTVarIO tSubmissionsAccepted (+ ptxcAccepted processed)
-              traceI trmet meta "submissions.rejected.count" =<<
-                STM.modifyReadTVarIO tSubmissionsRejected (+ ptxcRejected processed)
-
-            TraceLabelPeer _ TraceTxInboundTerminated -> return ()
-            TraceLabelPeer _ (TraceTxInboundCanRequestMoreTxs _) -> return ()
-            TraceLabelPeer _ (TraceTxInboundCannotRequestMoreTxs _) -> return ()
+          Tracer $ \ev -> do
+            traceWith (annotateSeverity . toLogObject' verb $ appendName "TxInbound" tr) ev
+            case ev of
+              TraceLabelPeer _ (TraceTxSubmissionCollected collected) ->
+                traceI trmet meta "submissions.submitted.count" =<<
+                  STM.modifyReadTVarIO tSubmissionsCollected (+ collected)
+
+              TraceLabelPeer _ (TraceTxSubmissionProcessed processed) -> do
+                traceI trmet meta "submissions.accepted.count" =<<
+                  STM.modifyReadTVarIO tSubmissionsAccepted (+ ptxcAccepted processed)
+                traceI trmet meta "submissions.rejected.count" =<<
+                  STM.modifyReadTVarIO tSubmissionsRejected (+ ptxcRejected processed)
+
+              TraceLabelPeer _ TraceTxInboundTerminated -> return ()
+              TraceLabelPeer _ (TraceTxInboundCanRequestMoreTxs _) -> return ()
+              TraceLabelPeer _ (TraceTxInboundCannotRequestMoreTxs _) -> return ()
 
     , Consensus.txOutboundTracer = tracerOnOff (traceTxOutbound trSel) verb "TxOutbound" tr
     , Consensus.localTxSubmissionServerTracer = tracerOnOff (traceLocalTxSubmissionServer trSel) verb "LocalTxSubmissionServer" tr

diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs
@@ -21,11 +21,10 @@ import           Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (.
 import           Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec,
                    codecHandshake, noTimeLimitsHandshake)
 import           Ouroboros.Network.Protocol.Handshake.Type (Handshake)
-import           Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion,
-                   queryVersion, simpleSingletonVersions)
+import           Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion,
                    simpleSingletonVersions)
-import           Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, makeLocalBearer,
-                   localAddressFromPath, localSnocket)
+import           Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket,
+                   localAddressFromPath, localSnocket, makeLocalBearer)
 import           Ouroboros.Network.Socket (ConnectionId (..), HandshakeCallbacks (..),
                    connectToNode, nullNetworkConnectTracers)
 import qualified System.Metrics.Configuration as EKGF