network tracers: added ToObjcet TxSubmission2 instance

IntersectMBO · Jan 13, 2021 · 60cbace · 60cbace
1 parent 36769a6
commit 60cbace
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 2 deletions.
diff --git 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
@@ -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