From 0aef763f0e271f4b97544492afeb2f38919b76b2 Mon Sep 17 00:00:00 2001
From: Luke Nadur <19835357+intricate@users.noreply.github.com>
Date: Tue, 18 Feb 2020 13:11:29 -0600
Subject: [PATCH] Only trace the MsgRequestTxs and MsgReplyTxs cases

---
 cardano-node/src/Cardano/Tracing/Tracers.hs | 23 ++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
index 7bb62405415..53ae87d5b6b 100644
--- a/cardano-node/src/Cardano/Tracing/Tracers.hs
+++ b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
@@ -32,6 +33,7 @@ import           Data.Functor.Contravariant (contramap)
 import           Data.Text (Text, pack)
 import           Network.Mux (MuxTrace, WithMuxBearer)
 import qualified Network.Socket as Socket (SockAddr)
+import           Network.TypedProtocol.Codec (AnyMessage (..))
 
 import           Cardano.BM.Data.Aggregated (Measurable (..))
 import           Cardano.BM.Data.LogItem (LOContent (..), LogObject (..),
@@ -60,8 +62,11 @@ import           Ouroboros.Network.Block (Point, BlockNo(..),
                                           blockNo, unBlockNo, unSlotNo)
 import           Ouroboros.Network.BlockFetch.Decision (FetchDecision)
 import           Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..))
-import           Ouroboros.Network.NodeToNode (WithAddr, ErrorPolicyTrace)
+import           Ouroboros.Network.NodeToNode (WithAddr, ErrorPolicyTrace,
+                                               TraceSendRecv (..))
 import           Ouroboros.Network.Point (fromWithOrigin)
+import           Ouroboros.Network.Protocol.TxSubmission.Type (Message (..),
+                                                               TxSubmission)
 import           Ouroboros.Network.Subscription
 
 import qualified Ouroboros.Storage.ChainDB as ChainDB
@@ -462,6 +467,7 @@ mkTracers traceOptions tracer = do
         $ showTracing $ withName "BlockFetchProtocol" tracer
       , ptTxSubmissionTracer
         = tracerOnOff (traceTxSubmissionProtocol traceOpts)
+        $ traceMsgRequestAndReplyTxs
         $ toLogObject' StructuredLogging tracingVerbosity
         $ addName "TxSubmissionProtocol" tracer
       , ptLocalChainSyncTracer
@@ -475,6 +481,21 @@ mkTracers traceOptions tracer = do
         $ showTracing $ withName "LocalStateQueryProtocol" tracer
       }
 
+    -- Only trace the 'MsgRequestTxs' and 'MsgReplyTxs' cases.
+    traceMsgRequestAndReplyTxs
+      :: Tracer IO (TraceLabelPeer peer (TraceSendRecv (TxSubmission txid tx)))
+      -> Tracer IO (TraceLabelPeer peer (TraceSendRecv (TxSubmission txid tx)))
+    traceMsgRequestAndReplyTxs tr =
+        Tracer $ \ev@(TraceLabelPeer _peerid traceSendRecv) ->
+          case getMsg traceSendRecv of
+            AnyMessage (MsgRequestTxs _txids) -> traceWith tr ev
+            AnyMessage (MsgReplyTxs _txs)     -> traceWith tr ev
+            _                                 -> pure ()
+      where
+        getMsg :: forall ps. TraceSendRecv ps -> AnyMessage ps
+        getMsg (TraceSendMsg msg) = msg
+        getMsg (TraceRecvMsg msg) = msg
+
 -- | get information about a chain fragment
 
 data ChainInformation = ChainInformation