From 60cbace24c2c95840e1eabc3852514f43803db56 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <profunctor@pm.me>
Date: Wed, 13 Jan 2021 10:15:56 +0100
Subject: [PATCH] network tracers: added ToObjcet TxSubmission2 instance

---
 .../Tracing/OrphanInstances/Network.hs        | 25 ++++++++++++++++++-
 cardano-node/src/Cardano/Tracing/Tracers.hs   |  2 +-
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
index 64ec5cd07d5..b651510ffa1 100644
--- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
+++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
@@ -33,7 +33,7 @@ import           Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState
                      TraceLabelPeer (..))
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
 import           Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..))
-import           Ouroboros.Network.Codec (AnyMessageAndAgency (..))
+import           Ouroboros.Network.Codec (AnyMessageAndAgency (..), PeerHasAgency (..))
 import           Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..))
 import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
 import qualified Ouroboros.Network.NodeToClient as NtC
@@ -48,6 +48,9 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQu
 import           Ouroboros.Network.Protocol.LocalTxSubmission.Type (LocalTxSubmission)
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LocalTxSub
 import           Ouroboros.Network.Protocol.TxSubmission.Type (Message (..), TxSubmission)
+import           Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2)
+import           Ouroboros.Network.Protocol.Trans.Hello.Type (Message (..),
+                     ClientHasAgency (..), ServerHasAgency (..))
 import           Ouroboros.Network.Snocket (LocalAddress (..))
 import           Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..),
                      SubscriberError (..), SubscriptionTrace (..), WithDomainName (..),
@@ -569,6 +572,26 @@ instance (Show txid, Show tx)
       , "agency" .= String (pack $ show stok)
       ]
 
+instance (Show txid, Show tx)
+      => ToObject (AnyMessageAndAgency (TxSubmission2 txid tx)) where
+  toObject _verb (AnyMessageAndAgency
+                   -- we need this pattern match inorder for GHC to recognise
+                   -- this function as total.
+                   (stok@(ClientAgency TokHello))
+                   MsgHello) =
+    mkObject
+      [ "kind" .= String "MsgHello"
+      , "agency" .= String (pack $ show stok)
+      ]
+  toObject verb (AnyMessageAndAgency
+                  (ClientAgency (TokClientTalk stok))
+                  (MsgTalk msg)) =
+    toObject verb (AnyMessageAndAgency (ClientAgency stok) msg)
+  toObject verb (AnyMessageAndAgency
+                  (ServerAgency (TokServerTalk stok))
+                  (MsgTalk msg)) =
+    toObject verb (AnyMessageAndAgency (ServerAgency stok) msg)
+
 
 instance ToObject (FetchDecision [Point header]) where
   toObject _verb (Left decline) =
diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
index 6ed745915da..994d2f695f9 100644
--- a/cardano-node/src/Cardano/Tracing/Tracers.hs
+++ b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -858,7 +858,7 @@ nodeToNodeTracers' trSel verb tr =
   , NodeToNode.tBlockFetchTracer = tracerOnOff (traceBlockFetchProtocol trSel) verb "BlockFetchProtocol" tr
   , NodeToNode.tBlockFetchSerialisedTracer = showOnOff (traceBlockFetchProtocolSerialised trSel) "BlockFetchProtocolSerialised" tr
   , NodeToNode.tTxSubmissionTracer = tracerOnOff (traceTxSubmissionProtocol trSel) verb "TxSubmissionProtocol" tr
-  , NodeToNode.tTxSubmission2Tracer = nullTracer -- TODO @coot: tracerOnOff (traceTxSubmission2Protocol trSel) verb "TxSubmission2Protocol" tr
+  , NodeToNode.tTxSubmission2Tracer = tracerOnOff (traceTxSubmission2Protocol trSel) verb "TxSubmission2Protocol" tr
   }
 
 teeTraceBlockFetchDecision