{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Tracing.OrphanInstances.Network () where

import           Cardano.Prelude hiding (show)
import           Prelude (String, show)

import           Control.Monad.Class.MonadTime (DiffTime, Time (..))
import           Data.Text (pack)

import           Network.Mux (MuxTrace (..), WithMuxBearer (..))
import qualified Network.Socket as Socket (SockAddr)

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.Node.Run (RunNode, estimateBlockSize)
import           Ouroboros.Network.Block
import           Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..),
                     TraceLabelPeer (..))
import           Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..))
import           Ouroboros.Network.Codec (AnyMessageAndAgency (..))
import           Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..))
import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
import qualified Ouroboros.Network.NodeToClient as NtC
import           Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), TraceSendRecv (..),
                     WithAddr (..))
import qualified Ouroboros.Network.NodeToNode as NtN
import           Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch, Message (..))
import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
import qualified Ouroboros.Network.Protocol.ChainSync.Type as ChainSync
import           Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery)
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
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.Snocket (LocalAddress (..))
import           Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..),
                     SubscriberError (..), SubscriptionTrace (..), WithDomainName (..),
                     WithIPList (..))
import           Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound (..))
import           Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound (..))

{- HLINT ignore "Use record patterns" -}

--
-- * instances of @HasPrivacyAnnotation@ and @HasSeverityAnnotation@
--
-- NOTE: this list is sorted by the unqualified name of the outermost type.

instance HasPrivacyAnnotation NtC.HandshakeTr
instance HasSeverityAnnotation NtC.HandshakeTr where
  getSeverityAnnotation :: HandshakeTr -> Severity
getSeverityAnnotation HandshakeTr
_ = Severity
Info


instance HasPrivacyAnnotation NtN.HandshakeTr
instance HasSeverityAnnotation NtN.HandshakeTr where
  getSeverityAnnotation :: HandshakeTr -> Severity
getSeverityAnnotation HandshakeTr
_ = Severity
Info


instance HasPrivacyAnnotation NtN.AcceptConnectionsPolicyTrace
instance HasSeverityAnnotation NtN.AcceptConnectionsPolicyTrace where
  getSeverityAnnotation :: AcceptConnectionsPolicyTrace -> Severity
getSeverityAnnotation NtN.ServerTraceAcceptConnectionRateLimiting {} = Severity
Info
  getSeverityAnnotation NtN.ServerTraceAcceptConnectionHardLimit {} = Severity
Warning


instance HasPrivacyAnnotation (TraceFetchClientState header)
instance HasSeverityAnnotation (TraceFetchClientState header) where
  getSeverityAnnotation :: TraceFetchClientState header -> Severity
getSeverityAnnotation TraceFetchClientState header
_ = Severity
Info


instance HasPrivacyAnnotation (TraceSendRecv a)
instance HasSeverityAnnotation (TraceSendRecv a) where
  getSeverityAnnotation :: TraceSendRecv a -> Severity
getSeverityAnnotation TraceSendRecv a
_ = Severity
Debug


instance HasPrivacyAnnotation a => HasPrivacyAnnotation (TraceLabelPeer peer a)
instance HasSeverityAnnotation a => HasSeverityAnnotation (TraceLabelPeer peer a) where
  getSeverityAnnotation :: TraceLabelPeer peer a -> Severity
getSeverityAnnotation (TraceLabelPeer peer
_p a
a) = a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
a


instance HasPrivacyAnnotation [TraceLabelPeer peer (FetchDecision [Point header])]
instance HasSeverityAnnotation [TraceLabelPeer peer (FetchDecision [Point header])] where
  getSeverityAnnotation :: [TraceLabelPeer peer (FetchDecision [Point header])] -> Severity
getSeverityAnnotation [] = Severity
Debug
  getSeverityAnnotation [TraceLabelPeer peer (FetchDecision [Point header])]
xs =
      [Severity] -> Severity
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Severity] -> Severity) -> [Severity] -> Severity
forall a b. (a -> b) -> a -> b
$ (TraceLabelPeer peer (FetchDecision [Point header]) -> Severity)
-> [TraceLabelPeer peer (FetchDecision [Point header])]
-> [Severity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(TraceLabelPeer peer
_ FetchDecision [Point header]
a) -> FetchDecision [Point header] -> Severity
forall a. FetchDecision a -> Severity
fetchDecisionSeverity FetchDecision [Point header]
a) [TraceLabelPeer peer (FetchDecision [Point header])]
xs
    where
      fetchDecisionSeverity :: FetchDecision a -> Severity
      fetchDecisionSeverity :: FetchDecision a -> Severity
fetchDecisionSeverity FetchDecision a
fd =
        case FetchDecision a
fd of
          Left FetchDecline
FetchDeclineChainNotPlausible     -> Severity
Debug
          Left FetchDecline
FetchDeclineChainNoIntersection   -> Severity
Notice
          Left FetchDecline
FetchDeclineAlreadyFetched        -> Severity
Debug
          Left FetchDecline
FetchDeclineInFlightThisPeer      -> Severity
Debug
          Left FetchDecline
FetchDeclineInFlightOtherPeer     -> Severity
Debug
          Left FetchDecline
FetchDeclinePeerShutdown          -> Severity
Info
          Left FetchDecline
FetchDeclinePeerSlow              -> Severity
Info
          Left FetchDeclineReqsInFlightLimit {}  -> Severity
Info
          Left FetchDeclineBytesInFlightLimit {} -> Severity
Info
          Left FetchDeclinePeerBusy {}           -> Severity
Info
          Left FetchDeclineConcurrencyLimit {}   -> Severity
Info
          Right a
_                                -> Severity
Info


instance HasPrivacyAnnotation (TraceTxSubmissionInbound txid tx)
instance HasSeverityAnnotation (TraceTxSubmissionInbound txid tx) where
  getSeverityAnnotation :: TraceTxSubmissionInbound txid tx -> Severity
getSeverityAnnotation TraceTxSubmissionInbound txid tx
_ = Severity
Info


instance HasPrivacyAnnotation (TraceTxSubmissionOutbound txid tx)
instance HasSeverityAnnotation (TraceTxSubmissionOutbound txid tx) where
  getSeverityAnnotation :: TraceTxSubmissionOutbound txid tx -> Severity
getSeverityAnnotation TraceTxSubmissionOutbound txid tx
_ = Severity
Info


instance HasPrivacyAnnotation (TraceKeepAliveClient remotePeer)
instance HasSeverityAnnotation (TraceKeepAliveClient remotePeer) where
  getSeverityAnnotation :: TraceKeepAliveClient remotePeer -> Severity
getSeverityAnnotation TraceKeepAliveClient remotePeer
_ = Severity
Info


instance HasPrivacyAnnotation (WithAddr addr ErrorPolicyTrace)
instance HasSeverityAnnotation (WithAddr addr ErrorPolicyTrace) where
  getSeverityAnnotation :: WithAddr addr ErrorPolicyTrace -> Severity
getSeverityAnnotation (WithAddr addr
_ ErrorPolicyTrace
ev) = case ErrorPolicyTrace
ev of
    ErrorPolicySuspendPeer {} -> Severity
Warning -- peer misbehaved
    ErrorPolicySuspendConsumer {} -> Severity
Notice -- peer temporarily not useful
    ErrorPolicyLocalNodeError {} -> Severity
Error
    ErrorPolicyResumePeer {} -> Severity
Debug
    ErrorPolicyKeepSuspended {} -> Severity
Debug
    ErrorPolicyResumeConsumer {} -> Severity
Debug
    ErrorPolicyResumeProducer {} -> Severity
Debug
    ErrorPolicyUnhandledApplicationException {} -> Severity
Error
    ErrorPolicyUnhandledConnectionException {} -> Severity
Error
    ErrorPolicyAcceptException {} -> Severity
Error


instance HasPrivacyAnnotation (WithDomainName DnsTrace)
instance HasSeverityAnnotation (WithDomainName DnsTrace) where
  getSeverityAnnotation :: WithDomainName DnsTrace -> Severity
getSeverityAnnotation (WithDomainName Domain
_ DnsTrace
ev) = case DnsTrace
ev of
    DnsTraceLookupException {} -> Severity
Error
    DnsTraceLookupAError {} -> Severity
Error
    DnsTraceLookupAAAAError {} -> Severity
Error
    DnsTrace
DnsTraceLookupIPv6First -> Severity
Debug
    DnsTrace
DnsTraceLookupIPv4First -> Severity
Debug
    DnsTraceLookupAResult {} -> Severity
Debug
    DnsTraceLookupAAAAResult {} -> Severity
Debug


instance HasPrivacyAnnotation (WithDomainName (SubscriptionTrace Socket.SockAddr))
instance HasSeverityAnnotation (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
  getSeverityAnnotation :: WithDomainName (SubscriptionTrace SockAddr) -> Severity
getSeverityAnnotation (WithDomainName Domain
_ SubscriptionTrace SockAddr
ev) = case SubscriptionTrace SockAddr
ev of
    SubscriptionTraceConnectStart {} -> Severity
Notice
    SubscriptionTraceConnectEnd {} -> Severity
Notice
    SubscriptionTraceConnectException SockAddr
_ e
e ->
        case SomeException -> Maybe SubscriberError
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SubscriberError)
-> SomeException -> Maybe SubscriberError
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e of
             Just (SubscriberError
_::SubscriberError) -> Severity
Debug
             Maybe SubscriberError
Nothing -> Severity
Error
    SubscriptionTraceSocketAllocationException {} -> Severity
Error
    SubscriptionTraceTryConnectToPeer {} -> Severity
Info
    SubscriptionTraceSkippingPeer {} -> Severity
Info
    SubscriptionTrace SockAddr
SubscriptionTraceSubscriptionRunning -> Severity
Debug
    SubscriptionTraceSubscriptionWaiting {} -> Severity
Debug
    SubscriptionTrace SockAddr
SubscriptionTraceSubscriptionFailed -> Severity
Warning
    SubscriptionTraceSubscriptionWaitingNewConnection {} -> Severity
Debug
    SubscriptionTraceStart {} -> Severity
Debug
    SubscriptionTraceRestart {} -> Severity
Debug
    SubscriptionTraceConnectionExist {} -> Severity
Info
    SubscriptionTraceUnsupportedRemoteAddr {} -> Severity
Warning
    SubscriptionTrace SockAddr
SubscriptionTraceMissingLocalAddress -> Severity
Warning
    SubscriptionTraceApplicationException SockAddr
_ e
e ->
        case SomeException -> Maybe SubscriberError
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SubscriberError)
-> SomeException -> Maybe SubscriberError
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e of
             Just (SubscriberError
_::SubscriberError) -> Severity
Debug
             Maybe SubscriberError
Nothing -> Severity
Error
    SubscriptionTraceAllocateSocket {} -> Severity
Debug
    SubscriptionTraceCloseSocket {} -> Severity
Debug


instance HasPrivacyAnnotation (WithIPList (SubscriptionTrace Socket.SockAddr))
instance HasSeverityAnnotation (WithIPList (SubscriptionTrace Socket.SockAddr)) where
  getSeverityAnnotation :: WithIPList (SubscriptionTrace SockAddr) -> Severity
getSeverityAnnotation (WithIPList LocalAddresses SockAddr
_ [SockAddr]
_ SubscriptionTrace SockAddr
ev) = case SubscriptionTrace SockAddr
ev of
    SubscriptionTraceConnectStart SockAddr
_ -> Severity
Info
    SubscriptionTraceConnectEnd SockAddr
_ ConnectResult
connectResult -> case ConnectResult
connectResult of
      ConnectResult
ConnectSuccess -> Severity
Info
      ConnectResult
ConnectSuccessLast -> Severity
Notice
      ConnectResult
ConnectValencyExceeded -> Severity
Warning
    SubscriptionTraceConnectException SockAddr
_ e
e ->
        case SomeException -> Maybe SubscriberError
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SubscriberError)
-> SomeException -> Maybe SubscriberError
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e of
             Just (SubscriberError
_::SubscriberError) -> Severity
Debug
             Maybe SubscriberError
Nothing -> Severity
Error
    SubscriptionTraceSocketAllocationException {} -> Severity
Error
    SubscriptionTraceTryConnectToPeer {} -> Severity
Info
    SubscriptionTraceSkippingPeer {} -> Severity
Info
    SubscriptionTrace SockAddr
SubscriptionTraceSubscriptionRunning -> Severity
Debug
    SubscriptionTraceSubscriptionWaiting {} -> Severity
Debug
    SubscriptionTrace SockAddr
SubscriptionTraceSubscriptionFailed -> Severity
Error
    SubscriptionTraceSubscriptionWaitingNewConnection {} -> Severity
Notice
    SubscriptionTraceStart {} -> Severity
Debug
    SubscriptionTraceRestart {} -> Severity
Info
    SubscriptionTraceConnectionExist {} -> Severity
Notice
    SubscriptionTraceUnsupportedRemoteAddr {} -> Severity
Error
    SubscriptionTrace SockAddr
SubscriptionTraceMissingLocalAddress -> Severity
Warning
    SubscriptionTraceApplicationException SockAddr
_ e
e ->
        case SomeException -> Maybe SubscriberError
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SubscriberError)
-> SomeException -> Maybe SubscriberError
forall a b. (a -> b) -> a -> b
$ e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e of
             Just (SubscriberError
_::SubscriberError) -> Severity
Debug
             Maybe SubscriberError
Nothing -> Severity
Error
    SubscriptionTraceAllocateSocket {} -> Severity
Debug
    SubscriptionTraceCloseSocket {} -> Severity
Info


instance HasPrivacyAnnotation (Identity (SubscriptionTrace LocalAddress))
instance HasSeverityAnnotation (Identity (SubscriptionTrace LocalAddress)) where
  getSeverityAnnotation :: Identity (SubscriptionTrace LocalAddress) -> Severity
getSeverityAnnotation (Identity SubscriptionTrace LocalAddress
ev) = case SubscriptionTrace LocalAddress
ev of
    SubscriptionTraceConnectStart {} -> Severity
Notice
    SubscriptionTraceConnectEnd {} -> Severity
Notice
    SubscriptionTraceConnectException {} -> Severity
Error
    SubscriptionTraceSocketAllocationException {} -> Severity
Error
    SubscriptionTraceTryConnectToPeer {} -> Severity
Notice
    SubscriptionTraceSkippingPeer {} -> Severity
Info
    SubscriptionTrace LocalAddress
SubscriptionTraceSubscriptionRunning -> Severity
Notice
    SubscriptionTraceSubscriptionWaiting {} -> Severity
Debug
    SubscriptionTrace LocalAddress
SubscriptionTraceSubscriptionFailed -> Severity
Warning
    SubscriptionTraceSubscriptionWaitingNewConnection {} -> Severity
Debug
    SubscriptionTraceStart {} -> Severity
Notice
    SubscriptionTraceRestart {} -> Severity
Notice
    SubscriptionTraceConnectionExist {} -> Severity
Debug
    SubscriptionTraceUnsupportedRemoteAddr {} -> Severity
Warning
    SubscriptionTrace LocalAddress
SubscriptionTraceMissingLocalAddress -> Severity
Warning
    SubscriptionTraceApplicationException {} -> Severity
Error
    SubscriptionTraceAllocateSocket {} -> Severity
Debug
    SubscriptionTraceCloseSocket {} -> Severity
Debug


instance Transformable Text IO (Identity (SubscriptionTrace LocalAddress)) where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO (Identity (SubscriptionTrace LocalAddress))
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO (Identity (SubscriptionTrace LocalAddress))
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (Identity (SubscriptionTrace LocalAddress)) where
  formatText :: Identity (SubscriptionTrace LocalAddress) -> Object -> Text
formatText Identity (SubscriptionTrace LocalAddress)
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance ToObject (Identity (SubscriptionTrace LocalAddress)) where
  toObject :: TracingVerbosity
-> Identity (SubscriptionTrace LocalAddress) -> Object
toObject TracingVerbosity
_verb (Identity SubscriptionTrace LocalAddress
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"SubscriptionTrace" :: String)
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SubscriptionTrace LocalAddress -> String
forall a. Show a => a -> String
show SubscriptionTrace LocalAddress
ev
             ]


instance HasPrivacyAnnotation (WithMuxBearer peer MuxTrace)
instance HasSeverityAnnotation (WithMuxBearer peer MuxTrace) where
  getSeverityAnnotation :: WithMuxBearer peer MuxTrace -> Severity
getSeverityAnnotation (WithMuxBearer peer
_ MuxTrace
ev) = case MuxTrace
ev of
    MuxTrace
MuxTraceRecvHeaderStart -> Severity
Debug
    MuxTraceRecvHeaderEnd {} -> Severity
Debug
    MuxTraceRecvStart {} -> Severity
Debug
    MuxTraceRecvEnd {} -> Severity
Debug
    MuxTraceSendStart {} -> Severity
Debug
    MuxTrace
MuxTraceSendEnd -> Severity
Debug
    MuxTraceState {} -> Severity
Info
    MuxTraceCleanExit {} -> Severity
Notice
    MuxTraceExceptionExit {} -> Severity
Notice
    MuxTraceChannelRecvStart {} -> Severity
Debug
    MuxTraceChannelRecvEnd {} -> Severity
Debug
    MuxTraceChannelSendStart {} -> Severity
Debug
    MuxTraceChannelSendEnd {} -> Severity
Debug
    MuxTrace
MuxTraceHandshakeStart -> Severity
Debug
    MuxTraceHandshakeClientEnd {} -> Severity
Info
    MuxTrace
MuxTraceHandshakeServerEnd -> Severity
Debug
    MuxTraceHandshakeClientError {} -> Severity
Error
    MuxTraceHandshakeServerError {} -> Severity
Error
    MuxTraceRecvDeltaQObservation {} -> Severity
Debug
    MuxTraceRecvDeltaQSample {} -> Severity
Debug
    MuxTrace
MuxTraceSDUReadTimeoutException -> Severity
Notice
    MuxTrace
MuxTraceSDUWriteTimeoutException -> Severity
Notice
    MuxTraceStartEagerly MiniProtocolNum
_ MiniProtocolDir
_ -> Severity
Debug
    MuxTraceStartOnDemand MiniProtocolNum
_ MiniProtocolDir
_ -> Severity
Debug
    MuxTraceStartedOnDemand MiniProtocolNum
_ MiniProtocolDir
_ -> Severity
Debug
    MuxTrace
MuxTraceShutdown -> Severity
Debug

--
-- | instances of @Transformable@
--
-- NOTE: this list is sorted by the unqualified name of the outermost type.

instance Transformable Text IO NtN.HandshakeTr where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO HandshakeTr
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO HandshakeTr
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter NtN.HandshakeTr where
  formatText :: HandshakeTr -> Object -> Text
formatText HandshakeTr
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO NtC.HandshakeTr where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO HandshakeTr
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO HandshakeTr
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter NtC.HandshakeTr where
  formatText :: HandshakeTr -> Object -> Text
formatText HandshakeTr
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO NtN.AcceptConnectionsPolicyTrace where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO AcceptConnectionsPolicyTrace
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO AcceptConnectionsPolicyTrace
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter NtN.AcceptConnectionsPolicyTrace where
  formatText :: AcceptConnectionsPolicyTrace -> Object -> Text
formatText AcceptConnectionsPolicyTrace
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Show peer
      => Transformable Text IO [TraceLabelPeer peer (FetchDecision [Point header])] where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO [TraceLabelPeer peer (FetchDecision [Point header])]
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO [TraceLabelPeer peer (FetchDecision [Point header])]
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter [TraceLabelPeer peer (FetchDecision [Point header])] where
  formatText :: [TraceLabelPeer peer (FetchDecision [Point header])]
-> Object -> Text
formatText [TraceLabelPeer peer (FetchDecision [Point header])]
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance (Show peer, HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a)
      => Transformable Text IO (TraceLabelPeer peer a) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceLabelPeer peer a)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceLabelPeer peer a)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (TraceLabelPeer peer a) where
  formatText :: TraceLabelPeer peer a -> Object -> Text
formatText TraceLabelPeer peer a
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO (TraceTxSubmissionInbound txid tx) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceTxSubmissionInbound txid tx)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceTxSubmissionInbound txid tx)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (TraceTxSubmissionInbound txid tx) where
  formatText :: TraceTxSubmissionInbound txid tx -> Object -> Text
formatText TraceTxSubmissionInbound txid tx
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance (Show tx, Show txid)
      => Transformable Text IO (TraceTxSubmissionOutbound txid tx) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceTxSubmissionOutbound txid tx)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceTxSubmissionOutbound txid tx)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (TraceTxSubmissionOutbound txid tx) where
  formatText :: TraceTxSubmissionOutbound txid tx -> Object -> Text
formatText TraceTxSubmissionOutbound txid tx
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Show remotePeer => Transformable Text IO (TraceKeepAliveClient remotePeer) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceKeepAliveClient remotePeer)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceKeepAliveClient remotePeer)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (TraceKeepAliveClient peer) where
  formatText :: TraceKeepAliveClient peer -> Object -> Text
formatText TraceKeepAliveClient peer
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Show addr => Transformable Text IO (WithAddr addr ErrorPolicyTrace) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (WithAddr addr ErrorPolicyTrace)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (WithAddr addr ErrorPolicyTrace)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (WithAddr addr ErrorPolicyTrace) where
  formatText :: WithAddr addr ErrorPolicyTrace -> Object -> Text
formatText WithAddr addr ErrorPolicyTrace
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
  formatText :: WithDomainName (SubscriptionTrace SockAddr) -> Object -> Text
formatText WithDomainName (SubscriptionTrace SockAddr)
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO (WithDomainName DnsTrace) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (WithDomainName DnsTrace)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (WithDomainName DnsTrace)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (WithDomainName DnsTrace) where
  formatText :: WithDomainName DnsTrace -> Object -> Text
formatText WithDomainName DnsTrace
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance Transformable Text IO (WithIPList (SubscriptionTrace Socket.SockAddr)) where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithIPList (SubscriptionTrace SockAddr))
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithIPList (SubscriptionTrace SockAddr))
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance HasTextFormatter (WithIPList (SubscriptionTrace Socket.SockAddr)) where
  formatText :: WithIPList (SubscriptionTrace SockAddr) -> Object -> Text
formatText WithIPList (SubscriptionTrace SockAddr)
_ = String -> Text
pack (String -> Text) -> (Object -> String) -> Object -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> String
forall a. Show a => a -> String
show ([Value] -> String) -> (Object -> [Value]) -> Object -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Object -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


instance (Show peer)
      => Transformable Text IO (WithMuxBearer peer MuxTrace) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (WithMuxBearer peer MuxTrace)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (WithMuxBearer peer MuxTrace)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText
instance (Show peer)
      => HasTextFormatter (WithMuxBearer peer MuxTrace) where
  formatText :: WithMuxBearer peer MuxTrace -> Object -> Text
formatText (WithMuxBearer peer
peer MuxTrace
ev) = \Object
_o ->
    Text
"Bearer on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (peer -> String
forall a. Show a => a -> String
show peer
peer)
   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" event: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (MuxTrace -> String
forall a. Show a => a -> String
show MuxTrace
ev)


--
-- | instances of @ToObject@
--
-- NOTE: this list is sorted by the unqualified name of the outermost type.

instance ( ConvertTxId blk
         , RunNode blk
         , HasTxs blk
         )
      => ToObject (AnyMessageAndAgency (BlockFetch blk (Point blk))) where
  toObject :: TracingVerbosity
-> AnyMessageAndAgency (BlockFetch blk (Point blk)) -> Object
toObject TracingVerbosity
MaximalVerbosity (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgBlock blk)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgBlock"
             , Text
"blockHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (block1 -> HeaderHash block1
forall b. HasHeader b => b -> HeaderHash b
blockHash block1
blk)
             , Text
"blockSize" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SizeInBytes -> Value
forall a. ToJSON a => a -> Value
toJSON (Header block1 -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (block1 -> Header block1
forall blk. GetHeader blk => blk -> Header blk
getHeader block1
blk))
             , Text
"txIds" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON (GenTx blk -> Value
presentTx (GenTx blk -> Value) -> [GenTx blk] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> block1 -> [GenTx block1]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs block1
blk)
             ]
      where
        presentTx :: GenTx blk -> Value
        presentTx :: GenTx blk -> Value
presentTx =  Text -> Value
String (Text -> Value) -> (GenTx blk -> Text) -> GenTx blk -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TracingVerbosity -> TxId (GenTx blk) -> Text
forall blk.
ConvertTxId blk =>
TracingVerbosity -> TxId (GenTx blk) -> Text
renderTxIdForVerbosity TracingVerbosity
MaximalVerbosity (TxId (GenTx blk) -> Text)
-> (GenTx blk -> TxId (GenTx blk)) -> GenTx blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenTx blk -> TxId (GenTx blk)
forall tx. HasTxId tx => tx -> TxId tx
txId

  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgBlock blk)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgBlock"
             , Text
"blockHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (block1 -> HeaderHash block1
forall b. HasHeader b => b -> HeaderHash b
blockHash block1
blk)
             , Text
"blockSize" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SizeInBytes -> Value
forall a. ToJSON a => a -> Value
toJSON (Header block1 -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (block1 -> Header block1
forall blk. GetHeader blk => blk -> Header blk
getHeader block1
blk))
             ]
  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ MsgRequestRange{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRequestRange" ]
  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ MsgStartBatch{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgStartBatch" ]
  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ MsgNoBlocks{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgNoBlocks" ]
  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ MsgBatchDone{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgBatchDone" ]
  toObject TracingVerbosity
_v (AnyMessageAndAgency PeerHasAgency pr st
_ MsgClientDone{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgClientDone" ]

instance ToObject (AnyMessageAndAgency (LocalStateQuery blk pt query)) where
  toObject :: TracingVerbosity
-> AnyMessageAndAgency (LocalStateQuery blk pt query) -> Object
toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgAcquire{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgAcquire" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgAcquired{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgAcquired" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgFailure{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgFailure" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgQuery{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgQuery" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgResult{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgResult" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgRelease{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRelease" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgReAcquire{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgReAcquire" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalStateQuery.MsgDone{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgDone" ]

instance ToObject (AnyMessageAndAgency (LocalTxSubmission tx err)) where
  toObject :: TracingVerbosity
-> AnyMessageAndAgency (LocalTxSubmission tx err) -> Object
toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalTxSub.MsgSubmitTx{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgSubmitTx" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalTxSub.MsgAcceptTx{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgAcceptTx" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalTxSub.MsgRejectTx{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRejectTx" ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ LocalTxSub.MsgDone{}) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgDone" ]

instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where
   toObject :: TracingVerbosity
-> AnyMessageAndAgency (ChainSync blk pt tip) -> Object
toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgRequestNext{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRequestNext" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgAwaitReply{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgAwaitReply" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgRollForward{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRollForward" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgRollBackward{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRollBackward" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgFindIntersect{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgFindIntersect" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgIntersectFound{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgIntersectFound" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgIntersectNotFound{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgIntersectNotFound" ]
   toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ ChainSync.MsgDone{}) =
     [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgDone" ]

instance ToObject (FetchDecision [Point header]) where
  toObject :: TracingVerbosity -> FetchDecision [Point header] -> Object
toObject TracingVerbosity
_verb (Left FetchDecline
decline) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"FetchDecision declined"
             , Text
"declined" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (FetchDecline -> String
forall a. Show a => a -> String
show FetchDecline
decline))
             ]
  toObject TracingVerbosity
_verb (Right [Point header]
results) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"FetchDecision results"
             , Text
"length" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [Point header] -> Int
forall a. HasLength a => a -> Int
length [Point header]
results)
             ]


instance ToObject NtC.HandshakeTr where
  toObject :: TracingVerbosity -> HandshakeTr -> Object
toObject TracingVerbosity
_verb (WithMuxBearer ConnectionId LocalAddress
b TraceSendRecv (Handshake NodeToClientVersion Term)
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"LocalHandshakeTrace"
             , Text
"bearer" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ConnectionId LocalAddress -> String
forall a. Show a => a -> String
show ConnectionId LocalAddress
b
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TraceSendRecv (Handshake NodeToClientVersion Term) -> String
forall a. Show a => a -> String
show TraceSendRecv (Handshake NodeToClientVersion Term)
ev ]


instance ToObject NtN.HandshakeTr where
  toObject :: TracingVerbosity -> HandshakeTr -> Object
toObject TracingVerbosity
_verb (WithMuxBearer ConnectionId SockAddr
b TraceSendRecv (Handshake NodeToNodeVersion Term)
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"HandshakeTrace"
             , Text
"bearer" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ConnectionId SockAddr -> String
forall a. Show a => a -> String
show ConnectionId SockAddr
b
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TraceSendRecv (Handshake NodeToNodeVersion Term) -> String
forall a. Show a => a -> String
show TraceSendRecv (Handshake NodeToNodeVersion Term)
ev ]


instance ToObject NtN.AcceptConnectionsPolicyTrace where
  toObject :: TracingVerbosity -> AcceptConnectionsPolicyTrace -> Object
toObject TracingVerbosity
_verb (NtN.ServerTraceAcceptConnectionRateLimiting DiffTime
delay Int
numOfConnections) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ServerTraceAcceptConnectionRateLimiting"
             , Text
"delay" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
delay
             , Text
"numberOfConnection" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int -> String
forall a. Show a => a -> String
show Int
numOfConnections
             ]
  toObject TracingVerbosity
_verb (NtN.ServerTraceAcceptConnectionHardLimit SizeInBytes
softLimit) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ServerTraceAcceptConnectionHardLimit"
             , Text
"softLimit" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SizeInBytes -> String
forall a. Show a => a -> String
show SizeInBytes
softLimit
             ]


instance (Show txid, Show tx)
      => ToObject (AnyMessageAndAgency (TxSubmission txid tx)) where
  toObject :: TracingVerbosity
-> AnyMessageAndAgency (TxSubmission txid tx) -> Object
toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgRequestTxs txids)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRequestTxs"
      , Text
"txIds" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [txid1] -> String
forall a. Show a => a -> String
show [txid1]
txids)
      ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgReplyTxs txs)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgReplyTxs"
      , Text
"txs" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [tx1] -> String
forall a. Show a => a -> String
show [tx1]
txs)
      ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgRequestTxIds _ _ _)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgRequestTxIds"
      ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ (MsgReplyTxIds _)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgReplyTxIds"
      ]
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ Message (TxSubmission txid tx) st st'
MsgDone) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgDone"
      ]
  --TODO: Can't use 'MsgKThxBye' because NodeToNodeV_2 is not introduced yet.
  toObject TracingVerbosity
_verb (AnyMessageAndAgency PeerHasAgency pr st
_ Message (TxSubmission txid tx) st st'
_) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MsgKThxBye" ]


instance ConvertRawHash blk
      => ToObject (Point blk) where
  toObject :: TracingVerbosity -> Point blk -> Object
toObject TracingVerbosity
_verb Point blk
GenesisPoint =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"GenesisPoint" ]
  toObject TracingVerbosity
verb (BlockPoint SlotNo
slot HeaderHash blk
h) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"BlockPoint"
      , Text
"slot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slot)
      , Text
"headerHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Proxy blk -> TracingVerbosity -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> TracingVerbosity -> HeaderHash blk -> Text
renderHeaderHashForVerbosity (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) TracingVerbosity
verb HeaderHash blk
h
      ]


instance ToObject SlotNo where
  toObject :: TracingVerbosity -> SlotNo -> Object
toObject TracingVerbosity
_verb SlotNo
slot =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"SlotNo"
             , Text
"slot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slot) ]


instance ToObject (TraceFetchClientState header) where
  toObject :: TracingVerbosity -> TraceFetchClientState header -> Object
toObject TracingVerbosity
_verb AddedFetchRequest {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"AddedFetchRequest" ]
  toObject TracingVerbosity
_verb AcknowledgedFetchRequest {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"AcknowledgedFetchRequest" ]
  toObject TracingVerbosity
_verb CompletedBlockFetch {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"CompletedBlockFetch" ]
  toObject TracingVerbosity
_verb CompletedFetchBatch {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"CompletedFetchBatch" ]
  toObject TracingVerbosity
_verb StartedFetchBatch {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StartedFetchBatch" ]
  toObject TracingVerbosity
_verb RejectedFetchBatch {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"RejectedFetchBatch" ]
  toObject TracingVerbosity
_verb ClientTerminating {} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ClientTerminating" ]


instance Show peer
      => ToObject [TraceLabelPeer peer (FetchDecision [Point header])] where
  toObject :: TracingVerbosity
-> [TraceLabelPeer peer (FetchDecision [Point header])] -> Object
toObject TracingVerbosity
MinimalVerbosity [TraceLabelPeer peer (FetchDecision [Point header])]
_ = Object
forall a. ToObject a => HashMap Text a
emptyObject
  toObject TracingVerbosity
_ [] = Object
forall a. ToObject a => HashMap Text a
emptyObject
  toObject TracingVerbosity
_ [TraceLabelPeer peer (FetchDecision [Point header])]
xs = [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
    [ Text
"kind"  Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"PeersFetch"
    , Text
"peers" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON
      (([Object]
 -> TraceLabelPeer peer (FetchDecision [Point header]) -> [Object])
-> [Object]
-> [TraceLabelPeer peer (FetchDecision [Point header])]
-> [Object]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Object]
acc TraceLabelPeer peer (FetchDecision [Point header])
x -> TracingVerbosity
-> TraceLabelPeer peer (FetchDecision [Point header]) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
MaximalVerbosity TraceLabelPeer peer (FetchDecision [Point header])
x Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
acc) [] [TraceLabelPeer peer (FetchDecision [Point header])]
xs) ]


instance (Show peer, ToObject a) => ToObject (TraceLabelPeer peer a) where
  toObject :: TracingVerbosity -> TraceLabelPeer peer a -> Object
toObject TracingVerbosity
verb (TraceLabelPeer peer
peerid a
a) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"peer" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= peer -> String
forall a. Show a => a -> String
show peer
peerid ] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> TracingVerbosity -> a -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb a
a


instance ToObject (AnyMessageAndAgency ps)
      => ToObject (TraceSendRecv ps) where
  toObject :: TracingVerbosity -> TraceSendRecv ps -> Object
toObject TracingVerbosity
verb (TraceSendMsg AnyMessageAndAgency ps
m) = [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
    [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Send" , Text
"msg" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> AnyMessageAndAgency ps -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb AnyMessageAndAgency ps
m ]
  toObject TracingVerbosity
verb (TraceRecvMsg AnyMessageAndAgency ps
m) = [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
    [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Recv" , Text
"msg" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> AnyMessageAndAgency ps -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb AnyMessageAndAgency ps
m ]


instance ToObject (TraceTxSubmissionInbound txid tx) where
  toObject :: TracingVerbosity -> TraceTxSubmissionInbound txid tx -> Object
toObject TracingVerbosity
_verb TraceTxSubmissionInbound txid tx
TraceTxSubmissionInbound =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceTxSubmissionInbound" ]


instance (Show txid, Show tx)
      => ToObject (TraceTxSubmissionOutbound txid tx) where
  toObject :: TracingVerbosity -> TraceTxSubmissionOutbound txid tx -> Object
toObject TracingVerbosity
MaximalVerbosity (TraceTxSubmissionOutboundRecvMsgRequestTxs [txid]
txids) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceTxSubmissionOutboundRecvMsgRequestTxs"
      , Text
"txIds" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [txid] -> String
forall a. Show a => a -> String
show [txid]
txids)
      ]
  toObject TracingVerbosity
_verb (TraceTxSubmissionOutboundRecvMsgRequestTxs [txid]
_txids) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceTxSubmissionOutboundRecvMsgRequestTxs"
      ]
  toObject TracingVerbosity
MaximalVerbosity (TraceTxSubmissionOutboundSendMsgReplyTxs [tx]
txs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceTxSubmissionOutboundSendMsgReplyTxs"
      , Text
"txs" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [tx] -> String
forall a. Show a => a -> String
show [tx]
txs)
      ]
  toObject TracingVerbosity
_verb (TraceTxSubmissionOutboundSendMsgReplyTxs [tx]
_txs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceTxSubmissionOutboundSendMsgReplyTxs"
      ]
  toObject TracingVerbosity
_verb (TraceControlMessage ControlMessage
_msg) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceControlMessage"
      ]


instance Show remotePeer => ToObject (TraceKeepAliveClient remotePeer) where
  toObject :: TracingVerbosity -> TraceKeepAliveClient remotePeer -> Object
toObject TracingVerbosity
_verb (AddSample remotePeer
peer DiffTime
rtt PeerGSV
pgsv) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceKeepAliveClient AddSample"
      , Text
"address" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= remotePeer -> String
forall a. Show a => a -> String
show remotePeer
peer
      , Text
"rtt" Text -> DiffTime -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DiffTime
rtt
      , Text
"sampleTime" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double -> String
forall a. Show a => a -> String
show (Time -> Double
dTime (Time -> Double) -> Time -> Double
forall a b. (a -> b) -> a -> b
$ PeerGSV -> Time
sampleTime PeerGSV
pgsv)
      , Text
"outboundG" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> Double) -> DiffTime -> Double
forall a b. (a -> b) -> a -> b
$ GSV -> DiffTime
gGSV (PeerGSV -> GSV
outboundGSV PeerGSV
pgsv) :: Double)
      , Text
"inboundG" Text -> Double -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> Double) -> DiffTime -> Double
forall a b. (a -> b) -> a -> b
$ GSV -> DiffTime
gGSV (PeerGSV -> GSV
inboundGSV PeerGSV
pgsv) :: Double)
      ]
    where
      gGSV :: GSV -> DiffTime
      gGSV :: GSV -> DiffTime
gGSV (GSV DiffTime
g SizeInBytes -> DiffTime
_ Distribution DiffTime
_) = DiffTime
g

      dTime :: Time -> Double
      dTime :: Time -> Double
dTime (Time DiffTime
d) = DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
d

instance Show addr => ToObject (WithAddr addr ErrorPolicyTrace) where
  toObject :: TracingVerbosity -> WithAddr addr ErrorPolicyTrace -> Object
toObject TracingVerbosity
_verb (WithAddr addr
addr ErrorPolicyTrace
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ErrorPolicyTrace"
             , Text
"address" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= addr -> String
forall a. Show a => a -> String
show addr
addr
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ErrorPolicyTrace -> String
forall a. Show a => a -> String
show ErrorPolicyTrace
ev ]


instance ToObject (WithIPList (SubscriptionTrace Socket.SockAddr)) where
  toObject :: TracingVerbosity
-> WithIPList (SubscriptionTrace SockAddr) -> Object
toObject TracingVerbosity
_verb (WithIPList LocalAddresses SockAddr
localAddresses [SockAddr]
dests SubscriptionTrace SockAddr
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WithIPList SubscriptionTrace"
             , Text
"localAddresses" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LocalAddresses SockAddr -> String
forall a. Show a => a -> String
show LocalAddresses SockAddr
localAddresses
             , Text
"dests" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [SockAddr] -> String
forall a. Show a => a -> String
show [SockAddr]
dests
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SubscriptionTrace SockAddr -> String
forall a. Show a => a -> String
show SubscriptionTrace SockAddr
ev ]


instance ToObject (WithDomainName DnsTrace) where
  toObject :: TracingVerbosity -> WithDomainName DnsTrace -> Object
toObject TracingVerbosity
_verb (WithDomainName Domain
dom DnsTrace
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"DnsTrace"
             , Text
"domain" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Domain -> String
forall a. Show a => a -> String
show Domain
dom
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DnsTrace -> String
forall a. Show a => a -> String
show DnsTrace
ev ]


instance ToObject (WithDomainName (SubscriptionTrace Socket.SockAddr)) where
  toObject :: TracingVerbosity
-> WithDomainName (SubscriptionTrace SockAddr) -> Object
toObject TracingVerbosity
_verb (WithDomainName Domain
dom SubscriptionTrace SockAddr
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"SubscriptionTrace"
             , Text
"domain" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Domain -> String
forall a. Show a => a -> String
show Domain
dom
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SubscriptionTrace SockAddr -> String
forall a. Show a => a -> String
show SubscriptionTrace SockAddr
ev ]


instance (Show peer) => ToObject (WithMuxBearer peer MuxTrace) where
  toObject :: TracingVerbosity -> WithMuxBearer peer MuxTrace -> Object
toObject TracingVerbosity
_verb (WithMuxBearer peer
b MuxTrace
ev) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MuxTrace"
             , Text
"bearer" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= peer -> String
forall a. Show a => a -> String
show peer
b
             , Text
"event" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MuxTrace -> String
forall a. Show a => a -> String
show MuxTrace
ev ]