From bd957a33f8d5eccef08b4044549f2c6accfa579a Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Sat, 5 Dec 2020 14:11:23 +0100 Subject: [PATCH 1/2] Improved mini-protocol tracers Trace the agancy together with a mini-protocol message tag. Ouroboros-Network was able to do that for some time, this patch provides necessary tracing class instance changes. --- .../Tracing/OrphanInstances/Network.hs | 208 ++++++++++++------ cardano-node/src/Cardano/Tracing/Tracers.hs | 6 +- 2 files changed, 143 insertions(+), 71 deletions(-) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index dd38be203fd..9ac0afa75c2 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -28,8 +29,9 @@ import Ouroboros.Consensus.Block (ConvertRawHash (..), getHeader) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, HasTxs (..), txId) import Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize) import Ouroboros.Network.Block -import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..), +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.DeltaQ (GSV (..), PeerGSV (..)) @@ -84,7 +86,13 @@ instance HasSeverityAnnotation NtN.AcceptConnectionsPolicyTrace where instance HasPrivacyAnnotation (TraceFetchClientState header) instance HasSeverityAnnotation (TraceFetchClientState header) where - getSeverityAnnotation _ = Info + getSeverityAnnotation BlockFetch.AddedFetchRequest {} = Info + getSeverityAnnotation BlockFetch.AcknowledgedFetchRequest {} = Info + getSeverityAnnotation BlockFetch.StartedFetchBatch {} = Info + getSeverityAnnotation BlockFetch.CompletedBlockFetch {} = Info + getSeverityAnnotation BlockFetch.CompletedFetchBatch {} = Info + getSeverityAnnotation BlockFetch.RejectedFetchBatch {} = Info + getSeverityAnnotation BlockFetch.ClientTerminating {} = Notice instance HasPrivacyAnnotation (TraceSendRecv a) @@ -394,14 +402,16 @@ instance ( ConvertTxId blk , HasTxs blk ) => ToObject (AnyMessageAndAgency (BlockFetch blk (Point blk))) where - toObject MinimalVerbosity (AnyMessageAndAgency _ (MsgBlock blk)) = + toObject MinimalVerbosity (AnyMessageAndAgency stok (MsgBlock blk)) = mkObject [ "kind" .= String "MsgBlock" + , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) ] - toObject verb (AnyMessageAndAgency _ (MsgBlock blk)) = + toObject verb (AnyMessageAndAgency stok (MsgBlock blk)) = mkObject [ "kind" .= String "MsgBlock" + , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) , "txIds" .= toJSON (presentTx <$> extractTxs blk) @@ -410,62 +420,113 @@ instance ( ConvertTxId blk presentTx :: GenTx blk -> Value presentTx = String . renderTxIdForVerbosity verb . txId - toObject _v (AnyMessageAndAgency _ MsgRequestRange{}) = - mkObject [ "kind" .= String "MsgRequestRange" ] - toObject _v (AnyMessageAndAgency _ MsgStartBatch{}) = - mkObject [ "kind" .= String "MsgStartBatch" ] - toObject _v (AnyMessageAndAgency _ MsgNoBlocks{}) = - mkObject [ "kind" .= String "MsgNoBlocks" ] - toObject _v (AnyMessageAndAgency _ MsgBatchDone{}) = - mkObject [ "kind" .= String "MsgBatchDone" ] - toObject _v (AnyMessageAndAgency _ MsgClientDone{}) = - mkObject [ "kind" .= String "MsgClientDone" ] - -instance ToObject (AnyMessageAndAgency (LocalStateQuery blk pt query)) where - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgAcquire{}) = - mkObject [ "kind" .= String "MsgAcquire" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgAcquired{}) = - mkObject [ "kind" .= String "MsgAcquired" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgFailure{}) = - mkObject [ "kind" .= String "MsgFailure" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgQuery{}) = - mkObject [ "kind" .= String "MsgQuery" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgResult{}) = - mkObject [ "kind" .= String "MsgResult" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgRelease{}) = - mkObject [ "kind" .= String "MsgRelease" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgReAcquire{}) = - mkObject [ "kind" .= String "MsgReAcquire" ] - toObject _verb (AnyMessageAndAgency _ LocalStateQuery.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" ] + toObject _v (AnyMessageAndAgency stok MsgRequestRange{}) = + mkObject [ "kind" .= String "MsgRequestRange" + , "agency" .= String (pack $ show stok) + ] + toObject _v (AnyMessageAndAgency stok MsgStartBatch{}) = + mkObject [ "kind" .= String "MsgStartBatch" + , "agency" .= String (pack $ show stok) + ] + toObject _v (AnyMessageAndAgency stok MsgNoBlocks{}) = + mkObject [ "kind" .= String "MsgNoBlocks" + , "agency" .= String (pack $ show stok) + ] + toObject _v (AnyMessageAndAgency stok MsgBatchDone{}) = + mkObject [ "kind" .= String "MsgBatchDone" + , "agency" .= String (pack $ show stok) + ] + toObject _v (AnyMessageAndAgency stok MsgClientDone{}) = + mkObject [ "kind" .= String "MsgClientDone" + , "agency" .= String (pack $ show stok) + ] + +instance (forall result. Show (query result)) + => ToObject (AnyMessageAndAgency (LocalStateQuery blk pt query)) where + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgAcquire{}) = + mkObject [ "kind" .= String "MsgAcquire" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgAcquired{}) = + mkObject [ "kind" .= String "MsgAcquired" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgFailure{}) = + mkObject [ "kind" .= String "MsgFailure" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgQuery{}) = + mkObject [ "kind" .= String "MsgQuery" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgResult{}) = + mkObject [ "kind" .= String "MsgResult" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgRelease{}) = + mkObject [ "kind" .= String "MsgRelease" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgReAcquire{}) = + mkObject [ "kind" .= String "MsgReAcquire" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgDone{}) = + mkObject [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] instance ToObject (AnyMessageAndAgency (LocalTxSubmission tx err)) where - toObject _verb (AnyMessageAndAgency _ LocalTxSub.MsgSubmitTx{}) = - mkObject [ "kind" .= String "MsgSubmitTx" ] - toObject _verb (AnyMessageAndAgency _ LocalTxSub.MsgAcceptTx{}) = - mkObject [ "kind" .= String "MsgAcceptTx" ] - toObject _verb (AnyMessageAndAgency _ LocalTxSub.MsgRejectTx{}) = - mkObject [ "kind" .= String "MsgRejectTx" ] - toObject _verb (AnyMessageAndAgency _ LocalTxSub.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" ] + toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgSubmitTx{}) = + mkObject [ "kind" .= String "MsgSubmitTx" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgAcceptTx{}) = + mkObject [ "kind" .= String "MsgAcceptTx" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgRejectTx{}) = + mkObject [ "kind" .= String "MsgRejectTx" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgDone{}) = + mkObject [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgRequestNext{}) = - mkObject [ "kind" .= String "MsgRequestNext" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgAwaitReply{}) = - mkObject [ "kind" .= String "MsgAwaitReply" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgRollForward{}) = - mkObject [ "kind" .= String "MsgRollForward" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgRollBackward{}) = - mkObject [ "kind" .= String "MsgRollBackward" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgFindIntersect{}) = - mkObject [ "kind" .= String "MsgFindIntersect" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgIntersectFound{}) = - mkObject [ "kind" .= String "MsgIntersectFound" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgIntersectNotFound{}) = - mkObject [ "kind" .= String "MsgIntersectNotFound" ] - toObject _verb (AnyMessageAndAgency _ ChainSync.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = + mkObject [ "kind" .= String "MsgRequestNext" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgAwaitReply{}) = + mkObject [ "kind" .= String "MsgAwaitReply" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRollForward{}) = + mkObject [ "kind" .= String "MsgRollForward" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRollBackward{}) = + mkObject [ "kind" .= String "MsgRollBackward" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgFindIntersect{}) = + mkObject [ "kind" .= String "MsgFindIntersect" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgIntersectFound{}) = + mkObject [ "kind" .= String "MsgIntersectFound" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgIntersectNotFound{}) = + mkObject [ "kind" .= String "MsgIntersectNotFound" + , "agency" .= String (pack $ show stok) + ] + toObject _verb (AnyMessageAndAgency stok ChainSync.MsgDone{}) = + mkObject [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) + ] instance ToObject (FetchDecision [Point header]) where toObject _verb (Left decline) = @@ -571,32 +632,39 @@ instance ToObject NtN.AcceptConnectionsPolicyTrace where instance (Show txid, Show tx) => ToObject (AnyMessageAndAgency (TxSubmission txid tx)) where - toObject _verb (AnyMessageAndAgency _ (MsgRequestTxs txids)) = + toObject _verb (AnyMessageAndAgency stok (MsgRequestTxs txids)) = mkObject [ "kind" .= String "MsgRequestTxs" + , "agency" .= String (pack $ show stok) , "txIds" .= String (pack $ show txids) ] - toObject _verb (AnyMessageAndAgency _ (MsgReplyTxs txs)) = + toObject _verb (AnyMessageAndAgency stok (MsgReplyTxs txs)) = mkObject [ "kind" .= String "MsgReplyTxs" + , "agency" .= String (pack $ show stok) , "txs" .= String (pack $ show txs) ] - toObject _verb (AnyMessageAndAgency _ (MsgRequestTxIds _ _ _)) = + toObject _verb (AnyMessageAndAgency stok (MsgRequestTxIds _ _ _)) = mkObject [ "kind" .= String "MsgRequestTxIds" + , "agency" .= String (pack $ show stok) ] - toObject _verb (AnyMessageAndAgency _ (MsgReplyTxIds _)) = + toObject _verb (AnyMessageAndAgency stok (MsgReplyTxIds _)) = mkObject [ "kind" .= String "MsgReplyTxIds" + , "agency" .= String (pack $ show stok) ] - toObject _verb (AnyMessageAndAgency _ MsgDone) = + toObject _verb (AnyMessageAndAgency stok MsgDone) = mkObject [ "kind" .= String "MsgDone" + , "agency" .= String (pack $ show stok) ] --TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet. - toObject _verb (AnyMessageAndAgency _ _) = + toObject _verb (AnyMessageAndAgency stok _) = mkObject - [ "kind" .= String "MsgKThxBye" ] + [ "kind" .= String "MsgKThxBye" + , "agency" .= String (pack $ show stok) + ] instance ConvertRawHash blk @@ -619,19 +687,19 @@ instance ToObject SlotNo where instance ToObject (TraceFetchClientState header) where - toObject _verb AddedFetchRequest {} = + toObject _verb BlockFetch.AddedFetchRequest {} = mkObject [ "kind" .= String "AddedFetchRequest" ] - toObject _verb AcknowledgedFetchRequest {} = + toObject _verb BlockFetch.AcknowledgedFetchRequest {} = mkObject [ "kind" .= String "AcknowledgedFetchRequest" ] - toObject _verb CompletedBlockFetch {} = + toObject _verb BlockFetch.CompletedBlockFetch {} = mkObject [ "kind" .= String "CompletedBlockFetch" ] - toObject _verb CompletedFetchBatch {} = + toObject _verb BlockFetch.CompletedFetchBatch {} = mkObject [ "kind" .= String "CompletedFetchBatch" ] - toObject _verb StartedFetchBatch {} = + toObject _verb BlockFetch.StartedFetchBatch {} = mkObject [ "kind" .= String "StartedFetchBatch" ] - toObject _verb RejectedFetchBatch {} = + toObject _verb BlockFetch.RejectedFetchBatch {} = mkObject [ "kind" .= String "RejectedFetchBatch" ] - toObject _verb ClientTerminating {} = + toObject _verb BlockFetch.ClientTerminating {} = mkObject [ "kind" .= String "ClientTerminating" ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 2b2052d85e7..1cc813061b9 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -7,6 +7,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -55,6 +56,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.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..)) @@ -798,7 +800,9 @@ forgeStateInfoTracer p _ts tracer = Tracer $ \ev -> do -------------------------------------------------------------------------------- nodeToClientTracers' - :: Show localPeer + :: ( Show localPeer + , forall result. Show (Query blk result) + ) => TraceSelection -> TracingVerbosity -> Trace IO Text From 49942cfd67fbe8b9f986043fc235cd02a0d158cd Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Sat, 5 Dec 2020 14:11:28 +0100 Subject: [PATCH 2/2] networking traces using show instances rather than json values When using 'ScText' format, Show instances provide much more readable logging output. --- .../src/Cardano/Tracing/Constraints.hs | 4 ++ .../Tracing/OrphanInstances/Network.hs | 50 ++++++++++--------- cardano-node/src/Cardano/Tracing/Tracers.hs | 11 +++- 3 files changed, 40 insertions(+), 25 deletions(-) diff --git a/cardano-node/src/Cardano/Tracing/Constraints.hs b/cardano-node/src/Cardano/Tracing/Constraints.hs index ede5996c6a1..017e5a570db 100644 --- a/cardano-node/src/Cardano/Tracing/Constraints.hs +++ b/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) ) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 9ac0afa75c2..68c78031e25 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/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) -- diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 1cc813061b9..c60d101be1c 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/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