From 8260e91f4fe2e8caf823ff72ad9635873cc716ad Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 26 May 2023 10:08:37 +1000 Subject: [PATCH] Throw away peer informatio in tracing to get node to compile --- cardano-node/src/Cardano/Tracing/Tracers.hs | 47 ++++++++++--------- .../src/Cardano/Tracer/Acceptors/Client.hs | 7 ++- 2 files changed, 28 insertions(+), 26 deletions(-) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index d8ce541aa07..3df5adb6837 100644 --- 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 index 236dcdfbe10..d962b69bee8 100644 --- 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