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 45c3035ef90..fb71fc9c789 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 652969c3152..38699e6ec0e 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -77,6 +77,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 @@ -435,6 +436,7 @@ mkConsensusTracers , ToObject (ForgeStateUpdateError blk) , Consensus.RunNode blk , HasKESMetricsData blk + , Show (Header blk) ) => TraceSelection -> TracingVerbosity @@ -808,8 +810,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 @@ -833,6 +838,8 @@ nodeToNodeTracers' :: ( Consensus.RunNode blk , ConvertTxId blk , HasTxs blk + , Show blk + , Show (Header blk) , Show peer ) => TraceSelection