From 15c8c7c41306842aea02241e9c456a701dabc305 Mon Sep 17 00:00:00 2001
From: Luke Nadur <19835357+intricate@users.noreply.github.com>
Date: Thu, 6 Feb 2020 09:25:02 -0600
Subject: [PATCH] Add structured logging for TraceSendRecv TxSubmission objects

---
 .../src/Cardano/Tracing/ToObjectOrphans.hs    | 47 ++++++++++++++++++-
 cardano-node/src/Cardano/Tracing/Tracers.hs   |  3 +-
 2 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/cardano-node/src/Cardano/Tracing/ToObjectOrphans.hs b/cardano-node/src/Cardano/Tracing/ToObjectOrphans.hs
index 6d76b469c90..6b3d7e9fc24 100644
--- a/cardano-node/src/Cardano/Tracing/ToObjectOrphans.hs
+++ b/cardano-node/src/Cardano/Tracing/ToObjectOrphans.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
@@ -23,6 +24,7 @@ import           Data.Text (pack)
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Network.Socket as Socket (SockAddr)
 import           Network.Mux (WithMuxBearer (..), MuxTrace (..))
+import           Network.TypedProtocol.Codec (AnyMessage (..))
 
 import           Cardano.BM.Data.LogItem (LOContent (..), LogObject (..),
                    mkLOMeta)
@@ -51,7 +53,9 @@ import           Ouroboros.Network.BlockFetch.ClientState
                    (TraceFetchClientState (..), TraceLabelPeer (..))
 import           Ouroboros.Network.BlockFetch.Decision (FetchDecision)
 import           Ouroboros.Network.NodeToNode
-                   (WithAddr(..), ErrorPolicyTrace(..))
+                   (WithAddr(..), ErrorPolicyTrace(..), TraceSendRecv (..))
+import           Ouroboros.Network.Protocol.TxSubmission.Type
+                   (Message (..), TxSubmission)
 import           Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..),
                    SubscriptionTrace (..),
                    WithDomainName (..), WithIPList (..))
@@ -297,6 +301,12 @@ instance DefineSeverity (TraceLabelPeer peer
                          (TraceFetchClientState header)) where
   defineSeverity _ = Info
 
+instance DefinePrivacyAnnotation (TraceLabelPeer peer
+                                  (TraceSendRecv (TxSubmission txid tx)))
+instance DefineSeverity (TraceLabelPeer peer
+                         (TraceSendRecv (TxSubmission txid tx))) where
+  defineSeverity _ = Info
+
 instance DefinePrivacyAnnotation (TraceBlockFetchServerEvent blk)
 instance DefineSeverity (TraceBlockFetchServerEvent blk) where
   defineSeverity _ = Info
@@ -356,6 +366,11 @@ instance Show peer => Transformable Text IO (TraceLabelPeer peer
                                 (TraceFetchClientState header)) where
   trTransformer _ verb tr = trStructured verb tr
 
+instance (Show peer, Show txid, Show tx)
+      => Transformable Text IO (TraceLabelPeer peer
+           (TraceSendRecv (TxSubmission txid tx))) where
+  trTransformer _ verb tr = trStructured verb tr
+
 -- transform @BlockFetchServerEvent@
 instance Transformable Text IO (TraceBlockFetchServerEvent blk) where
   trTransformer _ verb tr = trStructured verb tr
@@ -822,6 +837,36 @@ instance ToObject (FetchDecision [Point header]) where
     mkObject [ "kind" .= String "FetchDecision results"
              , "length" .= String (pack $ show $ length results) ]
 
+instance (Show peer, Show txid, Show tx)
+    => ToObject (TraceLabelPeer peer
+         (TraceSendRecv (TxSubmission txid tx))) where
+  toObject verb (TraceLabelPeer peerid (TraceSendMsg (AnyMessage msg))) =
+    mkObject
+        [ "kind" .= String "TraceSendMsg"
+        , "peer" .= show peerid
+        , "message" .= toObject verb msg
+        ]
+  toObject verb (TraceLabelPeer peerid (TraceRecvMsg (AnyMessage msg))) =
+    mkObject
+        [ "kind" .= String "TraceRecvMsg"
+        , "peer" .= show peerid
+        , "message" .= toObject verb msg
+        ]
+
+instance (Show txid, Show tx) => ToObject (Message
+                                   (TxSubmission txid tx) from to) where
+  toObject _verb (MsgRequestTxs txids) =
+    mkObject
+        [ "kind" .= String "MsgRequestTxs"
+        , "txIds" .= String (pack $ show $ txids)
+        ]
+  toObject _verb (MsgReplyTxs txs) =
+    mkObject
+        [ "kind" .= String "MsgReplyTxs"
+        , "txs" .= String (pack $ show $ txs)
+        ]
+  toObject _verb _ = emptyObject -- TODO: What should we do here?
+
 instance Show peer => ToObject (TraceLabelPeer peer
                         (TraceFetchClientState header)) where
   toObject verb (TraceLabelPeer peerid a) =
diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
index cb281f443fe..f2a3420cce2 100644
--- a/cardano-node/src/Cardano/Tracing/Tracers.hs
+++ b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -462,7 +462,8 @@ mkTracers traceOptions tracer = do
         $ showTracing $ withName "BlockFetchProtocol" tracer
       , ptTxSubmissionTracer
         = tracerOnOff (traceTxSubmissionProtocol traceOpts)
-        $ showTracing $ withName "TxSubmissionProtocol" tracer
+        $ toLogObject' StructuredLogging tracingVerbosity
+        $ addName "TxSubmissionProtocol" tracer
       , ptLocalChainSyncTracer
         = tracerOnOff (traceLocalChainSyncProtocol traceOpts)
         $ showTracing $ withName "LocalChainSyncProtocol" tracer