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

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Tracing.OrphanInstances.Consensus () where

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

import           Data.Aeson (Value (..))
import           Data.Text (pack)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import           Cardano.Tracing.OrphanInstances.Common
import           Cardano.Tracing.OrphanInstances.Network ()
import           Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderHeaderHash,
                   renderHeaderHashForVerbosity, renderPoint, renderPointAsPhrase,
                   renderPointForVerbosity, renderRealPoint, renderRealPointAsPhrase,
                   renderTipBlockNo, renderTipHash, renderWithOrigin)
import           Cardano.Slotting.Slot (fromWithOrigin)

import           Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ConvertRawHash (..),
                   ForgeStateUpdateError, Header, RealPoint, getHeader, headerPoint, realPointHash,
                   realPointSlot, blockNo, blockPrevHash, pointHash)
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent (..), LedgerUpdate,
                   LedgerWarning)
import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxId,
                   LedgerSupportsMempool, TxId, txForgetValidated, txId)
import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
import           Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..))
import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..))
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..))
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent (..))
import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                   (TraceLocalTxSubmissionServerEvent (..))
import           Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize)
import           Ouroboros.Consensus.Node.Tracers (TraceForgeEvent (..))
import qualified Ouroboros.Consensus.Node.Tracers as Consensus
import           Ouroboros.Consensus.Protocol.Abstract
import qualified Ouroboros.Consensus.Protocol.BFT as BFT
import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT
import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb

import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.Orphans ()

import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo (..), StandardHash,
                   Tip (..), blockHash, pointSlot, tipFromHeader)
import           Ouroboros.Network.Point (withOrigin)

import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
-- TODO: 'TraceCacheEvent' should be exported by the 'Impl' module
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB


{- HLINT ignore "Use const" -}
{- HLINT ignore "Use record patterns" -}

instance ConvertRawHash blk => ConvertRawHash (Header blk) where
  toShortRawHash :: proxy (Header blk) -> HeaderHash (Header blk) -> ShortByteString
toShortRawHash proxy (Header blk)
_ HeaderHash (Header blk)
h = Proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) HeaderHash blk
HeaderHash (Header blk)
h
  fromShortRawHash :: proxy (Header blk) -> ShortByteString -> HeaderHash (Header blk)
fromShortRawHash proxy (Header blk)
_ ShortByteString
bs = Proxy blk -> ShortByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
fromShortRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) ShortByteString
bs
  hashSize :: proxy (Header blk) -> Word32
hashSize proxy (Header blk)
_ = Proxy blk -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
hashSize (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)

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

instance HasPrivacyAnnotation (ChainDB.TraceEvent blk)
instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where
  getSeverityAnnotation :: TraceEvent blk -> Severity
getSeverityAnnotation (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev) = case TraceAddBlockEvent blk
ev of
    ChainDB.IgnoreBlockOlderThanK {} -> Severity
Info
    ChainDB.IgnoreBlockAlreadyInVolatileDB {} -> Severity
Info
    ChainDB.IgnoreInvalidBlock {} -> Severity
Info
    ChainDB.AddedBlockToQueue {} -> Severity
Debug
    ChainDB.BlockInTheFuture {} -> Severity
Info
    ChainDB.AddedBlockToVolatileDB {} -> Severity
Debug
    ChainDB.TryAddToCurrentChain {} -> Severity
Debug
    ChainDB.TrySwitchToAFork {} -> Severity
Info
    ChainDB.StoreButDontChange {} -> Severity
Debug
    ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_ ->
      Severity -> [Severity] -> Severity
forall a. Ord a => a -> [a] -> a
maximumDef Severity
Notice ((LedgerEvent blk -> Severity) -> [LedgerEvent blk] -> [Severity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map LedgerEvent blk -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation [LedgerEvent blk]
events)
    ChainDB.SwitchedToAFork [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_ ->
      Severity -> [Severity] -> Severity
forall a. Ord a => a -> [a] -> a
maximumDef Severity
Notice ((LedgerEvent blk -> Severity) -> [LedgerEvent blk] -> [Severity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map LedgerEvent blk -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation [LedgerEvent blk]
events)
    ChainDB.AddBlockValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock {} -> Severity
Error
      ChainDB.InvalidCandidate {} -> Severity
Error
      ChainDB.ValidCandidate {} -> Severity
Info
      ChainDB.CandidateContainsFutureBlocks{} -> Severity
Debug
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{} -> Severity
Error
    ChainDB.ChainSelectionForFutureBlock{} -> Severity
Debug

  getSeverityAnnotation (ChainDB.TraceLedgerReplayEvent TraceLedgerReplayEvent blk
ev) = case TraceLedgerReplayEvent blk
ev of
    LedgerDB.ReplayFromGenesis {} -> Severity
Info
    LedgerDB.ReplayFromSnapshot {} -> Severity
Info
    LedgerDB.ReplayedBlock {} -> Severity
Info

  getSeverityAnnotation (ChainDB.TraceLedgerEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    LedgerDB.TookSnapshot {} -> Severity
Info
    LedgerDB.DeletedSnapshot {} -> Severity
Debug
    LedgerDB.InvalidSnapshot {} -> Severity
Error

  getSeverityAnnotation (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev) = case TraceCopyToImmutableDBEvent blk
ev of
    ChainDB.CopiedBlockToImmutableDB {} -> Severity
Debug
    TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB -> Severity
Debug

  getSeverityAnnotation (ChainDB.TraceGCEvent TraceGCEvent blk
ev) = case TraceGCEvent blk
ev of
    ChainDB.PerformedGC {} -> Severity
Debug
    ChainDB.ScheduledGC {} -> Severity
Debug

  getSeverityAnnotation (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev) = case TraceOpenEvent blk
ev of
    ChainDB.OpenedDB {} -> Severity
Info
    ChainDB.ClosedDB {} -> Severity
Info
    ChainDB.OpenedImmutableDB {} -> Severity
Info
    TraceOpenEvent blk
ChainDB.OpenedVolatileDB -> Severity
Info
    TraceOpenEvent blk
ChainDB.OpenedLgrDB -> Severity
Info

  getSeverityAnnotation (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev) = case TraceFollowerEvent blk
ev of
    ChainDB.NewFollower {} -> Severity
Debug
    ChainDB.FollowerNoLongerInMem {} -> Severity
Debug
    ChainDB.FollowerSwitchToMem {} -> Severity
Debug
    ChainDB.FollowerNewImmIterator {} -> Severity
Debug
  getSeverityAnnotation (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev) = case TraceInitChainSelEvent blk
ev of
    ChainDB.InitChainSelValidation {} -> Severity
Debug
  getSeverityAnnotation (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev) = case TraceIteratorEvent blk
ev of
    ChainDB.StreamFromVolatileDB {} -> Severity
Debug
    TraceIteratorEvent blk
_ -> Severity
Debug
  getSeverityAnnotation (ChainDB.TraceImmutableDBEvent TraceEvent blk
_ev) = Severity
Debug
  getSeverityAnnotation (ChainDB.TraceVolatileDBEvent TraceEvent blk
_ev) = Severity
Debug

instance HasSeverityAnnotation (LedgerEvent blk) where
  getSeverityAnnotation :: LedgerEvent blk -> Severity
getSeverityAnnotation (LedgerUpdate LedgerUpdate blk
_)  = Severity
Notice
  getSeverityAnnotation (LedgerWarning LedgerWarning blk
_) = Severity
Critical

instance HasPrivacyAnnotation (TraceBlockFetchServerEvent blk)
instance HasSeverityAnnotation (TraceBlockFetchServerEvent blk) where
  getSeverityAnnotation :: TraceBlockFetchServerEvent blk -> Severity
getSeverityAnnotation TraceBlockFetchServerEvent blk
_ = Severity
Info


instance HasPrivacyAnnotation (TraceChainSyncClientEvent blk)
instance HasSeverityAnnotation (TraceChainSyncClientEvent blk) where
  getSeverityAnnotation :: TraceChainSyncClientEvent blk -> Severity
getSeverityAnnotation (TraceDownloadedHeader Header blk
_) = Severity
Info
  getSeverityAnnotation (TraceFoundIntersection Point blk
_ Our (Tip blk)
_ Their (Tip blk)
_) = Severity
Info
  getSeverityAnnotation (TraceRolledBack Point blk
_) = Severity
Notice
  getSeverityAnnotation (TraceException ChainSyncClientException
_) = Severity
Warning
  getSeverityAnnotation (TraceTermination ChainSyncClientResult
_) = Severity
Notice


instance HasPrivacyAnnotation (TraceChainSyncServerEvent blk)
instance HasSeverityAnnotation (TraceChainSyncServerEvent blk) where
  getSeverityAnnotation :: TraceChainSyncServerEvent blk -> Severity
getSeverityAnnotation TraceChainSyncServerEvent blk
_ = Severity
Info


instance HasPrivacyAnnotation (TraceEventMempool blk)
instance HasSeverityAnnotation (TraceEventMempool blk) where
  getSeverityAnnotation :: TraceEventMempool blk -> Severity
getSeverityAnnotation TraceEventMempool blk
_ = Severity
Info

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

instance HasPrivacyAnnotation (TraceForgeEvent blk)
instance HasSeverityAnnotation (TraceForgeEvent blk) where
  getSeverityAnnotation :: TraceForgeEvent blk -> Severity
getSeverityAnnotation TraceStartLeadershipCheck {}   = Severity
Info
  getSeverityAnnotation TraceSlotIsImmutable {}        = Severity
Error
  getSeverityAnnotation TraceBlockFromFuture {}        = Severity
Error
  getSeverityAnnotation TraceBlockContext {}           = Severity
Debug
  getSeverityAnnotation TraceNoLedgerState {}          = Severity
Error
  getSeverityAnnotation TraceLedgerState {}            = Severity
Debug
  getSeverityAnnotation TraceNoLedgerView {}           = Severity
Error
  getSeverityAnnotation TraceLedgerView {}             = Severity
Debug
  getSeverityAnnotation TraceForgeStateUpdateError {}  = Severity
Error
  getSeverityAnnotation TraceNodeCannotForge {}        = Severity
Error
  getSeverityAnnotation TraceNodeNotLeader {}          = Severity
Info
  getSeverityAnnotation TraceNodeIsLeader {}           = Severity
Info
  getSeverityAnnotation TraceForgedBlock {}            = Severity
Info
  getSeverityAnnotation TraceDidntAdoptBlock {}        = Severity
Error
  getSeverityAnnotation TraceForgedInvalidBlock {}     = Severity
Error
  getSeverityAnnotation TraceAdoptedBlock {}           = Severity
Info


instance HasPrivacyAnnotation (TraceLocalTxSubmissionServerEvent blk)
instance HasSeverityAnnotation (TraceLocalTxSubmissionServerEvent blk) where
  getSeverityAnnotation :: TraceLocalTxSubmissionServerEvent blk -> Severity
getSeverityAnnotation TraceLocalTxSubmissionServerEvent blk
_ = Severity
Info


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

instance ( HasPrivacyAnnotation (ChainDB.TraceAddBlockEvent blk)
         , HasSeverityAnnotation (ChainDB.TraceAddBlockEvent blk)
         , LedgerSupportsProtocol blk
         , ToObject (ChainDB.TraceAddBlockEvent blk))
      => Transformable Text IO (ChainDB.TraceAddBlockEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceAddBlockEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceAddBlockEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText


instance (LedgerSupportsProtocol blk)
      => HasTextFormatter (ChainDB.TraceAddBlockEvent blk) where
  formatText :: TraceAddBlockEvent blk -> Object -> Text
formatText TraceAddBlockEvent blk
_ = 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 ConvertRawHash blk
      => Transformable Text IO (TraceBlockFetchServerEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceBlockFetchServerEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceBlockFetchServerEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText


instance HasTextFormatter (TraceBlockFetchServerEvent blk) where
  formatText :: TraceBlockFetchServerEvent blk -> Object -> Text
formatText TraceBlockFetchServerEvent blk
_ = 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 (ConvertRawHash blk, LedgerSupportsProtocol blk)
      => Transformable Text IO (TraceChainSyncClientEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceChainSyncClientEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceChainSyncClientEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured


instance ConvertRawHash blk
      => Transformable Text IO (TraceChainSyncServerEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceChainSyncServerEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceChainSyncServerEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured


instance ( ToObject (ApplyTxErr blk), Show (ApplyTxErr blk), ToObject (GenTx blk),
           ToJSON (GenTxId blk), LedgerSupportsMempool blk)
      => Transformable Text IO (TraceEventMempool blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceEventMempool blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceEventMempool blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured


condenseT :: Condense a => a -> Text
condenseT :: a -> Text
condenseT = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Condense a => a -> String
condense

showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
show


instance ( tx ~ GenTx blk
         , HasTxId tx
         , RunNode blk
         , Show (TxId tx)
         , ToObject (LedgerError blk)
         , ToObject (OtherHeaderEnvelopeError blk)
         , ToObject (ValidationErr (BlockProtocol blk))
         , ToObject (CannotForge blk)
         , ToObject (ForgeStateUpdateError blk)
         , LedgerSupportsMempool blk)
      => Transformable Text IO (TraceForgeEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceForgeEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text -> Tracer IO (TraceForgeEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText

instance ( tx ~ GenTx blk
         , ConvertRawHash blk
         , HasTxId tx
         , LedgerSupportsMempool blk
         , LedgerSupportsProtocol blk
         , LedgerSupportsMempool blk
         , Show (TxId tx)
         , Show (ForgeStateUpdateError blk)
         , Show (CannotForge blk)
         , LedgerSupportsMempool blk)
      => HasTextFormatter (TraceForgeEvent blk) where
  formatText :: TraceForgeEvent blk -> Object -> Text
formatText = \case
    TraceStartLeadershipCheck SlotNo
slotNo -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Checking for leadership in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceSlotIsImmutable SlotNo
slotNo Point blk
immutableTipPoint BlockNo
immutableTipBlkNo -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Couldn't forge block because current slot is immutable: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"immutable tip: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
immutableTipPoint
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", immutable tip block no: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (BlockNo -> Word64
unBlockNo BlockNo
immutableTipBlkNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceBlockFromFuture SlotNo
currentSlot SlotNo
tipSlot -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Couldn't forge block because current tip is in the future: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"current tip slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
tipSlot)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
    TraceBlockContext SlotNo
currentSlot BlockNo
tipBlockNo Point blk
tipPoint -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"New block will fit onto: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"tip: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
tipPoint
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", tip block no: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (BlockNo -> Word64
unBlockNo BlockNo
tipBlockNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
    TraceNoLedgerState SlotNo
slotNo Point blk
pt -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Could not obtain ledger state for point "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
pt
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceLedgerState SlotNo
slotNo Point blk
pt -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Obtained a ledger state for point "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
pt
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceNoLedgerView SlotNo
slotNo OutsideForecastRange
_ -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Could not obtain ledger view for slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceLedgerView SlotNo
slotNo -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Obtained a ledger view for slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceForgeStateUpdateError SlotNo
slotNo ForgeStateUpdateError blk
reason -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Updating the forge state in slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed because: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ForgeStateUpdateError blk -> Text
forall a. Show a => a -> Text
showT ForgeStateUpdateError blk
reason
    TraceNodeCannotForge SlotNo
slotNo CannotForge blk
reason -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"We are the leader in slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but we cannot forge because: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CannotForge blk -> Text
forall a. Show a => a -> Text
showT CannotForge blk
reason
    TraceNodeNotLeader SlotNo
slotNo -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Not leading slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceNodeIsLeader SlotNo
slotNo -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Leading slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceForgedBlock SlotNo
slotNo Point blk
_ blk
_ MempoolSize
_ -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Forged block in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceDidntAdoptBlock SlotNo
slotNo blk
_ -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Didn't adopt forged block in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
    TraceForgedInvalidBlock SlotNo
slotNo blk
_ InvalidBlockReason blk
reason -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Forged invalid block in slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", reason: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InvalidBlockReason blk -> Text
forall a. Show a => a -> Text
showT InvalidBlockReason blk
reason
    TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
txs -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"Adopted block forged in slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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) (blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", TxIds: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [TxId (GenTx blk)] -> Text
forall a. Show a => a -> Text
showT ((Validated (GenTx blk) -> TxId (GenTx blk))
-> [Validated (GenTx blk)] -> [TxId (GenTx blk)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (GenTx blk -> TxId (GenTx blk)
forall tx. HasTxId tx => tx -> TxId tx
txId (GenTx blk -> TxId (GenTx blk))
-> (Validated (GenTx blk) -> GenTx blk)
-> Validated (GenTx blk)
-> TxId (GenTx blk)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated) [Validated (GenTx blk)]
txs)


instance Transformable Text IO (TraceLocalTxSubmissionServerEvent blk) where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO (TraceLocalTxSubmissionServerEvent blk)
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO (TraceLocalTxSubmissionServerEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured

instance HasPrivacyAnnotation a => HasPrivacyAnnotation (Consensus.TraceLabelCreds a)
instance HasSeverityAnnotation a => HasSeverityAnnotation (Consensus.TraceLabelCreds a) where
  getSeverityAnnotation :: TraceLabelCreds a -> Severity
getSeverityAnnotation (Consensus.TraceLabelCreds Text
_ a
a) = a -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation a
a

instance ToObject a => ToObject (Consensus.TraceLabelCreds a) where
  toObject :: TracingVerbosity -> TraceLabelCreds a -> Object
toObject TracingVerbosity
verb (Consensus.TraceLabelCreds Text
creds a
val) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"credentials" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
creds
             , Text
"val"         Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> a -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb a
val
             ]

instance (HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a)
      => Transformable Text IO (Consensus.TraceLabelCreds a) where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO (TraceLabelCreds a)
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO (TraceLabelCreds a)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured

instance ( ConvertRawHash blk
         , LedgerSupportsProtocol blk
         , InspectLedger blk
         , ToObject (Header blk)
         , ToObject (LedgerEvent blk))
      => Transformable Text IO (ChainDB.TraceEvent blk) where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO (TraceEvent blk)
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO (TraceEvent blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText

instance ( ConvertRawHash blk
         , LedgerSupportsProtocol blk
         , InspectLedger blk)
      => HasTextFormatter (ChainDB.TraceEvent blk) where
    formatText :: TraceEvent blk -> Object -> Text
formatText TraceEvent blk
tev Object
_obj = case TraceEvent blk
tev of
      ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev -> case TraceAddBlockEvent blk
ev of
        ChainDB.IgnoreBlockOlderThanK RealPoint blk
pt ->
          Text
"Ignoring block older than K: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.IgnoreBlockAlreadyInVolatileDB RealPoint blk
pt ->
          Text
"Ignoring block already in DB: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.IgnoreInvalidBlock RealPoint blk
pt InvalidBlockReason blk
_reason ->
          Text
"Ignoring previously seen invalid block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.AddedBlockToQueue RealPoint blk
pt Word
sz ->
          Text
"Block added to queue: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" queue size " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word -> Text
forall a. Condense a => a -> Text
condenseT Word
sz
        ChainDB.BlockInTheFuture RealPoint blk
pt SlotNo
slot ->
          Text
"Ignoring block from future: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Condense a => a -> Text
condenseT SlotNo
slot
        ChainDB.StoreButDontChange RealPoint blk
pt ->
          Text
"Ignoring block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.TryAddToCurrentChain RealPoint blk
pt ->
          Text
"Block fits onto the current chain: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.TrySwitchToAFork RealPoint blk
pt ChainDiff (HeaderFields blk)
_ ->
          Text
"Block fits onto some fork: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.AddedToCurrentChain [LedgerEvent blk]
es NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
c ->
          Text
"Chain extended, new tip: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          [Text] -> Text
Text.concat [ Text
"\nEvent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LedgerEvent blk -> Text
forall a. Show a => a -> Text
showT LedgerEvent blk
e | LedgerEvent blk
e <- [LedgerEvent blk]
es ]
        ChainDB.SwitchedToAFork [LedgerEvent blk]
es NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
c ->
          Text
"Switched to a fork, new tip: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          [Text] -> Text
Text.concat [ Text
"\nEvent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LedgerEvent blk -> Text
forall a. Show a => a -> Text
showT LedgerEvent blk
e | LedgerEvent blk
e <- [LedgerEvent blk]
es ]
        ChainDB.AddBlockValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
          ChainDB.InvalidBlock ExtValidationError blk
err RealPoint blk
pt ->
            Text
"Invalid block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtValidationError blk -> Text
forall a. Show a => a -> Text
showT ExtValidationError blk
err
          ChainDB.InvalidCandidate AnchoredFragment (Header blk)
c ->
            Text
"Invalid candidate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
          ChainDB.ValidCandidate AnchoredFragment (Header blk)
c ->
            Text
"Valid candidate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
          ChainDB.CandidateContainsFutureBlocks AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
            Text
"Candidate contains blocks from near future:  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", slots " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text -> [Text] -> Text
Text.intercalate Text
", " ((Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs)
          ChainDB.CandidateContainsFutureBlocksExceedingClockSkew AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
            Text
"Candidate contains blocks from future exceeding clock skew limit: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", slots " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text -> [Text] -> Text
Text.intercalate Text
", " ((Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs)
        ChainDB.AddedBlockToVolatileDB RealPoint blk
pt BlockNo
_ IsEBB
_ ->
          Text
"Chain added block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        ChainDB.ChainSelectionForFutureBlock RealPoint blk
pt ->
          Text
"Chain selection run for block previously from future: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
      ChainDB.TraceLedgerReplayEvent TraceLedgerReplayEvent blk
ev -> case TraceLedgerReplayEvent blk
ev of
        LedgerDB.ReplayFromGenesis Point blk
_replayTo ->
          Text
"Replaying ledger from genesis"
        LedgerDB.ReplayFromSnapshot DiskSnapshot
snap RealPoint blk
tip' Point blk
_replayTo ->
          Text
"Replaying ledger from snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
tip'
        LedgerDB.ReplayedBlock RealPoint blk
pt [LedgerEvent blk]
_ledgerEvents Point blk
replayTo ->
          Text
"Replayed block: slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Show a => a -> Text
showT (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
pt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin SlotNo -> Text
forall a. Show a => a -> Text
showT (Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point blk
replayTo)
      ChainDB.TraceLedgerEvent TraceEvent blk
ev -> case TraceEvent blk
ev of
        LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt ->
          Text
"Took ledger snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
        LedgerDB.DeletedSnapshot DiskSnapshot
snap ->
          Text
"Deleted old snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap
        LedgerDB.InvalidSnapshot DiskSnapshot
snap InitFailure blk
failure ->
          Text
"Invalid snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InitFailure blk -> Text
forall a. Show a => a -> Text
showT InitFailure blk
failure
      ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev -> case TraceCopyToImmutableDBEvent blk
ev of
        ChainDB.CopiedBlockToImmutableDB Point blk
pt ->
          Text
"Copied block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the ImmutableDB"
        TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB ->
          Text
"There are no blocks to copy to the ImmutableDB"
      ChainDB.TraceGCEvent TraceGCEvent blk
ev -> case TraceGCEvent blk
ev of
        ChainDB.PerformedGC SlotNo
slot ->
          Text
"Performed a garbage collection for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Condense a => a -> Text
condenseT SlotNo
slot
        ChainDB.ScheduledGC SlotNo
slot Time
_difft ->
          Text
"Scheduled a garbage collection for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Condense a => a -> Text
condenseT SlotNo
slot
      ChainDB.TraceOpenEvent TraceOpenEvent blk
ev -> case TraceOpenEvent blk
ev of
        ChainDB.OpenedDB Point blk
immTip Point blk
tip' ->
          Text
"Opened db with immutable tip at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
immTip Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" and tip " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
tip'
        ChainDB.ClosedDB Point blk
immTip Point blk
tip' ->
          Text
"Closed db with immutable tip at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
immTip Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" and tip " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
tip'
        ChainDB.OpenedImmutableDB Point blk
immTip ChunkNo
chunk ->
          Text
"Opened imm db with immutable tip at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
immTip Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" and chunk " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
chunk
        TraceOpenEvent blk
ChainDB.OpenedVolatileDB ->  Text
"Opened vol db"
        TraceOpenEvent blk
ChainDB.OpenedLgrDB ->  Text
"Opened lgr db"
      ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev -> case TraceFollowerEvent blk
ev of
        TraceFollowerEvent blk
ChainDB.NewFollower ->  Text
"New follower was created"
        ChainDB.FollowerNoLongerInMem FollowerRollState blk
_ ->  Text
"FollowerNoLongerInMem"
        ChainDB.FollowerSwitchToMem Point blk
_ WithOrigin SlotNo
_ ->  Text
"FollowerSwitchToMem"
        ChainDB.FollowerNewImmIterator Point blk
_ WithOrigin SlotNo
_ ->  Text
"FollowerNewImmIterator"
      ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev -> case TraceInitChainSelEvent blk
ev of
        ChainDB.InitChainSelValidation TraceValidationEvent blk
_ ->  Text
"InitChainSelValidation"
      ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev -> case TraceIteratorEvent blk
ev of
        ChainDB.UnknownRangeRequested UnknownRange blk
ev' ->
          case UnknownRange blk
ev' of
            ChainDB.MissingBlock RealPoint blk
realPt ->
              Text
"The block at the given point was not found in the ChainDB."
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt
            ChainDB.ForkTooOld StreamFrom blk
streamFrom ->
              Text
"The requested range forks off too far in the past"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom
        ChainDB.BlockMissingFromVolatileDB RealPoint blk
realPt ->
          Text
"This block is no longer in the VolatileDB because it has been garbage\
           \ collected. It might now be in the ImmutableDB if it was part of the\
           \ current chain. Block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt
        ChainDB.StreamFromImmutableDB StreamFrom blk
sFrom StreamTo blk
sTo ->
          Text
"Stream only from the ImmutableDB. StreamFrom:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
sFrom Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" StreamTo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
sTo
        ChainDB.StreamFromBoth StreamFrom blk
sFrom StreamTo blk
sTo [RealPoint blk]
pts ->
          Text
"Stream from both the VolatileDB and the ImmutableDB."
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" StreamFrom: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
sFrom Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" StreamTo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
sTo
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Points: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showT ((RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint [RealPoint blk]
pts)
        ChainDB.StreamFromVolatileDB StreamFrom blk
sFrom StreamTo blk
sTo [RealPoint blk]
pts ->
          Text
"Stream only from the VolatileDB."
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" StreamFrom: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
sFrom Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" StreamTo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
sTo
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Points: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showT ((RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint [RealPoint blk]
pts)
        ChainDB.BlockWasCopiedToImmutableDB RealPoint blk
pt ->
          Text
"This block has been garbage collected from the VolatileDB is now\
          \ found and streamed from the ImmutableDB. Block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
pt
        ChainDB.BlockGCedFromVolatileDB RealPoint blk
pt ->
          Text
"This block no longer in the VolatileDB and isn't in the ImmutableDB\
          \ either; it wasn't part of the current chain. Block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
pt
        TraceIteratorEvent blk
ChainDB.SwitchBackToVolatileDB ->  Text
"SwitchBackToVolatileDB"
      ChainDB.TraceImmutableDBEvent TraceEvent blk
_ev ->  Text
"TraceImmutableDBEvent"
      ChainDB.TraceVolatileDBEvent TraceEvent blk
_ev ->  Text
"TraceVolatileDBEvent"


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

instance ToObject BFT.BftValidationErr where
  toObject :: TracingVerbosity -> BftValidationErr -> Object
toObject TracingVerbosity
_verb (BFT.BftInvalidSignature String
err) =
    [(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
"BftInvalidSignature"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack String
err)
      ]


instance ToObject LedgerDB.DiskSnapshot where
  toObject :: TracingVerbosity -> DiskSnapshot -> Object
toObject TracingVerbosity
MinimalVerbosity DiskSnapshot
snap = TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
NormalVerbosity DiskSnapshot
snap
  toObject TracingVerbosity
NormalVerbosity DiskSnapshot
_ = [(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
"snapshot" ]
  toObject TracingVerbosity
MaximalVerbosity DiskSnapshot
snap =
    [(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
"snapshot"
             , Text
"snapshot" 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
$ DiskSnapshot -> String
forall a. Show a => a -> String
show DiskSnapshot
snap) ]


instance ( StandardHash blk
         , ToObject (LedgerError blk)
         , ToObject (OtherHeaderEnvelopeError blk)
         , ToObject (ValidationErr (BlockProtocol blk)))
      => ToObject (ExtValidationError blk) where
  toObject :: TracingVerbosity -> ExtValidationError blk -> Object
toObject TracingVerbosity
verb (ExtValidationErrorLedger LedgerError blk
err) = TracingVerbosity -> LedgerError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb LedgerError blk
err
  toObject TracingVerbosity
verb (ExtValidationErrorHeader HeaderError blk
err) = TracingVerbosity -> HeaderError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb HeaderError blk
err


instance ( StandardHash blk
         , ToObject (OtherHeaderEnvelopeError blk)
         )
      => ToObject (HeaderEnvelopeError blk) where
  toObject :: TracingVerbosity -> HeaderEnvelopeError blk -> Object
toObject TracingVerbosity
_verb (UnexpectedBlockNo BlockNo
expect BlockNo
act) =
    [(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
"UnexpectedBlockNo"
      , Text
"expected" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockNo -> String
forall a. Condense a => a -> String
condense BlockNo
expect
      , Text
"actual" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockNo -> String
forall a. Condense a => a -> String
condense BlockNo
act
      ]
  toObject TracingVerbosity
_verb (UnexpectedSlotNo SlotNo
expect SlotNo
act) =
    [(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
"UnexpectedSlotNo"
      , Text
"expected" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
expect
      , Text
"actual" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
act
      ]
  toObject TracingVerbosity
_verb (UnexpectedPrevHash WithOrigin (HeaderHash blk)
expect ChainHash blk
act) =
    [(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
"UnexpectedPrevHash"
      , Text
"expected" 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
$ WithOrigin (HeaderHash blk) -> String
forall a. Show a => a -> String
show WithOrigin (HeaderHash blk)
expect)
      , Text
"actual" 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
$ ChainHash blk -> String
forall a. Show a => a -> String
show ChainHash blk
act)
      ]
  toObject TracingVerbosity
verb (OtherHeaderEnvelopeError OtherHeaderEnvelopeError blk
err) =
    TracingVerbosity -> OtherHeaderEnvelopeError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb OtherHeaderEnvelopeError blk
err


instance ( StandardHash blk
         , ToObject (ValidationErr (BlockProtocol blk))
         , ToObject (OtherHeaderEnvelopeError blk)
         )
      => ToObject (HeaderError blk) where
  toObject :: TracingVerbosity -> HeaderError blk -> Object
toObject TracingVerbosity
verb (HeaderProtocolError ValidationErr (BlockProtocol blk)
err) =
    [(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
"HeaderProtocolError"
      , Text
"error" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> ValidationErr (BlockProtocol blk) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb ValidationErr (BlockProtocol blk)
err
      ]
  toObject TracingVerbosity
verb (HeaderEnvelopeError HeaderEnvelopeError blk
err) =
    [(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
"HeaderEnvelopeError"
      , Text
"error" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> HeaderEnvelopeError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb HeaderEnvelopeError blk
err
      ]


instance ( ConvertRawHash blk
         , StandardHash blk
         , ToObject (LedgerError blk)
         , ToObject (OtherHeaderEnvelopeError blk)
         , ToObject (ValidationErr (BlockProtocol blk)))
      => ToObject (ChainDB.InvalidBlockReason blk) where
  toObject :: TracingVerbosity -> InvalidBlockReason blk -> Object
toObject TracingVerbosity
verb (ChainDB.ValidationError ExtValidationError blk
extvalerr) =
    [(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
"ValidationError"
      , Text
"error" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> ExtValidationError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb ExtValidationError blk
extvalerr
      ]
  toObject TracingVerbosity
verb (ChainDB.InFutureExceedsClockSkew RealPoint blk
point) =
    [(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
"InFutureExceedsClockSkew"
      , Text
"point" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
point
      ]


instance (Show (PBFT.PBftVerKeyHash c))
      => ToObject (PBFT.PBftValidationErr c) where
  toObject :: TracingVerbosity -> PBftValidationErr c -> Object
toObject TracingVerbosity
_verb (PBFT.PBftInvalidSignature Text
text) =
    [(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
"PBftInvalidSignature"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
text
      ]
  toObject TracingVerbosity
_verb (PBFT.PBftNotGenesisDelegate PBftVerKeyHash c
vkhash PBftLedgerView c
_ledgerView) =
    [(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
"PBftNotGenesisDelegate"
      , Text
"vk" 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
$ PBftVerKeyHash c -> String
forall a. Show a => a -> String
show PBftVerKeyHash c
vkhash)
      ]
  toObject TracingVerbosity
_verb (PBFT.PBftExceededSignThreshold PBftVerKeyHash c
vkhash Word64
numForged) =
    [(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
"PBftExceededSignThreshold"
      , Text
"vk" 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
$ PBftVerKeyHash c -> String
forall a. Show a => a -> String
show PBftVerKeyHash c
vkhash)
      , Text
"numForged" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
pack (Word64 -> String
forall a. Show a => a -> String
show Word64
numForged))
      ]
  toObject TracingVerbosity
_verb PBftValidationErr c
PBFT.PBftInvalidSlot =
    [(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
"PBftInvalidSlot"
      ]


instance (Show (PBFT.PBftVerKeyHash c))
      => ToObject (PBFT.PBftCannotForge c) where
  toObject :: TracingVerbosity -> PBftCannotForge c -> Object
toObject TracingVerbosity
_verb (PBFT.PBftCannotForgeInvalidDelegation PBftVerKeyHash c
vkhash) =
    [(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
"PBftCannotForgeInvalidDelegation"
      , Text
"vk" 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
$ PBftVerKeyHash c -> String
forall a. Show a => a -> String
show PBftVerKeyHash c
vkhash)
      ]
  toObject TracingVerbosity
_verb (PBFT.PBftCannotForgeThresholdExceeded Word64
numForged) =
    [(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
"PBftCannotForgeThresholdExceeded"
      , Text
"numForged" Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
numForged
      ]


instance ConvertRawHash blk
      => ToObject (RealPoint blk) where
  toObject :: TracingVerbosity -> RealPoint blk -> Object
toObject TracingVerbosity
verb RealPoint blk
p = [(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
"Point"
        , Text
"slot" Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo -> Word64
unSlotNo (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
p)
        , Text
"hash" 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 (RealPoint blk -> HeaderHash blk
forall blk. RealPoint blk -> HeaderHash blk
realPointHash RealPoint blk
p) ]


instance (ToObject (LedgerUpdate blk), ToObject (LedgerWarning blk))
      => ToObject (LedgerEvent blk) where
  toObject :: TracingVerbosity -> LedgerEvent blk -> Object
toObject TracingVerbosity
verb = \case
    LedgerUpdate  LedgerUpdate blk
update  -> TracingVerbosity -> LedgerUpdate blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb LedgerUpdate blk
update
    LedgerWarning LedgerWarning blk
warning -> TracingVerbosity -> LedgerWarning blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb LedgerWarning blk
warning


instance ( ConvertRawHash blk
         , LedgerSupportsProtocol blk
         , ToObject (Header blk)
         , ToObject (LedgerEvent blk))
      => ToObject (ChainDB.TraceEvent blk) where
  toObject :: TracingVerbosity -> TraceEvent blk -> Object
toObject TracingVerbosity
verb (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev) = case TraceAddBlockEvent blk
ev of
    ChainDB.IgnoreBlockOlderThanK RealPoint blk
pt ->
      [(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
"TraceAddBlockEvent.IgnoreBlockOlderThanK"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.IgnoreBlockAlreadyInVolatileDB RealPoint blk
pt ->
      [(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
"TraceAddBlockEvent.IgnoreBlockAlreadyInVolatileDB"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.IgnoreInvalidBlock RealPoint blk
pt InvalidBlockReason blk
reason ->
      [(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
"TraceAddBlockEvent.IgnoreInvalidBlock"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Text
"reason" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InvalidBlockReason blk -> String
forall a. Show a => a -> String
show InvalidBlockReason blk
reason ]
    ChainDB.AddedBlockToQueue RealPoint blk
pt Word
sz ->
      [(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
"TraceAddBlockEvent.AddedBlockToQueue"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Text
"queueSize" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
sz ]
    ChainDB.BlockInTheFuture RealPoint blk
pt 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
"TraceAddBlockEvent.BlockInTheFuture"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Text
"slot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ]
    ChainDB.StoreButDontChange RealPoint blk
pt ->
      [(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
"TraceAddBlockEvent.StoreButDontChange"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.TryAddToCurrentChain RealPoint blk
pt ->
      [(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
"TraceAddBlockEvent.TryAddToCurrentChain"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.TrySwitchToAFork RealPoint blk
pt ChainDiff (HeaderFields 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
"TraceAddBlockEvent.TrySwitchToAFork"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
               [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddedToCurrentChain"
               , Text
"newtip" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
extended)
               , Text
"chainLengthDelta" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AnchoredFragment (Header blk)
extended AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> Int
`chainLengthΔ` AnchoredFragment (Header blk)
base
               ]
            [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"headers" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON (TracingVerbosity -> Header blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb (Header blk -> Object) -> [Header blk] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`map` AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> [Header blk]
addedHdrsNewChain AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended)
               | TracingVerbosity
verb TracingVerbosity -> TracingVerbosity -> Bool
forall a. Eq a => a -> a -> Bool
== TracingVerbosity
MaximalVerbosity ]
            [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"events" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> LedgerEvent blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events) ]
    ChainDB.SwitchedToAFork [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
old AnchoredFragment (Header blk)
new ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
               [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.SwitchedToAFork"
               , Text
"newtip" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
new)
               , Text
"chainLengthDelta" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AnchoredFragment (Header blk)
new AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> Int
`chainLengthΔ` AnchoredFragment (Header blk)
old
               ]
            [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"headers" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON (TracingVerbosity -> Header blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb (Header blk -> Object) -> [Header blk] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`map` AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> [Header blk]
addedHdrsNewChain AnchoredFragment (Header blk)
old AnchoredFragment (Header blk)
new)
               | TracingVerbosity
verb TracingVerbosity -> TracingVerbosity -> Bool
forall a. Eq a => a -> a -> Bool
== TracingVerbosity
MaximalVerbosity ]
            [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"events" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> LedgerEvent blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events) ]
    ChainDB.AddBlockValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock ExtValidationError blk
err RealPoint blk
pt ->
        [(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
"TraceAddBlockEvent.AddBlockValidation.InvalidBlock"
                 , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
                 , Text
"error" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ExtValidationError blk -> String
forall a. Show a => a -> String
show ExtValidationError blk
err ]
      ChainDB.InvalidCandidate AnchoredFragment (Header blk)
c ->
        [(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
"TraceAddBlockEvent.AddBlockValidation.InvalidCandidate"
                 , Text
"block" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) ]
      ChainDB.ValidCandidate AnchoredFragment (Header blk)
c ->
        [(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
"TraceAddBlockEvent.AddBlockValidation.ValidCandidate"
                 , Text
"block" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) ]
      ChainDB.CandidateContainsFutureBlocks AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
        [(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
"TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocks"
                 , Text
"block"   Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
                 , Text
"headers" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs ]
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
        [(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
"TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew"
                 , Text
"block"   Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
                 , Text
"headers" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs ]
    ChainDB.AddedBlockToVolatileDB RealPoint blk
pt (BlockNo Word64
bn) IsEBB
_ ->
      [(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
"TraceAddBlockEvent.AddedBlockToVolatileDB"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Text
"blockNo" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> String
forall a. Show a => a -> String
show Word64
bn ]
    ChainDB.ChainSelectionForFutureBlock RealPoint blk
pt ->
      [(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
"TraceAddBlockEvent.ChainSelectionForFutureBlock"
               , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
   where
     addedHdrsNewChain
       :: AF.AnchoredFragment (Header blk)
       -> AF.AnchoredFragment (Header blk)
       -> [Header blk]
     addedHdrsNewChain :: AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> [Header blk]
addedHdrsNewChain AnchoredFragment (Header blk)
fro AnchoredFragment (Header blk)
to_ =
       case AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Maybe
     (AnchoredFragment (Header blk), AnchoredFragment (Header blk),
      AnchoredFragment (Header blk), AnchoredFragment (Header blk))
forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
AF.intersect AnchoredFragment (Header blk)
fro AnchoredFragment (Header blk)
to_ of
         Just (AnchoredFragment (Header blk)
_, AnchoredFragment (Header blk)
_, AnchoredFragment (Header blk)
_, AnchoredFragment (Header blk)
s2 :: AF.AnchoredFragment (Header blk)) ->
           AnchoredFragment (Header blk) -> [Header blk]
forall v a b. AnchoredSeq v a b -> [b]
AF.toOldestFirst AnchoredFragment (Header blk)
s2
         Maybe
  (AnchoredFragment (Header blk), AnchoredFragment (Header blk),
   AnchoredFragment (Header blk), AnchoredFragment (Header blk))
Nothing -> [] -- No sense to do validation here.
     chainLengthΔ :: AF.AnchoredFragment (Header blk) -> AF.AnchoredFragment (Header blk) -> Int
     chainLengthΔ :: AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> Int
chainLengthΔ = (Int -> Int -> Int)
-> (AnchoredFragment (Header blk) -> Int)
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) (Int -> WithOrigin Int -> Int
forall t. t -> WithOrigin t -> t
fromWithOrigin (-Int
1) (WithOrigin Int -> Int)
-> (AnchoredFragment (Header blk) -> WithOrigin Int)
-> AnchoredFragment (Header blk)
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BlockNo -> Int) -> WithOrigin BlockNo -> WithOrigin Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (BlockNo -> Word64) -> BlockNo -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockNo -> Word64
unBlockNo) (WithOrigin BlockNo -> WithOrigin Int)
-> (AnchoredFragment (Header blk) -> WithOrigin BlockNo)
-> AnchoredFragment (Header blk)
-> WithOrigin Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnchoredFragment (Header blk) -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo)
  toObject TracingVerbosity
MinimalVerbosity (ChainDB.TraceLedgerReplayEvent TraceLedgerReplayEvent blk
_ev) = Object
forall a. ToObject a => HashMap Text a
emptyObject -- no output
  toObject TracingVerbosity
verb (ChainDB.TraceLedgerReplayEvent TraceLedgerReplayEvent blk
ev) = case TraceLedgerReplayEvent blk
ev of
    LedgerDB.ReplayFromGenesis Point blk
_replayTo ->
      [(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
"TraceLedgerReplayEvent.ReplayFromGenesis" ]
    LedgerDB.ReplayFromSnapshot DiskSnapshot
snap RealPoint blk
tip' Point blk
_replayTo ->
      [(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
"TraceLedgerReplayEvent.ReplayFromSnapshot"
               , Text
"snapshot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Text
"tip" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RealPoint blk -> String
forall a. Show a => a -> String
show RealPoint blk
tip' ]
    LedgerDB.ReplayedBlock RealPoint blk
pt [LedgerEvent blk]
_ledgerEvents Point blk
replayTo ->
      [(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
"TraceLedgerReplayEvent.ReplayedBlock"
               , Text
"slot" Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo -> Word64
unSlotNo (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
pt)
               , Text
"tip"  Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> (SlotNo -> Word64) -> WithOrigin SlotNo -> Word64
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin Word64
0 SlotNo -> Word64
unSlotNo (Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point blk
replayTo) ]

  toObject TracingVerbosity
MinimalVerbosity (ChainDB.TraceLedgerEvent TraceEvent blk
_ev) = Object
forall a. ToObject a => HashMap Text a
emptyObject -- no output
  toObject TracingVerbosity
verb (ChainDB.TraceLedgerEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt ->
      [(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
"TraceLedgerEvent.TookSnapshot"
               , Text
"snapshot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Text
"tip" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RealPoint blk -> String
forall a. Show a => a -> String
show RealPoint blk
pt ]
    LedgerDB.DeletedSnapshot DiskSnapshot
snap ->
      [(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
"TraceLedgerEvent.DeletedSnapshot"
               , Text
"snapshot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap ]
    LedgerDB.InvalidSnapshot DiskSnapshot
snap InitFailure blk
failure ->
      [(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
"TraceLedgerEvent.InvalidSnapshot"
               , Text
"snapshot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Text
"failure" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InitFailure blk -> String
forall a. Show a => a -> String
show InitFailure blk
failure ]

  toObject TracingVerbosity
verb (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev) = case TraceCopyToImmutableDBEvent blk
ev of
    ChainDB.CopiedBlockToImmutableDB Point blk
pt ->
      [(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
"TraceCopyToImmutableDBEvent.CopiedBlockToImmutableDB"
               , Text
"slot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
pt ]
    TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB ->
      [(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
"TraceCopyToImmutableDBEvent.NoBlocksToCopyToImmutableDB" ]

  toObject TracingVerbosity
verb (ChainDB.TraceGCEvent TraceGCEvent blk
ev) = case TraceGCEvent blk
ev of
    ChainDB.PerformedGC 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
"TraceGCEvent.PerformedGC"
               , Text
"slot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ]
    ChainDB.ScheduledGC SlotNo
slot Time
difft ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TraceGCEvent.ScheduledGC"
                 , Text
"slot" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<>
                 [ Text
"difft" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((String -> Text
pack (String -> Text) -> (Time -> String) -> Time -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Time -> String
forall a. Show a => a -> String
show) Time
difft) | TracingVerbosity
verb TracingVerbosity -> TracingVerbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= TracingVerbosity
MaximalVerbosity]

  toObject TracingVerbosity
verb (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev) = case TraceOpenEvent blk
ev of
    ChainDB.OpenedDB Point blk
immTip Point blk
tip' ->
      [(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
"TraceOpenEvent.OpenedDB"
               , Text
"immtip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Text
"tip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
tip' ]
    ChainDB.ClosedDB Point blk
immTip Point blk
tip' ->
      [(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
"TraceOpenEvent.ClosedDB"
               , Text
"immtip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Text
"tip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
tip' ]
    ChainDB.OpenedImmutableDB Point blk
immTip ChunkNo
epoch ->
      [(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
"TraceOpenEvent.OpenedImmutableDB"
               , Text
"immtip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Text
"epoch" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((String -> Text
pack (String -> Text) -> (ChunkNo -> String) -> ChunkNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ChunkNo -> String
forall a. Show a => a -> String
show) ChunkNo
epoch) ]
    TraceOpenEvent blk
ChainDB.OpenedVolatileDB ->
      [(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
"TraceOpenEvent.OpenedVolatileDB" ]
    TraceOpenEvent blk
ChainDB.OpenedLgrDB ->
      [(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
"TraceOpenEvent.OpenedLgrDB" ]

  toObject TracingVerbosity
_verb (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev) = case TraceFollowerEvent blk
ev of
    TraceFollowerEvent blk
ChainDB.NewFollower ->
      [(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
"TraceFollowerEvent.NewFollower" ]
    ChainDB.FollowerNoLongerInMem FollowerRollState 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
"TraceFollowerEvent.FollowerNoLongerInMem" ]
    ChainDB.FollowerSwitchToMem Point blk
_ WithOrigin SlotNo
_ ->
      [(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
"TraceFollowerEvent.FollowerSwitchToMem" ]
    ChainDB.FollowerNewImmIterator Point blk
_ WithOrigin SlotNo
_ ->
      [(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
"TraceFollowerEvent.FollowerNewImmIterator" ]
  toObject TracingVerbosity
verb (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev) = case TraceInitChainSelEvent blk
ev of
    ChainDB.InitChainSelValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock ExtValidationError blk
err RealPoint blk
pt ->
         [(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
"TraceInitChainSelEvent.InvalidBlock"
                  , Text
"block" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
                  , Text
"error" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ExtValidationError blk -> String
forall a. Show a => a -> String
show ExtValidationError blk
err ]
      ChainDB.InvalidCandidate AnchoredFragment (Header blk)
c ->
        [(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
"TraceInitChainSelEvent.InvalidCandidate"
                 , Text
"block" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) ]
      ChainDB.ValidCandidate AnchoredFragment (Header blk)
c ->
        [(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
"TraceInitChainSelEvent.ValidCandidate"
                 , Text
"block" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) ]
      ChainDB.CandidateContainsFutureBlocks AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
        [(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
"TraceInitChainSelEvent.CandidateContainsFutureBlocks"
                 , Text
"block"   Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
                 , Text
"headers" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs ]
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew AnchoredFragment (Header blk)
c [Header blk]
hdrs ->
        [(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
"TraceInitChainSelEvent.CandidateContainsFutureBlocksExceedingClockSkew"
                 , Text
"block"   Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c)
                 , Text
"headers" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Header blk -> Text) -> [Header blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Point blk -> Text)
-> (Header blk -> Point blk) -> Header blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint) [Header blk]
hdrs ]
  toObject TracingVerbosity
_verb (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev) = case TraceIteratorEvent blk
ev of
    ChainDB.UnknownRangeRequested UnknownRange blk
unkRange ->
      [(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
"TraceIteratorEvent.UnknownRangeRequested"
               , Text
"range" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (UnknownRange blk -> Text
forall a. Show a => a -> Text
showT UnknownRange blk
unkRange)
               ]
    ChainDB.StreamFromVolatileDB StreamFrom blk
streamFrom StreamTo blk
streamTo [RealPoint blk]
realPt ->
      [(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
"TraceIteratorEvent.StreamFromVolatileDB"
               , Text
"from" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Text
"to" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
streamTo)
               , Text
"point" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
Text.pack (String -> Text) -> ([Text] -> String) -> [Text] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> String
forall a. Show a => a -> String
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint [RealPoint blk]
realPt)
               ]
    ChainDB.StreamFromImmutableDB StreamFrom blk
streamFrom StreamTo blk
streamTo ->
      [(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
"TraceIteratorEvent.StreamFromImmutableDB"
               , Text
"from" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Text
"to" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
streamTo)
               ]
    ChainDB.StreamFromBoth StreamFrom blk
streamFrom StreamTo blk
streamTo [RealPoint blk]
realPt ->
      [(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
"TraceIteratorEvent.StreamFromBoth"
               , Text
"from" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Text
"to" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
streamTo)
               , Text
"point" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
Text.pack (String -> Text) -> ([Text] -> String) -> [Text] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> String
forall a. Show a => a -> String
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint [RealPoint blk]
realPt)
               ]
    ChainDB.BlockMissingFromVolatileDB RealPoint blk
realPt ->
      [(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
"TraceIteratorEvent.BlockMissingFromVolatileDB"
               , Text
"point" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    ChainDB.BlockWasCopiedToImmutableDB RealPoint blk
realPt ->
      [(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
"TraceIteratorEvent.BlockWasCopiedToImmutableDB"
               , Text
"point" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    ChainDB.BlockGCedFromVolatileDB RealPoint blk
realPt ->
      [(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
"TraceIteratorEvent.BlockGCedFromVolatileDB"
               , Text
"point" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    TraceIteratorEvent blk
ChainDB.SwitchBackToVolatileDB ->
      [(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
"TraceIteratorEvent.SwitchBackToVolatileDB"
               ]
  toObject TracingVerbosity
verb (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    TraceEvent blk
ImmDB.NoValidLastLocation -> [(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
"TraceImmutableDBEvent.NoValidLastLocation" ]
    ImmDB.ValidatedLastLocation ChunkNo
chunkNo Tip blk
immTip ->
      [(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
"TraceImmutableDBEvent.ValidatedLastLocation"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Text
"immTip" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Tip blk -> Text
forall blk. StandardHash blk => Tip blk -> Text
renderTipHash Tip blk
immTip)
               , Text
"blockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Tip blk -> Text
forall blk. Tip blk -> Text
renderTipBlockNo Tip blk
immTip)
               ]
    ImmDB.ValidatingChunk ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.ValidatingChunk"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.MissingChunkFile ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.MissingChunkFile"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidChunkFile ChunkNo
chunkNo (ImmDB.ChunkErrRead ReadIncrementalErr
readIncErr) ->
      [(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
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ReadIncrementalErr -> Text
forall a. Show a => a -> Text
showT ReadIncrementalErr
readIncErr)
               ]
    ImmDB.InvalidChunkFile ChunkNo
chunkNo (ImmDB.ChunkErrHashMismatch HeaderHash blk
hashPrevBlock ChainHash blk
prevHashOfBlock) ->
      [(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
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Text
"hashPrevBlock" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall a b. (a -> b) -> a -> b
$ HeaderHash blk
hashPrevBlock)
               , Text
"prevHashOfBlock" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((HeaderHash blk -> Text) -> ChainHash blk -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)) ChainHash blk
prevHashOfBlock)
               ]
    ImmDB.InvalidChunkFile ChunkNo
chunkNo (ImmDB.ChunkErrCorrupt Point blk
pt) ->
      [(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
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Text
"block" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
pt)
               ]
    ImmDB.ChunkFileDoesntFit ChainHash blk
expectPrevHash ChainHash blk
actualPrevHash ->
      [(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
"TraceImmutableDBEvent.ChunkFileDoesntFit"
               , Text
"expectedPrevHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((HeaderHash blk -> Text) -> ChainHash blk -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)) ChainHash blk
expectPrevHash)
               , Text
"actualPrevHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((HeaderHash blk -> Text) -> ChainHash blk -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)) ChainHash blk
actualPrevHash)
               ]
    ImmDB.MissingPrimaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.MissingPrimaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.MissingSecondaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.MissingSecondaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidPrimaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.InvalidPrimaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidSecondaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.InvalidSecondaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.RewritePrimaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.RewritePrimaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.RewriteSecondaryIndex ChunkNo
chunkNo ->
      [(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
"TraceImmutableDBEvent.RewriteSecondaryIndex"
               , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.Migrating Text
txt ->
      [(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
"TraceImmutableDBEvent.Migrating"
               , Text
"info" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
txt
               ]
    ImmDB.DeletingAfter WithOrigin (Tip blk)
immTipWithInfo ->
      [(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
"TraceImmutableDBEvent.DeletingAfter"
               , Text
"immTipHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((Tip blk -> Text) -> WithOrigin (Tip blk) -> Text
forall a. (a -> Text) -> WithOrigin a -> Text
renderWithOrigin Tip blk -> Text
forall blk. StandardHash blk => Tip blk -> Text
renderTipHash WithOrigin (Tip blk)
immTipWithInfo)
               , Text
"immTipBlockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((Tip blk -> Text) -> WithOrigin (Tip blk) -> Text
forall a. (a -> Text) -> WithOrigin a -> Text
renderWithOrigin Tip blk -> Text
forall blk. Tip blk -> Text
renderTipBlockNo WithOrigin (Tip blk)
immTipWithInfo)
               ]
    TraceEvent blk
ImmDB.DBAlreadyClosed -> [(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
"TraceImmutableDBEvent.DBAlreadyClosed" ]
    TraceEvent blk
ImmDB.DBClosed -> [(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
"TraceImmutableDBEvent.DBClosed" ]
    ImmDB.TraceCacheEvent TraceCacheEvent
cacheEv ->
      case TraceCacheEvent
cacheEv of
        ImmDB.TraceCurrentChunkHit ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [(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
"TraceImmDbEvent.TraceCacheEvent.TraceCurrentChunkHit"
                   , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Text
"noPastChunks" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkHit ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [(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
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkHit"
                   , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Text
"noPastChunks" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkMiss ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [(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
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkMiss"
                   , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Text
"noPastChunks" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkEvict ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [(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
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkEvict"
                   , Text
"chunkNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Text
"noPastChunks" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunksExpired [ChunkNo]
chunkNos Word32
nbPastChunksInCache ->
          [(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
"TraceImmDbEvent.TraceCacheEvent.TracePastChunksExpired"
                   , Text
"chunkNos" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
Text.pack (String -> Text) -> ([Text] -> String) -> [Text] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> String
forall a. Show a => a -> String
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ChunkNo -> Text) -> [ChunkNo] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ChunkNo -> Text
renderChunkNo [ChunkNo]
chunkNos)
                   , Text
"noPastChunks" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
  toObject TracingVerbosity
_verb (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    TraceEvent blk
VolDb.DBAlreadyClosed -> [(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
"TraceVolatileDbEvent.DBAlreadyClosed"]
    TraceEvent blk
VolDb.DBAlreadyOpen -> [(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
"TraceVolatileDbEvent.DBAlreadyOpen"]
    VolDb.BlockAlreadyHere HeaderHash blk
blockId ->
      [(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
"TraceVolatileDbEvent.BlockAlreadyHere"
               , Text
"blockId" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (HeaderHash blk -> Text
forall a. Show a => a -> Text
showT HeaderHash blk
blockId)
               ]
    VolDb.TruncateCurrentFile FsPath
fsPath ->
      [(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
"TraceVolatileDbEvent.TruncateCurrentFile"
               , Text
"file" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (FsPath -> Text
forall a. Show a => a -> Text
showT FsPath
fsPath)
               ]
    VolDb.Truncate ParseError blk
pErr FsPath
fsPath BlockOffset
blockOffset ->
      [(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
"TraceVolatileDbEvent.Truncate"
               , Text
"parserError" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ParseError blk -> Text
forall a. Show a => a -> Text
showT ParseError blk
pErr)
               , Text
"file" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (FsPath -> Text
forall a. Show a => a -> Text
showT FsPath
fsPath)
               , Text
"blockOffset" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (BlockOffset -> Text
forall a. Show a => a -> Text
showT BlockOffset
blockOffset)
               ]
    VolDb.InvalidFileNames [FsPath]
fsPaths ->
      [(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
"TraceVolatileDBEvent.InvalidFileNames"
               , Text
"files" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
Text.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [String] -> String
forall a. Show a => a -> String
show ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ (FsPath -> String) -> [FsPath] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map FsPath -> String
forall a. Show a => a -> String
show [FsPath]
fsPaths)
               ]

instance ConvertRawHash blk => ToObject (TraceBlockFetchServerEvent blk) where
  toObject :: TracingVerbosity -> TraceBlockFetchServerEvent blk -> Object
toObject TracingVerbosity
_verb (TraceBlockFetchServerSendBlock Point blk
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
"TraceBlockFetchServerSendBlock"
             , Text
"block" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((HeaderHash blk -> Text) -> ChainHash blk -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash @blk (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)) (ChainHash blk -> Text) -> ChainHash blk -> Text
forall a b. (a -> b) -> a -> b
$ Point blk -> ChainHash blk
forall block. Point block -> ChainHash block
pointHash Point blk
blk)
             ]

tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject :: Tip blk -> [(Text, Value)]
tipToObject = \case
  Tip blk
TipGenesis ->
    [ Text
"slot"    Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int
0 :: Int)
    , Text
"block"   Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"genesis"
    , Text
"blockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ((-Int
1) :: Int)
    ]
  Tip SlotNo
slot HeaderHash blk
hash BlockNo
blockno ->
    [ Text
"slot"    Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
    , Text
"block"   Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (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) HeaderHash blk
hash)
    , Text
"blockNo" Text -> BlockNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockNo
blockno
    ]

instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
      => ToObject (TraceChainSyncClientEvent blk) where
  toObject :: TracingVerbosity -> TraceChainSyncClientEvent blk -> Object
toObject TracingVerbosity
verb TraceChainSyncClientEvent blk
ev = case TraceChainSyncClientEvent blk
ev of
    TraceDownloadedHeader Header blk
h ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
               [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceDownloadedHeader"
               ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> Tip (Header blk) -> [(Text, Value)]
forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject (Header blk -> Tip (Header blk)
forall a. HasHeader a => a -> Tip a
tipFromHeader Header blk
h)
    TraceRolledBack Point blk
tip ->
      [(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
"ChainSyncClientEvent.TraceRolledBack"
               , Text
"tip" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
tip ]
    TraceException ChainSyncClientException
exc ->
      [(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
"ChainSyncClientEvent.TraceException"
               , Text
"exception" 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
$ ChainSyncClientException -> String
forall a. Show a => a -> String
show ChainSyncClientException
exc) ]
    TraceFoundIntersection Point blk
_ Our (Tip blk)
_ Their (Tip 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
"ChainSyncClientEvent.TraceFoundIntersection" ]
    TraceTermination ChainSyncClientResult
_ ->
      [(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
"ChainSyncClientEvent.TraceTermination" ]

instance ConvertRawHash blk
      => ToObject (TraceChainSyncServerEvent blk) where
  toObject :: TracingVerbosity -> TraceChainSyncServerEvent blk -> Object
toObject TracingVerbosity
verb TraceChainSyncServerEvent blk
ev = case TraceChainSyncServerEvent blk
ev of
    TraceChainSyncServerRead Tip blk
tip AddBlock{} ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainSyncServerEvent.TraceChainSyncServerRead.AddBlock"
        ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> Tip blk -> [(Text, Value)]
forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject Tip blk
tip
    TraceChainSyncServerRead Tip blk
tip RollBack{} ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainSyncServerEvent.TraceChainSyncServerRead.RollBack"
        ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> Tip blk -> [(Text, Value)]
forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject Tip blk
tip
    TraceChainSyncServerReadBlocked Tip blk
tip AddBlock{} ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainSyncServerEvent.TraceChainSyncServerReadBlocked.AddBlock"
        ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> Tip blk -> [(Text, Value)]
forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject Tip blk
tip
    TraceChainSyncServerReadBlocked Tip blk
tip RollBack{} ->
      [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainSyncServerEvent.TraceChainSyncServerReadBlocked.RollBack"
        ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> Tip blk -> [(Text, Value)]
forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)]
tipToObject Tip blk
tip

    TraceChainSyncRollForward Point blk
point ->
      [(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
"ChainSyncServerEvent.TraceChainSyncRollForward"
               , Text
"point" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
point
               ]
    TraceChainSyncRollBackward Point blk
point ->
      [(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
"ChainSyncServerEvent.TraceChainSyncRollBackward"
               , Text
"point" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
point
               ]

instance ( Show (ApplyTxErr blk), ToObject (ApplyTxErr blk), ToObject (GenTx blk),
           ToJSON (GenTxId blk), LedgerSupportsMempool blk
         ) => ToObject (TraceEventMempool blk) where
  toObject :: TracingVerbosity -> TraceEventMempool blk -> Object
toObject TracingVerbosity
verb (TraceMempoolAddedTx Validated (GenTx blk)
tx MempoolSize
_mpSzBefore MempoolSize
mpSzAfter) =
    [(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
"TraceMempoolAddedTx"
      , Text
"tx" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> GenTx blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb (Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated Validated (GenTx blk)
tx)
      , Text
"mempoolSize" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> MempoolSize -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb MempoolSize
mpSzAfter
      ]
  toObject TracingVerbosity
verb (TraceMempoolRejectedTx GenTx blk
tx ApplyTxErr blk
txApplyErr MempoolSize
mpSz) =
    [(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
"TraceMempoolRejectedTx"
      , Text
"err" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> ApplyTxErr blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb ApplyTxErr blk
txApplyErr
      , Text
"tx" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> GenTx blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb GenTx blk
tx
      , Text
"mempoolSize" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> MempoolSize -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb MempoolSize
mpSz
      ]
  toObject TracingVerbosity
verb (TraceMempoolRemoveTxs [Validated (GenTx blk)]
txs MempoolSize
mpSz) =
    [(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
"TraceMempoolRemoveTxs"
      , Text
"txs" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Validated (GenTx blk) -> Object)
-> [Validated (GenTx blk)] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> GenTx blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb (GenTx blk -> Object)
-> (Validated (GenTx blk) -> GenTx blk)
-> Validated (GenTx blk)
-> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated) [Validated (GenTx blk)]
txs
      , Text
"mempoolSize" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> MempoolSize -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb MempoolSize
mpSz
      ]
  toObject TracingVerbosity
verb (TraceMempoolManuallyRemovedTxs [GenTxId blk]
txs0 [Validated (GenTx blk)]
txs1 MempoolSize
mpSz) =
    [(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
"TraceMempoolManuallyRemovedTxs"
      , Text
"txsRemoved" Text -> [GenTxId blk] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [GenTxId blk]
txs0
      , Text
"txsInvalidated" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Validated (GenTx blk) -> Object)
-> [Validated (GenTx blk)] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> GenTx blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb (GenTx blk -> Object)
-> (Validated (GenTx blk) -> GenTx blk)
-> Validated (GenTx blk)
-> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated) [Validated (GenTx blk)]
txs1
      , Text
"mempoolSize" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> MempoolSize -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb MempoolSize
mpSz
      ]

instance ToObject MempoolSize where
  toObject :: TracingVerbosity -> MempoolSize -> Object
toObject TracingVerbosity
_verb MempoolSize{Word32
msNumTxs :: MempoolSize -> Word32
msNumTxs :: Word32
msNumTxs, Word32
msNumBytes :: MempoolSize -> Word32
msNumBytes :: Word32
msNumBytes} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"numTxs" Text -> Word32 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
msNumTxs
      , Text
"bytes" Text -> Word32 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32
msNumBytes
      ]

instance HasTextFormatter () where
  formatText :: () -> Object -> Text
formatText ()
_ = 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

-- ForgeStateInfo default value = ()
instance Transformable Text IO () where
  trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO ()
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO ()
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasTextFormatter b, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructuredText

instance ( tx ~ GenTx blk
         , ConvertRawHash blk
         , HasTxId tx
         , RunNode blk
         , Show (TxId tx)
         , ToObject (LedgerError blk)
         , ToObject (OtherHeaderEnvelopeError blk)
         , ToObject (ValidationErr (BlockProtocol blk))
         , ToObject (CannotForge blk)
         , ToObject (ForgeStateUpdateError blk))
      => ToObject (TraceForgeEvent blk) where
  toObject :: TracingVerbosity -> TraceForgeEvent blk -> Object
toObject TracingVerbosity
_verb (TraceStartLeadershipCheck SlotNo
slotNo) =
    [(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
"TraceStartLeadershipCheck"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
verb (TraceSlotIsImmutable SlotNo
slotNo Point blk
tipPoint BlockNo
tipBlkNo) =
    [(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
"TraceSlotIsImmutable"
      , 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
slotNo)
      , Text
"tip" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
tipPoint
      , Text
"tipBlockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo BlockNo
tipBlkNo)
      ]
  toObject TracingVerbosity
_verb (TraceBlockFromFuture SlotNo
currentSlot SlotNo
tip) =
    [(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
"TraceBlockFromFuture"
      , Text
"current 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
currentSlot)
      , Text
"tip" 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
tip)
      ]
  toObject TracingVerbosity
verb (TraceBlockContext SlotNo
currentSlot BlockNo
tipBlkNo Point blk
tipPoint) =
    [(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
"TraceBlockContext"
      , Text
"current 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
currentSlot)
      , Text
"tip" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
tipPoint
      , Text
"tipBlockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo BlockNo
tipBlkNo)
      ]
  toObject TracingVerbosity
_verb (TraceNoLedgerState SlotNo
slotNo Point blk
_pt) =
    [(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
"TraceNoLedgerState"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceLedgerState SlotNo
slotNo Point blk
_pt) =
    [(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
"TraceLedgerState"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceNoLedgerView SlotNo
slotNo OutsideForecastRange
_) =
    [(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
"TraceNoLedgerView"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceLedgerView SlotNo
slotNo) =
    [(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
"TraceLedgerView"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
verb (TraceForgeStateUpdateError SlotNo
slotNo ForgeStateUpdateError blk
reason) =
    [(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
"TraceForgeStateUpdateError"
      , 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
slotNo)
      , Text
"reason" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> ForgeStateUpdateError blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb ForgeStateUpdateError blk
reason
      ]
  toObject TracingVerbosity
verb (TraceNodeCannotForge SlotNo
slotNo CannotForge blk
reason) =
    [(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
"TraceNodeCannotForge"
      , 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
slotNo)
      , Text
"reason" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> CannotForge blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb CannotForge blk
reason
      ]
  toObject TracingVerbosity
_verb (TraceNodeNotLeader SlotNo
slotNo) =
    [(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
"TraceNodeNotLeader"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceNodeIsLeader SlotNo
slotNo) =
    [(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
"TraceNodeIsLeader"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceForgedBlock SlotNo
slotNo Point blk
_ blk
blk MempoolSize
_) =
    [(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
"TraceForgedBlock"
      , 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
slotNo)
      , Text
"block"     Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (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) (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall a b. (a -> b) -> a -> b
$ blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
      , Text
"blockNo"   Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> BlockNo -> Word64
forall a b. (a -> b) -> a -> b
$ blk -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo blk
blk)
      , Text
"blockPrev" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String ((HeaderHash blk -> Text) -> ChainHash blk -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash @blk (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)) (ChainHash blk -> Text) -> ChainHash blk -> Text
forall a b. (a -> b) -> a -> b
$ blk -> ChainHash blk
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash blk
blk)
      ]
  toObject TracingVerbosity
_verb (TraceDidntAdoptBlock SlotNo
slotNo 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
"TraceDidntAdoptBlock"
      , 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
slotNo)
      ]
  toObject TracingVerbosity
verb (TraceForgedInvalidBlock SlotNo
slotNo blk
_ InvalidBlockReason blk
reason) =
    [(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
"TraceForgedInvalidBlock"
      , 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
slotNo)
      , Text
"reason" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> InvalidBlockReason blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb InvalidBlockReason blk
reason
      ]
  toObject TracingVerbosity
MaximalVerbosity (TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
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
"TraceAdoptedBlock"
      , 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
slotNo)
      , Text
"blockHash" 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
MaximalVerbosity
          (blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
      , Text
"blockSize" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (Header blk -> Word32
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> Word32
estimateBlockSize (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk))
      , Text
"txIds" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [String] -> Value
forall a. ToJSON a => a -> Value
toJSON ((Validated (GenTx blk) -> String)
-> [Validated (GenTx blk)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TxId (GenTx blk) -> String
forall a. Show a => a -> String
show (TxId (GenTx blk) -> String)
-> (Validated (GenTx blk) -> TxId (GenTx blk))
-> Validated (GenTx blk)
-> String
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 (GenTx blk -> TxId (GenTx blk))
-> (Validated (GenTx blk) -> GenTx blk)
-> Validated (GenTx blk)
-> TxId (GenTx blk)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated) [Validated (GenTx blk)]
txs)
      ]
  toObject TracingVerbosity
verb (TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
_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
"TraceAdoptedBlock"
      , 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
slotNo)
      , Text
"blockHash" 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
          (blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
      , Text
"blockSize" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (Header blk -> Word32
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> Word32
estimateBlockSize (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk))
      ]


instance ToObject (TraceLocalTxSubmissionServerEvent blk) where
  toObject :: TracingVerbosity -> TraceLocalTxSubmissionServerEvent blk -> Object
toObject TracingVerbosity
_verb TraceLocalTxSubmissionServerEvent 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
"TraceLocalTxSubmissionServerEvent" ]