Fix verbosity issue of TraceFetchClientState

IntersectMBO · Aug 9, 2021 · 12093b7 · 12093b7
1 parent 3be20df
commit 12093b7
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 24 deletions.
diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs
@@ -21,17 +21,17 @@ import           Data.Text (pack)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
+import           Cardano.Slotting.Slot (fromWithOrigin)
 import           Cardano.Tracing.OrphanInstances.Common
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderHeaderHash,
                    renderHeaderHashForVerbosity, renderPoint, renderPointAsPhrase,
                    renderPointForVerbosity, renderRealPoint, renderRealPointAsPhrase,
                    renderTipBlockNo, renderTipHash, renderWithOrigin)
-import           Cardano.Slotting.Slot (fromWithOrigin)
 
-import           Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ConvertRawHash (..),
-                   ForgeStateUpdateError, Header, RealPoint, getHeader, headerPoint, realPointHash,
-                   realPointSlot, blockNo, blockPrevHash, pointHash)
+import           Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge,
+                   ConvertRawHash (..), ForgeStateUpdateError, Header, RealPoint, blockNo,
+                   blockPrevHash, getHeader, headerPoint, pointHash, realPointHash, realPointSlot)
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
@@ -41,7 +41,8 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx,
                    LedgerSupportsMempool, TxId, txForgetValidated, txId)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..))
-import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..))
+import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
+                   (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
@@ -53,6 +54,7 @@ import           Ouroboros.Consensus.Protocol.Abstract
 import qualified Ouroboros.Consensus.Protocol.BFT as BFT
 import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT
 import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb
+import           Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..))
 
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.Orphans ()
@@ -152,6 +154,13 @@ instance HasSeverityAnnotation (TraceBlockFetchServerEvent blk) where
   getSeverityAnnotation _ = Info
 
 
+instance (ToObject peer, ToObject (TraceChainSyncClientEvent blk))
+    => Transformable Text IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk)) where
+  trTransformer = trStructured
+instance (BlockSupportsProtocol blk, Show peer, Show (Header blk))
+    => HasTextFormatter (TraceLabelPeer peer (TraceChainSyncClientEvent blk)) where
+  formatText a _ = pack $ show a
+
 instance HasPrivacyAnnotation (TraceChainSyncClientEvent blk)
 instance HasSeverityAnnotation (TraceChainSyncClientEvent blk) where
   getSeverityAnnotation (TraceDownloadedHeader _) = Info

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs
@@ -27,8 +27,10 @@ import           Cardano.Tracing.ConvertTxId (ConvertTxId)
 import           Cardano.Tracing.OrphanInstances.Common
 import           Cardano.Tracing.Render
 
-import           Ouroboros.Consensus.Block (ConvertRawHash (..), getHeader)
-import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, HasTxs (..), txId)
+import           Ouroboros.Consensus.Block (ConvertRawHash (..), Header, getHeader)
+import           Ouroboros.Consensus.Ledger.Query (BlockQuery, Query)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId,
+                   HasTxs (..), TxId, txId)
 import           Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import qualified Ouroboros.Network.AnchoredSeq as AS
@@ -342,15 +344,55 @@ instance (StandardHash header, Show peer)
       => HasTextFormatter [TraceLabelPeer peer (FetchDecision [Point header])] where
   formatText a _ = pack (show a)
 
+instance (HasHeader header, ConvertRawHash header, ToObject peer)
+     => Transformable Text IO (TraceLabelPeer peer (TraceFetchClientState header)) where
+  trTransformer = trStructured
+instance (Show header, StandardHash header, Show peer)
+     => HasTextFormatter (TraceLabelPeer peer (TraceFetchClientState header)) where
+  formatText a _ = pack (show a)
 
-instance ( Show peer, ToObject peer, Show a, HasPrivacyAnnotation a
-         , HasSeverityAnnotation a, ToObject a)
-      => Transformable Text IO (TraceLabelPeer peer a) where
-  trTransformer = trStructuredText
-instance (Show peer, Show a)
-      => HasTextFormatter (TraceLabelPeer peer a) where
+instance ToObject peer
+     => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))) where
+  trTransformer = trStructured
+instance (Show peer, StandardHash blk, Show (Header blk))
+     => HasTextFormatter (TraceLabelPeer peer (NtN.TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))) where
   formatText a _ = pack (show a)
 
+instance (ToObject peer, ToObject (AnyMessageAndAgency (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
+     => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TraceTxSubmissionInbound  (GenTxId blk) (GenTx blk)))) where
+  trTransformer = trStructured
+
+instance ToObject peer
+     => Transformable Text IO (TraceLabelPeer peer (TraceTxSubmissionInbound  (GenTxId blk) (GenTx blk))) where
+  trTransformer = trStructured
+
+instance (ToObject peer, ConvertTxId blk, RunNode blk, HasTxs blk)
+     => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (BlockFetch blk (Point blk)))) where
+  trTransformer = trStructured
+
+instance ToObject localPeer
+     => Transformable Text IO (TraceLabelPeer localPeer (NtN.TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))) where
+  trTransformer = trStructured
+
+instance (applyTxErr ~ ApplyTxErr blk, ToObject localPeer)
+     => Transformable Text IO (TraceLabelPeer localPeer (NtN.TraceSendRecv (LocalTxSubmission (GenTx blk) applyTxErr))) where
+  trTransformer = trStructured
+
+instance (LocalStateQuery.ShowQuery (BlockQuery blk), ToObject localPeer)
+     => Transformable Text IO (TraceLabelPeer localPeer (NtN.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))) where
+  trTransformer = trStructured
+
+instance (ToObject peer, Show (TxId (GenTx blk)), Show (GenTx blk))
+     => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))) where
+  trTransformer = trStructured
+
+instance (ToObject peer, Show (TxId (GenTx blk)), Show (GenTx blk))
+  => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TxSubmission (GenTxId blk) (GenTx blk)))) where
+  trTransformer = trStructured
+
+instance (ToObject peer, Show (TxId (GenTx blk)), Show (GenTx blk))
+     => Transformable Text IO (TraceLabelPeer peer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))) where
+  trTransformer = trStructured
 
 instance Transformable Text IO (TraceTxSubmissionInbound txid tx) where
   trTransformer = trStructuredText
@@ -557,7 +599,7 @@ instance (Show txid, Show tx)
       , "agency" .= String (pack $ show stok)
       , "txs" .= String (pack $ show txs)
       ]
-  toObject _verb (AnyMessageAndAgency stok (MsgRequestTxIds _ _ _)) =
+  toObject _verb (AnyMessageAndAgency stok MsgRequestTxIds{}) =
     mkObject
       [ "kind" .= String "MsgRequestTxIds"
       , "agency" .= String (pack $ show stok)

diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs
@@ -62,7 +62,7 @@ import           Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError)
 import           Ouroboros.Consensus.Ledger.Abstract (LedgerErr, LedgerState)
 import           Ouroboros.Consensus.Ledger.Extended (ledgerState)
 import           Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent)
-import           Ouroboros.Consensus.Ledger.Query (Query)
+import           Ouroboros.Consensus.Ledger.Query (BlockQuery)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs,
                    LedgerSupportsMempool)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
@@ -514,7 +514,6 @@ mkConsensusTracers
      , Consensus.RunNode blk
      , HasKESMetricsData blk
      , HasKESInfo blk
-     , Show (Header blk)
      )
   => Maybe EKGDirect
   -> TraceSelection
@@ -964,12 +963,8 @@ forgeStateInfoTracer p _ts tracer = Tracer $ \ev -> do
 --------------------------------------------------------------------------------
 
 nodeToClientTracers'
-  :: ( StandardHash blk
-     , Show (ApplyTxErr blk)
-     , Show (GenTx blk)
-     , Show localPeer
-     , ToObject localPeer
-     , ShowQuery (Query blk)
+  :: ( ToObject localPeer
+     , ShowQuery (BlockQuery blk)
      )
   => TraceSelection
   -> TracingVerbosity
@@ -993,8 +988,6 @@ nodeToNodeTracers'
   :: ( Consensus.RunNode blk
      , ConvertTxId blk
      , HasTxs blk
-     , Show blk
-     , Show (Header blk)
      , Show peer
      , ToObject peer
      )