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

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Node.Tracing.Tracers.ChainDB
  ( severityChainDB
  , namesForChainDBTraceEvents
  , withAddedToCurrentChainEmptyLimited
  , docChainDBTraceEvent
  ) where

import           Data.Aeson (Value (String), toJSON, (.=))
import qualified Data.Aeson as A
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Numeric (showFFloat)
import           Prelude (id)
import           Text.Show

import           Cardano.Logging
import           Cardano.Node.Tracing.Era.Byron ()
import           Cardano.Node.Tracing.Era.Shelley ()
import           Cardano.Node.Tracing.Formatting ()
import           Cardano.Node.Tracing.Render
import           Cardano.Prelude hiding (Show, show, trace)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HeaderValidation (HeaderEnvelopeError (..), HeaderError (..),
                   OtherHeaderEnvelopeError)
import           Ouroboros.Consensus.Ledger.Abstract (LedgerError)
import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError (..))
import           Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent (..))
import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
import           Ouroboros.Consensus.Protocol.Abstract (ValidationErr)
import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmDB
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (chunkNoToInt)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB
import           Ouroboros.Consensus.Storage.LedgerDB.Types (UpdateLedgerDbTraceEvent (..))
import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB
import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb
import           Ouroboros.Consensus.Util.Condense (condense)
import           Ouroboros.Consensus.Util.Enclose

import qualified Data.Aeson.KeyMap as KeyMap
import qualified Ouroboros.Network.AnchoredFragment as AF

{-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}

withAddedToCurrentChainEmptyLimited
  :: Trace IO (ChainDB.TraceEvent blk)
  -> IO (Trace IO (ChainDB.TraceEvent blk))
withAddedToCurrentChainEmptyLimited :: Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
withAddedToCurrentChainEmptyLimited Trace IO (TraceEvent blk)
tr = do
  Trace IO (TraceEvent blk)
ltr <- Double
-> Text
-> Trace IO (TraceEvent blk)
-> Trace IO LimitingMessage
-> IO (Trace IO (TraceEvent blk))
forall a (m :: * -> *).
(MonadIO m, MonadUnliftIO m) =>
Double
-> Text -> Trace m a -> Trace m LimitingMessage -> m (Trace m a)
limitFrequency Double
1.25 Text
"AddedToCurrentChainLimiter" Trace IO (TraceEvent blk)
tr Trace IO LimitingMessage
forall a. Monoid a => a
mempty
  (TraceEvent blk -> IO (Trace IO (TraceEvent blk)))
-> Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
forall (m :: * -> *) a.
Monad m =>
(a -> m (Trace m a)) -> Trace m a -> m (Trace m a)
routingTrace (Trace IO (TraceEvent blk)
-> TraceEvent blk -> IO (Trace IO (TraceEvent blk))
selecting Trace IO (TraceEvent blk)
ltr) Trace IO (TraceEvent blk)
tr
 where
    selecting :: Trace IO (TraceEvent blk)
-> TraceEvent blk -> IO (Trace IO (TraceEvent blk))
selecting
      Trace IO (TraceEvent blk)
ltr
      (ChainDB.TraceAddBlockEvent (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_)) =
        if [LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events
          then Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace IO (TraceEvent blk)
ltr
          else Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace IO (TraceEvent blk)
tr
    selecting Trace IO (TraceEvent blk)
_ TraceEvent blk
_ = Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace IO (TraceEvent blk)
tr

kindContext :: Text -> A.Object -> A.Object
kindContext :: Text -> Object -> Object
kindContext Text
toAdd = Identity Object -> Object
forall a. Identity a -> a
runIdentity (Identity Object -> Object)
-> (Object -> Identity Object) -> Object -> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Value -> Identity (Maybe Value))
-> Key -> Object -> Identity Object
forall (f :: * -> *) v.
Functor f =>
(Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
KeyMap.alterF Maybe Value -> Identity (Maybe Value)
f Key
"kind"
  where
    f :: Maybe Value -> Identity (Maybe Value)
f Maybe Value
Nothing = Maybe Value -> Identity (Maybe Value)
forall a. a -> Identity a
Identity (Maybe Value -> Identity (Maybe Value))
-> Maybe Value -> Identity (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
toAdd)
    f (Just (String Text
old)) = Maybe Value -> Identity (Maybe Value)
forall a. a -> Identity a
Identity (Maybe Value -> Identity (Maybe Value))
-> Maybe Value -> Identity (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String (Text
toAdd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
old))
    f Maybe Value
_ = Maybe Value -> Identity (Maybe Value)
forall a. a -> Identity a
Identity Maybe Value
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- ChainDB Tracer
--------------------------------------------------------------------------------

severityChainDB :: ChainDB.TraceEvent blk -> SeverityS
severityChainDB :: TraceEvent blk -> SeverityS
severityChainDB (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
v)          = TraceAddBlockEvent blk -> SeverityS
forall blk. TraceAddBlockEvent blk -> SeverityS
sevTraceAddBlockEvent TraceAddBlockEvent blk
v
severityChainDB (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
v)          = TraceFollowerEvent blk -> SeverityS
forall blk. TraceFollowerEvent blk -> SeverityS
sevTraceFollowerEvent TraceFollowerEvent blk
v
severityChainDB (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
v) = TraceCopyToImmutableDBEvent blk -> SeverityS
forall blk. TraceCopyToImmutableDBEvent blk -> SeverityS
sevTraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
v
severityChainDB (ChainDB.TraceGCEvent TraceGCEvent blk
v)                = TraceGCEvent blk -> SeverityS
forall blk. TraceGCEvent blk -> SeverityS
sevTraceGCEvent TraceGCEvent blk
v
severityChainDB (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
v)      = TraceInitChainSelEvent blk -> SeverityS
forall blk. TraceInitChainSelEvent blk -> SeverityS
sevTraceInitChainSelEvent TraceInitChainSelEvent blk
v
severityChainDB (ChainDB.TraceOpenEvent TraceOpenEvent blk
v)              = TraceOpenEvent blk -> SeverityS
forall blk. TraceOpenEvent blk -> SeverityS
sevTraceOpenEvent TraceOpenEvent blk
v
severityChainDB (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
v)          = TraceIteratorEvent blk -> SeverityS
forall blk. TraceIteratorEvent blk -> SeverityS
sevTraceIteratorEvent TraceIteratorEvent blk
v
severityChainDB (ChainDB.TraceLedgerEvent TraceEvent blk
v)            = TraceEvent blk -> SeverityS
forall blk. TraceEvent blk -> SeverityS
sevTraceLedgerEvent TraceEvent blk
v
severityChainDB (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
v)      = TraceReplayEvent blk -> SeverityS
forall blk. TraceReplayEvent blk -> SeverityS
sevTraceLedgerReplayEvent TraceReplayEvent blk
v
severityChainDB (ChainDB.TraceImmutableDBEvent TraceEvent blk
v)       = TraceEvent blk -> SeverityS
forall blk. TraceEvent blk -> SeverityS
sevTraceImmutableDBEvent TraceEvent blk
v
severityChainDB (ChainDB.TraceVolatileDBEvent TraceEvent blk
v)        = TraceEvent blk -> SeverityS
forall blk. TraceEvent blk -> SeverityS
sevTraceVolatileDBEvent TraceEvent blk
v

namesForChainDBTraceEvents :: ChainDB.TraceEvent blk -> [Text]
namesForChainDBTraceEvents :: TraceEvent blk -> [Text]
namesForChainDBTraceEvents (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev) =
  Text
"AddBlockEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceAddBlockEvent blk -> [Text]
forall blk. TraceAddBlockEvent blk -> [Text]
namesForChainDBAddBlock TraceAddBlockEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev) =
  Text
"FollowerEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceFollowerEvent blk -> [Text]
forall blk. TraceFollowerEvent blk -> [Text]
namesForChainDBFollower TraceFollowerEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev) =
  Text
"CopyToImmutableDBEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceCopyToImmutableDBEvent blk -> [Text]
forall blk. TraceCopyToImmutableDBEvent blk -> [Text]
namesForChainDBCopyToImmutable TraceCopyToImmutableDBEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceGCEvent TraceGCEvent blk
ev) =
  Text
"GCEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceGCEvent blk -> [Text]
forall blk. TraceGCEvent blk -> [Text]
namesForChainDBGCEvent TraceGCEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev) =
  Text
"InitChainSelEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceInitChainSelEvent blk -> [Text]
forall blk. TraceInitChainSelEvent blk -> [Text]
namesForInitChainSel TraceInitChainSelEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev) =
  Text
"OpenEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceOpenEvent blk -> [Text]
forall blk. TraceOpenEvent blk -> [Text]
namesForChainDBOpenEvent TraceOpenEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev) =
  Text
"IteratorEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceIteratorEvent blk -> [Text]
forall blk. TraceIteratorEvent blk -> [Text]
namesForChainDBIteratorEvent TraceIteratorEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceLedgerEvent TraceEvent blk
ev) =
  Text
"LedgerEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceEvent blk -> [Text]
forall blk. TraceEvent blk -> [Text]
namesForChainDBLedgerEvent TraceEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev) =
  Text
"LedgerEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceReplayEvent blk -> [Text]
forall blk. TraceReplayEvent blk -> [Text]
namesForChainDBLedgerReplayEvent TraceReplayEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev) =
  Text
"ImmDbEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceEvent blk -> [Text]
forall blk. TraceEvent blk -> [Text]
namesForChainDBImmutableDBEvent TraceEvent blk
ev
namesForChainDBTraceEvents (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev) =
  Text
"VolatileDbEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceEvent blk -> [Text]
forall blk. TraceEvent blk -> [Text]
namesForChainDBVolatileDBEvent TraceEvent blk
ev


instance (  LogFormatting (Header blk)
          , LogFormatting (LedgerEvent blk)
          , LogFormatting (RealPoint blk)
          , ConvertRawHash blk
          , ConvertRawHash (Header blk)
          , HasHeader (Header blk)
          , LedgerSupportsProtocol blk
          , InspectLedger blk
          ) => LogFormatting (ChainDB.TraceEvent blk) where
  forHuman :: TraceEvent blk -> Text
forHuman (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
v)          = TraceAddBlockEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceAddBlockEvent blk
v
  forHuman (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
v)          = TraceFollowerEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceFollowerEvent blk
v
  forHuman (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
v) = TraceCopyToImmutableDBEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceCopyToImmutableDBEvent blk
v
  forHuman (ChainDB.TraceGCEvent TraceGCEvent blk
v)                = TraceGCEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceGCEvent blk
v
  forHuman (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
v)      = TraceInitChainSelEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceInitChainSelEvent blk
v
  forHuman (ChainDB.TraceOpenEvent TraceOpenEvent blk
v)              = TraceOpenEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceOpenEvent blk
v
  forHuman (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
v)          = TraceIteratorEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceIteratorEvent blk
v
  forHuman (ChainDB.TraceLedgerEvent TraceEvent blk
v)            = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent blk
v
  forHuman (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
v)      = TraceReplayEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceReplayEvent blk
v
  forHuman (ChainDB.TraceImmutableDBEvent TraceEvent blk
v)       = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent blk
v
  forHuman (ChainDB.TraceVolatileDBEvent TraceEvent blk
v)        = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent blk
v

  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
details (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"AddBlockEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceAddBlockEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceAddBlockEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"FollowerEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceFollowerEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceFollowerEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"CopyToImmutableDBEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceCopyToImmutableDBEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceCopyToImmutableDBEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceGCEvent TraceGCEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"TraceGCEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceGCEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceGCEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"InitChainSelEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceInitChainSelEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceInitChainSelEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceOpenEvent TraceOpenEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"OpenEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceOpenEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceOpenEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"IteratorEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceIteratorEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceIteratorEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceLedgerEvent TraceEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"LedgerEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"LedgerReplayEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceReplayEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceReplayEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceImmutableDBEvent TraceEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"ImmDbEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceVolatileDBEvent TraceEvent blk
v) =
    Text -> Object -> Object
kindContext Text
"VolatileDBEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v

  asMetrics :: TraceEvent blk -> [Metric]
asMetrics (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
v)          = TraceAddBlockEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceAddBlockEvent blk
v
  asMetrics (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
v)          = TraceFollowerEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceFollowerEvent blk
v
  asMetrics (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
v) = TraceCopyToImmutableDBEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceCopyToImmutableDBEvent blk
v
  asMetrics (ChainDB.TraceGCEvent TraceGCEvent blk
v)                = TraceGCEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceGCEvent blk
v
  asMetrics (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
v)      = TraceInitChainSelEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceInitChainSelEvent blk
v
  asMetrics (ChainDB.TraceOpenEvent TraceOpenEvent blk
v)              = TraceOpenEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceOpenEvent blk
v
  asMetrics (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
v)          = TraceIteratorEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceIteratorEvent blk
v
  asMetrics (ChainDB.TraceLedgerEvent TraceEvent blk
v)            = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent blk
v
  asMetrics (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
v)      = TraceReplayEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceReplayEvent blk
v
  asMetrics (ChainDB.TraceImmutableDBEvent TraceEvent blk
v)       = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent blk
v
  asMetrics (ChainDB.TraceVolatileDBEvent TraceEvent blk
v)        = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent blk
v

docChainDBTraceEvent :: Documented (ChainDB.TraceEvent blk)
docChainDBTraceEvent :: Documented (TraceEvent blk)
docChainDBTraceEvent = [Text]
-> Documented (TraceEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [] Documented (TraceEvent Any)
forall blk. Documented (TraceEvent blk)
docChainDBTraceEvent'

docChainDBTraceEvent' :: Documented (ChainDB.TraceEvent blk)
docChainDBTraceEvent' :: Documented (TraceEvent blk)
docChainDBTraceEvent' =
    [Text]
-> Documented (TraceAddBlockEvent Any)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"AddBlockEvent"] Documented (TraceAddBlockEvent Any)
forall blk. Documented (TraceAddBlockEvent blk)
docChainDBAddBlock
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceFollowerEvent Any)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"FollowerEvent"] Documented (TraceFollowerEvent Any)
forall ev. Documented (TraceFollowerEvent ev)
docChainDBFollower
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceCopyToImmutableDBEvent Any)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"CopyToImmutableDBEvent"] Documented (TraceCopyToImmutableDBEvent Any)
forall blk. Documented (TraceCopyToImmutableDBEvent blk)
docChainDBImmtable
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceGCEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"GCEvent"] Documented (TraceGCEvent Any)
forall blk. Documented (TraceGCEvent blk)
docChainDBGCEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceInitChainSelEvent Any)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"InitChainSelEvent"] Documented (TraceInitChainSelEvent Any)
forall blk. Documented (TraceInitChainSelEvent blk)
docChainDBInitChainSel
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceOpenEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"OpenEvent"] Documented (TraceOpenEvent Any)
forall blk. Documented (TraceOpenEvent blk)
docChainDBOpenEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceIteratorEvent Any)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"IteratorEvent"] Documented (TraceIteratorEvent Any)
forall blk. Documented (TraceIteratorEvent blk)
docChainDBIteratorEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"LedgerEvent"] Documented (TraceEvent Any)
forall blk. Documented (TraceEvent blk)
docChainDBLedgerEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceReplayEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"LedgerReplayEvent"] Documented (TraceReplayEvent Any)
forall ev. Documented (TraceReplayEvent ev)
docChainDBLedgerReplayEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"ImmutableDBEvent"] Documented (TraceEvent Any)
forall blk. Documented (TraceEvent blk)
docChainDBImmutableDBEvent
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceEvent Any) -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"VolatileDBEvent"] Documented (TraceEvent Any)
forall blk. Documented (TraceEvent blk)
docChainDBVolatileDBEvent

--------------------------------------------------------------------------------
-- AddBlockEvent
--------------------------------------------------------------------------------

sevTraceAddBlockEvent :: ChainDB.TraceAddBlockEvent blk -> SeverityS
sevTraceAddBlockEvent :: TraceAddBlockEvent blk -> SeverityS
sevTraceAddBlockEvent ChainDB.IgnoreBlockOlderThanK {} = SeverityS
Info
sevTraceAddBlockEvent ChainDB.IgnoreBlockAlreadyInVolatileDB {} = SeverityS
Info
sevTraceAddBlockEvent ChainDB.IgnoreInvalidBlock {} = SeverityS
Info
sevTraceAddBlockEvent ChainDB.AddedBlockToQueue {} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.BlockInTheFuture {} = SeverityS
Info
sevTraceAddBlockEvent ChainDB.AddedBlockToVolatileDB {} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.PoppedBlockFromQueue {} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.TryAddToCurrentChain {} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.TrySwitchToAFork {} = SeverityS
Info
sevTraceAddBlockEvent ChainDB.StoreButDontChange {} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.ChangingSelection {} = SeverityS
Debug
sevTraceAddBlockEvent (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_) =
      SeverityS -> [SeverityS] -> SeverityS
forall a. Ord a => a -> [a] -> a
maximumDef SeverityS
Notice ((LedgerEvent blk -> SeverityS) -> [LedgerEvent blk] -> [SeverityS]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map LedgerEvent blk -> SeverityS
forall blk. LedgerEvent blk -> SeverityS
sevLedgerEvent [LedgerEvent blk]
events)
sevTraceAddBlockEvent (ChainDB.SwitchedToAFork [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_) =
      SeverityS -> [SeverityS] -> SeverityS
forall a. Ord a => a -> [a] -> a
maximumDef SeverityS
Notice ((LedgerEvent blk -> SeverityS) -> [LedgerEvent blk] -> [SeverityS]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map LedgerEvent blk -> SeverityS
forall blk. LedgerEvent blk -> SeverityS
sevLedgerEvent [LedgerEvent blk]
events)
sevTraceAddBlockEvent (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') = TraceValidationEvent blk -> SeverityS
forall blk. TraceValidationEvent blk -> SeverityS
sevTraceValidationEvent TraceValidationEvent blk
ev'
sevTraceAddBlockEvent ChainDB.ChainSelectionForFutureBlock{} = SeverityS
Debug
sevTraceAddBlockEvent ChainDB.PipeliningEvent{} = SeverityS
Debug

sevLedgerEvent :: LedgerEvent blk -> SeverityS
sevLedgerEvent :: LedgerEvent blk -> SeverityS
sevLedgerEvent (LedgerUpdate LedgerUpdate blk
_)  = SeverityS
Notice
sevLedgerEvent (LedgerWarning LedgerWarning blk
_) = SeverityS
Critical

sevTraceValidationEvent :: ChainDB.TraceValidationEvent blk -> SeverityS
sevTraceValidationEvent :: TraceValidationEvent blk -> SeverityS
sevTraceValidationEvent ChainDB.InvalidBlock {} = SeverityS
Error
sevTraceValidationEvent ChainDB.ValidCandidate {} = SeverityS
Info
sevTraceValidationEvent ChainDB.CandidateContainsFutureBlocks {} = SeverityS
Debug
sevTraceValidationEvent ChainDB.UpdateLedgerDbTraceEvent {} = SeverityS
Debug
sevTraceValidationEvent ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{} = SeverityS
Error

namesForChainDBAddBlock :: ChainDB.TraceAddBlockEvent blk -> [Text]
namesForChainDBAddBlock :: TraceAddBlockEvent blk -> [Text]
namesForChainDBAddBlock (ChainDB.IgnoreBlockOlderThanK RealPoint blk
_) =
      [Text
"IgnoreBlockOlderThanK"]
namesForChainDBAddBlock (ChainDB.IgnoreBlockAlreadyInVolatileDB RealPoint blk
_) =
      [Text
"IgnoreBlockAlreadyInVolatileDB"]
namesForChainDBAddBlock (ChainDB.IgnoreInvalidBlock {}) =
      [Text
"IgnoreInvalidBlock"]
namesForChainDBAddBlock (ChainDB.AddedBlockToQueue {}) =
      [Text
"AddedBlockToQueue"]
namesForChainDBAddBlock (ChainDB.PoppedBlockFromQueue {}) =
      [Text
"PoppedBlockFromQueue"]
namesForChainDBAddBlock (ChainDB.BlockInTheFuture {}) =
      [Text
"BlockInTheFuture"]
namesForChainDBAddBlock (ChainDB.AddedBlockToVolatileDB {}) =
      [Text
"AddedBlockToVolatileDB"]
namesForChainDBAddBlock (ChainDB.TryAddToCurrentChain {}) =
      [Text
"TryAddToCurrentChain"]
namesForChainDBAddBlock (ChainDB.TrySwitchToAFork {}) =
      [Text
"TrySwitchToAFork"]
namesForChainDBAddBlock (ChainDB.StoreButDontChange {}) =
      [Text
"StoreButDontChange"]
namesForChainDBAddBlock (ChainDB.AddedToCurrentChain {}) =
      [Text
"AddedToCurrentChain"]
namesForChainDBAddBlock (ChainDB.SwitchedToAFork {}) =
      [Text
"SwitchedToAFork"]
namesForChainDBAddBlock (ChainDB.ChangingSelection {}) =
      [Text
"ChangingSelection"]
namesForChainDBAddBlock (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') =
      Text
"AddBlockValidation" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceValidationEvent blk -> [Text]
forall blk. TraceValidationEvent blk -> [Text]
namesForChainDBAddBlockValidation TraceValidationEvent blk
ev'
namesForChainDBAddBlock (ChainDB.ChainSelectionForFutureBlock {}) =
      [Text
"ChainSelectionForFutureBlock"]
namesForChainDBAddBlock (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev) =
      Text
"PipeliningEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: case TracePipeliningEvent blk
ev of
        ChainDB.SetTentativeHeader{}      -> [Text
"SetTentativeHeader"]
        ChainDB.TrapTentativeHeader{}     -> [Text
"TrapTentativeHeader"]
        ChainDB.OutdatedTentativeHeader{} -> [Text
"OutdatedTentativeHeader"]

namesForChainDBAddBlockValidation :: ChainDB.TraceValidationEvent blk -> [Text]
namesForChainDBAddBlockValidation :: TraceValidationEvent blk -> [Text]
namesForChainDBAddBlockValidation (ChainDB.ValidCandidate {}) =
      [Text
"ValidCandidate"]
namesForChainDBAddBlockValidation (ChainDB.CandidateContainsFutureBlocks {}) =
      [Text
"CandidateContainsFutureBlocks"]
namesForChainDBAddBlockValidation (ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {}) =
      [Text
"CandidateContainsFutureBlocksExceedingClockSkew"]
namesForChainDBAddBlockValidation (ChainDB.InvalidBlock {}) =
      [Text
"InvalidBlock"]
namesForChainDBAddBlockValidation (ChainDB.UpdateLedgerDbTraceEvent {}) =
      [Text
"UpdateLedgerDb"]

instance ( LogFormatting (Header blk)
         , LogFormatting (LedgerEvent blk)
         , LogFormatting (RealPoint blk)
         , ConvertRawHash blk
         , ConvertRawHash (Header blk)
         , HasHeader (Header blk)
         , LedgerSupportsProtocol blk
         , InspectLedger blk
         ) => LogFormatting (ChainDB.TraceAddBlockEvent blk) where
  forHuman :: TraceAddBlockEvent blk -> Text
forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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
  forHuman (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 ]
  forHuman (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 ]
  forHuman (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') = TraceValidationEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceValidationEvent blk
ev'
  forHuman (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
  forHuman (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
  forHuman (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev') = TracePipeliningEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TracePipeliningEvent blk
ev'
  forMachine :: DetailLevel -> TraceAddBlockEvent blk -> Object
forMachine DetailLevel
dtal (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
"IgnoreBlockOlderThanK"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
"IgnoreBlockAlreadyInVolatileDB"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
"IgnoreInvalidBlock"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt
               , Key
"reason" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InvalidBlockReason blk -> Text
forall a. Show a => a -> Text
showT InvalidBlockReason blk
reason ]
  forMachine DetailLevel
dtal (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
"AddedBlockToQueue"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal 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 ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
"BlockInTheFuture"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> SlotNo -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal SlotNo
slot ]
  forMachine DetailLevel
dtal (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
"StoreButDontChange"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
"TryAddToCurrentChain"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
pt ]
  forMachine DetailLevel
dtal (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
"AddedToCurrentChain"
               , Key
"newtip" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
extended)
               ]
            [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 (DetailLevel -> Header blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (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]
forall blk.
HasHeader (Header blk) =>
AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> [Header blk]
addedHdrsNewChain AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended)
               | DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DDetailed ]
            [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 (DetailLevel -> LedgerEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events) ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint 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 (DetailLevel -> Header blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (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]
forall blk.
HasHeader (Header blk) =>
AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> [Header blk]
addedHdrsNewChain AnchoredFragment (Header blk)
old AnchoredFragment (Header blk)
new)
               | DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
DDetailed ]
            [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 (DetailLevel -> LedgerEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events) ]
  forMachine DetailLevel
dtal (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') =
    Text -> Object -> Object
kindContext Text
"AddBlockEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceValidationEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceValidationEvent blk
ev'
  forMachine DetailLevel
dtal (ChainDB.AddedBlockToVolatileDB RealPoint blk
pt (BlockNo Word64
bn) 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
"AddedBlockToVolatileDB"
                , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt
                , Key
"blockNo" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Text
forall a. Show a => a -> Text
showT 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] ]
  forMachine DetailLevel
dtal (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
"TChainSelectionForFutureBlock"
               , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt ]
  forMachine DetailLevel
dtal (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev') =
    Text -> Object -> Object
kindContext Text
"PipeliningEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TracePipeliningEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TracePipeliningEvent blk
ev'

  asMetrics :: TraceAddBlockEvent blk -> [Metric]
asMetrics (ChainDB.SwitchedToAFork [LedgerEvent blk]
_warnings NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
_oldChain AnchoredFragment (Header blk)
newChain) =
    let ChainInformation { Word64
slots :: ChainInformation -> Word64
slots :: Word64
slots, Word64
blocks :: ChainInformation -> Word64
blocks :: Word64
blocks, Rational
density :: ChainInformation -> Rational
density :: Rational
density, EpochNo
epoch :: ChainInformation -> EpochNo
epoch :: EpochNo
epoch, Word64
slotInEpoch :: ChainInformation -> Word64
slotInEpoch :: Word64
slotInEpoch } =
          NewTipInfo blk
-> AnchoredFragment (Header blk) -> Int64 -> ChainInformation
forall blk.
HasHeader (Header blk) =>
NewTipInfo blk
-> AnchoredFragment (Header blk) -> Int64 -> ChainInformation
chainInformation NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
newChain Int64
0
    in  [ Text -> Double -> Metric
DoubleM Text
"cardano.node.density" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
density)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.slotNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slots)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.blockNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blocks)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.slotInEpoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotInEpoch)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.epoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
epoch))
        ]
  asMetrics (ChainDB.AddedToCurrentChain [LedgerEvent blk]
_warnings NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
_oldChain AnchoredFragment (Header blk)
newChain) =
    let ChainInformation { Word64
slots :: Word64
slots :: ChainInformation -> Word64
slots, Word64
blocks :: Word64
blocks :: ChainInformation -> Word64
blocks, Rational
density :: Rational
density :: ChainInformation -> Rational
density, EpochNo
epoch :: EpochNo
epoch :: ChainInformation -> EpochNo
epoch, Word64
slotInEpoch :: Word64
slotInEpoch :: ChainInformation -> Word64
slotInEpoch } =
          NewTipInfo blk
-> AnchoredFragment (Header blk) -> Int64 -> ChainInformation
forall blk.
HasHeader (Header blk) =>
NewTipInfo blk
-> AnchoredFragment (Header blk) -> Int64 -> ChainInformation
chainInformation NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
newChain Int64
0
    in  [ Text -> Double -> Metric
DoubleM Text
"cardano.node.density" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
density)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.slotNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slots)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.blockNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blocks)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.slotInEpoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotInEpoch)
        , Text -> Integer -> Metric
IntM    Text
"cardano.node.epoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
epoch))
        ]
  asMetrics TraceAddBlockEvent blk
_ = []

instance ( ConvertRawHash (Header blk)
         , HasHeader (Header blk)
         ) => LogFormatting (ChainDB.TracePipeliningEvent blk) where
  forHuman :: TracePipeliningEvent blk -> Text
forHuman (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)
  forHuman (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)
  forHuman (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)

  forMachine :: DetailLevel -> TracePipeliningEvent blk -> Object
forMachine DetailLevel
dtals (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
"SetTentativeHeader"
                , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtals (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] ]
  forMachine DetailLevel
dtals (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
"TrapTentativeHeader"
               , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtals (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr) ]
  forMachine DetailLevel
dtals (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
"OutdatedTentativeHeader"
               , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtals (Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint Header blk
hdr)]

addedHdrsNewChain :: HasHeader (Header blk)
  => 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.

instance ( HasHeader (Header blk)
         , LedgerSupportsProtocol blk
         , ConvertRawHash (Header blk)
         , ConvertRawHash blk
         , LogFormatting (RealPoint blk))
         => LogFormatting (ChainDB.TraceValidationEvent blk) where
    forHuman :: TraceValidationEvent blk -> Text
forHuman (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
    forHuman (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)
    forHuman (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)
    forHuman (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)
    forHuman (ChainDB.UpdateLedgerDbTraceEvent
                (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
"%"

    forMachine :: DetailLevel -> TraceValidationEvent blk -> Object
forMachine DetailLevel
dtal  (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
"InvalidBlock"
                     , Key
"block" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> RealPoint blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal RealPoint blk
pt
                     , Key
"error" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExtValidationError blk -> Text
forall a. Show a => a -> Text
showT ExtValidationError blk
err ]
    forMachine DetailLevel
dtal  (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
"ValidCandidate"
                     , Key
"block" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
c) ]
    forMachine DetailLevel
dtal  (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
"CandidateContainsFutureBlocks"
                     , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (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 (DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (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 ]
    forMachine DetailLevel
dtal  (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
"CandidateContainsFutureBlocksExceedingClockSkew"
                     , Key
"block"   Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (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 (DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal (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 ]
    forMachine DetailLevel
_dtal (ChainDB.UpdateLedgerDbTraceEvent
                        (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
"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
                     ]

showProgressT :: Int -> Int -> Text
showProgressT :: Int -> Int -> Text
showProgressT Int
chunkNo Int
outOf =
  String -> Text
Text.pack (Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
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)

data ChainInformation = ChainInformation
  { ChainInformation -> Word64
slots                :: Word64
  , ChainInformation -> Word64
blocks               :: Word64
  , ChainInformation -> Rational
density              :: Rational
    -- ^ the actual number of blocks created over the maximum expected number
    -- of blocks that could be created over the span of the last @k@ blocks.
  , ChainInformation -> EpochNo
epoch                :: EpochNo
    -- ^ In which epoch is the tip of the current chain
  , ChainInformation -> Word64
slotInEpoch          :: Word64
    -- ^ Relative slot number of the tip of the current chain within the
    -- epoch.
  , ChainInformation -> Int64
blocksUncoupledDelta :: Int64
    -- ^ The net change in number of blocks forged since last restart not on the
    -- current chain.
  }

chainInformation
  :: forall blk. HasHeader (Header blk)
  => ChainDB.NewTipInfo blk
  -> AF.AnchoredFragment (Header blk)
  -> Int64
  -> ChainInformation
chainInformation :: NewTipInfo blk
-> AnchoredFragment (Header blk) -> Int64 -> ChainInformation
chainInformation NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
frag Int64
blocksUncoupledDelta = ChainInformation :: Word64
-> Word64
-> Rational
-> EpochNo
-> Word64
-> Int64
-> ChainInformation
ChainInformation
    { slots :: Word64
slots = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ SlotNo -> WithOrigin SlotNo -> SlotNo
forall t. t -> WithOrigin t -> t
fromWithOrigin SlotNo
0 (AnchoredFragment (Header blk) -> WithOrigin SlotNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
AF.headSlot AnchoredFragment (Header blk)
frag)
    , blocks :: Word64
blocks = BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> BlockNo -> Word64
forall a b. (a -> b) -> a -> b
$ BlockNo -> WithOrigin BlockNo -> BlockNo
forall t. t -> WithOrigin t -> t
fromWithOrigin (Word64 -> BlockNo
BlockNo Word64
1) (AnchoredFragment (Header blk) -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment (Header blk)
frag)
    , density :: Rational
density = AnchoredFragment (Header blk) -> Rational
forall blk.
HasHeader (Header blk) =>
AnchoredFragment (Header blk) -> Rational
fragmentChainDensity AnchoredFragment (Header blk)
frag
    , epoch :: EpochNo
epoch = NewTipInfo blk -> EpochNo
forall blk. NewTipInfo blk -> EpochNo
ChainDB.newTipEpoch NewTipInfo blk
newTipInfo
    , slotInEpoch :: Word64
slotInEpoch = NewTipInfo blk -> Word64
forall blk. NewTipInfo blk -> Word64
ChainDB.newTipSlotInEpoch NewTipInfo blk
newTipInfo
    , blocksUncoupledDelta :: Int64
blocksUncoupledDelta = Int64
blocksUncoupledDelta
    }

fragmentChainDensity ::
  HasHeader (Header blk)
  => AF.AnchoredFragment (Header blk) -> Rational
fragmentChainDensity :: AnchoredFragment (Header blk) -> Rational
fragmentChainDensity AnchoredFragment (Header blk)
frag = Word64 -> Word64 -> Rational
calcDensity Word64
blockD Word64
slotD
  where
    calcDensity :: Word64 -> Word64 -> Rational
    calcDensity :: Word64 -> Word64 -> Rational
calcDensity Word64
bl Word64
sl
      | Word64
sl Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0 = Word64 -> Rational
forall a. Real a => a -> Rational
toRational Word64
bl Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Word64 -> Rational
forall a. Real a => a -> Rational
toRational Word64
sl
      | Bool
otherwise = Rational
0
    slotN :: Word64
slotN  = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ SlotNo -> WithOrigin SlotNo -> SlotNo
forall t. t -> WithOrigin t -> t
fromWithOrigin SlotNo
0 (AnchoredFragment (Header blk) -> WithOrigin SlotNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
AF.headSlot AnchoredFragment (Header blk)
frag)
    -- Slot of the tip - slot @k@ blocks back. Use 0 as the slot for genesis
    -- includes EBBs
    slotD :: Word64
slotD   = Word64
slotN
            Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- SlotNo -> Word64
unSlotNo (SlotNo -> WithOrigin SlotNo -> SlotNo
forall t. t -> WithOrigin t -> t
fromWithOrigin SlotNo
0 (AnchoredFragment (Header blk) -> WithOrigin SlotNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
AF.lastSlot AnchoredFragment (Header blk)
frag))
    -- Block numbers start at 1. We ignore the genesis EBB, which has block number 0.
    blockD :: Word64
blockD = Word64
blockN Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
firstBlock
    blockN :: Word64
blockN = BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> BlockNo -> Word64
forall a b. (a -> b) -> a -> b
$ BlockNo -> WithOrigin BlockNo -> BlockNo
forall t. t -> WithOrigin t -> t
fromWithOrigin (Word64 -> BlockNo
BlockNo Word64
1) (AnchoredFragment (Header blk) -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment (Header blk)
frag)
    firstBlock :: Word64
firstBlock = case BlockNo -> Word64
unBlockNo (BlockNo -> Word64)
-> (Header blk -> BlockNo) -> Header blk -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header blk -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo (Header blk -> Word64)
-> Either (Anchor (Header blk)) (Header blk)
-> Either (Anchor (Header blk)) Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnchoredFragment (Header blk)
-> Either (Anchor (Header blk)) (Header blk)
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
AF.last AnchoredFragment (Header blk)
frag of
      -- Empty fragment, no blocks. We have that @blocks = 1 - 1 = 0@
      Left Anchor (Header blk)
_  -> Word64
1
      -- The oldest block is the genesis EBB with block number 0,
      -- don't let it contribute to the number of blocks
      Right Word64
0 -> Word64
1
      Right Word64
b -> Word64
b


docChainDBAddBlock :: Documented (ChainDB.TraceAddBlockEvent blk)
docChainDBAddBlock :: Documented (TraceAddBlockEvent blk)
docChainDBAddBlock = [DocMsg (TraceAddBlockEvent blk)]
-> Documented (TraceAddBlockEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"IgnoreBlockOlderThanK"]
        []
        Text
"A block with a 'BlockNo' more than @k@ back than the current tip\
        \ was ignored."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
         [Text
"IgnoreBlockAlreadyInVolatileDB"]
        []
        Text
"A block that is already in the Volatile DB was ignored."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"IgnoreInvalidBlock"]
        []
        Text
"A block that is already in the Volatile DB was ignored."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddedBlockToQueue"]
        []
        Text
"The block was added to the queue and will be added to the ChainDB by\
        \ the background thread. The size of the queue is included.."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"PoppedBlockFromQueue"]
        []
        Text
""
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"BlockInTheFuture"]
        []
        Text
"The block is from the future, i.e., its slot number is greater than\
        \ the current slot (the second argument)."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
         [Text
"AddedBlockToVolatileDB"]
        []
        Text
"A block was added to the Volatile DB"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"TryAddToCurrentChain"]
        []
        Text
"The block fits onto the current chain, we'll try to use it to extend\
        \ our chain."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"TrySwitchToAFork"]
        []
        Text
"The block fits onto some fork, we'll try to switch to that fork (if\
        \ it is preferable to our chain)"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"StoreButDontChange"]
        []
        Text
"The block fits onto some fork, we'll try to switch to that fork (if\
        \ it is preferable to our chain)."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
         [Text
"AddedToCurrentChain"]
        [(Text
"cardano.node.density",
          Text
"The actual number of blocks created over the maximum expected number\
          \ of blocks that could be created over the span of the last @k@ blocks.")
        , (Text
"cardano.node.slots",
          Text
"Number of slots in this chain fragment.")
        , (Text
"cardano.node.blocks",
          Text
"Number of blocks in this chain fragment.")
        , (Text
"cardano.node.slotInEpoch",
          Text
"Relative slot number of the tip of the current chain within the\
          \epoch..")
        , (Text
"cardano.node.epoch",
          Text
"In which epoch is the tip of the current chain.")
        ]
        Text
"The new block fits onto the current chain (first\
        \ fragment) and we have successfully used it to extend our (new) current\
        \ chain (second fragment)."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
         [Text
"SwitchedToAFork"]
        [ (Text
"cardano.node.density",
          Text
"The actual number of blocks created over the maximum expected number\
          \ of blocks that could be created over the span of the last @k@ blocks.")
        , (Text
"cardano.node.slots",
          Text
"Number of slots in this chain fragment.")
        , (Text
"cardano.node.blocks",
          Text
"Number of blocks in this chain fragment.")
        , (Text
"cardano.node.slotInEpoch",
          Text
"Relative slot number of the tip of the current chain within the\
          \epoch..")
        , (Text
"cardano.node.epoch",
          Text
"In which epoch is the tip of the current chain.")
        ]
        Text
"The new block fits onto some fork and we have switched to that fork\
        \ (second fragment), as it is preferable to our (previous) current chain\
        \ (first fragment)."

    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddBlockValidation", Text
"ValidCandidate"]
        []
        Text
"An event traced during validating performed while adding a block.\
        \ A candidate chain was valid."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddBlockValidation", Text
"CandidateContainsFutureBlocks"]
        []
        Text
"An event traced during validating performed while adding a block.\
        \ Candidate contains headers from the future which do no exceed the\
        \ clock skew."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddBlockValidation", Text
"CandidateContainsFutureBlocksExceedingClockSkew"]
        []
        Text
"An event traced during validating performed while adding a block.\
        \ Candidate contains headers from the future which exceed the\
        \ clock skew."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddBlockValidation", Text
"InvalidBlock"]
        []
        Text
"An event traced during validating performed while adding a block.\
        \ A point was found to be invalid."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AddBlockValidation", Text
"UpdateLedgerDb"]
        []
        Text
""
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ChainSelectionForFutureBlock"]
        []
        Text
"Run chain selection for a block that was previously from the future.\
        \ This is done for all blocks from the future each time a new block is\
        \ added."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"PipeliningEvent", Text
"SetTentativeHeader"]
        []
        Text
"An event traced during block selection when the tentative header\
        \ (in the context of diffusion pipelining) is set."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"PipeliningEvent", Text
"TrapTentativeHeader"]
        []
        Text
"An event traced during block selection when the body of the tentative\
        \ header turned out to be invalid."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceAddBlockEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"PipeliningEvent", Text
"OutdatedTentativeHeader"]
        []
        Text
"An event traced during block selection when the tentative header got\
        \ cleared on chain selection."
  ]


--------------------------------------------------------------------------------
-- FollowerEvent
--------------------------------------------------------------------------------

sevTraceFollowerEvent :: ChainDB.TraceFollowerEvent blk -> SeverityS
sevTraceFollowerEvent :: TraceFollowerEvent blk -> SeverityS
sevTraceFollowerEvent ChainDB.NewFollower {}            = SeverityS
Debug
sevTraceFollowerEvent ChainDB.FollowerNoLongerInMem {}  = SeverityS
Debug
sevTraceFollowerEvent ChainDB.FollowerSwitchToMem {}    = SeverityS
Debug
sevTraceFollowerEvent ChainDB.FollowerNewImmIterator {} = SeverityS
Debug

namesForChainDBFollower :: ChainDB.TraceFollowerEvent blk -> [Text]
namesForChainDBFollower :: TraceFollowerEvent blk -> [Text]
namesForChainDBFollower  TraceFollowerEvent blk
ChainDB.NewFollower =
      [Text
"NewFollower"]
namesForChainDBFollower (ChainDB.FollowerNoLongerInMem {}) =
      [Text
"FollowerNoLongerInMem"]
namesForChainDBFollower (ChainDB.FollowerSwitchToMem {}) =
      [Text
"FollowerSwitchToMem"]
namesForChainDBFollower (ChainDB.FollowerNewImmIterator {}) =
      [Text
"FollowerNewImmIterator"]

docChainDBFollower :: Documented (ChainDB.TraceFollowerEvent ev)
docChainDBFollower :: Documented (TraceFollowerEvent ev)
docChainDBFollower = [DocMsg (TraceFollowerEvent ev)]
-> Documented (TraceFollowerEvent ev)
forall a. [DocMsg a] -> Documented a
Documented
    [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceFollowerEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"NewFollower"]
        []
        Text
"A new follower was created."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceFollowerEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"FollowerNoLongerInMem"]
        []
        Text
"The follower was in the 'FollowerInImmutableDB' state and is switched to\
        \ the 'FollowerInMem' state."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceFollowerEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"FollowerSwitchToMem"]
        []
        Text
"The follower was in the 'FollowerInImmutableDB' state and is switched to\
        \ the 'FollowerInMem' state."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceFollowerEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"FollowerNewImmIterator"]
        []
        Text
"The follower is in the 'FollowerInImmutableDB' state but the iterator is\
        \ exhausted while the ImmDB has grown, so we open a new iterator to\
        \ stream these blocks too."
  ]

--------------------------------------------------------------------------------
-- CopiedBlockToImmutableDB
--------------------------------------------------------------------------------

sevTraceCopyToImmutableDBEvent :: ChainDB.TraceCopyToImmutableDBEvent blk -> SeverityS
sevTraceCopyToImmutableDBEvent :: TraceCopyToImmutableDBEvent blk -> SeverityS
sevTraceCopyToImmutableDBEvent ChainDB.CopiedBlockToImmutableDB {} = SeverityS
Debug
sevTraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB = SeverityS
Debug

namesForChainDBCopyToImmutable :: ChainDB.TraceCopyToImmutableDBEvent blk -> [Text]
namesForChainDBCopyToImmutable :: TraceCopyToImmutableDBEvent blk -> [Text]
namesForChainDBCopyToImmutable (ChainDB.CopiedBlockToImmutableDB {}) =
  [Text
"CopiedBlockToImmutableDB"]
namesForChainDBCopyToImmutable TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB =
  [Text
"NoBlocksToCopyToImmutableDB"]

instance ConvertRawHash blk
          => LogFormatting (ChainDB.TraceCopyToImmutableDBEvent blk) where
  forHuman :: TraceCopyToImmutableDBEvent blk -> Text
forHuman (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 ImmDB"
  forHuman TraceCopyToImmutableDBEvent blk
ChainDB.NoBlocksToCopyToImmutableDB  =
      Text
"There are no blocks to copy to the ImmDB"

  forMachine :: DetailLevel -> TraceCopyToImmutableDBEvent blk -> Object
forMachine DetailLevel
dtals (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
"CopiedBlockToImmutableDB"
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals Point blk
pt ]
  forMachine DetailLevel
_dtals 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
"NoBlocksToCopyToImmutableDB" ]

docChainDBImmtable :: Documented (ChainDB.TraceCopyToImmutableDBEvent blk)
docChainDBImmtable :: Documented (TraceCopyToImmutableDBEvent blk)
docChainDBImmtable = [DocMsg (TraceCopyToImmutableDBEvent blk)]
-> Documented (TraceCopyToImmutableDBEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"CopiedBlockToImmutableDB"]
        []
        Text
"A block was successfully copied to the ImmDB."
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"NoBlocksToCopyToImmutableDB"]
        []
        Text
"There are no block to copy to the ImmDB."
  ]

--------------------------------------------------------------------------------
-- GCEvent
--------------------------------------------------------------------------------

sevTraceGCEvent :: ChainDB.TraceGCEvent blk -> SeverityS
sevTraceGCEvent :: TraceGCEvent blk -> SeverityS
sevTraceGCEvent ChainDB.PerformedGC {} = SeverityS
Debug
sevTraceGCEvent ChainDB.ScheduledGC {} = SeverityS
Debug

namesForChainDBGCEvent :: ChainDB.TraceGCEvent blk -> [Text]
namesForChainDBGCEvent :: TraceGCEvent blk -> [Text]
namesForChainDBGCEvent (ChainDB.ScheduledGC {}) =
      [Text
"ScheduledGC"]
namesForChainDBGCEvent (ChainDB.PerformedGC {}) =
      [Text
"PerformedGC"]

instance LogFormatting (ChainDB.TraceGCEvent blk) where
  forHuman :: TraceGCEvent blk -> Text
forHuman (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
  forHuman (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

  forMachine :: DetailLevel -> TraceGCEvent blk -> Object
forMachine DetailLevel
dtals (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
"PerformedGC"
               , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> SlotNo -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals SlotNo
slot ]
  forMachine DetailLevel
dtals (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
"ScheduledGC"
                 , Key
"slot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> SlotNo -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals 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
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) | DetailLevel
dtals DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DDetailed]

docChainDBGCEvent :: Documented (ChainDB.TraceGCEvent blk)
docChainDBGCEvent :: Documented (TraceGCEvent blk)
docChainDBGCEvent = [DocMsg (TraceGCEvent blk)] -> Documented (TraceGCEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceGCEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ScheduledGC"]
        []
        Text
"There are no block to copy to the ImmDB."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceGCEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"PerformedGC"]
        []
        Text
"There are no block to copy to the ImmDB."
  ]

--------------------------------------------------------------------------------
-- TraceInitChainSelEvent
--------------------------------------------------------------------------------

sevTraceInitChainSelEvent :: ChainDB.TraceInitChainSelEvent blk -> SeverityS
sevTraceInitChainSelEvent :: TraceInitChainSelEvent blk -> SeverityS
sevTraceInitChainSelEvent ChainDB.StartedInitChainSelection {} = SeverityS
Info
sevTraceInitChainSelEvent ChainDB.InitalChainSelected {} = SeverityS
Info
sevTraceInitChainSelEvent (ChainDB.InitChainSelValidation TraceValidationEvent blk
ev') =
  case TraceValidationEvent blk
ev' of
      ChainDB.InvalidBlock{}                                     -> SeverityS
Debug
      ChainDB.ValidCandidate {}                                  -> SeverityS
Info
      ChainDB.CandidateContainsFutureBlocks {}                   -> SeverityS
Debug
      ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> SeverityS
Debug
      ChainDB.UpdateLedgerDbTraceEvent {}                        -> SeverityS
Info

namesForInitChainSel :: ChainDB.TraceInitChainSelEvent blk -> [Text]
namesForInitChainSel :: TraceInitChainSelEvent blk -> [Text]
namesForInitChainSel (ChainDB.InitChainSelValidation
                              (ChainDB.InvalidBlock {})) =
      [Text
"InvalidBlock"]
namesForInitChainSel (ChainDB.InitChainSelValidation
                              (ChainDB.ValidCandidate {})) =
      [Text
"ValidCandidate"]
namesForInitChainSel (ChainDB.InitChainSelValidation
                              (ChainDB.CandidateContainsFutureBlocks {})) =
      [Text
"CandidateContainsFutureBlocks"]
namesForInitChainSel (ChainDB.InitChainSelValidation
              (ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {})) =
      [Text
"CandidateContainsFutureBlocksExceedingClockSkew"]
namesForInitChainSel (ChainDB.InitChainSelValidation
                        (ChainDB.UpdateLedgerDbTraceEvent {})) =
      [Text
"UpdateLedgerDb"]
namesForInitChainSel (ChainDB.StartedInitChainSelection {}) =
      [Text
"StartedInitChainSelection"]
namesForInitChainSel (ChainDB.InitalChainSelected {}) =
      [Text
"InitalChainSelected"]

instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
  => LogFormatting (ChainDB.TraceInitChainSelEvent blk) where
    forHuman :: TraceInitChainSelEvent blk -> Text
forHuman (ChainDB.InitChainSelValidation TraceValidationEvent blk
v) = TraceValidationEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceValidationEvent blk
v
    forHuman (ChainDB.InitalChainSelected {}) =
        Text
"Initial chain selected"
    forHuman (ChainDB.StartedInitChainSelection {}) =
        Text
"Started initial chain selection"

    forMachine :: DetailLevel -> TraceInitChainSelEvent blk -> Object
forMachine DetailLevel
dtal (ChainDB.InitChainSelValidation TraceValidationEvent blk
v) = DetailLevel -> TraceValidationEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceValidationEvent blk
v
    forMachine DetailLevel
_dtal 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
"Follower.InitalChainSelected"]
    forMachine DetailLevel
_dtal 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
"Follower.StartedInitChainSelection"]

    asMetrics :: TraceInitChainSelEvent blk -> [Metric]
asMetrics (ChainDB.InitChainSelValidation TraceValidationEvent blk
v) = TraceValidationEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceValidationEvent blk
v
    asMetrics TraceInitChainSelEvent blk
ChainDB.InitalChainSelected        = []
    asMetrics TraceInitChainSelEvent blk
ChainDB.StartedInitChainSelection  = []


docChainDBInitChainSel :: Documented (ChainDB.TraceInitChainSelEvent blk)
docChainDBInitChainSel :: Documented (TraceInitChainSelEvent blk)
docChainDBInitChainSel = [DocMsg (TraceInitChainSelEvent blk)]
-> Documented (TraceInitChainSelEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidBlock"]
      []
      Text
"A point was found to be invalid."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
     [Text
"ValidCandidate"]
      []
      Text
"A candidate chain was valid."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
       [Text
"CandidateContainsFutureBlocks"]
      []
      Text
"Candidate contains headers from the future which do not exceed the\
      \ clock skew."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"CandidateContainsFutureBlocksExceedingClockSkew"]
      []
      Text
"Candidate contains headers from the future which exceed the\
      \ clock skew, making them invalid."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"UpdateLedgerDb"]
      []
      Text
"UpdateLedgerDb"
   ,  [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedInitChainSelection"]
      []
      Text
"StartedInitChainSelection"
   ,  [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceInitChainSelEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InitalChainSelected"]
      []
      Text
"InitalChainSelected"
  ]

--------------------------------------------------------------------------------
-- TraceOpenEvent
--------------------------------------------------------------------------------

sevTraceOpenEvent :: ChainDB.TraceOpenEvent blk -> SeverityS
sevTraceOpenEvent :: TraceOpenEvent blk -> SeverityS
sevTraceOpenEvent ChainDB.OpenedDB {}               = SeverityS
Info
sevTraceOpenEvent ChainDB.ClosedDB {}               = SeverityS
Info
sevTraceOpenEvent ChainDB.OpenedImmutableDB {}      = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.OpenedVolatileDB          = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.OpenedLgrDB               = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningDB          = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB  = SeverityS
Info
sevTraceOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB       = SeverityS
Info

namesForChainDBOpenEvent :: ChainDB.TraceOpenEvent blk -> [Text]
namesForChainDBOpenEvent :: TraceOpenEvent blk -> [Text]
namesForChainDBOpenEvent (ChainDB.OpenedDB {}) =
      [Text
"OpenedDB"]
namesForChainDBOpenEvent (ChainDB.ClosedDB {}) =
      [Text
"ClosedDB"]
namesForChainDBOpenEvent (ChainDB.OpenedImmutableDB {}) =
      [Text
"OpenedImmutableDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.OpenedVolatileDB =
      [Text
"OpenedVolatileDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.OpenedLgrDB =
      [Text
"OpenedLgrDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningDB =
      [Text
"StartedOpeningDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB =
      [Text
"StartedOpeningImmutableDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB =
      [Text
"StartedOpeningVolatileDB"]
namesForChainDBOpenEvent TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB =
      [Text
"StartedOpeningLgrDB"]


instance ConvertRawHash blk
          => LogFormatting (ChainDB.TraceOpenEvent blk) where
  forHuman :: TraceOpenEvent blk -> Text
forHuman (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'
  forHuman (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'
  forHuman (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
  forHuman TraceOpenEvent blk
ChainDB.OpenedVolatileDB = Text
"Opened vol db"
  forHuman TraceOpenEvent blk
ChainDB.OpenedLgrDB = Text
"Opened lgr db"
  forHuman TraceOpenEvent blk
ChainDB.StartedOpeningDB = Text
"Started opening Chain DB"
  forHuman TraceOpenEvent blk
ChainDB.StartedOpeningImmutableDB = Text
"Started opening Immutable DB"
  forHuman TraceOpenEvent blk
ChainDB.StartedOpeningVolatileDB = Text
"Started opening Volatile DB"
  forHuman TraceOpenEvent blk
ChainDB.StartedOpeningLgrDB = Text
"Started opening Ledger DB"

  forMachine :: DetailLevel -> TraceOpenEvent blk -> Object
forMachine DetailLevel
dtal (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
"OpenedDB"
             , Key
"immtip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
immTip
             , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
tip' ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
immTip
             , Key
"tip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
tip' ]
  forMachine DetailLevel
dtal (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
"OpenedImmutableDB"
             , Key
"immtip" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Point blk
immTip
             , Key
"epoch" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ((String -> Text
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) ]
  forMachine DetailLevel
_dtal 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
"OpenedVolatileDB" ]
  forMachine DetailLevel
_dtal 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
"OpenedLgrDB" ]
  forMachine DetailLevel
_dtal 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
"StartedOpeningDB"]
  forMachine DetailLevel
_dtal 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
"StartedOpeningImmutableDB"]
  forMachine DetailLevel
_dtal 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
"StartedOpeningVolatileDB"]
  forMachine DetailLevel
_dtal 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
"StartedOpeningLgrDB"]


docChainDBOpenEvent :: Documented (ChainDB.TraceOpenEvent blk)
docChainDBOpenEvent :: Documented (TraceOpenEvent blk)
docChainDBOpenEvent = [DocMsg (TraceOpenEvent blk)] -> Documented (TraceOpenEvent blk)
forall a. [DocMsg a] -> Documented a
Documented
    [ [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"OpenedDB"]
      []
      Text
"The ChainDB was opened."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ClosedDB"]
      []
      Text
"The ChainDB was closed."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"OpenedImmutableDB"]
      []
      Text
"The ImmDB was opened."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"OpenedVolatileDB"]
      []
      Text
"The VolatileDB was opened."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"OpenedLgrDB"]
      []
      Text
"The LedgerDB was opened."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedOpeningDB"]
      []
      Text
""
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedOpeningImmutableDB"]
      []
      Text
""
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedOpeningVolatileDB"]
      []
      Text
""
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceOpenEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedOpeningLgrDB"]
      []
      Text
"The LedgerDB was opened."
  ]

--------------------------------------------------------------------------------
-- IteratorEvent
--------------------------------------------------------------------------------

sevTraceIteratorEvent :: ChainDB.TraceIteratorEvent blk -> SeverityS
sevTraceIteratorEvent :: TraceIteratorEvent blk -> SeverityS
sevTraceIteratorEvent ChainDB.StreamFromVolatileDB {} = SeverityS
Debug
sevTraceIteratorEvent TraceIteratorEvent blk
_                               = SeverityS
Debug

namesForChainDBIteratorEvent  :: ChainDB.TraceIteratorEvent blk -> [Text]
namesForChainDBIteratorEvent :: TraceIteratorEvent blk -> [Text]
namesForChainDBIteratorEvent (ChainDB.UnknownRangeRequested {}) =
      [Text
"UnknownRangeRequested"]
namesForChainDBIteratorEvent (ChainDB.StreamFromVolatileDB {}) =
      [Text
"StreamFromVolatileDB"]
namesForChainDBIteratorEvent (ChainDB.StreamFromImmutableDB {}) =
      [Text
"StreamFromImmutableDB"]
namesForChainDBIteratorEvent (ChainDB.StreamFromBoth {}) =
      [Text
"StreamFromBoth"]
namesForChainDBIteratorEvent (ChainDB.BlockMissingFromVolatileDB {}) =
      [Text
"BlockMissingFromVolatileDB"]
namesForChainDBIteratorEvent (ChainDB.BlockWasCopiedToImmutableDB {}) =
      [Text
"BlockWasCopiedToImmutableDB"]
namesForChainDBIteratorEvent (ChainDB.BlockGCedFromVolatileDB {}) =
      [Text
"BlockGCedFromVolatileDB"]
namesForChainDBIteratorEvent TraceIteratorEvent blk
ChainDB.SwitchBackToVolatileDB =
      [Text
"SwitchBackToVolatileDB"]

instance  ( StandardHash blk
          , ConvertRawHash blk
          ) => LogFormatting (ChainDB.TraceIteratorEvent blk) where
  forHuman :: TraceIteratorEvent blk -> Text
forHuman (ChainDB.UnknownRangeRequested UnknownRange blk
ev') = UnknownRange blk -> Text
forall a. LogFormatting a => a -> Text
forHuman UnknownRange blk
ev'
  forHuman (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 ImmDB 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
  forHuman (ChainDB.StreamFromImmutableDB StreamFrom blk
sFrom StreamTo blk
sTo) =
      Text
"Stream only from the ImmDB. 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
  forHuman (ChainDB.StreamFromBoth StreamFrom blk
sFrom StreamTo blk
sTo [RealPoint blk]
pts) =
      Text
"Stream from both the VolatileDB and the ImmDB."
        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)
  forHuman (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)
  forHuman (ChainDB.BlockWasCopiedToImmutableDB RealPoint blk
pt) =
      Text
"This block has been garbage collected from the VolatileDB is now\
        \ found and streamed from the ImmDB. 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
  forHuman (ChainDB.BlockGCedFromVolatileDB RealPoint blk
pt) =
      Text
"This block no longer in the VolatileDB and isn't in the ImmDB\
        \ 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
  forHuman TraceIteratorEvent blk
ChainDB.SwitchBackToVolatileDB = Text
"SwitchBackToVolatileDB"

  forMachine :: DetailLevel -> TraceIteratorEvent blk -> Object
forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal (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
"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)
             ]
  forMachine DetailLevel
_dtal 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
"SwitchBackToVolatileDB"
             ]

instance  ( StandardHash blk
          , ConvertRawHash blk
          ) => LogFormatting (ChainDB.UnknownRange blk) where
  forHuman :: UnknownRange blk -> Text
forHuman (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
  forHuman (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

  forMachine :: DetailLevel -> UnknownRange blk -> Object
forMachine DetailLevel
_dtal (ChainDB.MissingBlock 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
"MissingBlock"
             , 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)
             ]
  forMachine DetailLevel
_dtal (ChainDB.ForkTooOld StreamFrom blk
streamFrom) =
    [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
"ForkTooOld"
             , 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)
             ]

docChainDBIteratorEvent :: Documented (ChainDB.TraceIteratorEvent blk)
docChainDBIteratorEvent :: Documented (TraceIteratorEvent blk)
docChainDBIteratorEvent = [DocMsg (TraceIteratorEvent blk)]
-> Documented (TraceIteratorEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"UnknownRangeRequested"]
      []
      Text
"An unknown range was requested, see 'UnknownRange'."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StreamFromVolatileDB"]
      []
      Text
"Stream only from the VolatileDB."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StreamFromImmutableDB"]
      []
      Text
"Stream only from the ImmDB."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StreamFromBoth"]
      []
      Text
"Stream from both the VolatileDB and the ImmDB."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"BlockMissingFromVolatileDB"]
      []
      Text
"A block is no longer in the VolatileDB because it has been garbage\
      \ collected. It might now be in the ImmDB if it was part of the\
      \ current chain."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
       [Text
"BlockWasCopiedToImmutableDB"]
      []
      Text
"A block that has been garbage collected from the VolatileDB is now\
      \ found and streamed from the ImmDB."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"BlockGCedFromVolatileDB"]
      []
      Text
"A block is no longer in the VolatileDB and isn't in the ImmDB\
      \ either; it wasn't part of the current chain."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceIteratorEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"SwitchBackToVolatileDB"]
      []
      Text
"We have streamed one or more blocks from the ImmDB that were part\
      \ of the VolatileDB when initialising the iterator. Now, we have to look\
      \ back in the VolatileDB again because the ImmDB doesn't have the\
      \ next block we're looking for."
  ]


--------------------------------------------------------------------------------
-- LedgerDB.TraceEvent
--------------------------------------------------------------------------------

sevTraceLedgerEvent :: LedgerDB.TraceEvent blk -> SeverityS
sevTraceLedgerEvent :: TraceEvent blk -> SeverityS
sevTraceLedgerEvent LedgerDB.TookSnapshot {}    = SeverityS
Info
sevTraceLedgerEvent LedgerDB.DeletedSnapshot {} = SeverityS
Debug
sevTraceLedgerEvent LedgerDB.InvalidSnapshot {} = SeverityS
Error

namesForChainDBLedgerEvent :: LedgerDB.TraceEvent blk -> [Text]
namesForChainDBLedgerEvent :: TraceEvent blk -> [Text]
namesForChainDBLedgerEvent (LedgerDB.InvalidSnapshot {}) =
      [Text
"InvalidSnapshot"]
namesForChainDBLedgerEvent (LedgerDB.TookSnapshot {}) =
      [Text
"TookSnapshot"]
namesForChainDBLedgerEvent (LedgerDB.DeletedSnapshot {}) =
      [Text
"DeletedSnapshot"]

instance ( StandardHash blk
         , ConvertRawHash blk)
         => LogFormatting (LedgerDB.TraceEvent blk) where
  forHuman :: TraceEvent blk -> Text
forHuman (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
  forHuman (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
  forHuman (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

  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
dtals (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
"TookSnapshot"
             , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals 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 ]
  forMachine DetailLevel
dtals (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
"DeletedSnapshot"
             , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals DiskSnapshot
snap ]
  forMachine DetailLevel
dtals (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
"InvalidSnapshot"
             , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals 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 ]

docChainDBLedgerEvent :: Documented (LedgerDB.TraceEvent blk)
docChainDBLedgerEvent :: Documented (TraceEvent blk)
docChainDBLedgerEvent = [DocMsg (TraceEvent blk)] -> Documented (TraceEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidSnapshot"]
      []
      Text
"An on disk snapshot was skipped because it was invalid."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"TookSnapshot"]
      []
      Text
"A snapshot was written to disk."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DeletedSnapshot"]
      []
      Text
"An old or invalid on-disk snapshot was deleted."
  ]

--------------------------------------------------------------------------------
-- LedgerReplayEvent
--------------------------------------------------------------------------------

sevTraceLedgerReplayEvent :: LedgerDB.TraceReplayEvent blk -> SeverityS
sevTraceLedgerReplayEvent :: TraceReplayEvent blk -> SeverityS
sevTraceLedgerReplayEvent LedgerDB.ReplayFromGenesis {}  = SeverityS
Info
sevTraceLedgerReplayEvent LedgerDB.ReplayFromSnapshot {} = SeverityS
Info
sevTraceLedgerReplayEvent LedgerDB.ReplayedBlock {}      = SeverityS
Info

namesForChainDBLedgerReplayEvent :: LedgerDB.TraceReplayEvent blk -> [Text]
namesForChainDBLedgerReplayEvent :: TraceReplayEvent blk -> [Text]
namesForChainDBLedgerReplayEvent (LedgerDB.ReplayFromGenesis {}) =
    [Text
"ReplayFromGenesis"]
namesForChainDBLedgerReplayEvent (LedgerDB.ReplayFromSnapshot {}) =
    [Text
"ReplayFromSnapshot"]
namesForChainDBLedgerReplayEvent (LedgerDB.ReplayedBlock {}) =
    [Text
"ReplayedBlock"]

instance (StandardHash blk, ConvertRawHash blk)
          => LogFormatting (LedgerDB.TraceReplayEvent blk) where
  forHuman :: TraceReplayEvent blk -> Text
forHuman (LedgerDB.ReplayFromGenesis ReplayGoal blk
_replayTo) =
      Text
"Replaying ledger from genesis"
  forHuman (LedgerDB.ReplayFromSnapshot DiskSnapshot
snap RealPoint blk
tip' ReplayStart blk
_ ReplayGoal blk
_) =
      Text
"Replaying ledger from snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
tip'
  forHuman (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
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
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
"%"

  forMachine :: DetailLevel -> TraceReplayEvent blk -> Object
forMachine DetailLevel
_dtal (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
"ReplayFromGenesis" ]
  forMachine DetailLevel
dtal (LedgerDB.ReplayFromSnapshot DiskSnapshot
snap RealPoint blk
tip' ReplayStart blk
_ ReplayGoal 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
"ReplayFromSnapshot"
               , Key
"snapshot" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal 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' ]
  forMachine DetailLevel
_dtal (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
"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) ]


docChainDBLedgerReplayEvent :: Documented (ChainDB.TraceReplayEvent ev)
docChainDBLedgerReplayEvent :: Documented (TraceReplayEvent ev)
docChainDBLedgerReplayEvent = [DocMsg (TraceReplayEvent ev)] -> Documented (TraceReplayEvent ev)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceReplayEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ReplayFromGenesis"]
      []
      Text
"There were no LedgerDB snapshots on disk, so we're replaying all\
      \ blocks starting from Genesis against the initial ledger.\
      \ The @replayTo@ parameter corresponds to the block at the tip of the\
      \ ImmDB, i.e., the last block to replay."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceReplayEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ReplayFromSnapshot"]
      []
      Text
"There was a LedgerDB snapshot on disk corresponding to the given tip.\
      \ We're replaying more recent blocks against it.\
      \ The @replayTo@ parameter corresponds to the block at the tip of the\
      \ ImmDB, i.e., the last block to replay."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceReplayEvent ev)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ReplayedBlock"]
      []
      Text
"We replayed the given block (reference) on the genesis snapshot\
      \ during the initialisation of the LedgerDB.\
      \\n\
      \ The @blockInfo@ parameter corresponds replayed block and the @replayTo@\
      \ parameter corresponds to the block at the tip of the ImmDB, i.e.,\
      \ the last block to replay."
    ]

--------------------------------------------------------------------------------
-- TraceImmutableDBEvent
--------------------------------------------------------------------------------

sevTraceImmutableDBEvent :: ImmDB.TraceEvent blk -> SeverityS
sevTraceImmutableDBEvent :: TraceEvent blk -> SeverityS
sevTraceImmutableDBEvent ImmDB.NoValidLastLocation {} = SeverityS
Info
sevTraceImmutableDBEvent ImmDB.ValidatedLastLocation {} = SeverityS
Info
sevTraceImmutableDBEvent (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev') =
  case TraceChunkValidation blk ChunkNo
ev' of
      ImmDB.StartedValidatingChunk{} -> SeverityS
Info
      ImmDB.ValidatedChunk{}         -> SeverityS
Info
      ImmDB.MissingChunkFile{}       -> SeverityS
Warning
      ImmDB.InvalidChunkFile {}      -> SeverityS
Warning
      ImmDB.MissingPrimaryIndex{}    -> SeverityS
Warning
      ImmDB.MissingSecondaryIndex{}  -> SeverityS
Warning
      ImmDB.InvalidPrimaryIndex{}    -> SeverityS
Warning
      ImmDB.InvalidSecondaryIndex{}  -> SeverityS
Warning
      ImmDB.RewritePrimaryIndex{}    -> SeverityS
Warning
      ImmDB.RewriteSecondaryIndex{}  -> SeverityS
Warning
sevTraceImmutableDBEvent ImmDB.ChunkFileDoesntFit{} = SeverityS
Warning
sevTraceImmutableDBEvent ImmDB.Migrating{}          = SeverityS
Debug
sevTraceImmutableDBEvent ImmDB.DeletingAfter{}      = SeverityS
Debug
sevTraceImmutableDBEvent ImmDB.DBAlreadyClosed{}    = SeverityS
Error
sevTraceImmutableDBEvent ImmDB.DBClosed{}           = SeverityS
Info
sevTraceImmutableDBEvent ImmDB.TraceCacheEvent{}    = SeverityS
Debug

namesForChainDBImmutableDBEvent :: ImmDB.TraceEvent blk -> [Text]
namesForChainDBImmutableDBEvent :: TraceEvent blk -> [Text]
namesForChainDBImmutableDBEvent TraceEvent blk
ImmDB.NoValidLastLocation =
    [Text
"NoValidLastLocation"]
namesForChainDBImmutableDBEvent (ImmDB.ValidatedLastLocation {}) =
    [Text
"ValidatedLastLocation"]
namesForChainDBImmutableDBEvent (ImmDB.ChunkFileDoesntFit {}) =
    [Text
"ChunkFileDoesntFit"]
namesForChainDBImmutableDBEvent (ImmDB.Migrating {}) =
    [Text
"Migrating"]
namesForChainDBImmutableDBEvent (ImmDB.DeletingAfter {}) =
    [Text
"DeletingAfter"]
namesForChainDBImmutableDBEvent TraceEvent blk
ImmDB.DBAlreadyClosed =
    [Text
"DBAlreadyClosed"]
namesForChainDBImmutableDBEvent TraceEvent blk
ImmDB.DBClosed =
    [Text
"DBClosed"]

namesForChainDBImmutableDBEvent (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev) =
    Text
"ChunkValidation" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceChunkValidation blk ChunkNo -> [Text]
forall blk. TraceChunkValidation blk ChunkNo -> [Text]
namesForChainDBImmutableChunkValidation TraceChunkValidation blk ChunkNo
ev
namesForChainDBImmutableDBEvent (ImmDB.TraceCacheEvent TraceCacheEvent
ev') =
    Text
"CacheEvent" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: TraceCacheEvent -> [Text]
namesForChainDBImmutableDBCacheEvent TraceCacheEvent
ev'

namesForChainDBImmutableChunkValidation ::
     ImmDB.TraceChunkValidation blk ImmDB.ChunkNo
  -> [Text]
namesForChainDBImmutableChunkValidation :: TraceChunkValidation blk ChunkNo -> [Text]
namesForChainDBImmutableChunkValidation (ImmDB.StartedValidatingChunk {}) =
    [Text
"StartedValidatingChunk"]
namesForChainDBImmutableChunkValidation (ImmDB.ValidatedChunk {}) =
    [Text
"ValidatedChunk"]
namesForChainDBImmutableChunkValidation (ImmDB.MissingChunkFile {}) =
    [Text
"MissingChunkFile"]
namesForChainDBImmutableChunkValidation (ImmDB.InvalidChunkFile {}) =
    [Text
"InvalidChunkFile"]
namesForChainDBImmutableChunkValidation (ImmDB.MissingPrimaryIndex {}) =
    [Text
"MissingPrimaryIndex"]
namesForChainDBImmutableChunkValidation (ImmDB.MissingSecondaryIndex {}) =
    [Text
"MissingSecondaryIndex"]
namesForChainDBImmutableChunkValidation (ImmDB.InvalidPrimaryIndex {}) =
    [Text
"InvalidPrimaryIndex"]
namesForChainDBImmutableChunkValidation (ImmDB.InvalidSecondaryIndex {}) =
    [Text
"InvalidSecondaryIndex"]
namesForChainDBImmutableChunkValidation (ImmDB.RewritePrimaryIndex {}) =
    [Text
"RewritePrimaryIndex"]
namesForChainDBImmutableChunkValidation (ImmDB.RewriteSecondaryIndex {}) =
    [Text
"RewriteSecondaryIndex"]


namesForChainDBImmutableDBCacheEvent :: ImmDB.TraceCacheEvent -> [Text]
namesForChainDBImmutableDBCacheEvent :: TraceCacheEvent -> [Text]
namesForChainDBImmutableDBCacheEvent (ImmDB.TraceCurrentChunkHit {}) =
    [Text
"CurrentChunkHit"]
namesForChainDBImmutableDBCacheEvent (ImmDB.TracePastChunkHit {}) =
    [Text
"PastChunkHit"]
namesForChainDBImmutableDBCacheEvent (ImmDB.TracePastChunkMiss {}) =
    [Text
"PastChunkMiss"]
namesForChainDBImmutableDBCacheEvent (ImmDB.TracePastChunkEvict {}) =
    [Text
"PastChunkEvict"]
namesForChainDBImmutableDBCacheEvent (ImmDB.TracePastChunksExpired {}) =
    [Text
"PastChunkExpired"]

instance (ConvertRawHash blk, StandardHash blk)
  => LogFormatting (ImmDB.TraceEvent blk) where
    forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
_dtal 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
"NoValidLastLocation" ]
    forMachine DetailLevel
_dtal (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
"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)
               ]
    forMachine DetailLevel
dtal (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
traceChunkValidation) =
      DetailLevel -> TraceChunkValidation blk ChunkNo -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceChunkValidation blk ChunkNo
traceChunkValidation
    forMachine DetailLevel
_dtal (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
"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)
               ]
    forMachine DetailLevel
_dtal 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
"DBAlreadyClosed" ]
    forMachine DetailLevel
_dtal 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
"DBClosed" ]
    forMachine DetailLevel
dtal (ImmDB.TraceCacheEvent TraceCacheEvent
cacheEv) =
      Text -> Object -> Object
kindContext Text
"TraceCacheEvent" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceCacheEvent -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceCacheEvent
cacheEv
    forMachine DetailLevel
_dtal (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
"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)
               ]
    forMachine DetailLevel
_dtal (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
"Migrating"
               , Key
"info" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
txt
               ]

    forHuman :: TraceEvent blk -> Text
forHuman TraceEvent blk
ImmDB.NoValidLastLocation =
          Text
"No valid last location was found. Starting from Genesis."
    forHuman (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
"."
    forHuman (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
"."
    forHuman (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
"."
    forHuman (ImmDB.Migrating Text
t) = Text
"Migrating: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    forHuman (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
    forHuman ImmDB.DBAlreadyClosed {} = Text
"Immutable DB was already closed. Double closing."
    forHuman ImmDB.DBClosed {} = Text
"Closed Immutable DB."
    forHuman (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

instance ConvertRawHash blk => LogFormatting (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo) where
    forMachine :: DetailLevel -> TraceChunkValidation blk ChunkNo -> Object
forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
dtal (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 (DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
pt)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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)
                 ]
    forMachine DetailLevel
_dtal (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 LogFormatting ImmDB.TraceCacheEvent where
    forMachine :: DetailLevel -> TraceCacheEvent -> Object
forMachine DetailLevel
_dtal (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
"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)
                   ]
    forMachine DetailLevel
_dtal (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
"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)
                   ]
    forMachine DetailLevel
_dtal (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
"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)
                   ]
    forMachine DetailLevel
_dtal (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
"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)
                   ]
    forMachine DetailLevel
_dtal (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
"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)
                   ]

docChainDBImmutableDBEvent :: Documented (ImmDB.TraceEvent blk)
docChainDBImmutableDBEvent :: Documented (TraceEvent blk)
docChainDBImmutableDBEvent = [DocMsg (TraceEvent blk)] -> Documented (TraceEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"NoValidLastLocation"]
      []
      Text
"No valid last location was found"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ValidatedLastLocation"]
      []
      Text
"The last location was validatet"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ChunkFileDoesntFit"]
      []
      Text
"The hash of the last block in the previous epoch doesn't match the\
      \ previous hash of the first block in the current epoch"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"Migrating"]
      []
      Text
"Performing a migration of the on-disk files."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DeletingAfter"]
      []
      Text
"Delete after"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DBAlreadyClosed"]
      []
      Text
"The immutable DB is already closed"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DBClosed"]
      []
      Text
"Closing the immutable DB"
    ]
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (TraceChunkValidation Any ChunkNo)
-> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"ChunkValidation"] Documented (TraceChunkValidation Any ChunkNo)
forall blk. Documented (TraceChunkValidation blk ChunkNo)
docChainDBImmutableDBChunkValidation
    Documented (TraceEvent blk)
-> Documented (TraceEvent blk) -> Documented (TraceEvent blk)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text] -> Documented TraceCacheEvent -> Documented (TraceEvent blk)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace [Text
"CacheEvent"]  Documented TraceCacheEvent
docChainDBImmutableDBCacheEvent

docChainDBImmutableDBChunkValidation ::
     Documented (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo)
docChainDBImmutableDBChunkValidation :: Documented (TraceChunkValidation blk ChunkNo)
docChainDBImmutableDBChunkValidation = [DocMsg (TraceChunkValidation blk ChunkNo)]
-> Documented (TraceChunkValidation blk ChunkNo)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"StartedValidatingChunk"]
      []
      Text
""
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ValidatedChunk"]
      []
      Text
""
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"MissingChunkFile"]
      []
      Text
"Chunk file is missing"
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidChunkFile"]
      []
      Text
"Chunk file is invalid"
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"MissingPrimaryIndex"]
      []
      Text
"The primary index is missing."
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"MissingSecondaryIndex"]
      []
      Text
"The secondary index is missing."
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidPrimaryIndex"]
      []
      Text
"The primary index is invalid."
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidSecondaryIndex"]
      []
      Text
""
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"RewritePrimaryIndex"]
      []
      Text
""
    , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"RewriteSecondaryIndex"]
      []
      Text
""
    ]

docChainDBImmutableDBCacheEvent :: Documented ImmDB.TraceCacheEvent
docChainDBImmutableDBCacheEvent :: Documented TraceCacheEvent
docChainDBImmutableDBCacheEvent = [DocMsg TraceCacheEvent] -> Documented TraceCacheEvent
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg TraceCacheEvent
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"CurrentChunkHit"]
      []
      Text
"Current chunk found in the cache."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceCacheEvent
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PastChunkHit"]
      []
      Text
"Past chunk found in the cache"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceCacheEvent
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PastChunkMiss"]
      []
      Text
"Past chunk was not found in the cache"
    , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceCacheEvent
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PastChunkEvict"]
      []
      Text
"The least recently used past chunk was evicted because the cache\
      \ was full."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceCacheEvent
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PastChunkExpired"]
      []
      Text
""
  ]

--------------------------------------------------------------------------------
-- VolatileDBEvent
--------------------------------------------------------------------------------

sevTraceVolatileDBEvent :: VolDB.TraceEvent blk -> SeverityS
sevTraceVolatileDBEvent :: TraceEvent blk -> SeverityS
sevTraceVolatileDBEvent TraceEvent blk
_ = SeverityS
Debug

namesForChainDBVolatileDBEvent :: VolDB.TraceEvent blk -> [Text]
namesForChainDBVolatileDBEvent :: TraceEvent blk -> [Text]
namesForChainDBVolatileDBEvent TraceEvent blk
VolDb.DBAlreadyClosed =
    [Text
"DBAlreadyClosed"]
namesForChainDBVolatileDBEvent (VolDb.Truncate {}) =
    [Text
"Truncate"]
namesForChainDBVolatileDBEvent (VolDb.InvalidFileNames {}) =
    [Text
"InvalidFileNames"]
namesForChainDBVolatileDBEvent (VolDb.BlockAlreadyHere {}) =
    [Text
"BlockAlreadyHere"]


instance StandardHash blk => LogFormatting (VolDB.TraceEvent blk) where
    forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
_dtal 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
"DBAlreadyClosed"]
    forMachine DetailLevel
_dtal (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
"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)
               ]
    forMachine DetailLevel
_dtal (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
"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)
               ]
    forMachine DetailLevel
_dtal (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
"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)
               ]

docChainDBVolatileDBEvent :: Documented (VolDB.TraceEvent blk)
docChainDBVolatileDBEvent :: Documented (TraceEvent blk)
docChainDBVolatileDBEvent = [DocMsg (TraceEvent blk)] -> Documented (TraceEvent blk)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DBAlreadyClosed"]
      []
      Text
"When closing the DB it was found itis closed already."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"Truncate"]
      []
      Text
"Truncates a file up to offset because of the error."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"InvalidFileNames"]
      []
      Text
"Reports a list of invalid file paths."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (TraceEvent blk)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"BlockAlreadyHere"]
      []
      Text
"A block was found to be already in the DB."
  ]

--------------------------------------------------------------------------------
-- Other orophans
--------------------------------------------------------------------------------

instance ( StandardHash blk
         , LogFormatting (ValidationErr (BlockProtocol blk))
         , LogFormatting (OtherHeaderEnvelopeError blk)
         )
      => LogFormatting (HeaderError blk) where
  forMachine :: DetailLevel -> HeaderError blk -> Object
forMachine DetailLevel
dtal (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
.= DetailLevel -> ValidationErr (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ValidationErr (BlockProtocol blk)
err
      ]
  forMachine DetailLevel
dtal (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
.= DetailLevel -> HeaderEnvelopeError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal HeaderEnvelopeError blk
err
      ]

instance ( StandardHash blk
         , LogFormatting (OtherHeaderEnvelopeError blk)
         )
      => LogFormatting (HeaderEnvelopeError blk) where
  forMachine :: DetailLevel -> HeaderEnvelopeError blk -> Object
forMachine DetailLevel
_dtal (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
      ]
  forMachine DetailLevel
_dtal (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
      ]
  forMachine DetailLevel
_dtal (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
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
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)
      ]
  forMachine DetailLevel
dtal (OtherHeaderEnvelopeError OtherHeaderEnvelopeError blk
err) =
    DetailLevel -> OtherHeaderEnvelopeError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal OtherHeaderEnvelopeError blk
err


instance (   LogFormatting (LedgerError blk)
           , LogFormatting (HeaderError blk))
        => LogFormatting (ExtValidationError blk) where
    forMachine :: DetailLevel -> ExtValidationError blk -> Object
forMachine DetailLevel
dtal (ExtValidationErrorLedger LedgerError blk
err) = DetailLevel -> LedgerError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal LedgerError blk
err
    forMachine DetailLevel
dtal (ExtValidationErrorHeader HeaderError blk
err) = DetailLevel -> HeaderError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal HeaderError blk
err

    forHuman :: ExtValidationError blk -> Text
forHuman (ExtValidationErrorLedger LedgerError blk
err) =  LedgerError blk -> Text
forall a. LogFormatting a => a -> Text
forHuman LedgerError blk
err
    forHuman (ExtValidationErrorHeader HeaderError blk
err) =  HeaderError blk -> Text
forall a. LogFormatting a => a -> Text
forHuman HeaderError blk
err

    asMetrics :: ExtValidationError blk -> [Metric]
asMetrics (ExtValidationErrorLedger LedgerError blk
err) =  LedgerError blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics LedgerError blk
err
    asMetrics (ExtValidationErrorHeader HeaderError blk
err) =  HeaderError blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics HeaderError blk
err

instance LogFormatting LedgerDB.DiskSnapshot where
  forMachine :: DetailLevel -> DiskSnapshot -> Object
forMachine DetailLevel
DDetailed 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
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> String
forall a. Show a => a -> String
show DiskSnapshot
snap) ]
  forMachine DetailLevel
_ 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" ]



instance (Show (PBFT.PBftVerKeyHash c))
      => LogFormatting (PBFT.PBftValidationErr c) where
  forMachine :: DetailLevel -> PBftValidationErr c -> Object
forMachine DetailLevel
_dtal (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
      ]
  forMachine DetailLevel
_dtal (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
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)
      ]
  forMachine DetailLevel
_dtal (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
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
Text.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
numForged))
      ]
  forMachine DetailLevel
_dtal 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))
      => LogFormatting (PBFT.PBftCannotForge c) where
  forMachine :: DetailLevel -> PBftCannotForge c -> Object
forMachine DetailLevel
_dtal (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
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)
      ]
  forMachine DetailLevel
_dtal (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