networking trace using show instances rather than json values

cardano-node/src/Cardano/Tracing/Constraints.hs

@@ -5,6 +5,8 @@ module Cardano.Tracing.Constraints
   ( TraceConstraints
   ) where
 
+import           Prelude (Show)
+
 import           Data.Aeson
 
 import           Cardano.BM.Tracing (ToObject)
@@ -38,4 +40,6 @@ type TraceConstraints blk =
     , ToObject (ValidationErr (BlockProtocol blk))
     , ToObject (CannotForge blk)
     , ToObject (ForgeStateUpdateError blk)
+    , Show blk
+    , Show (Header blk)
     )

cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs

@@ -257,7 +257,7 @@ instance HasSeverityAnnotation (Identity (SubscriptionTrace LocalAddress)) where
 instance Transformable Text IO (Identity (SubscriptionTrace LocalAddress)) where
   trTransformer = trStructuredText
 instance HasTextFormatter (Identity (SubscriptionTrace LocalAddress)) where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance ToObject (Identity (SubscriptionTrace LocalAddress)) where
@@ -305,81 +305,85 @@ instance HasSeverityAnnotation (WithMuxBearer peer MuxTrace) where
 instance Transformable Text IO ND.DiffusionInitializationTracer where
   trTransformer = trStructuredText
 instance HasTextFormatter ND.DiffusionInitializationTracer where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 instance Transformable Text IO NtN.HandshakeTr where
   trTransformer = trStructuredText
 instance HasTextFormatter NtN.HandshakeTr where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO NtC.HandshakeTr where
   trTransformer = trStructuredText
 instance HasTextFormatter NtC.HandshakeTr where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO NtN.AcceptConnectionsPolicyTrace where
   trTransformer = trStructuredText
 instance HasTextFormatter NtN.AcceptConnectionsPolicyTrace where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
-instance Show peer
+instance (StandardHash header, Show peer)
       => Transformable Text IO [TraceLabelPeer peer (FetchDecision [Point header])] where
   trTransformer = trStructuredText
-instance HasTextFormatter [TraceLabelPeer peer (FetchDecision [Point header])] where
-  formatText _ = pack . show . toList
+instance (StandardHash header, Show peer)
+      => HasTextFormatter [TraceLabelPeer peer (FetchDecision [Point header])] where
+  formatText a _ = pack (show a)
 
 
-instance (Show peer, HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a)
+instance (Show peer, Show a, HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a)
       => Transformable Text IO (TraceLabelPeer peer a) where
   trTransformer = trStructuredText
-instance HasTextFormatter (TraceLabelPeer peer a) where
-  formatText _ = pack . show . toList
+instance (Show peer, Show a)
+      => HasTextFormatter (TraceLabelPeer peer a) where
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO (TraceTxSubmissionInbound txid tx) where
   trTransformer = trStructuredText
 instance HasTextFormatter (TraceTxSubmissionInbound txid tx) where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance (Show tx, Show txid)
       => Transformable Text IO (TraceTxSubmissionOutbound txid tx) where
   trTransformer = trStructuredText
-instance HasTextFormatter (TraceTxSubmissionOutbound txid tx) where
-  formatText _ = pack . show . toList
+instance (Show tx, Show txid)
+      => HasTextFormatter (TraceTxSubmissionOutbound txid tx) where
+  formatText a _ = pack (show a)
 
 
 instance Show remotePeer => Transformable Text IO (TraceKeepAliveClient remotePeer) where
   trTransformer = trStructuredText
-instance HasTextFormatter (TraceKeepAliveClient peer) where
-  formatText _ = pack . show . toList
+instance Show addr
+      => HasTextFormatter (TraceKeepAliveClient addr) where
+    formatText a _ = pack (show a)
 
 
 instance Show addr => Transformable Text IO (WithAddr addr ErrorPolicyTrace) where
   trTransformer = trStructuredText
-instance HasTextFormatter (WithAddr addr ErrorPolicyTrace) where
-  formatText _ = pack . show . toList
+instance Show addr => HasTextFormatter (WithAddr addr ErrorPolicyTrace) where
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
   trTransformer = trStructuredText
 instance HasTextFormatter (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO (WithDomainName DnsTrace) where
   trTransformer = trStructuredText
 instance HasTextFormatter (WithDomainName DnsTrace) where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance Transformable Text IO (WithIPList (SubscriptionTrace Socket.SockAddr)) where
   trTransformer = trStructuredText
 instance HasTextFormatter (WithIPList (SubscriptionTrace Socket.SockAddr)) where
-  formatText _ = pack . show . toList
+  formatText a _ = pack (show a)
 
 
 instance (Show peer)
@@ -388,8 +392,8 @@ instance (Show peer)
 instance (Show peer)
       => HasTextFormatter (WithMuxBearer peer MuxTrace) where
   formatText (WithMuxBearer peer ev) = \_o ->
-    "Bearer on " <> pack (show peer)
-   <> " event: " <> pack (show ev)
+        "Bearer on " <> pack (show peer)
+     <> " event: " <> pack (show ev)
 
 
 --

cardano-node/src/Cardano/Tracing/Tracers.hs

@@ -75,6 +75,7 @@ import qualified Ouroboros.Network.NodeToClient as NtC
 import qualified Ouroboros.Network.NodeToNode as NtN
 import           Ouroboros.Network.Point (fromWithOrigin, withOrigin)
 import           Ouroboros.Network.Subscription
+import           Ouroboros.Network.Protocol.LocalStateQuery.Type (ShowQuery)
 
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB
@@ -419,6 +420,7 @@ mkConsensusTracers
      , ToObject (ForgeStateUpdateError blk)
      , Consensus.RunNode blk
      , HasKESMetricsData blk
+     , Show (Header blk)
      )
   => TraceSelection
   -> TracingVerbosity
@@ -800,8 +802,11 @@ forgeStateInfoTracer p _ts tracer = Tracer $ \ev -> do
 --------------------------------------------------------------------------------
 
 nodeToClientTracers'
-  :: ( Show localPeer
-     , forall result. Show (Query blk result)
+  :: ( StandardHash blk
+     , Show (ApplyTxErr blk)
+     , Show (GenTx blk)
+     , Show localPeer
+     , ShowQuery (Query blk)
      )
   => TraceSelection
   -> TracingVerbosity
@@ -825,6 +830,8 @@ nodeToNodeTracers'
   :: ( Consensus.RunNode blk
      , ConvertTxId blk
      , HasTxs blk
+     , Show blk
+     , Show (Header blk)
      , Show peer
      )
   => TraceSelection