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

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Tracing.OrphanInstances.Consensus () where

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

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

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

import           Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge,
                   ConvertRawHash (..), ForgeStateUpdateError, Header, RealPoint, blockNo,
                   blockPoint, blockPrevHash, getHeader, headerPoint, pointHash, realPointHash,
                   realPointSlot)
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 (BlockingType (..),
                   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           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..),
                   chunkNoToInt)
import           Ouroboros.Consensus.Storage.LedgerDB.Types
import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB
import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb
import           Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..))

import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.Enclose
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 Data.Aeson as Aeson
import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB
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.PoppedBlockFromQueue {} -> Severity
Debug
    ChainDB.BlockInTheFuture {} -> Severity
Info
    ChainDB.AddedBlockToVolatileDB {} -> Severity
Debug
    ChainDB.TryAddToCurrentChain {} -> Severity
Debug
    ChainDB.TrySwitchToAFork {} -> Severity
Info
    ChainDB.StoreButDontChange {} -> Severity
Debug
    ChainDB.ChangingSelection {} -> 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.ValidCandidate {} -> Severity
Info
      ChainDB.CandidateContainsFutureBlocks{} -> Severity
Debug
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{} -> Severity
Error
      ChainDB.UpdateLedgerDbTraceEvent {} -> Severity
Debug
    ChainDB.ChainSelectionForFutureBlock{} -> Severity
Debug
    ChainDB.PipeliningEvent {} -> Severity
Debug

  getSeverityAnnotation (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev) = case TraceReplayEvent 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
    TraceOpenEvent blk
ChainDB.StartedOpeningDB -> Severity
Info
    TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB -> Severity
Info
    TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB -> Severity
Info
    TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB -> 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.StartedInitChainSelection{} -> Severity
Info
    ChainDB.InitalChainSelected{} -> Severity
Info
    ChainDB.InitChainSelValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock{} -> Severity
Debug
      ChainDB.ValidCandidate {} -> Severity
Info
      ChainDB.CandidateContainsFutureBlocks {} -> Severity
Debug
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> Severity
Debug
      ChainDB.UpdateLedgerDbTraceEvent {} -> Severity
Info

  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) = case TraceEvent blk
ev of
    ImmDB.NoValidLastLocation {} -> Severity
Info
    ImmDB.ValidatedLastLocation {} -> Severity
Info
    ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev' -> case TraceChunkValidation blk ChunkNo
ev' of
      ImmDB.StartedValidatingChunk{} -> Severity
Info
      ImmDB.ValidatedChunk{}         -> Severity
Info
      ImmDB.MissingChunkFile{}       -> Severity
Warning
      ImmDB.InvalidChunkFile {}      -> Severity
Warning
      ImmDB.MissingPrimaryIndex{}    -> Severity
Warning
      ImmDB.MissingSecondaryIndex{}  -> Severity
Warning
      ImmDB.InvalidPrimaryIndex{}    -> Severity
Warning
      ImmDB.InvalidSecondaryIndex{}  -> Severity
Warning
      ImmDB.RewritePrimaryIndex{}    -> Severity
Warning
      ImmDB.RewriteSecondaryIndex{}  -> Severity
Warning
    ImmDB.ChunkFileDoesntFit{} -> Severity
Warning
    ImmDB.Migrating{}          -> Severity
Debug
    ImmDB.DeletingAfter{}      -> Severity
Debug
    ImmDB.DBAlreadyClosed{}    -> Severity
Error
    ImmDB.DBClosed{}           -> Severity
Info
    ImmDB.TraceCacheEvent{}    -> Severity
Debug
  getSeverityAnnotation (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    VolDb.DBAlreadyClosed{}     -> Severity
Error
    VolDb.BlockAlreadyHere{}    -> Severity
Debug
    VolDb.Truncate{}            -> Severity
Error
    VolDb.InvalidFileNames{}    -> Severity
Warning

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 (ToObject peer, ToObject (TraceChainSyncClientEvent blk))
    => Transformable Text IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk)) where
  trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk))
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk))
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
 HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured
instance (BlockSupportsProtocol blk, Show peer, Show (Header blk))
    => HasTextFormatter (TraceLabelPeer peer (TraceChainSyncClientEvent blk)) where
  formatText :: TraceLabelPeer peer (TraceChainSyncClientEvent blk)
-> Object -> Text
formatText TraceLabelPeer peer (TraceChainSyncClientEvent blk)
a Object
_ = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TraceLabelPeer peer (TraceChainSyncClientEvent blk) -> String
forall a. Show a => a -> String
show TraceLabelPeer peer (TraceChainSyncClientEvent blk)
a

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 TraceForgeTickedLedgerState {} = Severity
Debug
  getSeverityAnnotation TraceForgingMempoolSnapshot {} = Severity
Debug
  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), 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

instance Condense t => Condense (Enclosing' t) where
  condense :: Enclosing' t -> String
condense Enclosing' t
RisingEdge = String
"RisingEdge"
  condense (FallingEdgeWith t
a) = String
"FallingEdge: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> t -> String
forall a. Condense a => a -> String
condense t
a

deriving instance Generic (Enclosing' t)
instance ToJSON t => ToJSON (Enclosing' t)

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
         , 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)
    TraceForgeTickedLedgerState SlotNo
slotNo Point blk
prevPt -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"While forging 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
" we ticked the ledger state ahead from "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
prevPt
    TraceForgingMempoolSnapshot SlotNo
slotNo Point blk
prevPt ChainHash blk
mpHash SlotNo
mpSlot -> Text -> Object -> Text
forall a b. a -> b -> a
const (Text -> Object -> Text) -> Text -> Object -> Text
forall a b. (a -> b) -> a -> b
$
      Text
"While forging 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
" we acquired a mempool snapshot valid against "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
prevPt
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from a mempool that was prepared for "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (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
mpHash
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ticked to slot "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
mpSlot)
    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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"credentials" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
creds
            , Key
"val"         Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 Enclosing' Word
edgeSz ->
          case Enclosing' Word
edgeSz of
            Enclosing' Word
RisingEdge ->
              Text
"About to add block 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
            FallingEdgeWith 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.PoppedBlockFromQueue Enclosing' (RealPoint blk)
edgePt ->
          case Enclosing' (RealPoint blk)
edgePt of
            Enclosing' (RealPoint blk)
RisingEdge ->
              Text
"Popping block from queue"
            FallingEdgeWith RealPoint blk
pt ->
              Text
"Popped block from 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
        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.ChangingSelection Point blk
pt ->
          Text
"Changing selection to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point 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.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.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb  (LedgerDB.PushStart RealPoint blk
start) (LedgerDB.PushGoal RealPoint blk
goal) (LedgerDB.Pushing RealPoint blk
curr)) ->
            let fromSlot :: Word64
fromSlot = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
start
                atSlot :: Word64
atSlot   = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
curr
                atDiff :: Word64
atDiff   = Word64
atSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
                toSlot :: Word64
toSlot   = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
goal
                toDiff :: Word64
toDiff   = Word64
toSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
            in
              Text
"Pushing ledger state for block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
curr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Int -> Int -> Text
showProgressT (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
atDiff) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
toDiff) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
        ChainDB.AddedBlockToVolatileDB RealPoint blk
pt BlockNo
_ IsEBB
_ Enclosing
enclosing -> case Enclosing
enclosing of
          Enclosing
RisingEdge  -> Text
"Chain about to add 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
          Enclosing
FallingEdge -> 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.PipeliningEvent TracePipeliningEvent blk
ev' -> case TracePipeliningEvent blk
ev' of
          ChainDB.SetTentativeHeader Header blk
hdr Enclosing
enclosing -> case Enclosing
enclosing of
            Enclosing
RisingEdge  -> Text
"About to set tentative header to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
            Enclosing
FallingEdge -> Text
"Set tentative header to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
          ChainDB.TrapTentativeHeader Header blk
hdr -> Text
"Discovered trap tentative header " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
          ChainDB.OutdatedTentativeHeader Header blk
hdr -> Text
"Tentative header is now outdated" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)

      ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev -> case TraceReplayEvent blk
ev of
        LedgerDB.ReplayFromGenesis ReplayGoal blk
_replayTo ->
          Text
"Replaying ledger from genesis"
        LedgerDB.ReplayFromSnapshot DiskSnapshot
_ RealPoint blk
tip' ReplayStart blk
_ ReplayGoal blk
_ ->
          Text
"Replaying ledger from snapshot 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 (LedgerDB.ReplayStart Point blk
replayFrom) (LedgerDB.ReplayGoal Point blk
replayTo) ->
          let fromSlot :: Word64
fromSlot = Word64 -> (Word64 -> Word64) -> WithOrigin Word64 -> Word64
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin Word64
0 Word64 -> Word64
forall a. a -> a
Prelude.id (WithOrigin Word64 -> Word64) -> WithOrigin Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> WithOrigin SlotNo -> WithOrigin Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point blk
replayFrom
              atSlot :: Word64
atSlot   = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
pt
              atDiff :: Word64
atDiff   = Word64
atSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
              toSlot :: Word64
toSlot   = Word64 -> (Word64 -> Word64) -> WithOrigin Word64 -> Word64
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin Word64
0 Word64 -> Word64
forall a. a -> a
Prelude.id (WithOrigin Word64 -> Word64) -> WithOrigin Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> WithOrigin SlotNo -> WithOrigin Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point blk
replayTo
              toDiff :: Word64
toDiff   = Word64
toSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
          in
             Text
"Replayed block: slot "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
atSlot
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
toSlot
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
showProgressT (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
atDiff) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
toDiff)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
      ChainDB.TraceLedgerEvent TraceEvent blk
ev -> case TraceEvent blk
ev of
        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
        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
      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
        TraceOpenEvent blk
ChainDB.StartedOpeningDB -> Text
"Started opening Chain DB"
        TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB -> Text
"Started opening Immutable DB"
        TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB -> Text
"Started opening Volatile DB"
        TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB -> Text
"Started opening Ledger DB"
        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
        TraceInitChainSelEvent blk
ChainDB.StartedInitChainSelection -> Text
"Started initial chain selection"
        TraceInitChainSelEvent blk
ChainDB.InitalChainSelected -> Text
"Initial chain selected"
        ChainDB.InitChainSelValidation TraceValidationEvent blk
e -> case TraceValidationEvent blk
e of
          ChainDB.InvalidBlock ExtValidationError blk
_err RealPoint blk
_pt -> Text
"Invalid block found during Initial chain selection, truncating the candidate and retrying to select a best candidate."
          ChainDB.ValidCandidate AnchoredFragment (Header blk)
af     -> Text
"Valid candidate at 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.lastPoint AnchoredFragment (Header blk)
af)
          ChainDB.CandidateContainsFutureBlocks {} -> Text
"Found a candidate containing future blocks during Initial chain selection, truncating the candidate and retrying to select a best candidate."
          ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> Text
"Found a candidate containing future blocks exceeding clock skew during Initial chain selection, truncating the candidate and retrying to select a best candidate."
          ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart RealPoint blk
start) (LedgerDB.PushGoal RealPoint blk
goal) (LedgerDB.Pushing RealPoint blk
curr)) ->
            let fromSlot :: Word64
fromSlot = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
start
                atSlot :: Word64
atSlot   = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
curr
                atDiff :: Word64
atDiff   = Word64
atSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
                toSlot :: Word64
toSlot   = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
goal
                toDiff :: Word64
toDiff   = Word64
toSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
            in
              Text
"Pushing ledger state for block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
curr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Int -> Int -> Text
showProgressT (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
atDiff) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
toDiff) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
      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 -> case TraceEvent blk
ev of
        TraceEvent blk
ImmDB.NoValidLastLocation ->
          Text
"No valid last location was found. Starting from Genesis."
        ImmDB.ValidatedLastLocation ChunkNo
cn Tip blk
t ->
            Text
"Found a valid last location at chunk "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with tip "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint (Tip blk -> RealPoint blk
forall blk. Tip blk -> RealPoint blk
ImmDB.tipToRealPoint Tip blk
t)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
e -> case TraceChunkValidation blk ChunkNo
e of
          ImmDB.StartedValidatingChunk ChunkNo
chunkNo ChunkNo
outOf ->
               Text
"Validating chunk no. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
chunkNo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
outOf
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
showProgressT (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (ChunkNo -> Int
chunkNoToInt ChunkNo
chunkNo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0) (ChunkNo -> Int
chunkNoToInt ChunkNo
outOf) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
          ImmDB.ValidatedChunk ChunkNo
chunkNo ChunkNo
outOf ->
               Text
"Validated chunk no. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
chunkNo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
outOf
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
showProgressT (ChunkNo -> Int
chunkNoToInt ChunkNo
chunkNo) (ChunkNo -> Int
chunkNoToInt ChunkNo
outOf) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
          ImmDB.MissingChunkFile ChunkNo
cn      ->
            Text
"The chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is missing."
          ImmDB.InvalidChunkFile ChunkNo
cn ChunkFileError blk
er    ->
            Text
"The chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is invalid: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkFileError blk -> Text
forall a. Show a => a -> Text
showT ChunkFileError blk
er
          ImmDB.MissingPrimaryIndex ChunkNo
cn   ->
            Text
"The primary index of the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is missing."
          ImmDB.MissingSecondaryIndex ChunkNo
cn ->
            Text
"The secondary index of the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is missing."
          ImmDB.InvalidPrimaryIndex ChunkNo
cn   ->
            Text
"The primary index of the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is invalid."
          ImmDB.InvalidSecondaryIndex ChunkNo
cn ->
            Text
"The secondary index of the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is invalid."
          ImmDB.RewritePrimaryIndex ChunkNo
cn   ->
            Text
"Rewriting the primary index for the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
          ImmDB.RewriteSecondaryIndex ChunkNo
cn ->
            Text
"Rewriting the secondary index for the chunk file with number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        ImmDB.ChunkFileDoesntFit ChainHash blk
ch1 ChainHash blk
ch2 ->
          Text
"Chunk file doesn't fit. The hash of the block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChainHash blk -> Text
forall a. Show a => a -> Text
showT ChainHash blk
ch2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't match the previous hash of the first block in the current epoch: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChainHash blk -> Text
forall a. Show a => a -> Text
showT ChainHash blk
ch1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        ImmDB.Migrating Text
t -> Text
"Migrating: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
        ImmDB.DeletingAfter WithOrigin (Tip blk)
wot -> Text
"Deleting chunk files after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin (Tip blk) -> Text
forall a. Show a => a -> Text
showT WithOrigin (Tip blk)
wot
        ImmDB.DBAlreadyClosed {} -> Text
"Immutable DB was already closed. Double closing."
        ImmDB.DBClosed {} -> Text
"Closed Immutable DB."
        ImmDB.TraceCacheEvent TraceCacheEvent
ev' -> Text
"Cache event: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case TraceCacheEvent
ev' of
          ImmDB.TraceCurrentChunkHit   ChunkNo
cn   Word32
curr -> Text
"Current chunk hit: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cache size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
curr
          ImmDB.TracePastChunkHit      ChunkNo
cn   Word32
curr -> Text
"Past chunk hit: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cache size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
curr
          ImmDB.TracePastChunkMiss     ChunkNo
cn   Word32
curr -> Text
"Past chunk miss: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cache size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
curr
          ImmDB.TracePastChunkEvict    ChunkNo
cn   Word32
curr -> Text
"Past chunk evict: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChunkNo -> Text
forall a. Show a => a -> Text
showT ChunkNo
cn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cache size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
curr
          ImmDB.TracePastChunksExpired [ChunkNo]
cns  Word32
curr -> Text
"Past chunks expired: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ChunkNo] -> Text
forall a. Show a => a -> Text
showT [ChunkNo]
cns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cache size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
curr
      ChainDB.TraceVolatileDBEvent TraceEvent blk
ev -> case TraceEvent blk
ev of
        TraceEvent blk
VolDb.DBAlreadyClosed       -> Text
"Volatile DB was already closed. Double closing."
        VolDb.BlockAlreadyHere HeaderHash blk
bh   -> Text
"Block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HeaderHash blk -> Text
forall a. Show a => a -> Text
showT HeaderHash blk
bh Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was already in the Volatile DB."
        VolDb.Truncate ParseError blk
e FsPath
pth BlockOffset
offs   -> Text
"Truncating the file at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FsPath -> Text
forall a. Show a => a -> Text
showT FsPath
pth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at offset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockOffset -> Text
forall a. Show a => a -> Text
showT BlockOffset
offs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError blk -> Text
forall a. Show a => a -> Text
showT ParseError blk
e
        VolDb.InvalidFileNames [FsPath]
fs   -> Text
"Invalid Volatile DB files: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FsPath] -> Text
forall a. Show a => a -> Text
showT [FsPath]
fs
     where showProgressT :: Int -> Int -> Text
           showProgressT :: Int -> Int -> Text
showProgressT Int
chunkNo Int
outOf =
             String -> Text
pack (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chunkNo Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outOf :: Float) String
forall a. Monoid a => a
mempty)

--
-- | 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BftInvalidSignature"
      , Key
"error" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
_ = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"snapshot" ]
  toObject TracingVerbosity
MaximalVerbosity DiskSnapshot
snap =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"snapshot"
             , Key
"snapshot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedBlockNo"
      , Key
"expected" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockNo -> String
forall a. Condense a => a -> String
condense BlockNo
expect
      , Key
"actual" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockNo -> String
forall a. Condense a => a -> String
condense BlockNo
act
      ]
  toObject TracingVerbosity
_verb (UnexpectedSlotNo SlotNo
expect SlotNo
act) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedSlotNo"
      , Key
"expected" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
expect
      , Key
"actual" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
act
      ]
  toObject TracingVerbosity
_verb (UnexpectedPrevHash WithOrigin (HeaderHash blk)
expect ChainHash blk
act) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedPrevHash"
      , Key
"expected" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"actual" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HeaderProtocolError"
      , Key
"error" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HeaderEnvelopeError"
      , Key
"error" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ValidationError"
      , Key
"error" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"InFutureExceedsClockSkew"
      , Key
"point" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftInvalidSignature"
      , Key
"error" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
text
      ]
  toObject TracingVerbosity
_verb (PBFT.PBftNotGenesisDelegate PBftVerKeyHash c
vkhash PBftLedgerView c
_ledgerView) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftNotGenesisDelegate"
      , Key
"vk" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftExceededSignThreshold"
      , Key
"vk" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"numForged" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftCannotForgeInvalidDelegation"
      , Key
"vk" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftCannotForgeThresholdExceeded"
      , Key
"numForged" Key -> Word64 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
numForged
      ]


instance ConvertRawHash blk
      => ToObject (RealPoint blk) where
  toObject :: TracingVerbosity -> RealPoint blk -> Object
toObject TracingVerbosity
verb RealPoint blk
p = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Point"
        , Key
"slot" Key -> Word64 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> Word64
unSlotNo (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
p)
        , Key
"hash" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.IgnoreBlockOlderThanK"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.IgnoreBlockAlreadyInVolatileDB RealPoint blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.IgnoreBlockAlreadyInVolatileDB"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.IgnoreInvalidBlock"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Key
"reason" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvalidBlockReason blk -> String
forall a. Show a => a -> String
show InvalidBlockReason blk
reason ]
    ChainDB.AddedBlockToQueue RealPoint blk
pt Enclosing' Word
edgeSz ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddedBlockToQueue"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , case Enclosing' Word
edgeSz of
                   Enclosing' Word
RisingEdge         -> Key
"risingEdge" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                   FallingEdgeWith Word
sz -> Key
"queueSize" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
sz ]
    ChainDB.PoppedBlockFromQueue Enclosing' (RealPoint blk)
edgePt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.PoppedBlockFromQueue"
               , case Enclosing' (RealPoint blk)
edgePt of
                   Enclosing' (RealPoint blk)
RisingEdge         -> Key
"risingEdge" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                   FallingEdgeWith RealPoint blk
pt -> Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.BlockInTheFuture RealPoint blk
pt SlotNo
slot ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.BlockInTheFuture"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ]
    ChainDB.StoreButDontChange RealPoint blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.StoreButDontChange"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.TryAddToCurrentChain RealPoint blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.TryAddToCurrentChain"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.TrySwitchToAFork"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.ChangingSelection Point blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.ChangingSelection"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
pt ]
    ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$
               [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddedToCurrentChain"
               , Key
"newtip" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
               , Key
"chainLengthDelta" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AnchoredFragment (Header blk)
extended AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> Int
`chainLengthΔ` AnchoredFragment (Header blk)
base
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"headers" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$
               [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.SwitchedToAFork"
               , Key
"newtip" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
               , Key
"chainLengthDelta" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AnchoredFragment (Header blk)
new AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> Int
`chainLengthΔ` AnchoredFragment (Header blk)
old
               -- Check that the SwitchedToAFork event was triggered by a proper fork.
               , Key
"realFork" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool -> Bool
not (Point (Header blk) -> AnchoredFragment (Header blk) -> Bool
forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
AF.withinFragmentBounds (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
old) AnchoredFragment (Header blk)
new)
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"headers" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.InvalidBlock"
                 , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
                 , Key
"error" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExtValidationError blk -> String
forall a. Show a => a -> String
show ExtValidationError blk
err ]
      ChainDB.ValidCandidate AnchoredFragment (Header blk)
c ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.ValidCandidate"
                 , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocks"
                 , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
                 , Key
"headers" Key -> [Text] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew"
                 , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
                 , Key
"headers" Key -> [Text] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart RealPoint blk
start) (LedgerDB.PushGoal RealPoint blk
goal) (LedgerDB.Pushing RealPoint blk
curr)) ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDb"
                 , Key
"startingBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
start
                 , Key
"currentBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
curr
                 , Key
"targetBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
goal
                 ]
    ChainDB.AddedBlockToVolatileDB RealPoint blk
pt (BlockNo Word64
bn) IsEBB
_isEBB Enclosing
enclosing ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddedBlockToVolatileDB"
                , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
                , Key
"blockNo" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> String
forall a. Show a => a -> String
show Word64
bn ]
                [Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> [ Key
"risingEdge" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True | Enclosing
RisingEdge <- [Enclosing
enclosing] ]
    ChainDB.ChainSelectionForFutureBlock RealPoint blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.ChainSelectionForFutureBlock"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt ]
    ChainDB.PipeliningEvent TracePipeliningEvent blk
ev' -> case TracePipeliningEvent blk
ev' of
      ChainDB.SetTentativeHeader Header blk
hdr Enclosing
enclosing ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.PipeliningEvent.SetTentativeHeader"
                  , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
                  ]
                  [Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> [ Key
"risingEdge" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True | Enclosing
RisingEdge <- [Enclosing
enclosing] ]
      ChainDB.TrapTentativeHeader Header blk
hdr ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.PipeliningEvent.TrapTentativeHeader"
                 , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
                 ]
      ChainDB.OutdatedTentativeHeader Header blk
hdr ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.PipeliningEvent.OutdatedTentativeHeader"
                 , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point (Header blk) -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)
                 ]
   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 TraceReplayEvent blk
_ev) = Object
forall a. Monoid a => a
mempty -- no output
  toObject TracingVerbosity
verb (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev) = case TraceReplayEvent blk
ev of
    LedgerDB.ReplayFromGenesis ReplayGoal blk
_replayTo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerReplayEvent.ReplayFromGenesis" ]
    LedgerDB.ReplayFromSnapshot DiskSnapshot
snap RealPoint blk
tip' ReplayStart blk
_replayFrom ReplayGoal blk
_replayTo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerReplayEvent.ReplayFromSnapshot"
               , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Key
"tip" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> String
forall a. Show a => a -> String
show RealPoint blk
tip' ]
    LedgerDB.ReplayedBlock RealPoint blk
pt [LedgerEvent blk]
_ledgerEvents ReplayStart blk
_ (LedgerDB.ReplayGoal Point blk
replayTo)  ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerReplayEvent.ReplayedBlock"
               , Key
"slot" Key -> Word64 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> Word64
unSlotNo (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
pt)
               , Key
"tip"  Key -> Word64 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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. Monoid a => a
mempty -- no output
  toObject TracingVerbosity
verb (ChainDB.TraceLedgerEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerEvent.TookSnapshot"
               , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Key
"tip" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> String
forall a. Show a => a -> String
show RealPoint blk
pt ]
    LedgerDB.DeletedSnapshot DiskSnapshot
snap ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerEvent.DeletedSnapshot"
               , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap ]
    LedgerDB.InvalidSnapshot DiskSnapshot
snap InitFailure blk
failure ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerEvent.InvalidSnapshot"
               , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> DiskSnapshot -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb DiskSnapshot
snap
               , Key
"failure" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceCopyToImmutableDBEvent.CopiedBlockToImmutableDB"
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
pt ]
    TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceGCEvent.PerformedGC"
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ]
    ChainDB.ScheduledGC SlotNo
slot Time
difft ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceGCEvent.ScheduledGC"
                 , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> SlotNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb SlotNo
slot ] [Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<>
                 [ Key
"difft" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
    TraceOpenEvent blk
ChainDB.StartedOpeningDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.StartedOpeningDB"]
    TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.StartedOpeningImmutableDB"]
    TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.StartedOpeningVolatileDB"]
    TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.StartedOpeningLgrDB"]
    ChainDB.OpenedDB Point blk
immTip Point blk
tip' ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.OpenedDB"
               , Key
"immtip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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' ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.ClosedDB"
               , Key
"immtip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.OpenedImmutableDB"
               , Key
"immtip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
immTip
               , Key
"epoch" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.OpenedVolatileDB" ]
    TraceOpenEvent blk
ChainDB.OpenedLgrDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.NewFollower" ]
    ChainDB.FollowerNoLongerInMem FollowerRollState blk
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.FollowerNoLongerInMem" ]
    ChainDB.FollowerSwitchToMem Point blk
_ WithOrigin SlotNo
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.FollowerSwitchToMem" ]
    ChainDB.FollowerNewImmIterator Point blk
_ WithOrigin SlotNo
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.FollowerNewImmIterator" ]
  toObject TracingVerbosity
verb (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev) = case TraceInitChainSelEvent blk
ev of
    TraceInitChainSelEvent blk
ChainDB.InitalChainSelected ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.InitalChainSelected"]
    TraceInitChainSelEvent blk
ChainDB.StartedInitChainSelection ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceFollowerEvent.StartedInitChainSelection"]
    ChainDB.InitChainSelValidation TraceValidationEvent blk
ev' -> case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock ExtValidationError blk
err RealPoint blk
pt ->
         [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceInitChainSelEvent.InvalidBlock"
                  , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> RealPoint blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb RealPoint blk
pt
                  , Key
"error" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExtValidationError blk -> String
forall a. Show a => a -> String
show ExtValidationError blk
err ]
      ChainDB.ValidCandidate AnchoredFragment (Header blk)
c ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceInitChainSelEvent.ValidCandidate"
                 , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceInitChainSelEvent.CandidateContainsFutureBlocks"
                 , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
                 , Key
"headers" Key -> [Text] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceInitChainSelEvent.CandidateContainsFutureBlocksExceedingClockSkew"
                 , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
                 , Key
"headers" Key -> [Text] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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.UpdateLedgerDbTraceEvent
        (StartedPushingBlockToTheLedgerDb (PushStart RealPoint blk
start) (PushGoal RealPoint blk
goal) (Pushing RealPoint blk
curr) ) ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb"
                   , Key
"startingBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
start
                   , Key
"currentBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
curr
                   , Key
"targetBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
goal
                   ]

  toObject TracingVerbosity
_verb (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev) = case TraceIteratorEvent blk
ev of
    ChainDB.UnknownRangeRequested UnknownRange blk
unkRange ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.UnknownRangeRequested"
               , Key
"range" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.StreamFromVolatileDB"
               , Key
"from" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Key
"to" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
streamTo)
               , Key
"point" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.StreamFromImmutableDB"
               , Key
"from" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Key
"to" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.StreamFromBoth"
               , Key
"from" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
               , Key
"to" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamTo blk -> Text
forall a. Show a => a -> Text
showT StreamTo blk
streamTo)
               , Key
"point" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.BlockMissingFromVolatileDB"
               , Key
"point" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    ChainDB.BlockWasCopiedToImmutableDB RealPoint blk
realPt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.BlockWasCopiedToImmutableDB"
               , Key
"point" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    ChainDB.BlockGCedFromVolatileDB RealPoint blk
realPt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.BlockGCedFromVolatileDB"
               , Key
"point" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
realPt)
               ]
    TraceIteratorEvent blk
ChainDB.SwitchBackToVolatileDB ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceIteratorEvent.SwitchBackToVolatileDB"
               ]
  toObject TracingVerbosity
verb (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev) = case TraceEvent blk
ev of
    ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
traceChunkValidation -> TracingVerbosity -> TraceChunkValidation blk ChunkNo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb TraceChunkValidation blk ChunkNo
traceChunkValidation
    TraceEvent blk
ImmDB.NoValidLastLocation ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.NoValidLastLocation" ]
    ImmDB.ValidatedLastLocation ChunkNo
chunkNo Tip blk
immTip ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.ValidatedLastLocation"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Key
"immTip" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Tip blk -> Text
forall blk. StandardHash blk => Tip blk -> Text
renderTipHash Tip blk
immTip)
               , Key
"blockNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Tip blk -> Text
forall blk. Tip blk -> Text
renderTipBlockNo Tip blk
immTip)
               ]
    ImmDB.ChunkFileDoesntFit ChainHash blk
expectPrevHash ChainHash blk
actualPrevHash ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.ChunkFileDoesntFit"
               , Key
"expectedPrevHash" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
               , Key
"actualPrevHash" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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.Migrating Text
txt ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.Migrating"
               , Key
"info" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
txt
               ]
    ImmDB.DeletingAfter WithOrigin (Tip blk)
immTipWithInfo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.DeletingAfter"
               , Key
"immTipHash" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
               , Key
"immTipBlockNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.DBAlreadyClosed" ]
    TraceEvent blk
ImmDB.DBClosed -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.DBClosed" ]
    ImmDB.TraceCacheEvent TraceCacheEvent
cacheEv ->
      case TraceCacheEvent
cacheEv of
        ImmDB.TraceCurrentChunkHit ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmDbEvent.TraceCacheEvent.TraceCurrentChunkHit"
                   , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Key
"noPastChunks" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkHit ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkHit"
                   , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Key
"noPastChunks" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkMiss ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkMiss"
                   , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Key
"noPastChunks" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunkEvict ChunkNo
chunkNo Word32
nbPastChunksInCache ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmDbEvent.TraceCacheEvent.TracePastChunkEvict"
                   , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
                   , Key
"noPastChunks" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
                   ]
        ImmDB.TracePastChunksExpired [ChunkNo]
chunkNos Word32
nbPastChunksInCache ->
          [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmDbEvent.TraceCacheEvent.TracePastChunksExpired"
                   , Key
"chunkNos" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
                   , Key
"noPastChunks" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceVolatileDbEvent.DBAlreadyClosed"]
    VolDb.BlockAlreadyHere HeaderHash blk
blockId ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceVolatileDbEvent.BlockAlreadyHere"
               , Key
"blockId" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (HeaderHash blk -> Text
forall a. Show a => a -> Text
showT HeaderHash blk
blockId)
               ]
    VolDb.Truncate ParseError blk
pErr FsPath
fsPath BlockOffset
blockOffset ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceVolatileDbEvent.Truncate"
               , Key
"parserError" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ParseError blk -> Text
forall a. Show a => a -> Text
showT ParseError blk
pErr)
               , Key
"file" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (FsPath -> Text
forall a. Show a => a -> Text
showT FsPath
fsPath)
               , Key
"blockOffset" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (BlockOffset -> Text
forall a. Show a => a -> Text
showT BlockOffset
blockOffset)
               ]
    VolDb.InvalidFileNames [FsPath]
fsPaths ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceVolatileDBEvent.InvalidFileNames"
               , Key
"files" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 (ImmDB.TraceChunkValidation blk ChunkNo) where
  toObject :: TracingVerbosity -> TraceChunkValidation blk ChunkNo -> Object
toObject TracingVerbosity
verb TraceChunkValidation blk ChunkNo
ev = case TraceChunkValidation blk ChunkNo
ev of
    ImmDB.RewriteSecondaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.RewriteSecondaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.RewritePrimaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.RewritePrimaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.MissingPrimaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingPrimaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.MissingSecondaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingSecondaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidPrimaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidPrimaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidSecondaryIndex ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidSecondaryIndex"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidChunkFile ChunkNo
chunkNo (ImmDB.ChunkErrHashMismatch HeaderHash blk
hashPrevBlock ChainHash blk
prevHashOfBlock) ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Key
"hashPrevBlock" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
               , Key
"prevHashOfBlock" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Key
"block" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
pt)
               ]
    ImmDB.ValidatedChunk ChunkNo
chunkNo ChunkNo
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.ValidatedChunk"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.MissingChunkFile ChunkNo
chunkNo ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingChunkFile"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               ]
    ImmDB.InvalidChunkFile ChunkNo
chunkNo (ImmDB.ChunkErrRead ReadIncrementalErr
readIncErr) ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead"
               , Key
"chunkNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
               , Key
"error" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ReadIncrementalErr -> Text
forall a. Show a => a -> Text
showT ReadIncrementalErr
readIncErr)
               ]
    ImmDB.StartedValidatingChunk ChunkNo
initialChunk ChunkNo
finalChunk ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.StartedValidatingChunk"
               , Key
"initialChunk" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChunkNo -> Text
renderChunkNo ChunkNo
initialChunk
               , Key
"finalChunk" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChunkNo -> Text
renderChunkNo ChunkNo
finalChunk
               ]


instance ConvertRawHash blk => ToObject (TraceBlockFetchServerEvent blk) where
  toObject :: TracingVerbosity -> TraceBlockFetchServerEvent blk -> Object
toObject TracingVerbosity
_verb (TraceBlockFetchServerSendBlock Point blk
blk) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind"  Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceBlockFetchServerSendBlock"
             , Key
"block" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 -> Aeson.Object
tipToObject :: Tip blk -> Object
tipToObject = \case
  Tip blk
TipGenesis -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"slot"    Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int
0 :: Int)
    , Key
"block"   Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"genesis"
    , Key
"blockNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ((-Int
1) :: Int)
    ]
  Tip SlotNo
slot HeaderHash blk
hash BlockNo
blockno -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"slot"    Key -> SlotNo -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
    , Key
"block"   Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
    , Key
"blockNo" Key -> BlockNo -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
               [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceDownloadedHeader"
               , Tip (Header blk) -> Object
forall blk. ConvertRawHash blk => Tip blk -> Object
tipToObject (Header blk -> Tip (Header blk)
forall a. HasHeader a => a -> Tip a
tipFromHeader Header blk
h)
               ]
    TraceRolledBack Point blk
tip ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceRolledBack"
               , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb Point blk
tip ]
    TraceException ChainSyncClientException
exc ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceException"
               , Key
"exception" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
_ ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceFoundIntersection" ]
    TraceTermination ChainSyncClientResult
reason ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncClientEvent.TraceTermination"
               , Key
"reason" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ChainSyncClientResult -> String
forall a. Show a => a -> String
show ChainSyncClientResult
reason) ]

instance ConvertRawHash blk
      => ToObject (TraceChainSyncServerEvent blk) where
  toObject :: TracingVerbosity -> TraceChainSyncServerEvent blk -> Object
toObject TracingVerbosity
verb TraceChainSyncServerEvent blk
ev = case TraceChainSyncServerEvent blk
ev of
    TraceChainSyncServerUpdate Tip blk
tip ChainUpdate blk (Point blk)
update BlockingType
blocking Enclosing
enclosing ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncServerEvent.TraceChainSyncServerUpdate"
        , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Tip blk -> Object
forall blk. ConvertRawHash blk => Tip blk -> Object
tipToObject Tip blk
tip
        , case ChainUpdate blk (Point blk)
update of
            AddBlock Point blk
pt -> Key
"addBlock" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
pt
            RollBack Point blk
pt -> Key
"rollBackTo" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
pt
        , Key
"blockingRead" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= case BlockingType
blocking of BlockingType
Blocking -> Bool
True; BlockingType
NonBlocking -> Bool
False
        ]
        [Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> [ Key
"risingEdge" Key -> Bool -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True | Enclosing
RisingEdge <- [Enclosing
enclosing] ]

instance ( 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceMempoolAddedTx"
      , Key
"tx" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"mempoolSize" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceMempoolRejectedTx"
      , Key
"err" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> ApplyTxErr blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb ApplyTxErr blk
txApplyErr
      , Key
"tx" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> GenTx blk -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb GenTx blk
tx
      , Key
"mempoolSize" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceMempoolRemoveTxs"
      , Key
"txs" Key -> [Object] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
      , Key
"mempoolSize" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceMempoolManuallyRemovedTxs"
      , Key
"txsRemoved" Key -> [GenTxId blk] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [GenTxId blk]
txs0
      , Key
"txsInvalidated" Key -> [Object] -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
      , Key
"mempoolSize" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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} =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"numTxs" Key -> Word32 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
msNumTxs
      , Key
"bytes" Key -> Word32 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 ( RunNode blk
         , 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceStartLeadershipCheck"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceSlotIsImmutable"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"tip" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
tipPoint
      , Key
"tipBlockNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo BlockNo
tipBlkNo)
      ]
  toObject TracingVerbosity
_verb (TraceBlockFromFuture SlotNo
currentSlot SlotNo
tip) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceBlockFromFuture"
      , Key
"current slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
      , Key
"tip" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceBlockContext"
      , Key
"current slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
      , Key
"tip" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
tipPoint
      , Key
"tipBlockNo" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceNoLedgerState"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerState"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceNoLedgerView SlotNo
slotNo OutsideForecastRange
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceNoLedgerView"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceLedgerView SlotNo
slotNo) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceLedgerView"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgeStateUpdateError"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"reason" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceNodeCannotForge"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"reason" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceNodeNotLeader"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      ]
  toObject TracingVerbosity
_verb (TraceNodeIsLeader SlotNo
slotNo) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceNodeIsLeader"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      ]
  toObject TracingVerbosity
verb (TraceForgeTickedLedgerState SlotNo
slotNo Point blk
prevPt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgeTickedLedgerState"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"prev" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
prevPt
      ]
  toObject TracingVerbosity
verb (TraceForgingMempoolSnapshot SlotNo
slotNo Point blk
prevPt ChainHash blk
mpHash SlotNo
mpSlot) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind"        Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgingMempoolSnapshot"
      , Key
"slot"        Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"prev"        Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TracingVerbosity -> Point blk -> Text
forall blk.
ConvertRawHash blk =>
TracingVerbosity -> Point blk -> Text
renderPointForVerbosity TracingVerbosity
verb Point blk
prevPt
      , Key
"mempoolHash" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
mpHash)
      , Key
"mempoolSlot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
mpSlot)
      ]
  toObject TracingVerbosity
_verb (TraceForgedBlock SlotNo
slotNo Point blk
_ blk
blk MempoolSize
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind"      Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgedBlock"
      , Key
"slot"      Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"block"     Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"blockNo"   Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"blockPrev" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceDidntAdoptBlock"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgedInvalidBlock"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"reason" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAdoptedBlock"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"blockHash" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"blockSize" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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))
      , Key
"txIds" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAdoptedBlock"
      , Key
"slot" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
      , Key
"blockHash" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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)
      , Key
"blockSize" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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
_ =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String