{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Tracing.ChainDB
  ( withAddedToCurrentChainEmptyLimited
  , fragmentChainDensity
  ) where

import Cardano.Ledger.BaseTypes (unNonZero)
import Cardano.Logging
import Cardano.Slotting.Time (getSlotLength)
import Data.Aeson (Object, ToJSON, Value (Object, String), object, toJSON, (.=))
import qualified Data.ByteString.Base16 as B16
import Data.Int (Int64)
import qualified Data.List.NonEmpty as NonEmpty
import Data.SOP (All, K (..), hcmap, hcollapse)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Time.Clock (NominalDiffTime)
import Data.Typeable (Typeable, cast)
import Data.Void (absurd)
import Data.Word (Word64)
import Numeric (showFFloat)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config.SecurityParam
  ( SecurityParam
  , maxRollbacks
  )
import Ouroboros.Consensus.HardFork.Combinator.Abstract.CanHardFork
import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock
import Ouroboros.Consensus.HardFork.Combinator.Info
import Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel
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.Peras.SelectView
import Ouroboros.Consensus.Protocol.Abstract
  ( Comparing (..)
  , ReasonForSwitch
  , SelectViewReasonForSwitch (..)
  , TiebreakerView
  , ValidationErr
  )
import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT
import Ouroboros.Consensus.Protocol.Praos.Common
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 as LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.Snapshots as LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as V2
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
import qualified Ouroboros.Consensus.Storage.PerasVoteDB as PerasVoteDB
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB
import Ouroboros.Consensus.Tracing.Formatting ()
import Ouroboros.Consensus.Tracing.HasIssuer
import Ouroboros.Consensus.Tracing.Render
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util.Condense (condense)
import Ouroboros.Consensus.Util.Enclose
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (MaxSlotNo (..))

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

-- A limiter that is not coming from configuration, because it carries a special filter
withAddedToCurrentChainEmptyLimited ::
  Trace IO (ChainDB.TraceEvent blk) ->
  IO (Trace IO (ChainDB.TraceEvent blk))
withAddedToCurrentChainEmptyLimited :: forall blk.
Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
withAddedToCurrentChainEmptyLimited Trace IO (TraceEvent blk)
tr = do
  ltr <- Double
-> Text
-> Trace IO TraceDispatcherMessage
-> Trace IO (TraceEvent blk)
-> IO (Trace IO (TraceEvent blk))
forall a (m :: * -> *).
MonadUnliftIO m =>
Double
-> Text
-> Trace m TraceDispatcherMessage
-> Trace m a
-> m (Trace m a)
limitFrequency Double
1.25 Text
"AddedToCurrentChainLimiter" Trace IO TraceDispatcherMessage
forall a. Monoid a => a
mempty Trace IO (TraceEvent blk)
tr
  pure $ routingTrace (selecting ltr) 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 SelectionChangedInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_ ReasonForSwitch' blk
_)) =
      if [LedgerEvent blk] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events
        then Trace IO (TraceEvent blk) -> IO (Trace IO (TraceEvent blk))
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace IO (TraceEvent blk)
tr

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

instance
  ( LogFormatting (Header blk)
  , LogFormatting (LedgerEvent blk)
  , LogFormatting (RealPoint blk)
  , LogFormatting (WeightedSelectView (BlockProtocol blk))
  , ConvertRawHash blk
  , ConvertRawHash (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  , HasIssuer blk
  , LogFormatting (ReasonForSwitch (TiebreakerView (BlockProtocol blk)))
  , Show (PerasCert blk)
  , Show (PerasError blk)
  ) =>
  LogFormatting (ChainDB.TraceEvent blk)
  where
  forHuman :: TraceEvent blk -> Text
forHuman TraceEvent blk
ChainDB.TraceLastShutdownUnclean =
    Text
"ChainDB is not clean. Validating all immutable chunks"
  forHuman (ChainDB.TracePerasVoteDbEvent TraceEvent blk
v) = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent blk
v
  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.TraceLedgerDBEvent TraceEvent blk
v) = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent 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
  forHuman (ChainDB.TraceChainSelStarvationEvent TraceChainSelStarvationEvent blk
ev) = case TraceChainSelStarvationEvent blk
ev of
    ChainDB.ChainSelStarvation Enclosing' (RealPoint blk)
RisingEdge ->
      Text
"Chain Selection was starved."
    ChainDB.ChainSelStarvation (FallingEdgeWith RealPoint blk
pt) ->
      Text
"Chain Selection was unstarved by " 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.TracePerasCertDbEvent TraceEvent blk
ev) = TraceEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceEvent blk
ev
  forHuman (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
ev) = TraceAddPerasCertEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceAddPerasCertEvent blk
ev

  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
_ TraceEvent blk
ChainDB.TraceLastShutdownUnclean =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LastShutdownUnclean"]
  forMachine DetailLevel
dtal (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation Enclosing' (RealPoint blk)
edge)) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSelStarvation"
      , case Enclosing' (RealPoint blk)
edge of
          Enclosing' (RealPoint blk)
RisingEdge -> Key
"risingEdge" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
          FallingEdgeWith RealPoint blk
pt -> Key
"fallingEdge" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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
details (ChainDB.TracePerasVoteDbEvent TraceEvent blk
v) =
    DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
v) =
    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) =
    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) =
    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) =
    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) =
    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) =
    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) =
    DetailLevel -> TraceIteratorEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceIteratorEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceLedgerDBEvent TraceEvent blk
v) =
    DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceImmutableDBEvent TraceEvent blk
v) =
    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) =
    DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TracePerasCertDbEvent TraceEvent blk
v) =
    DetailLevel -> TraceEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceEvent blk
v
  forMachine DetailLevel
details (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
v) =
    DetailLevel -> TraceAddPerasCertEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
details TraceAddPerasCertEvent blk
v

  asMetrics :: TraceEvent blk -> [Metric]
asMetrics TraceEvent blk
ChainDB.TraceLastShutdownUnclean = []
  asMetrics (ChainDB.TraceChainSelStarvationEvent TraceChainSelStarvationEvent blk
_) = []
  asMetrics (ChainDB.TracePerasVoteDbEvent TraceEvent blk
v) = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent blk
v
  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.TraceLedgerDBEvent TraceEvent blk
v) = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent 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
  asMetrics (ChainDB.TracePerasCertDbEvent TraceEvent blk
v) = TraceEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceEvent blk
v
  asMetrics (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
v) = TraceAddPerasCertEvent blk -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics TraceAddPerasCertEvent blk
v

instance MetaTrace (ChainDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor TraceEvent blk
ChainDB.TraceLastShutdownUnclean =
    [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LastShutdownUnclean"]
  namespaceFor ChainDB.TraceChainSelStarvationEvent{} =
    [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelStarvationEvent"]
  namespaceFor (ChainDB.TracePerasVoteDbEvent TraceEvent blk
ev) =
    Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PerasVoteDbEvent" (TraceEvent blk -> Namespace (TraceEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceEvent blk
ev)
  namespaceFor (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev) =
    Text
-> Namespace (TraceAddBlockEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddBlockEvent" (TraceAddBlockEvent blk -> Namespace (TraceAddBlockEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceAddBlockEvent blk
ev)
  namespaceFor (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev) =
    Text
-> Namespace (TraceFollowerEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"FollowerEvent" (TraceFollowerEvent blk -> Namespace (TraceFollowerEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceFollowerEvent blk
ev)
  namespaceFor (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev) =
    Text
-> Namespace (TraceCopyToImmutableDBEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"CopyToImmutableDBEvent" (TraceCopyToImmutableDBEvent blk
-> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceCopyToImmutableDBEvent blk
ev)
  namespaceFor (ChainDB.TraceGCEvent TraceGCEvent blk
ev) =
    Text -> Namespace (TraceGCEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"GCEvent" (TraceGCEvent blk -> Namespace (TraceGCEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceGCEvent blk
ev)
  namespaceFor (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev) =
    Text
-> Namespace (TraceInitChainSelEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"InitChainSelEvent" (TraceInitChainSelEvent blk
-> Namespace (TraceInitChainSelEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceInitChainSelEvent blk
ev)
  namespaceFor (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev) =
    Text
-> Namespace (TraceOpenEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"OpenEvent" (TraceOpenEvent blk -> Namespace (TraceOpenEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceOpenEvent blk
ev)
  namespaceFor (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev) =
    Text
-> Namespace (TraceIteratorEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"IteratorEvent" (TraceIteratorEvent blk -> Namespace (TraceIteratorEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceIteratorEvent blk
ev)
  namespaceFor (ChainDB.TraceLedgerDBEvent TraceEvent blk
ev) =
    Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"LedgerEvent" (TraceEvent blk -> Namespace (TraceEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceEvent blk
ev)
  namespaceFor (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev) =
    Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ImmDbEvent" (TraceEvent blk -> Namespace (TraceEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceEvent blk
ev)
  namespaceFor (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev) =
    Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"VolatileDbEvent" (TraceEvent blk -> Namespace (TraceEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceEvent blk
ev)
  namespaceFor (ChainDB.TracePerasCertDbEvent TraceEvent blk
ev) =
    Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PerasCertDbEvent" (TraceEvent blk -> Namespace (TraceEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceEvent blk
ev)
  namespaceFor (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
ev) =
    Text
-> Namespace (TraceAddPerasCertEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddPerasCertEvent" (TraceAddPerasCertEvent blk
-> Namespace (TraceAddPerasCertEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceAddPerasCertEvent blk
ev)

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"LastShutdownUnclean"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ChainSelStarvationEvent"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) (Just (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev')) =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddBlockEvent blk -> Maybe (TraceAddBlockEvent blk)
forall a. a -> Maybe a
Just TraceAddBlockEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) Maybe (TraceAddBlockEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) (Just (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev')) =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceFollowerEvent blk -> Maybe (TraceFollowerEvent blk)
forall a. a -> Maybe a
Just TraceFollowerEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Maybe (TraceFollowerEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev')) =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCopyToImmutableDBEvent blk
-> Maybe (TraceCopyToImmutableDBEvent blk)
forall a. a -> Maybe a
Just TraceCopyToImmutableDBEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Maybe (TraceCopyToImmutableDBEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) (Just (ChainDB.TraceGCEvent TraceGCEvent blk
ev')) =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceGCEvent blk -> Maybe (TraceGCEvent blk)
forall a. a -> Maybe a
Just TraceGCEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceGCEvent blk)) Maybe (TraceGCEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) (Just (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev')) =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceInitChainSelEvent blk -> Maybe (TraceInitChainSelEvent blk)
forall a. a -> Maybe a
Just TraceInitChainSelEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Maybe (TraceInitChainSelEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) (Just (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev')) =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceOpenEvent blk -> Maybe (TraceOpenEvent blk)
forall a. a -> Maybe a
Just TraceOpenEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceOpenEvent blk)) Maybe (TraceOpenEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) (Just (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev')) =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceIteratorEvent blk -> Maybe (TraceIteratorEvent blk)
forall a. a -> Maybe a
Just TraceIteratorEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Maybe (TraceIteratorEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) (Just (ChainDB.TraceLedgerDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) (Just (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) (Just (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (VolDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasVoteDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasVoteDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasCertDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasCertDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) (Just (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
ev')) =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddPerasCertEvent blk -> Maybe (TraceAddPerasCertEvent blk)
forall a. a -> Maybe a
Just TraceAddPerasCertEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddPerasCertEvent blk)) Maybe (TraceAddPerasCertEvent blk)
forall a. Maybe a
Nothing
  severityFor Namespace (TraceEvent blk)
_ns Maybe (TraceEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  privacyFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
privacyFor (Namespace [Text]
_ [Text
"LastShutdownUnclean"]) Maybe (TraceEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"ChainSelStarvationEvent"]) Maybe (TraceEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) (Just (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev')) =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddBlockEvent blk -> Maybe (TraceAddBlockEvent blk)
forall a. a -> Maybe a
Just TraceAddBlockEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) Maybe (TraceAddBlockEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) (Just (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev')) =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceFollowerEvent blk -> Maybe (TraceFollowerEvent blk)
forall a. a -> Maybe a
Just TraceFollowerEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Maybe (TraceFollowerEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev')) =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCopyToImmutableDBEvent blk
-> Maybe (TraceCopyToImmutableDBEvent blk)
forall a. a -> Maybe a
Just TraceCopyToImmutableDBEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Maybe (TraceCopyToImmutableDBEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) (Just (ChainDB.TraceGCEvent TraceGCEvent blk
ev')) =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceGCEvent blk -> Maybe (TraceGCEvent blk)
forall a. a -> Maybe a
Just TraceGCEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceGCEvent blk)) Maybe (TraceGCEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) (Just (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev')) =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceInitChainSelEvent blk -> Maybe (TraceInitChainSelEvent blk)
forall a. a -> Maybe a
Just TraceInitChainSelEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Maybe (TraceInitChainSelEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) (Just (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev')) =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceOpenEvent blk -> Maybe (TraceOpenEvent blk)
forall a. a -> Maybe a
Just TraceOpenEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceOpenEvent blk)) Maybe (TraceOpenEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) (Just (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev')) =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceIteratorEvent blk -> Maybe (TraceIteratorEvent blk)
forall a. a -> Maybe a
Just TraceIteratorEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Maybe (TraceIteratorEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) (Just (ChainDB.TraceLedgerDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) (Just (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) (Just (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (VolDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasVoteDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasVoteDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasCertDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasCertDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) (Just (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
ev')) =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddPerasCertEvent blk -> Maybe (TraceAddPerasCertEvent blk)
forall a. a -> Maybe a
Just TraceAddPerasCertEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddPerasCertEvent blk)) Maybe (TraceAddPerasCertEvent blk)
forall a. Maybe a
Nothing
  privacyFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Maybe Privacy
forall a. Maybe a
Nothing

  detailsFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
detailsFor (Namespace [Text]
_ [Text
"LastShutdownUnclean"]) Maybe (TraceEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
_ [Text
"ChainSelStarvationEvent"]) Maybe (TraceEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) (Just (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev')) =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddBlockEvent blk -> Maybe (TraceAddBlockEvent blk)
forall a. a -> Maybe a
Just TraceAddBlockEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) Maybe (TraceAddBlockEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) (Just (ChainDB.TraceFollowerEvent TraceFollowerEvent blk
ev')) =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceFollowerEvent blk -> Maybe (TraceFollowerEvent blk)
forall a. a -> Maybe a
Just TraceFollowerEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Maybe (TraceFollowerEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
ev')) =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCopyToImmutableDBEvent blk
-> Maybe (TraceCopyToImmutableDBEvent blk)
forall a. a -> Maybe a
Just TraceCopyToImmutableDBEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Maybe (TraceCopyToImmutableDBEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) (Just (ChainDB.TraceGCEvent TraceGCEvent blk
ev')) =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceGCEvent blk -> Maybe (TraceGCEvent blk)
forall a. a -> Maybe a
Just TraceGCEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceGCEvent blk)) Maybe (TraceGCEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) (Just (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev')) =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceInitChainSelEvent blk -> Maybe (TraceInitChainSelEvent blk)
forall a. a -> Maybe a
Just TraceInitChainSelEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Maybe (TraceInitChainSelEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) (Just (ChainDB.TraceOpenEvent TraceOpenEvent blk
ev')) =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceOpenEvent blk -> Maybe (TraceOpenEvent blk)
forall a. a -> Maybe a
Just TraceOpenEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceOpenEvent blk)) Maybe (TraceOpenEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) (Just (ChainDB.TraceIteratorEvent TraceIteratorEvent blk
ev')) =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceIteratorEvent blk -> Maybe (TraceIteratorEvent blk)
forall a. a -> Maybe a
Just TraceIteratorEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Maybe (TraceIteratorEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) (Just (ChainDB.TraceLedgerDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) (Just (ChainDB.TraceImmutableDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: (Namespace (ImmDB.TraceEvent blk))) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) (Just (ChainDB.TraceVolatileDBEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: (Namespace (VolDB.TraceEvent blk))) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasVoteDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasVoteDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) (Just (ChainDB.TracePerasCertDbEvent TraceEvent blk
ev')) =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceEvent blk -> Maybe (TraceEvent blk)
forall a. a -> Maybe a
Just TraceEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasCertDB.TraceEvent blk)) Maybe (TraceEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) (Just (ChainDB.TraceAddPerasCertEvent TraceAddPerasCertEvent blk
ev')) =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceAddPerasCertEvent blk -> Maybe (TraceAddPerasCertEvent blk)
forall a. a -> Maybe a
Just TraceAddPerasCertEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddPerasCertEvent blk)) Maybe (TraceAddPerasCertEvent blk)
forall a. Maybe a
Nothing
  detailsFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Maybe DetailLevel
forall a. Maybe a
Nothing

  metricsDocFor :: Namespace (TraceEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) =
    Namespace (TraceAddBlockEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddBlockEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) =
    Namespace (TraceFollowerEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceFollowerEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) =
    Namespace (TraceCopyToImmutableDBEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) =
    Namespace (TraceGCEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceGCEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) =
    Namespace (TraceInitChainSelEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceInitChainSelEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) =
    Namespace (TraceOpenEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceOpenEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) =
    Namespace (TraceIteratorEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceIteratorEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceEvent blk))
  metricsDocFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (VolDB.TraceEvent blk))
  metricsDocFor Namespace (TraceEvent blk)
_ = []

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"LastShutdownUnclean"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Last shutdown of the node didn't leave the ChainDB directory in a clean"
        , Text
" state. Therefore, revalidating all the immutable chunks is necessary to"
        , Text
" ensure the correctness of the chain."
        ]
  documentFor (Namespace [Text]
_ [Text
"ChainSelStarvationEvent"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"ChainSel is waiting for a next block to process, but there is no block in the queue."
        , Text
" Despite the name, it is a pretty normal (and frequent) event."
        ]
  documentFor (Namespace [Text]
out (Text
"AddBlockEvent" : [Text]
tl)) =
    Namespace (TraceAddBlockEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddBlockEvent blk))
  documentFor (Namespace [Text]
out (Text
"FollowerEvent" : [Text]
tl)) =
    Namespace (TraceFollowerEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceFollowerEvent blk))
  documentFor (Namespace [Text]
out (Text
"CopyToImmutableDBEvent" : [Text]
tl)) =
    Namespace (TraceCopyToImmutableDBEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk))
  documentFor (Namespace [Text]
out (Text
"GCEvent" : [Text]
tl)) =
    Namespace (TraceGCEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceGCEvent blk))
  documentFor (Namespace [Text]
out (Text
"InitChainSelEvent" : [Text]
tl)) =
    Namespace (TraceInitChainSelEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceInitChainSelEvent blk))
  documentFor (Namespace [Text]
out (Text
"OpenEvent" : [Text]
tl)) =
    Namespace (TraceOpenEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceOpenEvent blk))
  documentFor (Namespace [Text]
out (Text
"IteratorEvent" : [Text]
tl)) =
    Namespace (TraceIteratorEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceIteratorEvent blk))
  documentFor (Namespace [Text]
out (Text
"LedgerEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceEvent blk))
  documentFor (Namespace [Text]
out (Text
"ImmDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceEvent blk))
  documentFor (Namespace [Text]
out (Text
"VolatileDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (VolDB.TraceEvent blk))
  documentFor (Namespace [Text]
out (Text
"PerasVoteDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasVoteDB.TraceEvent blk))
  documentFor (Namespace [Text]
out (Text
"PerasCertDbEvent" : [Text]
tl)) =
    Namespace (TraceEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (PerasCertDB.TraceEvent blk))
  documentFor (Namespace [Text]
out (Text
"AddPerasCertEvent" : [Text]
tl)) =
    Namespace (TraceAddPerasCertEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceAddPerasCertEvent blk))
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LastShutdownUnclean"]
      Namespace (TraceEvent blk)
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. a -> [a] -> [a]
: [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelStarvationEvent"]
      Namespace (TraceEvent blk)
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. a -> [a] -> [a]
: ( (Namespace (TraceAddBlockEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceAddBlockEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
            (Text
-> Namespace (TraceAddBlockEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddBlockEvent")
            ([Namespace (TraceAddBlockEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceAddBlockEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceFollowerEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceFollowerEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceFollowerEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"FollowerEvent")
              ([Namespace (TraceFollowerEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceFollowerEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceCopyToImmutableDBEvent blk)
 -> Namespace (TraceEvent blk))
-> [Namespace (TraceCopyToImmutableDBEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceCopyToImmutableDBEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"CopyToImmutableDBEvent")
              ([Namespace (TraceCopyToImmutableDBEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceGCEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceGCEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceGCEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"GCEvent")
              ([Namespace (TraceGCEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceGCEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceInitChainSelEvent blk)
 -> Namespace (TraceEvent blk))
-> [Namespace (TraceInitChainSelEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceInitChainSelEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"InitChainSelEvent")
              ([Namespace (TraceInitChainSelEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceInitChainSelEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceOpenEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceOpenEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceOpenEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"OpenEvent")
              ([Namespace (TraceOpenEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceOpenEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceIteratorEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceIteratorEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceIteratorEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"IteratorEvent")
              ([Namespace (TraceIteratorEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceIteratorEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"LedgerEvent")
              ([Namespace (TraceEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (LedgerDB.TraceEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ImmDbEvent")
              ([Namespace (TraceEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ImmDB.TraceEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"VolatileDbEvent")
              ([Namespace (TraceEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (VolDB.TraceEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PerasVoteDbEvent")
              ([Namespace (TraceEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (PerasVoteDB.TraceEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text -> Namespace (TraceEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PerasCertDbEvent")
              ([Namespace (TraceEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (PerasCertDB.TraceEvent blk)])
            [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceAddPerasCertEvent blk)
 -> Namespace (TraceEvent blk))
-> [Namespace (TraceAddPerasCertEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
              (Text
-> Namespace (TraceAddPerasCertEvent blk)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddPerasCertEvent")
              ([Namespace (TraceAddPerasCertEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceAddPerasCertEvent blk)])
        )

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

instance LogFormatting (PraosReasonForSwitch c) where
  forHuman :: PraosReasonForSwitch c -> Text
forHuman (HigherOCert (Comparing Word64
ref Word64
cand)) =
    Text
"candidate has higher OCert (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
cand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") than our selection (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  forHuman (VRFTiebreak (Comparing OutputVRF (VRF c)
ref OutputVRF (VRF c)
cand)) =
    Text
"candidate has lower VRF (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputVRF (VRF c) -> Text
forall a. Show a => a -> Text
showT OutputVRF (VRF c)
cand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") than our selection (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OutputVRF (VRF c) -> Text
forall a. Show a => a -> Text
showT OutputVRF (VRF c)
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  forMachine :: DetailLevel -> PraosReasonForSwitch c -> Object
forMachine DetailLevel
_dtal (HigherOCert (Comparing Word64
ref Word64
cand)) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HigherOCert"
      , Key
"our" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
showT Word64
ref)
      , Key
"candidate" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
showT Word64
cand)
      ]
  forMachine DetailLevel
_dtal (VRFTiebreak (Comparing OutputVRF (VRF c)
ref OutputVRF (VRF c)
cand)) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"VRFTiebreak"
      , Key
"our" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (OutputVRF (VRF c) -> Text
forall a. Show a => a -> Text
showT OutputVRF (VRF c)
ref)
      , Key
"candidate" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (OutputVRF (VRF c) -> Text
forall a. Show a => a -> Text
showT OutputVRF (VRF c)
cand)
      ]

class (LogFormatting (ReasonForSwitch (TiebreakerView (BlockProtocol a))), SingleEraBlock a) => LFTBV a
instance (LogFormatting (ReasonForSwitch (TiebreakerView (BlockProtocol a))), SingleEraBlock a) => LFTBV a

instance (All LFTBV xs, CanHardFork xs) => LogFormatting (OneEraReasonForSwitch xs) where
  forHuman :: OneEraReasonForSwitch xs -> Text
forHuman (OneEraReasonForSwitch NS WrapReasonForSwitch xs
ns) =
    NS (K Text) xs -> CollapseTo NS Text
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Text) xs -> CollapseTo NS Text)
-> NS (K Text) xs -> CollapseTo NS Text
forall a b. (a -> b) -> a -> b
$ Proxy LFTBV
-> (forall a. LFTBV a => WrapReasonForSwitch a -> K Text a)
-> NS WrapReasonForSwitch xs
-> NS (K Text) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @LFTBV) WrapReasonForSwitch a -> K Text a
forall a. LFTBV a => WrapReasonForSwitch a -> K Text a
msg NS WrapReasonForSwitch xs
ns
   where
    msg :: forall era. LFTBV era => WrapReasonForSwitch era -> K Text era
    msg :: forall a. LFTBV a => WrapReasonForSwitch a -> K Text a
msg (WrapReasonForSwitch ReasonForSwitch (WrapTiebreakerView era)
rs) =
      Text -> K Text era
forall k a (b :: k). a -> K a b
K (Text -> K Text era) -> Text -> K Text era
forall a b. (a -> b) -> a -> b
$
        Text
"in era " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SingleEraInfo era -> Text
forall blk. SingleEraInfo blk -> Text
singleEraName (Proxy era -> SingleEraInfo era
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy era -> SingleEraInfo era
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReasonForSwitch (TiebreakerView (BlockProtocol era)) -> Text
forall a. LogFormatting a => a -> Text
forHuman ReasonForSwitch (TiebreakerView (BlockProtocol era))
ReasonForSwitch (WrapTiebreakerView era)
rs
  forMachine :: DetailLevel -> OneEraReasonForSwitch xs -> Object
forMachine DetailLevel
dtal (OneEraReasonForSwitch NS WrapReasonForSwitch xs
ns) =
    NS (K Object) xs -> CollapseTo NS Object
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Object) xs -> CollapseTo NS Object)
-> NS (K Object) xs -> CollapseTo NS Object
forall a b. (a -> b) -> a -> b
$ Proxy LFTBV
-> (forall a. LFTBV a => WrapReasonForSwitch a -> K Object a)
-> NS WrapReasonForSwitch xs
-> NS (K Object) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @LFTBV) WrapReasonForSwitch a -> K Object a
forall a. LFTBV a => WrapReasonForSwitch a -> K Object a
msg NS WrapReasonForSwitch xs
ns
   where
    msg :: forall era. LFTBV era => WrapReasonForSwitch era -> K Object era
    msg :: forall a. LFTBV a => WrapReasonForSwitch a -> K Object a
msg (WrapReasonForSwitch ReasonForSwitch (WrapTiebreakerView era)
rs) =
      Object -> K Object era
forall k a (b :: k). a -> K a b
K (Object -> K Object era) -> Object -> K Object era
forall a b. (a -> b) -> a -> b
$
        DetailLevel
-> ReasonForSwitch (TiebreakerView (BlockProtocol era)) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ReasonForSwitch (TiebreakerView (BlockProtocol era))
ReasonForSwitch (WrapTiebreakerView era)
rs Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"era" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (SingleEraInfo era -> Text
forall blk. SingleEraInfo blk -> Text
singleEraName (Proxy era -> SingleEraInfo era
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy era -> SingleEraInfo era
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era)))]

instance
  LogFormatting (ReasonForSwitch (TiebreakerView proto)) =>
  LogFormatting (WeightedSelectViewReasonForSwitch proto)
  where
  forHuman :: WeightedSelectViewReasonForSwitch proto -> Text
forHuman (Heavier (Comparing PerasWeight
ref PerasWeight
cand)) =
    Text
"candidate is heavier (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasWeight -> Text
forall a. Show a => a -> Text
showT PerasWeight
cand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") than our selection (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasWeight -> Text
forall a. Show a => a -> Text
showT PerasWeight
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  forHuman (WeightedSelectViewTiebreak ReasonForSwitch (TiebreakerView proto)
reason) = ReasonForSwitch (TiebreakerView proto) -> Text
forall a. LogFormatting a => a -> Text
forHuman ReasonForSwitch (TiebreakerView proto)
reason
  forMachine :: DetailLevel -> WeightedSelectViewReasonForSwitch proto -> Object
forMachine DetailLevel
_dtal (Heavier (Comparing PerasWeight
ref PerasWeight
cand)) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HigherOCert"
      , Key
"our" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (PerasWeight -> Text
forall a. Show a => a -> Text
showT PerasWeight
ref)
      , Key
"candidate" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (PerasWeight -> Text
forall a. Show a => a -> Text
showT PerasWeight
cand)
      ]
  forMachine DetailLevel
dtal (WeightedSelectViewTiebreak ReasonForSwitch (TiebreakerView proto)
reason) =
    DetailLevel -> ReasonForSwitch (TiebreakerView proto) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ReasonForSwitch (TiebreakerView proto)
reason

instance
  LogFormatting (ReasonForSwitch (TiebreakerView proto)) =>
  LogFormatting
    ( Either
        ( WithEmptyFragmentReasonForSwitch
            (WeightedSelectView proto)
        )
        (SelectViewReasonForSwitch proto)
    )
  where
  forHuman :: Either
  (WithEmptyFragmentReasonForSwitch (WeightedSelectView proto))
  (SelectViewReasonForSwitch proto)
-> Text
forHuman (Left WithEmptyFragmentReasonForSwitch (WeightedSelectView proto)
CandidateIsNonEmpty) = Text
"candidate is an extension of our selection"
  forHuman (Left (BothAreNonEmpty ReasonForSwitch (WeightedSelectView proto)
a)) = WeightedSelectViewReasonForSwitch proto -> Text
forall a. LogFormatting a => a -> Text
forHuman ReasonForSwitch (WeightedSelectView proto)
WeightedSelectViewReasonForSwitch proto
a
  forHuman (Right (Longer (Comparing WithOrigin BlockNo
ref WithOrigin BlockNo
cand))) =
    Text
"candidate is longer (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin BlockNo -> Text
forall a. Show a => a -> Text
showT WithOrigin BlockNo
cand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") than our selection (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin BlockNo -> Text
forall a. Show a => a -> Text
showT WithOrigin BlockNo
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  forHuman (Right (SelectViewTiebreak ReasonForSwitch (TiebreakerView proto)
a)) = ReasonForSwitch (TiebreakerView proto) -> Text
forall a. LogFormatting a => a -> Text
forHuman ReasonForSwitch (TiebreakerView proto)
a
  forMachine :: DetailLevel
-> Either
     (WithEmptyFragmentReasonForSwitch (WeightedSelectView proto))
     (SelectViewReasonForSwitch proto)
-> Object
forMachine DetailLevel
_dtal (Left WithEmptyFragmentReasonForSwitch (WeightedSelectView proto)
CandidateIsNonEmpty) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"extension"]
  forMachine DetailLevel
dtal (Left (BothAreNonEmpty ReasonForSwitch (WeightedSelectView proto)
a)) = DetailLevel -> WeightedSelectViewReasonForSwitch proto -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ReasonForSwitch (WeightedSelectView proto)
WeightedSelectViewReasonForSwitch proto
a
  forMachine DetailLevel
_dtal (Right (Longer (Comparing WithOrigin BlockNo
ref WithOrigin BlockNo
cand))) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Longer", Key
"our" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (WithOrigin BlockNo -> Text
forall a. Show a => a -> Text
showT WithOrigin BlockNo
ref), Key
"candidate" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (WithOrigin BlockNo -> Text
forall a. Show a => a -> Text
showT WithOrigin BlockNo
cand)]
  forMachine DetailLevel
dtal (Right (SelectViewTiebreak ReasonForSwitch (TiebreakerView proto)
a)) = DetailLevel -> ReasonForSwitch (TiebreakerView proto) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ReasonForSwitch (TiebreakerView proto)
a

instance
  ( LogFormatting (Header blk)
  , LogFormatting (LedgerEvent blk)
  , LogFormatting (RealPoint blk)
  , LogFormatting (WeightedSelectView (BlockProtocol blk))
  , LogFormatting
      ( Either
          (WithEmptyFragmentReasonForSwitch (WeightedSelectView (BlockProtocol blk)))
          (SelectViewReasonForSwitch (BlockProtocol blk))
      )
  , ConvertRawHash blk
  , ConvertRawHash (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  , HasIssuer blk
  , Show (PerasError blk)
  ) =>
  LogFormatting (ChainDB.TraceAddBlockEvent blk)
  where
  forHuman :: TraceAddBlockEvent blk -> Text
forHuman (ChainDB.IgnoreBlockOlderThanImmTip RealPoint blk
pt) =
    Text
"Ignoring block older than ImmTip: " 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 ExtValidationError 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 TraceAddBlockEvent blk
ChainDB.PoppingFromQueue =
    Text
"Popping block from queue"
  forHuman (ChainDB.PoppedBlockFromQueue 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.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 SelectionChangedInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
c ReasonForSwitch' blk
_) =
    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 SelectionChangedInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
c ReasonForSwitch' blk
reasonForSwitch) =
    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]
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nReason: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Either
  (WithEmptyFragmentReasonForSwitch
     (WeightedSelectView (BlockProtocol blk)))
  (SelectViewReasonForSwitch (BlockProtocol blk))
-> Text
forall a. LogFormatting a => a -> Text
forHuman ReasonForSwitch' blk
Either
  (WithEmptyFragmentReasonForSwitch
     (WeightedSelectView (BlockProtocol blk)))
  (SelectViewReasonForSwitch (BlockProtocol blk))
reasonForSwitch
  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.PipeliningEvent TracePipeliningEvent blk
ev') = TracePipeliningEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TracePipeliningEvent blk
ev'
  forHuman (ChainDB.AddedReprocessLoEBlocksToQueue Enclosing' Word
edgeSz) =
    case Enclosing' Word
edgeSz of
      Enclosing' Word
RisingEdge ->
        Text
"About to add request to queue to reprocess blocks postponed by LoE."
      FallingEdgeWith Word
sz ->
        Text
"Added request to queue to reprocess blocks postponed by LoE" 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 TraceAddBlockEvent blk
ChainDB.PoppedReprocessLoEBlocksFromQueue =
    Text
"Poppped request from queue to reprocess blocks postponed by LoE."
  forHuman ChainDB.ChainSelectionLoEDebug{} =
    Text
"ChainDB LoE debug event"
  forMachine :: DetailLevel -> TraceAddBlockEvent blk -> Object
forMachine DetailLevel
dtal (ChainDB.IgnoreBlockOlderThanImmTip RealPoint blk
pt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"IgnoreBlockOlderThanImmTip"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"IgnoreBlockAlreadyInVolatileDB"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 ExtValidationError blk
reason) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"IgnoreInvalidBlock"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExtValidationError blk -> Text
forall a. Show a => a -> Text
showT ExtValidationError 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedBlockToQueue"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
          FallingEdgeWith Word
sz -> Key
"queueSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
sz
      ]
  forMachine DetailLevel
_dtal TraceAddBlockEvent blk
ChainDB.PoppingFromQueue =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PoppingFromQueue"
      ]
  forMachine DetailLevel
dtal (ChainDB.PoppedBlockFromQueue RealPoint blk
pt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.PoppedBlockFromQueue"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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.StoreButDontChange RealPoint blk
pt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StoreButDontChange"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TryAddToCurrentChain"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.TrySwitchToAFork"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.ChangingSelection"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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
DDetailed (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended ReasonForSwitch' blk
_) =
    let ChainInformation{Int64
Rational
Word64
Text
EpochNo
BlockIssuerVerificationKeyHash
slots :: Word64
blocks :: Word64
density :: Rational
epoch :: EpochNo
slotInEpoch :: Word64
blocksUncoupledDelta :: Int64
tipBlockHash :: Text
tipBlockParentHash :: Text
tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash :: ChainInformation -> BlockIssuerVerificationKeyHash
tipBlockParentHash :: ChainInformation -> Text
tipBlockHash :: ChainInformation -> Text
blocksUncoupledDelta :: ChainInformation -> Int64
slotInEpoch :: ChainInformation -> Word64
epoch :: ChainInformation -> EpochNo
density :: ChainInformation -> Rational
blocks :: ChainInformation -> Word64
slots :: ChainInformation -> Word64
..} = SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
(HasHeader (Header blk), HasIssuer blk, ConvertRawHash blk) =>
SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
base AnchoredFragment (Header blk)
extended Int64
0
        tipBlockIssuerVkHashText :: Text
        tipBlockIssuerVkHashText :: Text
tipBlockIssuerVkHashText =
          case BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash of
            BlockIssuerVerificationKeyHash
NoBlockIssuer -> Text
"NoBlockIssuer"
            BlockIssuerVerificationKeyHash ByteString
bs ->
              ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
bs)
     in [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedToCurrentChain"
          , Key
"newtip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
DDetailed (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
extended)
          , Key
"newSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed (SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
forall blk.
SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
ChainDB.newSuffixSelectView SelectionChangedInfo blk
selChangedInfo)
          ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"oldSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView
               | Just WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView <- [SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
forall blk.
SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
ChainDB.oldSuffixSelectView SelectionChangedInfo blk
selChangedInfo]
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"headers" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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
DDetailed (Header blk -> Object) -> [Header blk] -> [Object]
forall a b. (a -> b) -> [a] -> [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)
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> LedgerEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events)
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"tipBlockHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockHash
               , Key
"tipBlockParentHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockParentHash
               , Key
"tipBlockIssuerVKeyHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockIssuerVkHashText
               ]
  forMachine DetailLevel
dtal (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
_base AnchoredFragment (Header blk)
extended ReasonForSwitch' blk
_) =
    [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedToCurrentChain"
      , Key
"newtip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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)
      , Key
"newSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
forall blk.
SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
ChainDB.newSuffixSelectView SelectionChangedInfo blk
selChangedInfo)
      ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"oldSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView
           | Just WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView <- [SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
forall blk.
SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
ChainDB.oldSuffixSelectView SelectionChangedInfo blk
selChangedInfo]
           ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall a b. (a -> b) -> [a] -> [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events)
           ]
  forMachine DetailLevel
DDetailed (ChainDB.SwitchedToAFork [LedgerEvent blk]
events SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
old AnchoredFragment (Header blk)
new ReasonForSwitch' blk
reasonForSwitch) =
    let ChainInformation{Int64
Rational
Word64
Text
EpochNo
BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash :: ChainInformation -> BlockIssuerVerificationKeyHash
tipBlockParentHash :: ChainInformation -> Text
tipBlockHash :: ChainInformation -> Text
blocksUncoupledDelta :: ChainInformation -> Int64
slotInEpoch :: ChainInformation -> Word64
epoch :: ChainInformation -> EpochNo
density :: ChainInformation -> Rational
blocks :: ChainInformation -> Word64
slots :: ChainInformation -> Word64
slots :: Word64
blocks :: Word64
density :: Rational
epoch :: EpochNo
slotInEpoch :: Word64
blocksUncoupledDelta :: Int64
tipBlockHash :: Text
tipBlockParentHash :: Text
tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
..} = SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
(HasHeader (Header blk), HasIssuer blk, ConvertRawHash blk) =>
SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
old AnchoredFragment (Header blk)
new Int64
0
        tipBlockIssuerVkHashText :: Text
        tipBlockIssuerVkHashText :: Text
tipBlockIssuerVkHashText =
          case BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash of
            BlockIssuerVerificationKeyHash
NoBlockIssuer -> Text
"NoBlockIssuer"
            BlockIssuerVerificationKeyHash ByteString
bs ->
              ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
bs)
     in [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.SwitchedToAFork"
          , Key
"newtip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
DDetailed (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
new)
          , Key
"newSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed (SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
forall blk.
SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
ChainDB.newSuffixSelectView SelectionChangedInfo blk
selChangedInfo)
          ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"oldSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView
               | Just WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView <- [SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
forall blk.
SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
ChainDB.oldSuffixSelectView SelectionChangedInfo blk
selChangedInfo]
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"headers" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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
DDetailed (Header blk -> Object) -> [Header blk] -> [Object]
forall a b. (a -> b) -> [a] -> [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)
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> LedgerEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed) [LedgerEvent blk]
events)
               | Bool -> Bool
not ([LedgerEvent blk] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events)
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"tipBlockHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockHash
               , Key
"tipBlockParentHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockParentHash
               , Key
"tipBlockIssuerVKeyHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tipBlockIssuerVkHashText
               ]
            [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [Key
"reason" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel
-> Either
     (WithEmptyFragmentReasonForSwitch
        (WeightedSelectView (BlockProtocol blk)))
     (SelectViewReasonForSwitch (BlockProtocol blk))
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
DDetailed ReasonForSwitch' blk
Either
  (WithEmptyFragmentReasonForSwitch
     (WeightedSelectView (BlockProtocol blk)))
  (SelectViewReasonForSwitch (BlockProtocol blk))
reasonForSwitch]
  forMachine DetailLevel
dtal (ChainDB.SwitchedToAFork [LedgerEvent blk]
events SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
_old AnchoredFragment (Header blk)
new ReasonForSwitch' blk
reasonForSwitch) =
    [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceAddBlockEvent.SwitchedToAFork"
      , Key
"newtip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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)
      , Key
"newSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
forall blk.
SelectionChangedInfo blk -> WeightedSelectView (BlockProtocol blk)
ChainDB.newSuffixSelectView SelectionChangedInfo blk
selChangedInfo)
      ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"oldSuffixSelectView" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> WeightedSelectView (BlockProtocol blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView
           | Just WeightedSelectView (BlockProtocol blk)
oldSuffixSelectView <- [SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
forall blk.
SelectionChangedInfo blk
-> Maybe (WeightedSelectView (BlockProtocol blk))
ChainDB.oldSuffixSelectView SelectionChangedInfo blk
selChangedInfo]
           ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [ Key
"events" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Object] -> Value
forall a. ToJSON a => a -> Value
toJSON ((LedgerEvent blk -> Object) -> [LedgerEvent blk] -> [Object]
forall a b. (a -> b) -> [a] -> [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events)
           ]
        [Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [Key
"reason" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel
-> Either
     (WithEmptyFragmentReasonForSwitch
        (WeightedSelectView (BlockProtocol blk)))
     (SelectViewReasonForSwitch (BlockProtocol blk))
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ReasonForSwitch' blk
Either
  (WithEmptyFragmentReasonForSwitch
     (WeightedSelectView (BlockProtocol blk)))
  (SelectViewReasonForSwitch (BlockProtocol blk))
reasonForSwitch]
  forMachine DetailLevel
dtal (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') =
    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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedBlockToVolatileDB"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True | Enclosing
RisingEdge <- [Enclosing
enclosing]]
  forMachine DetailLevel
dtal (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev') =
    DetailLevel -> TracePipeliningEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TracePipeliningEvent blk
ev'
  forMachine DetailLevel
_dtal (ChainDB.AddedReprocessLoEBlocksToQueue Enclosing' Word
edgeSz) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedReprocessLoEBlocksToQueue"
      , case Enclosing' Word
edgeSz of
          Enclosing' Word
RisingEdge -> Key
"risingEdge" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
          FallingEdgeWith Word
sz -> Key
"queueSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
sz
      ]
  forMachine DetailLevel
_dtal TraceAddBlockEvent blk
ChainDB.PoppedReprocessLoEBlocksFromQueue =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PoppedReprocessLoEBlocksFromQueue"]
  forMachine DetailLevel
dtal (ChainDB.ChainSelectionLoEDebug AnchoredFragment (Header blk)
curChain LoE (AnchoredFragment (Header blk))
loeFrag) =
    case LoE (AnchoredFragment (Header blk))
loeFrag of
      ChainDB.LoEEnabled AnchoredFragment (Header blk)
loeF ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
          [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSelectionLoEDebug"
          , Key
"curChain" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AnchoredFragment (Header blk) -> Value
headAndAnchor AnchoredFragment (Header blk)
curChain
          , Key
"loeFrag" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AnchoredFragment (Header blk) -> Value
headAndAnchor AnchoredFragment (Header blk)
loeF
          ]
      LoE (AnchoredFragment (Header blk))
ChainDB.LoEDisabled ->
        [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
          [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSelectionLoEDebug"
          , Key
"curChain" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AnchoredFragment (Header blk) -> Value
headAndAnchor AnchoredFragment (Header blk)
curChain
          , Key
"loeFrag" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LoE is disabled"
          ]
   where
    headAndAnchor :: AnchoredFragment (Header blk) -> Value
headAndAnchor AnchoredFragment (Header blk)
frag =
      [(Key, Value)] -> Value
object
        [ Key
"anchor" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (AnchoredFragment (Header blk) -> Point (Header blk)
forall block. AnchoredFragment block -> Point block
AF.anchorPoint AnchoredFragment (Header blk)
frag)
        , Key
"head" Key -> Object -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point (Header blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
frag)
        ]

  asMetrics :: TraceAddBlockEvent blk -> [Metric]
asMetrics (ChainDB.SwitchedToAFork [LedgerEvent blk]
_warnings SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
oldChain AnchoredFragment (Header blk)
newChain ReasonForSwitch' blk
_) =
    let forkIt :: Bool
forkIt =
          Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
            Point (Header blk) -> AnchoredFragment (Header blk) -> Bool
forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
AF.withinFragmentBounds
              (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
oldChain)
              AnchoredFragment (Header blk)
newChain
        ChainInformation{Int64
Rational
Word64
Text
EpochNo
BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash :: ChainInformation -> BlockIssuerVerificationKeyHash
tipBlockParentHash :: ChainInformation -> Text
tipBlockHash :: ChainInformation -> Text
blocksUncoupledDelta :: ChainInformation -> Int64
slotInEpoch :: ChainInformation -> Word64
epoch :: ChainInformation -> EpochNo
density :: ChainInformation -> Rational
blocks :: ChainInformation -> Word64
slots :: ChainInformation -> Word64
slots :: Word64
blocks :: Word64
density :: Rational
epoch :: EpochNo
slotInEpoch :: Word64
blocksUncoupledDelta :: Int64
tipBlockHash :: Text
tipBlockParentHash :: Text
tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
..} = SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
(HasHeader (Header blk), HasIssuer blk, ConvertRawHash blk) =>
SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
oldChain AnchoredFragment (Header blk)
newChain Int64
0
        tipBlockIssuerVkHashText :: Text
tipBlockIssuerVkHashText =
          case BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash of
            BlockIssuerVerificationKeyHash
NoBlockIssuer -> Text
"NoBlockIssuer"
            BlockIssuerVerificationKeyHash ByteString
bs ->
              ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
bs)
     in [ Text -> Double -> Metric
DoubleM Text
"density" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
density)
        , Text -> Integer -> Metric
IntM Text
"slotNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slots)
        , Text -> Integer -> Metric
IntM Text
"blockNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blocks)
        , Text -> Integer -> Metric
IntM Text
"slotInEpoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotInEpoch)
        , Text -> Integer -> Metric
IntM Text
"epoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
epoch))
        , Text -> Maybe Int -> Metric
CounterM Text
"forks" (Int -> Maybe Int
forall a. a -> Maybe a
Just (if Bool
forkIt then Int
1 else Int
0))
        , Text -> [(Text, Text)] -> Metric
PrometheusM
            Text
"tipBlock"
            [ (Text
"hash", Text
tipBlockHash)
            , (Text
"parent_hash", Text
tipBlockParentHash)
            , (Text
"issuer_VKey_hash", Text
tipBlockIssuerVkHashText)
            ]
        ]
  asMetrics (ChainDB.AddedToCurrentChain [LedgerEvent blk]
_warnings SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
oldChain AnchoredFragment (Header blk)
newChain ReasonForSwitch' blk
_) =
    let ChainInformation{Int64
Rational
Word64
Text
EpochNo
BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash :: ChainInformation -> BlockIssuerVerificationKeyHash
tipBlockParentHash :: ChainInformation -> Text
tipBlockHash :: ChainInformation -> Text
blocksUncoupledDelta :: ChainInformation -> Int64
slotInEpoch :: ChainInformation -> Word64
epoch :: ChainInformation -> EpochNo
density :: ChainInformation -> Rational
blocks :: ChainInformation -> Word64
slots :: ChainInformation -> Word64
slots :: Word64
blocks :: Word64
density :: Rational
epoch :: EpochNo
slotInEpoch :: Word64
blocksUncoupledDelta :: Int64
tipBlockHash :: Text
tipBlockParentHash :: Text
tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
..} =
          SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
(HasHeader (Header blk), HasIssuer blk, ConvertRawHash blk) =>
SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
oldChain AnchoredFragment (Header blk)
newChain Int64
0
        tipBlockIssuerVkHashText :: Text
tipBlockIssuerVkHashText =
          case BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash of
            BlockIssuerVerificationKeyHash
NoBlockIssuer -> Text
"NoBlockIssuer"
            BlockIssuerVerificationKeyHash ByteString
bs ->
              ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
bs)
     in [ Text -> Double -> Metric
DoubleM Text
"density" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
density)
        , Text -> Integer -> Metric
IntM Text
"slotNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slots)
        , Text -> Integer -> Metric
IntM Text
"blockNum" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
blocks)
        , Text -> Integer -> Metric
IntM Text
"slotInEpoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotInEpoch)
        , Text -> Integer -> Metric
IntM Text
"epoch" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
epoch))
        , Text -> [(Text, Text)] -> Metric
PrometheusM
            Text
"tipBlock"
            [ (Text
"hash", Text
tipBlockHash)
            , (Text
"parent_hash", Text
tipBlockParentHash)
            , (Text
"issuer_verification_key_hash", Text
tipBlockIssuerVkHashText)
            ]
        ]
  asMetrics TraceAddBlockEvent blk
_ = []

instance MetaTrace (ChainDB.TraceAddBlockEvent blk) where
  namespaceFor :: TraceAddBlockEvent blk -> Namespace (TraceAddBlockEvent blk)
namespaceFor ChainDB.IgnoreBlockOlderThanImmTip{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreBlockOlderThanImmTip"]
  namespaceFor ChainDB.IgnoreBlockAlreadyInVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreBlockAlreadyInVolatileDB"]
  namespaceFor ChainDB.IgnoreInvalidBlock{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreInvalidBlock"]
  namespaceFor ChainDB.AddedBlockToQueue{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedBlockToQueue"]
  namespaceFor ChainDB.PoppingFromQueue{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppingFromQueue"]
  namespaceFor ChainDB.PoppedBlockFromQueue{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedBlockFromQueue"]
  namespaceFor ChainDB.AddedBlockToVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedBlockToVolatileDB"]
  namespaceFor ChainDB.TryAddToCurrentChain{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TryAddToCurrentChain"]
  namespaceFor ChainDB.TrySwitchToAFork{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TrySwitchToAFork"]
  namespaceFor ChainDB.StoreButDontChange{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StoreButDontChange"]
  namespaceFor ChainDB.AddedToCurrentChain{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedToCurrentChain"]
  namespaceFor ChainDB.SwitchedToAFork{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SwitchedToAFork"]
  namespaceFor ChainDB.ChangingSelection{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChangingSelection"]
  namespaceFor (ChainDB.AddBlockValidation TraceValidationEvent blk
ev') =
    Text
-> Namespace (TraceValidationEvent blk)
-> Namespace (TraceAddBlockEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddBlockValidation" (TraceValidationEvent blk -> Namespace (TraceValidationEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceValidationEvent blk
ev')
  namespaceFor (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev') =
    Text
-> Namespace (TracePipeliningEvent blk)
-> Namespace (TraceAddBlockEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PipeliningEvent" (TracePipeliningEvent blk -> Namespace (TracePipeliningEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TracePipeliningEvent blk
ev')
  namespaceFor ChainDB.AddedReprocessLoEBlocksToQueue{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedReprocessLoEBlocksToQueue"]
  namespaceFor TraceAddBlockEvent blk
ChainDB.PoppedReprocessLoEBlocksFromQueue =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedReprocessLoEBlocksFromQueue"]
  namespaceFor ChainDB.ChainSelectionLoEDebug{} =
    [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelectionLoEDebug"]

  severityFor :: Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"IgnoreBlockOlderThanImmTip"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"IgnoreBlockAlreadyInVolatileDB"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"IgnoreInvalidBlock"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"AddedBlockToQueue"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"AddedBlockToVolatileDB"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PoppingFromQueue"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PoppedBlockFromQueue"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"TryAddToCurrentChain"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"TrySwitchToAFork"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StoreButDontChange"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"ChangingSelection"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor
    (Namespace [Text]
_ [Text
"AddedToCurrentChain"])
    (Just (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events SelectionChangedInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_ ReasonForSwitch' blk
_)) =
      SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just (SeverityS -> Maybe SeverityS) -> SeverityS -> Maybe SeverityS
forall a b. (a -> b) -> a -> b
$ (LedgerEvent blk -> SeverityS -> SeverityS)
-> SeverityS -> [LedgerEvent blk] -> SeverityS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SeverityS -> SeverityS -> SeverityS
forall a. Ord a => a -> a -> a
max (SeverityS -> SeverityS -> SeverityS)
-> (LedgerEvent blk -> SeverityS)
-> LedgerEvent blk
-> SeverityS
-> SeverityS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerEvent blk -> SeverityS
forall blk. LedgerEvent blk -> SeverityS
sevLedgerEvent) SeverityS
Notice [LedgerEvent blk]
events
  severityFor (Namespace [Text]
_ [Text
"AddedToCurrentChain"]) Maybe (TraceAddBlockEvent blk)
Nothing = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
  severityFor
    (Namespace [Text]
_ [Text
"SwitchedToAFork"])
    (Just (ChainDB.SwitchedToAFork [LedgerEvent blk]
events SelectionChangedInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_ ReasonForSwitch' blk
_)) =
      SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just (SeverityS -> Maybe SeverityS) -> SeverityS -> Maybe SeverityS
forall a b. (a -> b) -> a -> b
$ (LedgerEvent blk -> SeverityS -> SeverityS)
-> SeverityS -> [LedgerEvent blk] -> SeverityS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SeverityS -> SeverityS -> SeverityS
forall a. Ord a => a -> a -> a
max (SeverityS -> SeverityS -> SeverityS)
-> (LedgerEvent blk -> SeverityS)
-> LedgerEvent blk
-> SeverityS
-> SeverityS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerEvent blk -> SeverityS
forall blk. LedgerEvent blk -> SeverityS
sevLedgerEvent) SeverityS
Notice [LedgerEvent blk]
events
  severityFor (Namespace [Text]
_ [Text
"SwitchedToAFork"]) Maybe (TraceAddBlockEvent blk)
_ =
    SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
  severityFor
    (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl))
    (Just (ChainDB.AddBlockValidation TraceValidationEvent blk
ev')) =
      Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  severityFor (Namespace [Text]
_ (Text
"AddBlockValidation" : [Text]
_tl)) Maybe (TraceAddBlockEvent blk)
Nothing = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
  severityFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) (Just (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev')) =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TracePipeliningEvent blk -> Maybe (TracePipeliningEvent blk)
forall a. a -> Maybe a
Just TracePipeliningEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) Maybe (TraceAddBlockEvent blk)
Nothing =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Maybe (TracePipeliningEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
_ [Text
"AddedReprocessLoEBlocksToQueue"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PoppedReprocessLoEBlocksFromQueue"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"ChainSelectionLoEDebug"]) Maybe (TraceAddBlockEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceAddBlockEvent blk)
_ Maybe (TraceAddBlockEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  privacyFor :: Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe Privacy
privacyFor (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl)) (Just (ChainDB.AddBlockValidation TraceValidationEvent blk
ev')) =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl)) Maybe (TraceAddBlockEvent blk)
Nothing =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceValidationEvent blk)) Maybe (TraceValidationEvent blk)
forall a. Maybe a
Nothing
  privacyFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) (Just (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev')) =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TracePipeliningEvent blk -> Maybe (TracePipeliningEvent blk)
forall a. a -> Maybe a
Just TracePipeliningEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) Maybe (TraceAddBlockEvent blk)
Nothing =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Maybe (TracePipeliningEvent blk)
forall a. Maybe a
Nothing
  privacyFor Namespace (TraceAddBlockEvent blk)
_ Maybe (TraceAddBlockEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public

  detailsFor :: Namespace (TraceAddBlockEvent blk)
-> Maybe (TraceAddBlockEvent blk) -> Maybe DetailLevel
detailsFor (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl)) (Just (ChainDB.AddBlockValidation TraceValidationEvent blk
ev')) =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl)) Maybe (TraceAddBlockEvent blk)
Nothing =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceValidationEvent blk)) Maybe (TraceValidationEvent blk)
forall a. Maybe a
Nothing
  detailsFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) (Just (ChainDB.PipeliningEvent TracePipeliningEvent blk
ev')) =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TracePipeliningEvent blk -> Maybe (TracePipeliningEvent blk)
forall a. a -> Maybe a
Just TracePipeliningEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) Maybe (TraceAddBlockEvent blk)
Nothing =
    Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Maybe (TracePipeliningEvent blk)
forall a. Maybe a
Nothing
  detailsFor Namespace (TraceAddBlockEvent blk)
_ Maybe (TraceAddBlockEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  metricsDocFor :: Namespace (TraceAddBlockEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"SwitchedToAFork"]) =
    [
      ( Text
"density"
      , [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"The actual number of blocks created over the maximum expected number"
          , Text
" of blocks that could be created over the span of the last @k@ blocks."
          ]
      )
    ,
      ( Text
"slotNum"
      , Text
"Number of slots in this chain fragment."
      )
    ,
      ( Text
"blockNum"
      , Text
"Number of blocks in this chain fragment."
      )
    ,
      ( Text
"slotInEpoch"
      , [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Relative slot number of the tip of the current chain within the"
          , Text
" epoch.."
          ]
      )
    ,
      ( Text
"epoch"
      , Text
"In which epoch is the tip of the current chain."
      )
    ,
      ( Text
"forks"
      , Text
"counter for forks"
      )
    ,
      ( Text
"tipBlock"
      , Text
"Values for hash, parent hash and issuer verification key hash"
      )
    ]
  metricsDocFor (Namespace [Text]
_ [Text
"AddedToCurrentChain"]) =
    [
      ( Text
"density"
      , [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"The actual number of blocks created over the maximum expected number"
          , Text
" of blocks that could be created over the span of the last @k@ blocks."
          ]
      )
    ,
      ( Text
"slotNum"
      , Text
"Number of slots in this chain fragment."
      )
    ,
      ( Text
"blockNum"
      , Text
"Number of blocks in this chain fragment."
      )
    ,
      ( Text
"slotInEpoch"
      , [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Relative slot number of the tip of the current chain within the"
          , Text
" epoch.."
          ]
      )
    ,
      ( Text
"epoch"
      , Text
"In which epoch is the tip of the current chain."
      )
    ,
      ( Text
"tipBlock"
      , Text
"Values for hash, parent hash and issuer verification key hash"
      )
    ]
  metricsDocFor Namespace (TraceAddBlockEvent blk)
_ = []

  documentFor :: Namespace (TraceAddBlockEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"IgnoreBlockOlderThanImmTip"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block with a 'BlockNo' not newer than the immutable tip was ignored."
  documentFor (Namespace [Text]
_ [Text
"IgnoreBlockAlreadyInVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block that is already in the Volatile DB was ignored."
  documentFor (Namespace [Text]
_ [Text
"IgnoreInvalidBlock"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block that is invalid was ignored."
  documentFor (Namespace [Text]
_ [Text
"AddedBlockToQueue"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The block was added to the queue and will be added to the ChainDB by"
        , Text
" the background thread. The size of the queue is included.."
        ]
  documentFor (Namespace [Text]
_ [Text
"AddedBlockToVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block was added to the Volatile DB"
  documentFor (Namespace [Text]
_ [Text
"PoppingFromQueue"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
  documentFor (Namespace [Text]
_ [Text
"PoppedBlockFromQueue"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
  documentFor (Namespace [Text]
_ [Text
"TryAddToCurrentChain"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The block fits onto the current chain, we'll try to use it to extend"
        , Text
" our chain."
        ]
  documentFor (Namespace [Text]
_ [Text
"TrySwitchToAFork"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The block fits onto some fork, we'll try to switch to that fork (if"
        , Text
" it is preferable to our chain)"
        ]
  documentFor (Namespace [Text]
_ [Text
"StoreButDontChange"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The block fits onto some fork, we'll try to switch to that fork (if"
        , Text
" it is preferable to our chain)."
        ]
  documentFor (Namespace [Text]
_ [Text
"ChangingSelection"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The new block fits onto the current chain (first"
        , Text
" fragment) and we have successfully used it to extend our (new) current"
        , Text
" chain (second fragment)."
        ]
  documentFor (Namespace [Text]
_ [Text
"AddedToCurrentChain"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The new block fits onto the current chain (first"
        , Text
" fragment) and we have successfully used it to extend our (new) current"
        , Text
" chain (second fragment)."
        ]
  documentFor (Namespace [Text]
_out [Text
"SwitchedToAFork"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The new block fits onto some fork and we have switched to that fork"
        , Text
" (second fragment), as it is preferable to our (previous) current chain"
        , Text
" (first fragment)."
        ]
  documentFor (Namespace [Text]
out (Text
"AddBlockValidation" : [Text]
tl)) =
    Namespace (TraceValidationEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceValidationEvent blk))
  documentFor (Namespace [Text]
out (Text
"PipeliningEvent" : [Text]
tl)) =
    Namespace (TracePipeliningEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TracePipeliningEvent blk))
  documentFor Namespace (TraceAddBlockEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceAddBlockEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreBlockOlderThanImmTip"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreBlockAlreadyInVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnoreInvalidBlock"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedBlockToQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedBlockToVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppingFromQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedBlockFromQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TryAddToCurrentChain"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TrySwitchToAFork"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StoreButDontChange"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChangingSelection"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedToCurrentChain"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SwitchedToAFork"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedReprocessLoEBlocksToQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedReprocessLoEBlocksFromQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddBlockEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelectionLoEDebug"]
    ]
      [Namespace (TraceAddBlockEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TracePipeliningEvent blk)
 -> Namespace (TraceAddBlockEvent blk))
-> [Namespace (TracePipeliningEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TracePipeliningEvent blk)
-> Namespace (TraceAddBlockEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"PipeliningEvent")
        ([Namespace (TracePipeliningEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TracePipeliningEvent blk)])
      [Namespace (TraceAddBlockEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceValidationEvent blk)
 -> Namespace (TraceAddBlockEvent blk))
-> [Namespace (TraceValidationEvent blk)]
-> [Namespace (TraceAddBlockEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TraceValidationEvent blk)
-> Namespace (TraceAddBlockEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"AddBlockValidation")
        ([Namespace (TraceValidationEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceValidationEvent blk)])

--------------------------------------------------------------------------------
-- ChainDB TracePipeliningEvent
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SetTentativeHeader"
      , Key
"block" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TrapTentativeHeader"
      , Key
"block" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"OutdatedTentativeHeader"
      , Key
"block" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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)
      ]

instance MetaTrace (ChainDB.TracePipeliningEvent blk) where
  namespaceFor :: TracePipeliningEvent blk -> Namespace (TracePipeliningEvent blk)
namespaceFor ChainDB.SetTentativeHeader{} =
    [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SetTentativeHeader"]
  namespaceFor ChainDB.TrapTentativeHeader{} =
    [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TrapTentativeHeader"]
  namespaceFor ChainDB.OutdatedTentativeHeader{} =
    [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OutdatedTentativeHeader"]

  severityFor :: Namespace (TracePipeliningEvent blk)
-> Maybe (TracePipeliningEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"SetTentativeHeader"]) Maybe (TracePipeliningEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"TrapTentativeHeader"]) Maybe (TracePipeliningEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"OutdatedTentativeHeader"]) Maybe (TracePipeliningEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TracePipeliningEvent blk)
_ Maybe (TracePipeliningEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TracePipeliningEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"SetTentativeHeader"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A new tentative header got set"
  documentFor (Namespace [Text]
_ [Text
"TrapTentativeHeader"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The body of tentative block turned out to be invalid."
  documentFor (Namespace [Text]
_ [Text
"OutdatedTentativeHeader"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"We selected a new (better) chain, which cleared the previous tentative header."
  documentFor Namespace (TracePipeliningEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TracePipeliningEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SetTentativeHeader"]
    , [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TrapTentativeHeader"]
    , [Text] -> [Text] -> Namespace (TracePipeliningEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OutdatedTentativeHeader"]
    ]

addedHdrsNewChain ::
  HasHeader (Header blk) =>
  AF.AnchoredFragment (Header blk) ->
  AF.AnchoredFragment (Header blk) ->
  [Header blk]
addedHdrsNewChain :: forall blk.
HasHeader (Header blk) =>
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.

--------------------------------------------------------------------------------
-- ChainDB TraceFollowerEvent
--------------------------------------------------------------------------------

instance
  StandardHash blk =>
  LogFormatting (ChainDB.TraceFollowerEvent blk)
  where
  forHuman :: TraceFollowerEvent blk -> Text
forHuman TraceFollowerEvent blk
ChainDB.NewFollower = Text
"A new Follower was created"
  forHuman (ChainDB.FollowerNoLongerInMem FollowerRollState blk
_rrs) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"The follower was in the 'FollowerInMem' state but its point is no longer on"
      , Text
" the in-memory chain fragment, so it has to switch to the"
      , Text
" 'FollowerInImmutableDB' state"
      ]
  forHuman (ChainDB.FollowerSwitchToMem Point blk
point WithOrigin SlotNo
slot) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"The follower was in the 'FollowerInImmutableDB' state and is switched to"
      , Text
" the 'FollowerInMem' state. Point: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall a. Show a => a -> Text
showT Point blk
point Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin SlotNo -> Text
forall a. Show a => a -> Text
showT WithOrigin SlotNo
slot
      ]
  forHuman (ChainDB.FollowerNewImmIterator Point blk
point WithOrigin SlotNo
slot) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"The follower is in the 'FollowerInImmutableDB' state but the iterator is"
      , Text
" exhausted while the ImmDB has grown, so we open a new iterator to"
      , Text
" stream these blocks too. Point: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall a. Show a => a -> Text
showT Point blk
point Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithOrigin SlotNo -> Text
forall a. Show a => a -> Text
showT WithOrigin SlotNo
slot
      ]

  forMachine :: DetailLevel -> TraceFollowerEvent blk -> Object
forMachine DetailLevel
_dtal TraceFollowerEvent blk
ChainDB.NewFollower =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NewFollower"]
  forMachine DetailLevel
_dtal (ChainDB.FollowerNoLongerInMem FollowerRollState blk
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"FollowerNoLongerInMem"]
  forMachine DetailLevel
_dtal (ChainDB.FollowerSwitchToMem Point blk
_ WithOrigin SlotNo
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"FollowerSwitchToMem"]
  forMachine DetailLevel
_dtal (ChainDB.FollowerNewImmIterator Point blk
_ WithOrigin SlotNo
_) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"FollowerNewImmIterator"]

instance MetaTrace (ChainDB.TraceFollowerEvent blk) where
  namespaceFor :: TraceFollowerEvent blk -> Namespace (TraceFollowerEvent blk)
namespaceFor TraceFollowerEvent blk
ChainDB.NewFollower =
    [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NewFollower"]
  namespaceFor ChainDB.FollowerNoLongerInMem{} =
    [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerNoLongerInMem"]
  namespaceFor ChainDB.FollowerSwitchToMem{} =
    [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerSwitchToMem"]
  namespaceFor ChainDB.FollowerNewImmIterator{} =
    [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerNewImmIterator"]

  severityFor :: Namespace (TraceFollowerEvent blk)
-> Maybe (TraceFollowerEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"NewFollower"]) Maybe (TraceFollowerEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"FollowerNoLongerInMem"]) Maybe (TraceFollowerEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"FollowerSwitchToMem"]) Maybe (TraceFollowerEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"FollowerNewImmIterator"]) Maybe (TraceFollowerEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceFollowerEvent blk)
_ Maybe (TraceFollowerEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceFollowerEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"NewFollower"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A new follower was created."
  documentFor (Namespace [Text]
_ [Text
"FollowerNoLongerInMem"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The follower was in 'FollowerInMem' state and is switched to"
        , Text
" the 'FollowerInImmutableDB' state."
        ]
  documentFor (Namespace [Text]
_ [Text
"FollowerSwitchToMem"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The follower was in the 'FollowerInImmutableDB' state and is switched to"
        , Text
" the 'FollowerInMem' state."
        ]
  documentFor (Namespace [Text]
_ [Text
"FollowerNewImmIterator"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The follower is in the 'FollowerInImmutableDB' state but the iterator is"
        , Text
" exhausted while the ImmDB has grown, so we open a new iterator to"
        , Text
" stream these blocks too."
        ]
  documentFor Namespace (TraceFollowerEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceFollowerEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NewFollower"]
    , [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerNoLongerInMem"]
    , [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerSwitchToMem"]
    , [Text] -> [Text] -> Namespace (TraceFollowerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FollowerNewImmIterator"]
    ]

--------------------------------------------------------------------------------
-- ChainDB TraceCopyToImmutableDB
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CopiedBlockToImmutableDB"
      , Key
"slot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoBlocksToCopyToImmutableDB"]

instance MetaTrace (ChainDB.TraceCopyToImmutableDBEvent blk) where
  namespaceFor :: TraceCopyToImmutableDBEvent blk
-> Namespace (TraceCopyToImmutableDBEvent blk)
namespaceFor ChainDB.CopiedBlockToImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CopiedBlockToImmutableDB"]
  namespaceFor ChainDB.NoBlocksToCopyToImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoBlocksToCopyToImmutableDB"]

  severityFor :: Namespace (TraceCopyToImmutableDBEvent blk)
-> Maybe (TraceCopyToImmutableDBEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"CopiedBlockToImmutableDB"]) Maybe (TraceCopyToImmutableDBEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"NoBlocksToCopyToImmutableDB"]) Maybe (TraceCopyToImmutableDBEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceCopyToImmutableDBEvent blk)
_ Maybe (TraceCopyToImmutableDBEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceCopyToImmutableDBEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"CopiedBlockToImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block was successfully copied to the ImmDB."
  documentFor (Namespace [Text]
_ [Text
"NoBlocksToCopyToImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"There are no block to copy to the ImmDB."
  documentFor Namespace (TraceCopyToImmutableDBEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceCopyToImmutableDBEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CopiedBlockToImmutableDB"]
    , [Text] -> [Text] -> Namespace (TraceCopyToImmutableDBEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoBlocksToCopyToImmutableDB"]
    ]

-- --------------------------------------------------------------------------------
-- -- ChainDB GCEvent
-- --------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerformedGC"
      , Key
"slot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ScheduledGC"
      , Key
"slot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (([Char] -> Text
Text.pack ([Char] -> Text) -> (Time -> [Char]) -> Time -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> [Char]
forall a. Show a => a -> [Char]
show) Time
difft) | DetailLevel
dtals DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DDetailed]

instance MetaTrace (ChainDB.TraceGCEvent blk) where
  namespaceFor :: TraceGCEvent blk -> Namespace (TraceGCEvent blk)
namespaceFor ChainDB.PerformedGC{} =
    [Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerformedGC"]
  namespaceFor ChainDB.ScheduledGC{} =
    [Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ScheduledGC"]

  severityFor :: Namespace (TraceGCEvent blk)
-> Maybe (TraceGCEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"PerformedGC"]) Maybe (TraceGCEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"ScheduledGC"]) Maybe (TraceGCEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceGCEvent blk)
_ Maybe (TraceGCEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceGCEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"PerformedGC"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A garbage collection for the given 'SlotNo' was performed."
  documentFor (Namespace [Text]
_ [Text
"ScheduledGC"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A garbage collection for the given 'SlotNo' was scheduled to happen"
        , Text
" at the given time."
        ]
  documentFor Namespace (TraceGCEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceGCEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerformedGC"]
    , [Text] -> [Text] -> Namespace (TraceGCEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ScheduledGC"]
    ]

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

instance
  ( ConvertRawHash blk
  , ConvertRawHash (Header blk)
  , LedgerSupportsProtocol blk
  , Show (PerasError 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.InitialChainSelected{} =
    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.InitialChainSelected =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Follower.InitialChainSelected"]
  forMachine DetailLevel
_dtal TraceInitChainSelEvent blk
ChainDB.StartedInitChainSelection =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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.InitialChainSelected = []
  asMetrics TraceInitChainSelEvent blk
ChainDB.StartedInitChainSelection = []

instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where
  namespaceFor :: TraceInitChainSelEvent blk
-> Namespace (TraceInitChainSelEvent blk)
namespaceFor ChainDB.InitialChainSelected{} =
    [Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitialChainSelected"]
  namespaceFor ChainDB.StartedInitChainSelection{} =
    [Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedInitChainSelection"]
  namespaceFor (ChainDB.InitChainSelValidation TraceValidationEvent blk
ev') =
    Text
-> Namespace (TraceValidationEvent blk)
-> Namespace (TraceInitChainSelEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Validation" (TraceValidationEvent blk -> Namespace (TraceValidationEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceValidationEvent blk
ev')

  severityFor :: Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"InitialChainSelected"]) Maybe (TraceInitChainSelEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StartedInitChainSelection"]) Maybe (TraceInitChainSelEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor
    (Namespace [Text]
out (Text
"Validation" : [Text]
tl))
    (Just (ChainDB.InitChainSelValidation TraceValidationEvent blk
ev')) =
      Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  severityFor (Namespace [Text]
out (Text
"Validation" : [Text]
tl)) Maybe (TraceInitChainSelEvent blk)
Nothing =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor
      ( [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl ::
          Namespace (ChainDB.TraceValidationEvent blk)
      )
      Maybe (TraceValidationEvent blk)
forall a. Maybe a
Nothing
  severityFor Namespace (TraceInitChainSelEvent blk)
_ Maybe (TraceInitChainSelEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  privacyFor :: Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe Privacy
privacyFor
    (Namespace [Text]
out (Text
"Validation" : [Text]
tl))
    (Just (ChainDB.InitChainSelValidation TraceValidationEvent blk
ev')) =
      Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  privacyFor (Namespace [Text]
out (Text
"Validation" : [Text]
tl)) Maybe (TraceInitChainSelEvent blk)
Nothing =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor
      ( [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl ::
          Namespace (ChainDB.TraceValidationEvent blk)
      )
      Maybe (TraceValidationEvent blk)
forall a. Maybe a
Nothing
  privacyFor Namespace (TraceInitChainSelEvent blk)
_ Maybe (TraceInitChainSelEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public

  detailsFor :: Namespace (TraceInitChainSelEvent blk)
-> Maybe (TraceInitChainSelEvent blk) -> Maybe DetailLevel
detailsFor
    (Namespace [Text]
out (Text
"Validation" : [Text]
tl))
    (Just (ChainDB.InitChainSelValidation TraceValidationEvent blk
ev')) =
      Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceValidationEvent blk -> Maybe (TraceValidationEvent blk)
forall a. a -> Maybe a
Just TraceValidationEvent blk
ev')
  detailsFor (Namespace [Text]
out (Text
"Validation" : [Text]
tl)) Maybe (TraceInitChainSelEvent blk)
Nothing =
    Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor
      ( [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl ::
          Namespace (ChainDB.TraceValidationEvent blk)
      )
      Maybe (TraceValidationEvent blk)
forall a. Maybe a
Nothing
  detailsFor Namespace (TraceInitChainSelEvent blk)
_ Maybe (TraceInitChainSelEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  metricsDocFor :: Namespace (TraceInitChainSelEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
out (Text
"Validation" : [Text]
tl)) =
    Namespace (TraceValidationEvent blk) -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.TraceValidationEvent blk))
  metricsDocFor Namespace (TraceInitChainSelEvent blk)
_ = []

  documentFor :: Namespace (TraceInitChainSelEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"InitialChainSelected"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A garbage collection for the given 'SlotNo' was performed."
  documentFor (Namespace [Text]
_ [Text
"StartedInitChainSelection"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A garbage collection for the given 'SlotNo' was scheduled to happen"
        , Text
" at the given time."
        ]
  documentFor (Namespace [Text]
o (Text
"Validation" : [Text]
tl)) =
    Namespace (TraceValidationEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace (ChainDB.TraceValidationEvent blk))
  documentFor Namespace (TraceInitChainSelEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceInitChainSelEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitialChainSelected"]
    , [Text] -> [Text] -> Namespace (TraceInitChainSelEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedInitChainSelection"]
    ]
      [Namespace (TraceInitChainSelEvent blk)]
-> [Namespace (TraceInitChainSelEvent blk)]
-> [Namespace (TraceInitChainSelEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceValidationEvent blk)
 -> Namespace (TraceInitChainSelEvent blk))
-> [Namespace (TraceValidationEvent blk)]
-> [Namespace (TraceInitChainSelEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TraceValidationEvent blk)
-> Namespace (TraceInitChainSelEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Validation")
        ([Namespace (TraceValidationEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.TraceValidationEvent blk)])

--------------------------------------------------------------------------------
-- ChainDB TraceValidationEvent
--------------------------------------------------------------------------------

instance
  ( LedgerSupportsProtocol blk
  , ConvertRawHash (Header blk)
  , ConvertRawHash blk
  , LogFormatting (RealPoint blk)
  , Show (PerasError 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.UpdateLedgerDbTraceEvent
        ( LedgerDB.StartedPushingBlockToTheLedgerDb
            (LedgerDB.PushStart RealPoint blk
start)
            (LedgerDB.PushGoal RealPoint blk
goal)
            (LedgerDB.Pushing RealPoint blk
curr)
          )
      ) =
      let fromSlot :: Word64
fromSlot = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
start
          atSlot :: Word64
atSlot = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
curr
          atDiff :: Word64
atDiff = Word64
atSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
          toSlot :: Word64
toSlot = SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
goal
          toDiff :: Word64
toDiff = Word64
toSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
fromSlot
       in Text
"Pushing ledger state for block "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
curr
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Progress: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
showProgressT (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
atDiff) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
toDiff)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"

  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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"InvalidBlock"
      , Key
"block" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ValidCandidate"
      , Key
"block" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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.UpdateLedgerDbTraceEvent
        ( LedgerDB.StartedPushingBlockToTheLedgerDb
            (LedgerDB.PushStart RealPoint blk
start)
            (LedgerDB.PushGoal RealPoint blk
goal)
            (LedgerDB.Pushing RealPoint blk
curr)
          )
      ) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb"
        , Key
"startingBlock" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint RealPoint blk
goal
        ]

instance MetaTrace (ChainDB.TraceValidationEvent blk) where
  namespaceFor :: TraceValidationEvent blk -> Namespace (TraceValidationEvent blk)
namespaceFor ChainDB.ValidCandidate{} =
    [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidCandidate"]
  namespaceFor ChainDB.InvalidBlock{} =
    [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidBlock"]
  namespaceFor ChainDB.UpdateLedgerDbTraceEvent{} =
    [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UpdateLedgerDb"]

  severityFor :: Namespace (TraceValidationEvent blk)
-> Maybe (TraceValidationEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"ValidCandidate"]) Maybe (TraceValidationEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"InvalidBlock"]) Maybe (TraceValidationEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
  severityFor (Namespace [Text]
_ [Text
"UpdateLedgerDb"]) Maybe (TraceValidationEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceValidationEvent blk)
_ Maybe (TraceValidationEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceValidationEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"ValidCandidate"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"An event traced during validating performed while adding a block."
        , Text
" A candidate chain was valid."
        ]
  documentFor (Namespace [Text]
_ [Text
"InvalidBlock"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"An event traced during validating performed while adding a block."
        , Text
" A point was found to be invalid."
        ]
  documentFor (Namespace [Text]
_ [Text
"UpdateLedgerDb"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
  documentFor Namespace (TraceValidationEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceValidationEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidCandidate"]
    , [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidBlock"]
    , [Text] -> [Text] -> Namespace (TraceValidationEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UpdateLedgerDb"]
    ]

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

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 (ChainDB.OpenedVolatileDB MaxSlotNo
mx) =
    Text
"Opened " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case MaxSlotNo
mx of
      MaxSlotNo
NoMaxSlotNo -> Text
"empty Volatile DB"
      MaxSlotNo SlotNo
mxx -> Text
"Volatile DB with max slot seen " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Show a => a -> Text
showT SlotNo
mxx
  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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"OpenedDB"
      , Key
"immtip" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceOpenEvent.ClosedDB"
      , Key
"immtip" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"OpenedImmutableDB"
      , Key
"immtip" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (([Char] -> Text
Text.pack ([Char] -> Text) -> (ChunkNo -> [Char]) -> ChunkNo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkNo -> [Char]
forall a. Show a => a -> [Char]
show) ChunkNo
epoch)
      ]
  forMachine DetailLevel
_dtal (ChainDB.OpenedVolatileDB MaxSlotNo
maxSlotN) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"OpenedVolatileDB"
      , Key
"maxSlotNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (MaxSlotNo -> Text
forall a. Show a => a -> Text
showT MaxSlotNo
maxSlotN)
      ]
  forMachine DetailLevel
_dtal TraceOpenEvent blk
ChainDB.OpenedLgrDB =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StartedOpeningLgrDB"]

instance MetaTrace (ChainDB.TraceOpenEvent blk) where
  namespaceFor :: TraceOpenEvent blk -> Namespace (TraceOpenEvent blk)
namespaceFor ChainDB.OpenedDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedDB"]
  namespaceFor ChainDB.ClosedDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClosedDB"]
  namespaceFor ChainDB.OpenedImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedImmutableDB"]
  namespaceFor ChainDB.OpenedVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedVolatileDB"]
  namespaceFor ChainDB.OpenedLgrDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedLgrDB"]
  namespaceFor ChainDB.StartedOpeningDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningDB"]
  namespaceFor ChainDB.StartedOpeningImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningImmutableDB"]
  namespaceFor ChainDB.StartedOpeningVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningVolatileDB"]
  namespaceFor ChainDB.StartedOpeningLgrDB{} =
    [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningLgrDB"]

  severityFor :: Namespace (TraceOpenEvent blk)
-> Maybe (TraceOpenEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"OpenedDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ClosedDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"OpenedImmutableDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"OpenedVolatileDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"OpenedLgrDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StartedOpeningDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StartedOpeningImmutableDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StartedOpeningVolatileDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"StartedOpeningLgrDB"]) Maybe (TraceOpenEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace (TraceOpenEvent blk)
_ Maybe (TraceOpenEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceOpenEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"OpenedDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The ChainDB was opened."
  documentFor (Namespace [Text]
_ [Text
"ClosedDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The ChainDB was closed."
  documentFor (Namespace [Text]
_ [Text
"OpenedImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The ImmDB was opened."
  documentFor (Namespace [Text]
_ [Text
"OpenedVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The VolatileDB was opened."
  documentFor (Namespace [Text]
_ [Text
"OpenedLgrDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The LedgerDB was opened."
  documentFor (Namespace [Text]
_ [Text
"StartedOpeningDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The ChainDB is being opened."
  documentFor (Namespace [Text]
_ [Text
"StartedOpeningImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The ImmDB is being opened."
  documentFor (Namespace [Text]
_ [Text
"StartedOpeningVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The VolatileDB is being opened."
  documentFor (Namespace [Text]
_ [Text
"StartedOpeningLgrDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The LedgerDB is being opened."
  documentFor Namespace (TraceOpenEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceOpenEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClosedDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedImmutableDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OpenedLgrDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningImmutableDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceOpenEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedOpeningLgrDB"]
    ]

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

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] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"This block is no longer in the VolatileDB because it has been garbage"
      , Text
" collected. It might now be in the ImmDB if it was part of the"
      , Text
" 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] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ 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
" 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] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Stream from both the VolatileDB and the ImmDB."
      , 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
" 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 a b. (a -> b) -> [a] -> [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] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Stream only from the VolatileDB."
      , 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
" 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 a b. (a -> b) -> [a] -> [b]
map RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPoint [RealPoint blk]
pts)
      ]
  forHuman (ChainDB.BlockWasCopiedToImmutableDB RealPoint blk
pt) =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"This block has been garbage collected from the VolatileDB is now"
      , Text
" 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] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"This block no longer in the VolatileDB and isn't in the ImmDB"
      , Text
" 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnknownRangeRequested"
      , Key
"range" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StreamFromVolatileDB"
      , Key
"from" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> ([Text] -> [Char]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Char]
forall a. Show a => a -> [Char]
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall a b. (a -> b) -> [a] -> [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StreamFromImmutableDB"
      , Key
"from" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StreamFromBoth"
      , Key
"from" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> ([Text] -> [Char]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Char]
forall a. Show a => a -> [Char]
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RealPoint blk -> Text) -> [RealPoint blk] -> [Text]
forall a b. (a -> b) -> [a] -> [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BlockMissingFromVolatileDB"
      , Key
"point" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BlockWasCopiedToImmutableDB"
      , Key
"point" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BlockGCedFromVolatileDB"
      , Key
"point" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SwitchBackToVolatileDB"
      ]

instance MetaTrace (ChainDB.TraceIteratorEvent blk) where
  namespaceFor :: TraceIteratorEvent blk -> Namespace (TraceIteratorEvent blk)
namespaceFor (ChainDB.UnknownRangeRequested UnknownRange blk
ur) =
    Text
-> Namespace (UnknownRange blk)
-> Namespace (TraceIteratorEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"UnknownRangeRequested" (UnknownRange blk -> Namespace (UnknownRange blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor UnknownRange blk
ur)
  namespaceFor ChainDB.StreamFromVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromVolatileDB"]
  namespaceFor ChainDB.StreamFromImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromImmutableDB"]
  namespaceFor ChainDB.StreamFromBoth{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromBoth"]
  namespaceFor ChainDB.BlockMissingFromVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockMissingFromVolatileDB"]
  namespaceFor ChainDB.BlockWasCopiedToImmutableDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockWasCopiedToImmutableDB"]
  namespaceFor ChainDB.BlockGCedFromVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockGCedFromVolatileDB"]
  namespaceFor ChainDB.SwitchBackToVolatileDB{} =
    [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SwitchBackToVolatileDB"]

  severityFor :: Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe SeverityS
severityFor
    (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl))
    (Just (ChainDB.UnknownRangeRequested UnknownRange blk
ur)) =
      Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (UnknownRange blk -> Maybe (UnknownRange blk)
forall a. a -> Maybe a
Just UnknownRange blk
ur)
  severityFor (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl)) Maybe (TraceIteratorEvent blk)
Nothing =
    Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.UnknownRange blk)) Maybe (UnknownRange blk)
forall a. Maybe a
Nothing
  severityFor Namespace (TraceIteratorEvent blk)
_ Maybe (TraceIteratorEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug

  privacyFor :: Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe Privacy
privacyFor
    (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl))
    (Just (ChainDB.UnknownRangeRequested UnknownRange blk
ev')) =
      Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (UnknownRange blk -> Maybe (UnknownRange blk)
forall a. a -> Maybe a
Just UnknownRange blk
ev')
  privacyFor (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl)) Maybe (TraceIteratorEvent blk)
Nothing =
    Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor
      ( [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl ::
          Namespace (ChainDB.UnknownRange blk)
      )
      Maybe (UnknownRange blk)
forall a. Maybe a
Nothing
  privacyFor Namespace (TraceIteratorEvent blk)
_ Maybe (TraceIteratorEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public

  detailsFor :: Namespace (TraceIteratorEvent blk)
-> Maybe (TraceIteratorEvent blk) -> Maybe DetailLevel
detailsFor
    (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl))
    (Just (ChainDB.UnknownRangeRequested UnknownRange blk
ev')) =
      Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (UnknownRange blk -> Maybe (UnknownRange blk)
forall a. a -> Maybe a
Just UnknownRange blk
ev')
  detailsFor (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl)) Maybe (TraceIteratorEvent blk)
Nothing =
    Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor
      ( [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl ::
          Namespace (ChainDB.UnknownRange blk)
      )
      Maybe (UnknownRange blk)
forall a. Maybe a
Nothing
  detailsFor Namespace (TraceIteratorEvent blk)
_ Maybe (TraceIteratorEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  documentFor :: Namespace (TraceIteratorEvent blk) -> Maybe Text
documentFor (Namespace [Text]
out (Text
"UnknownRangeRequested" : [Text]
tl)) =
    Namespace (UnknownRange blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ChainDB.UnknownRange blk))
  documentFor (Namespace [Text]
_ [Text
"StreamFromVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Stream only from the VolatileDB."
  documentFor (Namespace [Text]
_ [Text
"StreamFromImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Stream only from the ImmDB."
  documentFor (Namespace [Text]
_ [Text
"StreamFromBoth"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Stream from both the VolatileDB and the ImmDB."
  documentFor (Namespace [Text]
_ [Text
"BlockMissingFromVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A block is no longer in the VolatileDB because it has been garbage"
        , Text
" collected. It might now be in the ImmDB if it was part of the"
        , Text
" current chain."
        ]
  documentFor (Namespace [Text]
_ [Text
"BlockWasCopiedToImmutableDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A block that has been garbage collected from the VolatileDB is now"
        , Text
" found and streamed from the ImmDB."
        ]
  documentFor (Namespace [Text]
_ [Text
"BlockGCedFromVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A block is no longer in the VolatileDB and isn't in the ImmDB"
        , Text
" either; it wasn't part of the current chain."
        ]
  documentFor (Namespace [Text]
_ [Text
"SwitchBackToVolatileDB"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"We have streamed one or more blocks from the ImmDB that were part"
        , Text
" of the VolatileDB when initialising the iterator. Now, we have to look"
        , Text
" back in the VolatileDB again because the ImmDB doesn't have the"
        , Text
" next block we're looking for."
        ]
  documentFor Namespace (TraceIteratorEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceIteratorEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromImmutableDB"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StreamFromBoth"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockMissingFromVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockWasCopiedToImmutableDB"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockGCedFromVolatileDB"]
    , [Text] -> [Text] -> Namespace (TraceIteratorEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SwitchBackToVolatileDB"]
    ]
      [Namespace (TraceIteratorEvent blk)]
-> [Namespace (TraceIteratorEvent blk)]
-> [Namespace (TraceIteratorEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (UnknownRange blk)
 -> Namespace (TraceIteratorEvent blk))
-> [Namespace (UnknownRange blk)]
-> [Namespace (TraceIteratorEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (UnknownRange blk)
-> Namespace (TraceIteratorEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"UnknownRangeRequested")
        ([Namespace (UnknownRange blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ChainDB.UnknownRange blk)])

--------------------------------------------------------------------------------
-- UnknownRange
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"MissingBlock"
      , Key
"point" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkTooOld"
      , Key
"from" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (StreamFrom blk -> Text
forall a. Show a => a -> Text
showT StreamFrom blk
streamFrom)
      ]

instance MetaTrace (ChainDB.UnknownRange blk) where
  namespaceFor :: UnknownRange blk -> Namespace (UnknownRange blk)
namespaceFor ChainDB.MissingBlock{} = [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingBlock"]
  namespaceFor ChainDB.ForkTooOld{} = [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForkTooOld"]

  severityFor :: Namespace (UnknownRange blk)
-> Maybe (UnknownRange blk) -> Maybe SeverityS
severityFor Namespace (UnknownRange blk)
_ Maybe (UnknownRange blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug

  documentFor :: Namespace (UnknownRange blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"MissingBlock"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"ForkTooOld"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor Namespace (UnknownRange blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (UnknownRange blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingBlock"]
    , [Text] -> [Text] -> Namespace (UnknownRange blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForkTooOld"]
    ]

-- --------------------------------------------------------------------------------
-- -- Peras
-- --------------------------------------------------------------------------------

instance MetaTrace (PerasVoteDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor (PerasVoteDB.AddVote{}) = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddVote"]
  namespaceFor (PerasVoteDB.GarbageCollected{}) = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GarbageCollected"]
  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddVote"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GarbageCollected"]
    ]

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  privacyFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
privacyFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  detailsFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
detailsFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"AddVote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"AddVote"
  documentFor (Namespace [Text]
_ [Text
"GarbageCollected"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"GarbageCollected"
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

instance Show (PerasCert blk) => LogFormatting (PerasVoteDB.TraceEvent blk) where
  forHuman :: TraceEvent blk -> Text
forHuman (PerasVoteDB.AddVote PerasVoteId
voteId WithArrivalTime (ValidatedPerasVote blk)
_vote AddPerasVoteResult blk
result) =
    Text
"Peras vote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasVoteId -> [Char]
forall a. Show a => a -> [Char]
show PerasVoteId
voteId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (AddPerasVoteResult blk -> [Char]
forall a. Show a => a -> [Char]
show AddPerasVoteResult blk
result)
  forHuman (PerasVoteDB.GarbageCollected SlotNo
slotNo) =
    Text
"Peras vote DB garbage collected at slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (SlotNo -> [Char]
forall a. Show a => a -> [Char]
show SlotNo
slotNo)

  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
_dtal (PerasVoteDB.AddVote PerasVoteId
voteId WithArrivalTime (ValidatedPerasVote blk)
_vote AddPerasVoteResult blk
result) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddVote"
      , Key
"voteId" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasVoteId -> [Char]
forall a. Show a => a -> [Char]
show PerasVoteId
voteId)
      , Key
"result" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ AddPerasVoteResult blk -> [Char]
forall a. Show a => a -> [Char]
show AddPerasVoteResult blk
result)
      ]
  forMachine DetailLevel
_dtal (PerasVoteDB.GarbageCollected SlotNo
slotNo) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"GarbageCollected"
      , Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SlotNo -> [Char]
forall a. Show a => a -> [Char]
show SlotNo
slotNo)
      ]

  asMetrics :: TraceEvent blk -> [Metric]
asMetrics TraceEvent blk
_ = []

instance MetaTrace (PerasCertDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor (PerasCertDB.AddCert{}) = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddCert"]
  namespaceFor (PerasCertDB.GarbageCollected SlotNo
_) = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GarbageCollected"]
  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddCert"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GarbageCollected"]
    ]

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  privacyFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
privacyFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  detailsFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
detailsFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"AddCert"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"AddCert"
  documentFor (Namespace [Text]
_ [Text
"GarbageCollected"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"GarbageCollected"
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

instance LogFormatting (PerasCertDB.TraceEvent blk) where
  forHuman :: TraceEvent blk -> Text
forHuman (PerasCertDB.AddCert PerasRoundNo
roundNo WithArrivalTime (ValidatedPerasCert blk)
_cert AddPerasCertResult
result) =
    Text
"Peras certificate for round " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (AddPerasCertResult -> [Char]
forall a. Show a => a -> [Char]
show AddPerasCertResult
result)
  forHuman (PerasCertDB.GarbageCollected SlotNo
slotNo) =
    Text
"Peras certificate DB garbage collected at slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (SlotNo -> [Char]
forall a. Show a => a -> [Char]
show SlotNo
slotNo)

  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
_dtal (PerasCertDB.AddCert PerasRoundNo
roundNo WithArrivalTime (ValidatedPerasCert blk)
_cert AddPerasCertResult
result) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddCert"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"result" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ AddPerasCertResult -> [Char]
forall a. Show a => a -> [Char]
show AddPerasCertResult
result)
      ]
  forMachine DetailLevel
_dtal (PerasCertDB.GarbageCollected SlotNo
slotNo) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"GarbageCollected"
      , Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SlotNo -> [Char]
forall a. Show a => a -> [Char]
show SlotNo
slotNo)
      ]

  asMetrics :: TraceEvent blk -> [Metric]
asMetrics TraceEvent blk
_ = []

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

instance
  ( StandardHash blk
  , ConvertRawHash blk
  ) =>
  LogFormatting (LedgerDB.TraceEvent blk)
  where
  forMachine :: DetailLevel -> TraceEvent blk -> Object
forMachine DetailLevel
dtals (LedgerDB.LedgerDBSnapshotEvent TraceSnapshotEvent blk
ev) = DetailLevel -> TraceSnapshotEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals TraceSnapshotEvent blk
ev
  forMachine DetailLevel
dtals (LedgerDB.LedgerReplayEvent TraceReplayEvent blk
ev) = DetailLevel -> TraceReplayEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals TraceReplayEvent blk
ev
  forMachine DetailLevel
dtals (LedgerDB.LedgerDBForkerEvent TraceForkerEventWithKey
ev) = DetailLevel -> TraceForkerEventWithKey -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals TraceForkerEventWithKey
ev
  forMachine DetailLevel
dtals (LedgerDB.LedgerDBFlavorImplEvent FlavorImplSpecificTrace
ev) = DetailLevel -> FlavorImplSpecificTrace -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals FlavorImplSpecificTrace
ev

  forHuman :: TraceEvent blk -> Text
forHuman (LedgerDB.LedgerDBSnapshotEvent TraceSnapshotEvent blk
ev) = TraceSnapshotEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceSnapshotEvent blk
ev
  forHuman (LedgerDB.LedgerReplayEvent TraceReplayEvent blk
ev) = TraceReplayEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceReplayEvent blk
ev
  forHuman (LedgerDB.LedgerDBForkerEvent TraceForkerEventWithKey
ev) = TraceForkerEventWithKey -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceForkerEventWithKey
ev
  forHuman (LedgerDB.LedgerDBFlavorImplEvent FlavorImplSpecificTrace
ev) = FlavorImplSpecificTrace -> Text
forall a. LogFormatting a => a -> Text
forHuman FlavorImplSpecificTrace
ev

instance MetaTrace (LedgerDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor (LedgerDB.LedgerDBSnapshotEvent TraceSnapshotEvent blk
ev) =
    Text
-> Namespace (TraceSnapshotEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Snapshot" (TraceSnapshotEvent blk -> Namespace (TraceSnapshotEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceSnapshotEvent blk
ev)
  namespaceFor (LedgerDB.LedgerReplayEvent TraceReplayEvent blk
ev) =
    Text
-> Namespace (TraceReplayEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Replay" (TraceReplayEvent blk -> Namespace (TraceReplayEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceReplayEvent blk
ev)
  namespaceFor (LedgerDB.LedgerDBForkerEvent TraceForkerEventWithKey
ev) =
    Text
-> Namespace TraceForkerEventWithKey -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Forker" (TraceForkerEventWithKey -> Namespace TraceForkerEventWithKey
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceForkerEventWithKey
ev)
  namespaceFor (LedgerDB.LedgerDBFlavorImplEvent FlavorImplSpecificTrace
ev) =
    Text
-> Namespace FlavorImplSpecificTrace -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Flavor" (FlavorImplSpecificTrace -> Namespace FlavorImplSpecificTrace
forall a. MetaTrace a => a -> Namespace a
namespaceFor FlavorImplSpecificTrace
ev)

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
out (Text
"Snapshot" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceSnapshotEvent blk)
-> Maybe (TraceSnapshotEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) Maybe (TraceSnapshotEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"Snapshot" : [Text]
tl)) (Just (LedgerDB.LedgerDBSnapshotEvent TraceSnapshotEvent blk
ev)) =
    Namespace (TraceSnapshotEvent blk)
-> Maybe (TraceSnapshotEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) (TraceSnapshotEvent blk -> Maybe (TraceSnapshotEvent blk)
forall a. a -> Maybe a
Just TraceSnapshotEvent blk
ev)
  severityFor (Namespace [Text]
out (Text
"Replay" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceReplayEvent blk)
-> Maybe (TraceReplayEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayEvent blk)) Maybe (TraceReplayEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"Replay" : [Text]
tl)) (Just (LedgerDB.LedgerReplayEvent TraceReplayEvent blk
ev)) =
    Namespace (TraceReplayEvent blk)
-> Maybe (TraceReplayEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayEvent blk)) (TraceReplayEvent blk -> Maybe (TraceReplayEvent blk)
forall a. a -> Maybe a
Just TraceReplayEvent blk
ev)
  severityFor (Namespace [Text]
out (Text
"Forker" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace TraceForkerEventWithKey
-> Maybe TraceForkerEventWithKey -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace TraceForkerEventWithKey
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace LedgerDB.TraceForkerEventWithKey) Maybe TraceForkerEventWithKey
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"Forker" : [Text]
tl)) (Just (LedgerDB.LedgerDBForkerEvent TraceForkerEventWithKey
ev)) =
    Namespace TraceForkerEventWithKey
-> Maybe TraceForkerEventWithKey -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace TraceForkerEventWithKey
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace LedgerDB.TraceForkerEventWithKey) (TraceForkerEventWithKey -> Maybe TraceForkerEventWithKey
forall a. a -> Maybe a
Just TraceForkerEventWithKey
ev)
  severityFor (Namespace [Text]
out (Text
"Flavor" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace FlavorImplSpecificTrace
-> Maybe FlavorImplSpecificTrace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace FlavorImplSpecificTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace LedgerDB.FlavorImplSpecificTrace) Maybe FlavorImplSpecificTrace
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"Flavor" : [Text]
tl)) (Just (LedgerDB.LedgerDBFlavorImplEvent FlavorImplSpecificTrace
ev)) =
    Namespace FlavorImplSpecificTrace
-> Maybe FlavorImplSpecificTrace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace FlavorImplSpecificTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace LedgerDB.FlavorImplSpecificTrace) (FlavorImplSpecificTrace -> Maybe FlavorImplSpecificTrace
forall a. a -> Maybe a
Just FlavorImplSpecificTrace
ev)
  severityFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
o (Text
"Snapshot" : [Text]
tl)) =
    Namespace (TraceSnapshotEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace (LedgerDB.TraceSnapshotEvent blk))
  documentFor (Namespace [Text]
o (Text
"Replay" : [Text]
tl)) =
    Namespace (TraceReplayEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceReplayEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace (LedgerDB.TraceReplayEvent blk))
  documentFor (Namespace [Text]
o (Text
"Forker" : [Text]
tl)) =
    Namespace TraceForkerEventWithKey -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace TraceForkerEventWithKey
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace LedgerDB.TraceForkerEventWithKey)
  documentFor (Namespace [Text]
o (Text
"Flavor" : [Text]
tl)) =
    Namespace FlavorImplSpecificTrace -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace FlavorImplSpecificTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace LedgerDB.FlavorImplSpecificTrace)
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    (Namespace (TraceSnapshotEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceSnapshotEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
      (Text
-> Namespace (TraceSnapshotEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Snapshot")
      ([Namespace (TraceSnapshotEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (LedgerDB.TraceSnapshotEvent blk)])
      [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceReplayEvent blk) -> Namespace (TraceEvent blk))
-> [Namespace (TraceReplayEvent blk)]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TraceReplayEvent blk) -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Replay")
        ([Namespace (TraceReplayEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (LedgerDB.TraceReplayEvent blk)])
      [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace TraceForkerEventWithKey -> Namespace (TraceEvent blk))
-> [Namespace TraceForkerEventWithKey]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace TraceForkerEventWithKey -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Forker")
        ([Namespace TraceForkerEventWithKey]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace LedgerDB.TraceForkerEventWithKey])
      [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace FlavorImplSpecificTrace -> Namespace (TraceEvent blk))
-> [Namespace FlavorImplSpecificTrace]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace FlavorImplSpecificTrace -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"Flavor")
        ([Namespace FlavorImplSpecificTrace]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace LedgerDB.FlavorImplSpecificTrace])

-- | The number of blocks that can be rolled back.
instance ToJSON SecurityParam where
  toJSON :: SecurityParam -> Value
toJSON = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word64 -> Value)
-> (SecurityParam -> Word64) -> SecurityParam -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64)
-> (SecurityParam -> NonZero Word64) -> SecurityParam -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityParam -> NonZero Word64
maxRollbacks

-- | The name of the mismatch, so that a consumer can match on it.
instance ToJSON LedgerDB.SnapshotPolicyMismatch where
  toJSON :: SnapshotPolicyMismatch -> Value
toJSON SnapshotPolicyMismatch
LedgerDB.WriteDelayExceedsInterval = Text -> Value
String Text
"WriteDelayExceedsInterval"
  toJSON SnapshotPolicyMismatch
LedgerDB.RateLimitExceedsInterval = Text -> Value
String Text
"RateLimitExceedsInterval"

instance
  ( StandardHash blk
  , ConvertRawHash blk
  ) =>
  LogFormatting (LedgerDB.TraceSnapshotEvent blk)
  where
  forHuman :: TraceSnapshotEvent blk -> Text
forHuman (LedgerDB.ConfiguredSnapshotPolicy SnapshotPolicyInfo
info) = SnapshotPolicyInfo -> Text
renderSnapshotPolicy SnapshotPolicyInfo
info
  forHuman (LedgerDB.SnapshotRequestDelayed Time
_snapshotRequestTime DiffTime
delayBeforeSnapshotting NonEmpty SlotNo
slots) =
    [Text] -> Text
Text.unwords
      [ Text
"Scheduling to take ledger state snapshots at slots "
      , [SlotNo] -> Text
forall a. Show a => a -> Text
showT (NonEmpty SlotNo -> [SlotNo]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty SlotNo
slots)
      , Text
", with a randomised delay of"
      , DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
delayBeforeSnapshotting
      ]
  forHuman TraceSnapshotEvent blk
LedgerDB.SnapshotRequestCompleted = Text
"Completed taking a ledger state snapshot"
  forHuman (LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt Enclosing' DiffTime
RisingEdge) =
    [Text] -> Text
Text.unwords
      [ Text
"Taking ledger snapshot"
      , DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap
      , Text
"at"
      , RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
      ]
  forHuman (LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt (FallingEdgeWith DiffTime
t)) =
    [Text] -> Text
Text.unwords
      [ Text
"Took ledger snapshot"
      , DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap
      , Text
"at"
      , RealPoint blk -> Text
forall blk. ConvertRawHash blk => RealPoint blk -> Text
renderRealPointAsPhrase RealPoint blk
pt
      , Text
", duration:"
      , DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
t
      ]
  forHuman (LedgerDB.DeletedSnapshot DiskSnapshot
snap) =
    [Text] -> Text
Text.unwords [Text
"Deleted old snapshot", DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap]
  forHuman (LedgerDB.InvalidSnapshot DiskSnapshot
snap SnapshotFailure blk
failure) =
    [Text] -> Text
Text.unwords
      [ Text
"Invalid snapshot"
      , DiskSnapshot -> Text
forall a. Show a => a -> Text
showT DiskSnapshot
snap
      , SnapshotFailure blk -> Text
forall a. Show a => a -> Text
showT SnapshotFailure blk
failure
      , Text
context
      ]
   where
    context :: Text
context = case SnapshotFailure blk
failure of
      LedgerDB.InitFailureRead LedgerDB.ReadSnapshotFailed{} ->
        Text
" This is most likely an expected change in the serialization format,"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" which currently requires a chain replay"
      LedgerDB.InitFailureRead ReadSnapshotErr
LedgerDB.ReadSnapshotDataCorruption ->
        Text
" The snapshot fails the CRC check. It seems there has been disk corruption"
      LedgerDB.InitFailureRead (LedgerDB.ReadMetadataError FsPath
_ MetadataErr
err) -> case MetadataErr
err of
        MetadataErr
LedgerDB.MetadataFileDoesNotExist ->
          Text
" The snapshot doesn't have the required metadata file."
        LedgerDB.MetadataInvalid [Char]
errMsg ->
          Text
" Snapshot metadata file failed to deserialize: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. Show a => a -> Text
showT [Char]
errMsg
        MetadataErr
LedgerDB.MetadataBackendMismatch ->
          Text
" Snapshot was created for a different backend. Convert it with `snapshot-converter`."
      SnapshotFailure blk
_ -> Text
""

  forMachine :: DetailLevel -> TraceSnapshotEvent blk -> Object
forMachine DetailLevel
_dtals (LedgerDB.ConfiguredSnapshotPolicy SnapshotPolicyInfo
info) =
    [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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ConfiguredSnapshotPolicy"
      , Key
"mismatches" Key -> [SnapshotPolicyMismatch] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotPolicyInfo -> [SnapshotPolicyMismatch]
LedgerDB.snapshotPolicyMismatches SnapshotPolicyInfo
info
      , Key
"securityParam" Key -> SecurityParam -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotPolicyInfo -> SecurityParam
LedgerDB.spiSecurityParam SnapshotPolicyInfo
info
      , Key
"slotLengthSeconds" Key -> Double -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NominalDiffTime -> Double
forall a. Real a => a -> Double
asSeconds (SlotLength -> NominalDiffTime
getSlotLength (SnapshotPolicyInfo -> SlotLength
LedgerDB.spiSlotLengthAtTip SnapshotPolicyInfo
info))
      , Key
"numOfDiskSnapshots"
          Key -> Word -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NumOfDiskSnapshots -> Word
LedgerDB.getNumOfDiskSnapshots (SnapshotPolicyArgs -> NumOfDiskSnapshots
LedgerDB.spaNum (SnapshotPolicyInfo -> SnapshotPolicyArgs
LedgerDB.spiArgs SnapshotPolicyInfo
info))
      ]
        [Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> case ( SnapshotPolicyArgs -> SnapshotFrequency
LedgerDB.spaFrequency (SnapshotPolicyInfo -> SnapshotPolicyArgs
LedgerDB.spiArgs SnapshotPolicyInfo
info)
                , SnapshotPolicyInfo -> Maybe (NonZero Word64)
LedgerDB.spiIntervalSlots SnapshotPolicyInfo
info
                ) of
          (LedgerDB.SnapshotFrequency SnapshotFrequencyArgs
fargs, Just NonZero Word64
intervalSlots) ->
            [ Key
"intervalSlots" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
intervalSlots
            , Key
"intervalSeconds"
                Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Double -> Value
forall a. ToJSON a => a -> Value
toJSON (NominalDiffTime -> Double
forall a. Real a => a -> Double
asSeconds (NominalDiffTime -> Double)
-> Maybe NominalDiffTime -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotPolicyInfo -> Maybe NominalDiffTime
LedgerDB.snapshotPolicyIntervalTime SnapshotPolicyInfo
info)
            , Key
"offsetSlots" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> Word64
unSlotNo (SnapshotFrequencyArgs -> SlotNo
LedgerDB.sfaOffset SnapshotFrequencyArgs
fargs)
            , Key
"rateLimitSeconds" Key -> Double -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> Double
forall a. Real a => a -> Double
asSeconds (SnapshotFrequencyArgs -> DiffTime
LedgerDB.sfaRateLimit SnapshotFrequencyArgs
fargs)
            , Key
"writeDelayMinSeconds"
                Key -> Double -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> Double
forall a. Real a => a -> Double
asSeconds (SnapshotDelayRange -> DiffTime
LedgerDB.minimumDelay (SnapshotFrequencyArgs -> SnapshotDelayRange
LedgerDB.sfaDelaySnapshotRange SnapshotFrequencyArgs
fargs))
            , Key
"writeDelayMaxSeconds"
                Key -> Double -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> Double
forall a. Real a => a -> Double
asSeconds (SnapshotDelayRange -> DiffTime
LedgerDB.maximumDelay (SnapshotFrequencyArgs -> SnapshotDelayRange
LedgerDB.sfaDelaySnapshotRange SnapshotFrequencyArgs
fargs))
            ]
          (SnapshotFrequency, Maybe (NonZero Word64))
_ -> [Key
"snapshotsDisabled" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
  forMachine DetailLevel
_dtals (LedgerDB.SnapshotRequestDelayed Time
snapshotRequestTime DiffTime
delayBeforeSnapshotting NonEmpty SlotNo
slots) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SnapshotRequestDelayed"
      , Key
"requestTime" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Time -> [Char]
forall a. Show a => a -> [Char]
show Time
snapshotRequestTime
      , Key
"delayBeforeSnapshotting" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> [Char]
forall a. Show a => a -> [Char]
show DiffTime
delayBeforeSnapshotting
      , Key
"slots" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [SlotNo] -> Value
forall a. ToJSON a => a -> Value
toJSON (NonEmpty SlotNo -> [SlotNo]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty SlotNo
slots)
      ]
  forMachine DetailLevel
_dtals TraceSnapshotEvent blk
LedgerDB.SnapshotRequestCompleted =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"SnapshotRequestCompleted"
      ]
  forMachine DetailLevel
dtals (LedgerDB.TookSnapshot DiskSnapshot
snap RealPoint blk
pt Enclosing' DiffTime
enclosedTiming) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TookSnapshot"
      , Key
"snapshot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals DiskSnapshot
snap
      , Key
"tip" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RealPoint blk -> [Char]
forall a. Show a => a -> [Char]
show RealPoint blk
pt
      , Key
"enclosedTime" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Enclosing' DiffTime -> Value
forall a. ToJSON a => Enclosing' a -> Value
enclosingValue Enclosing' DiffTime
enclosedTiming
      ]
  forMachine DetailLevel
dtals (LedgerDB.DeletedSnapshot DiskSnapshot
snap) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DeletedSnapshot"
      , Key
"snapshot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 SnapshotFailure blk
failure) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"InvalidSnapshot"
      , Key
"snapshot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals DiskSnapshot
snap
      , Key
"failure" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotFailure blk -> [Char]
forall a. Show a => a -> [Char]
show SnapshotFailure blk
failure
      ]

instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where
  namespaceFor :: TraceSnapshotEvent blk -> Namespace (TraceSnapshotEvent blk)
namespaceFor (LedgerDB.ConfiguredSnapshotPolicy SnapshotPolicyInfo
info)
    -- The severity belongs to the namespace, not to the value, so a policy that
    -- does not hang together on this network is reported under its own one.
    | [SnapshotPolicyMismatch] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SnapshotPolicyInfo -> [SnapshotPolicyMismatch]
LedgerDB.snapshotPolicyMismatches SnapshotPolicyInfo
info) =
        [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ConfiguredSnapshotPolicy"]
    | Bool
otherwise = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ImplausibleSnapshotPolicy"]
  namespaceFor LedgerDB.SnapshotRequestDelayed{} = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SnapshotRequestDelayed"]
  namespaceFor LedgerDB.SnapshotRequestCompleted{} = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SnapshotRequestCompleted"]
  namespaceFor LedgerDB.TookSnapshot{} = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TookSnapshot"]
  namespaceFor LedgerDB.DeletedSnapshot{} = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DeletedSnapshot"]
  namespaceFor LedgerDB.InvalidSnapshot{} = [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidSnapshot"]

  severityFor :: Namespace (TraceSnapshotEvent blk)
-> Maybe (TraceSnapshotEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"ConfiguredSnapshotPolicy"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ImplausibleSnapshotPolicy"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"SnapshotRequestDelayed"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"SnapshotRequestCompleted"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"TookSnapshot"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"DeletedSnapshot"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"InvalidSnapshot"]) Maybe (TraceSnapshotEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
  severityFor Namespace (TraceSnapshotEvent blk)
_ Maybe (TraceSnapshotEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceSnapshotEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"TookSnapshot"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"A snapshot is being written to disk. Two events will be traced, one"
        , Text
" for when the node starts taking the snapshot and another one for"
        , Text
" when the snapshot has been written to the disk."
        ]
  documentFor (Namespace [Text]
_ [Text
"DeletedSnapshot"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A snapshot was deleted from the disk."
  documentFor (Namespace [Text]
_ [Text
"InvalidSnapshot"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"An on disk snapshot was invalid. Unless it was suffixed or"
        , Text
" seems to be from an old node or different backend, it will"
        , Text
" be deleted"
        ]
  documentFor (Namespace [Text]
_ [Text
"ConfiguredSnapshotPolicy"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The snapshot policy the ledger database was opened with."
        , Text
" The interval is configured in slots while the write delay"
        , Text
" and the rate limit are in seconds, so the interval is also reported as"
        , Text
" wall-clock time, using the slot length of the era the tip is in. On a"
        , Text
" network with short slots, a delay window carried over from mainnet can"
        , Text
" be a large part of the interval, or longer than it."
        ]
  documentFor (Namespace [Text]
_ [Text
"ImplausibleSnapshotPolicy"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The snapshot policy the ledger database was opened with, where the"
        , Text
" write delay or the rate limit is at least as long as the interval"
        , Text
" between snapshots. The usual cause is a network whose slots are"
        , Text
" shorter than mainnet's, left on settings that were written for"
        , Text
" mainnet: the interval is counted in slots, so the time it stands for"
        , Text
" falls with the slot length, while the delay and the rate limit are in"
        , Text
" seconds and do not move."
        ]
  documentFor (Namespace [Text]
_ [Text
"SnapshotRequestDelayed"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A delayed snapshot request was issued. The snapshot will be initiated at the specified timestamp, with the specified delay and for the specified slots"
  documentFor (Namespace [Text]
_ [Text
"SnapshotRequestCompleted"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The delayed snapshot request was completed"
  documentFor Namespace (TraceSnapshotEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceSnapshotEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ConfiguredSnapshotPolicy"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ImplausibleSnapshotPolicy"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TookSnapshot"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DeletedSnapshot"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidSnapshot"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SnapshotRequestDelayed"]
    , [Text] -> [Text] -> Namespace (TraceSnapshotEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SnapshotRequestCompleted"]
    ]

-- | The snapshot policy, in terms an operator can act on.
--
-- The interval is configured in slots while the write delay and the rate limit
-- are in seconds, so the wall-clock interval is spelled out. The same settings
-- mean one thing on mainnet and quite another on a network whose slots are
-- shorter, which is how a testnet ends up running mainnet's cadence: a node
-- started from a configuration file always receives a concrete interval, 86400
-- slots unless that file says otherwise, and never the @k@-scaled default (see
-- IntersectMBO/ouroboros-consensus#2355).
renderSnapshotPolicy :: LedgerDB.SnapshotPolicyInfo -> Text
renderSnapshotPolicy :: SnapshotPolicyInfo -> Text
renderSnapshotPolicy SnapshotPolicyInfo
info = Text
policy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mismatches
 where
  args :: SnapshotPolicyArgs
args = SnapshotPolicyInfo -> SnapshotPolicyArgs
LedgerDB.spiArgs SnapshotPolicyInfo
info
  slotLength :: SlotLength
slotLength = SnapshotPolicyInfo -> SlotLength
LedgerDB.spiSlotLengthAtTip SnapshotPolicyInfo
info
  numSnapshots :: Word
numSnapshots = NumOfDiskSnapshots -> Word
LedgerDB.getNumOfDiskSnapshots (SnapshotPolicyArgs -> NumOfDiskSnapshots
LedgerDB.spaNum SnapshotPolicyArgs
args)

  policy :: Text
policy =
    case (SnapshotPolicyArgs -> SnapshotFrequency
LedgerDB.spaFrequency SnapshotPolicyArgs
args, SnapshotPolicyInfo -> Maybe (NonZero Word64)
LedgerDB.spiIntervalSlots SnapshotPolicyInfo
info) of
      (LedgerDB.SnapshotFrequency SnapshotFrequencyArgs
fargs, Just NonZero Word64
intervalSlots) ->
        [Text] -> Text
Text.concat
          [ Text
"Snapshot policy: a ledger snapshot every "
          , Word64 -> Text
forall a. Show a => a -> Text
showT (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
intervalSlots)
          , Text
" slots, which is "
          , Text -> (NominalDiffTime -> Text) -> Maybe NominalDiffTime -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unknown" NominalDiffTime -> Text
renderDuration (SnapshotPolicyInfo -> Maybe NominalDiffTime
LedgerDB.snapshotPolicyIntervalTime SnapshotPolicyInfo
info)
          , Text
" at the current slot length of "
          , NominalDiffTime -> Text
renderDuration (SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLength)
          , Text
". Each write is delayed by "
          , NominalDiffTime -> Text
renderDuration (DiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (SnapshotDelayRange -> DiffTime
LedgerDB.minimumDelay SnapshotDelayRange
delayRange))
          , Text
" to "
          , NominalDiffTime -> Text
renderDuration (DiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (SnapshotDelayRange -> DiffTime
LedgerDB.maximumDelay SnapshotDelayRange
delayRange))
          , Text
", "
          , DiffTime -> Text
forall {a}. Real a => a -> Text
renderRateLimit (SnapshotFrequencyArgs -> DiffTime
LedgerDB.sfaRateLimit SnapshotFrequencyArgs
fargs)
          , Text
". Keeping "
          , Word -> Text
forall a. Show a => a -> Text
showT Word
numSnapshots
          , Text
" snapshots on disk."
          ]
       where
        delayRange :: SnapshotDelayRange
delayRange = SnapshotFrequencyArgs -> SnapshotDelayRange
LedgerDB.sfaDelaySnapshotRange SnapshotFrequencyArgs
fargs
      (SnapshotFrequency, Maybe (NonZero Word64))
_ ->
        [Text] -> Text
Text.concat
          [ Text
"Snapshot policy: writing snapshots is disabled. Keeping "
          , Word -> Text
forall a. Show a => a -> Text
showT Word
numSnapshots
          , Text
" snapshots on disk."
          ]

  -- What the numbers mean for this network, when they do not fit together. This
  -- is what an operator sees after starting a node on a testnet with the
  -- snapshot settings left unset.
  mismatches :: Text
mismatches = case SnapshotPolicyInfo -> [SnapshotPolicyMismatch]
LedgerDB.snapshotPolicyMismatches SnapshotPolicyInfo
info of
    [] -> Text
""
    [SnapshotPolicyMismatch]
ms ->
      [Text] -> Text
Text.concat
        [ Text
" These settings do not fit this network: "
        , Text -> [Text] -> Text
Text.intercalate Text
"; " ((SnapshotPolicyMismatch -> Text)
-> [SnapshotPolicyMismatch] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotPolicyMismatch -> Text
forall {a}. IsString a => SnapshotPolicyMismatch -> a
renderMismatch [SnapshotPolicyMismatch]
ms)
        , Text
". Set the snapshot interval, the write delay range and the rate limit"
        , Text
" for this network instead of leaving them at the defaults, which are"
        , Text
" the mainnet ones."
        ]

  renderMismatch :: SnapshotPolicyMismatch -> a
renderMismatch SnapshotPolicyMismatch
LedgerDB.WriteDelayExceedsInterval =
    a
"the longest write delay is at least as long as the interval, so a write can\
    \ still be pending when the next snapshot is already due"
  renderMismatch SnapshotPolicyMismatch
LedgerDB.RateLimitExceedsInterval =
    a
"the rate limit is at least as long as the interval, so most of the writes\
    \ the interval asks for will be skipped"

  renderRateLimit :: a -> Text
renderRateLimit a
rateLimit
    | a
rateLimit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = Text
"with no rate limit"
    | Bool
otherwise = Text
"at most one write every " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
renderDuration (a -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
rateLimit)

asSeconds :: Real a => a -> Double
asSeconds :: forall a. Real a => a -> Double
asSeconds = a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | A duration in the largest unit that leaves a number above one, to one
-- decimal place. Snapshot intervals range from minutes on a short-slot testnet
-- to a day on mainnet, and raw seconds are hard to compare at that spread.
renderDuration :: NominalDiffTime -> Text
renderDuration :: NominalDiffTime -> Text
renderDuration NominalDiffTime
t
  | NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
day = NominalDiffTime -> Text -> Text
forall {a}. Real a => a -> Text -> Text
render (NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
day) Text
"d"
  | NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
hour = NominalDiffTime -> Text -> Text
forall {a}. Real a => a -> Text -> Text
render (NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
hour) Text
"h"
  | NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
minute = NominalDiffTime -> Text -> Text
forall {a}. Real a => a -> Text -> Text
render (NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
minute) Text
"min"
  | Bool
otherwise = NominalDiffTime -> Text -> Text
forall {a}. Real a => a -> Text -> Text
render NominalDiffTime
t Text
"s"
 where
  minute :: NominalDiffTime
minute = NominalDiffTime
60
  hour :: NominalDiffTime
hour = NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
minute
  day :: NominalDiffTime
day = NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
hour

  render :: a -> Text -> Text
render a
x Text
unit = [Char] -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x :: Double) [Char]
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unit

--------------------------------------------------------------------------------
-- LedgerDB TraceReplayEvent
--------------------------------------------------------------------------------

instance
  (StandardHash blk, ConvertRawHash blk) =>
  LogFormatting (LedgerDB.TraceReplayEvent blk)
  where
  forHuman :: TraceReplayEvent blk -> Text
forHuman (LedgerDB.TraceReplayStartEvent TraceReplayStartEvent blk
ev') = TraceReplayStartEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceReplayStartEvent blk
ev'
  forHuman (LedgerDB.TraceReplayProgressEvent TraceReplayProgressEvent blk
ev') = TraceReplayProgressEvent blk -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceReplayProgressEvent blk
ev'

  forMachine :: DetailLevel -> TraceReplayEvent blk -> Object
forMachine DetailLevel
dtal (LedgerDB.TraceReplayStartEvent TraceReplayStartEvent blk
ev') = DetailLevel -> TraceReplayStartEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceReplayStartEvent blk
ev'
  forMachine DetailLevel
dtal (LedgerDB.TraceReplayProgressEvent TraceReplayProgressEvent blk
ev') = DetailLevel -> TraceReplayProgressEvent blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal TraceReplayProgressEvent blk
ev'

instance
  (StandardHash blk, ConvertRawHash blk) =>
  LogFormatting (LedgerDB.TraceReplayStartEvent blk)
  where
  forHuman :: TraceReplayStartEvent blk -> Text
forHuman TraceReplayStartEvent blk
LedgerDB.ReplayFromGenesis =
    Text
"Replaying ledger from genesis"
  forHuman (LedgerDB.ReplayFromSnapshot DiskSnapshot
snap (LedgerDB.ReplayStart Point blk
tip')) =
    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
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
tip'

  forMachine :: DetailLevel -> TraceReplayStartEvent blk -> Object
forMachine DetailLevel
_dtal TraceReplayStartEvent blk
LedgerDB.ReplayFromGenesis =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ReplayFromGenesis"]
  forMachine DetailLevel
dtal (LedgerDB.ReplayFromSnapshot DiskSnapshot
snap ReplayStart blk
tip') =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ReplayFromSnapshot"
      , Key
"snapshot" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> DiskSnapshot -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal DiskSnapshot
snap
      , Key
"tip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReplayStart blk -> Text
forall a. Show a => a -> Text
showT ReplayStart blk
tip'
      ]

instance LogFormatting (LedgerDB.TraceReplayProgressEvent blk) where
  forHuman :: TraceReplayProgressEvent blk -> Text
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 {k} (block :: k). 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 {k} (block :: k). 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 -> TraceReplayProgressEvent blk -> Object
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ReplayedBlock"
        , Key
"slot" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point blk
replayTo)
        ]

instance MetaTrace (LedgerDB.TraceReplayEvent blk) where
  namespaceFor :: TraceReplayEvent blk -> Namespace (TraceReplayEvent blk)
namespaceFor (LedgerDB.TraceReplayStartEvent TraceReplayStartEvent blk
ev) =
    Text
-> Namespace (TraceReplayStartEvent blk)
-> Namespace (TraceReplayEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ReplayStart" (TraceReplayStartEvent blk -> Namespace (TraceReplayStartEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceReplayStartEvent blk
ev)
  namespaceFor (LedgerDB.TraceReplayProgressEvent TraceReplayProgressEvent blk
ev) =
    Text
-> Namespace (TraceReplayProgressEvent blk)
-> Namespace (TraceReplayEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ReplayProgress" (TraceReplayProgressEvent blk
-> Namespace (TraceReplayProgressEvent blk)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceReplayProgressEvent blk
ev)

  severityFor :: Namespace (TraceReplayEvent blk)
-> Maybe (TraceReplayEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
out (Text
"ReplayStart" : [Text]
tl)) Maybe (TraceReplayEvent blk)
Nothing =
    Namespace (TraceReplayStartEvent blk)
-> Maybe (TraceReplayStartEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayStartEvent blk)) Maybe (TraceReplayStartEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"ReplayStart" : [Text]
tl)) (Just (LedgerDB.TraceReplayStartEvent TraceReplayStartEvent blk
ev)) =
    Namespace (TraceReplayStartEvent blk)
-> Maybe (TraceReplayStartEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayStartEvent blk)) (TraceReplayStartEvent blk -> Maybe (TraceReplayStartEvent blk)
forall a. a -> Maybe a
Just TraceReplayStartEvent blk
ev)
  severityFor (Namespace [Text]
out (Text
"ReplayProgress" : [Text]
tl)) Maybe (TraceReplayEvent blk)
Nothing =
    Namespace (TraceReplayProgressEvent blk)
-> Maybe (TraceReplayProgressEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayProgressEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk)) Maybe (TraceReplayProgressEvent blk)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"ReplayProgress" : [Text]
tl)) (Just (LedgerDB.TraceReplayProgressEvent TraceReplayProgressEvent blk
ev)) =
    Namespace (TraceReplayProgressEvent blk)
-> Maybe (TraceReplayProgressEvent blk) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceReplayProgressEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk)) (TraceReplayProgressEvent blk
-> Maybe (TraceReplayProgressEvent blk)
forall a. a -> Maybe a
Just TraceReplayProgressEvent blk
ev)
  severityFor Namespace (TraceReplayEvent blk)
_ Maybe (TraceReplayEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceReplayEvent blk) -> Maybe Text
documentFor (Namespace [Text]
out (Text
"ReplayStart" : [Text]
tl)) =
    Namespace (TraceReplayStartEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayStartEvent blk))
  documentFor (Namespace [Text]
out (Text
"ReplayProgress" : [Text]
tl)) =
    Namespace (TraceReplayProgressEvent blk) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceReplayProgressEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk))
  documentFor Namespace (TraceReplayEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceReplayEvent blk)]
allNamespaces =
    (Namespace (TraceReplayStartEvent blk)
 -> Namespace (TraceReplayEvent blk))
-> [Namespace (TraceReplayStartEvent blk)]
-> [Namespace (TraceReplayEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
      (Text
-> Namespace (TraceReplayStartEvent blk)
-> Namespace (TraceReplayEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ReplayStart")
      ([Namespace (TraceReplayStartEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (LedgerDB.TraceReplayStartEvent blk)])
      [Namespace (TraceReplayEvent blk)]
-> [Namespace (TraceReplayEvent blk)]
-> [Namespace (TraceReplayEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceReplayProgressEvent blk)
 -> Namespace (TraceReplayEvent blk))
-> [Namespace (TraceReplayProgressEvent blk)]
-> [Namespace (TraceReplayEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TraceReplayProgressEvent blk)
-> Namespace (TraceReplayEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ReplayProgress")
        ([Namespace (TraceReplayProgressEvent blk)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (LedgerDB.TraceReplayProgressEvent blk)])

instance MetaTrace (LedgerDB.TraceReplayStartEvent blk) where
  namespaceFor :: TraceReplayStartEvent blk -> Namespace (TraceReplayStartEvent blk)
namespaceFor LedgerDB.ReplayFromGenesis{} = [Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayFromGenesis"]
  namespaceFor LedgerDB.ReplayFromSnapshot{} = [Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayFromSnapshot"]

  severityFor :: Namespace (TraceReplayStartEvent blk)
-> Maybe (TraceReplayStartEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"ReplayFromGenesis"]) Maybe (TraceReplayStartEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ReplayFromSnapshot"]) Maybe (TraceReplayStartEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace (TraceReplayStartEvent blk)
_ Maybe (TraceReplayStartEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceReplayStartEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"ReplayFromGenesis"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There were no LedgerDB snapshots on disk, so we're replaying all"
        , Text
" blocks starting from Genesis against the initial ledger."
        , Text
" The @replayTo@ parameter corresponds to the block at the tip of the"
        , Text
" ImmDB, i.e., the last block to replay."
        ]
  documentFor (Namespace [Text]
_ [Text
"ReplayFromSnapshot"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There was a LedgerDB snapshot on disk corresponding to the given tip."
        , Text
" We're replaying more recent blocks against it."
        , Text
" The @replayTo@ parameter corresponds to the block at the tip of the"
        , Text
" ImmDB, i.e., the last block to replay."
        ]
  documentFor Namespace (TraceReplayStartEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceReplayStartEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayFromGenesis"]
    , [Text] -> [Text] -> Namespace (TraceReplayStartEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayFromSnapshot"]
    ]

instance MetaTrace (LedgerDB.TraceReplayProgressEvent blk) where
  namespaceFor :: TraceReplayProgressEvent blk
-> Namespace (TraceReplayProgressEvent blk)
namespaceFor LedgerDB.ReplayedBlock{} = [Text] -> [Text] -> Namespace (TraceReplayProgressEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayedBlock"]

  severityFor :: Namespace (TraceReplayProgressEvent blk)
-> Maybe (TraceReplayProgressEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"ReplayedBlock"]) Maybe (TraceReplayProgressEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace (TraceReplayProgressEvent blk)
_ Maybe (TraceReplayProgressEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceReplayProgressEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"ReplayedBlock"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"We replayed the given block (reference) on the genesis snapshot"
        , Text
" during the initialisation of the LedgerDB."
        , Text
"\n"
        , Text
" The @blockInfo@ parameter corresponds replayed block and the @replayTo@"
        , Text
" parameter corresponds to the block at the tip of the ImmDB, i.e.,"
        , Text
" the last block to replay."
        ]
  documentFor Namespace (TraceReplayProgressEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceReplayProgressEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceReplayProgressEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReplayedBlock"]
    ]

--------------------------------------------------------------------------------
-- Forker events
--------------------------------------------------------------------------------

instance LogFormatting LedgerDB.TraceForkerEventWithKey where
  forMachine :: DetailLevel -> TraceForkerEventWithKey -> Object
forMachine DetailLevel
dtals (LedgerDB.TraceForkerEventWithKey ForkerKey
k TraceForkerEvent
ev) =
    (\Object
ev' -> [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"key" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ForkerKey -> Text
forall a. Show a => a -> Text
showT ForkerKey
k, Key
"event" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Object
ev']) (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ DetailLevel -> TraceForkerEvent -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtals TraceForkerEvent
ev
  forHuman :: TraceForkerEventWithKey -> Text
forHuman (LedgerDB.TraceForkerEventWithKey ForkerKey
k TraceForkerEvent
ev) =
    Text
"Forker " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ForkerKey -> Text
forall a. Show a => a -> Text
showT ForkerKey
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TraceForkerEvent -> Text
forall a. LogFormatting a => a -> Text
forHuman TraceForkerEvent
ev

instance LogFormatting LedgerDB.TraceForkerEvent where
  forMachine :: DetailLevel -> TraceForkerEvent -> Object
forMachine DetailLevel
_dtals TraceForkerEvent
LedgerDB.ForkerOpen =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkerOpen"]
  forMachine DetailLevel
_dtals (LedgerDB.ForkerReadTables Enclosing' DiffTime
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkerReadTables"
      , Key
"edge" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case Enclosing' DiffTime
e of
          Enclosing' DiffTime
RisingEdge -> Text -> Value
String Text
"RisingEdge"
          FallingEdgeWith DiffTime
t -> DiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON DiffTime
t
      ]
  forMachine DetailLevel
_dtals (LedgerDB.ForkerRangeReadTables Enclosing' DiffTime
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkerRangeReadTables"
      , Key
"edge" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case Enclosing' DiffTime
e of
          Enclosing' DiffTime
RisingEdge -> Text -> Value
String Text
"RisingEdge"
          FallingEdgeWith DiffTime
t -> DiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON DiffTime
t
      ]
  forMachine DetailLevel
_dtals TraceForkerEvent
LedgerDB.ForkerReadStatistics = Object
forall a. Monoid a => a
mempty
  forMachine DetailLevel
_dtals (LedgerDB.ForkerPush Enclosing' DiffTime
e) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkerPush"
      , Key
"edge" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case Enclosing' DiffTime
e of
          Enclosing' DiffTime
RisingEdge -> Text -> Value
String Text
"RisingEdge"
          FallingEdgeWith DiffTime
t -> DiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON DiffTime
t
      ]
  forMachine DetailLevel
_dtals (LedgerDB.ForkerClose ForkerWasCommitted
wc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ForkerClose"
      , Key
"wasCommitted" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (ForkerWasCommitted
wc ForkerWasCommitted -> ForkerWasCommitted -> Bool
forall a. Eq a => a -> a -> Bool
== ForkerWasCommitted
LedgerDB.ForkerWasCommitted)
      ]

  forHuman :: TraceForkerEvent -> Text
forHuman TraceForkerEvent
LedgerDB.ForkerOpen = Text
"Opened forker"
  forHuman (LedgerDB.ForkerReadTables Enclosing' DiffTime
RisingEdge) = Text
"Forker reading tables"
  forHuman (LedgerDB.ForkerReadTables (FallingEdgeWith DiffTime
t)) = Text
"Forker read tables, took " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
t
  forHuman (LedgerDB.ForkerRangeReadTables Enclosing' DiffTime
RisingEdge) = Text
"Forker range reading tables"
  forHuman (LedgerDB.ForkerRangeReadTables (FallingEdgeWith DiffTime
t)) = Text
"Forker range read tables, took " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
t
  forHuman TraceForkerEvent
LedgerDB.ForkerReadStatistics = Text
"Forker gathering statistics"
  forHuman (LedgerDB.ForkerPush Enclosing' DiffTime
RisingEdge) = Text
"Forker pushing"
  forHuman (LedgerDB.ForkerPush (FallingEdgeWith DiffTime
t)) = Text
"Forker pushed, took " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
t
  forHuman (LedgerDB.ForkerClose ForkerWasCommitted
wc) =
    Text
"Closed forker, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case ForkerWasCommitted
wc of
      ForkerWasCommitted
LedgerDB.ForkerWasCommitted -> Text
"was committed"
      ForkerWasCommitted
LedgerDB.ForkerWasUncommitted -> Text
"was discarded"

instance MetaTrace LedgerDB.TraceForkerEventWithKey where
  namespaceFor :: TraceForkerEventWithKey -> Namespace TraceForkerEventWithKey
namespaceFor (LedgerDB.TraceForkerEventWithKey ForkerKey
_ TraceForkerEvent
ev) =
    Namespace TraceForkerEvent -> Namespace TraceForkerEventWithKey
forall a b. Namespace a -> Namespace b
nsCast (Namespace TraceForkerEvent -> Namespace TraceForkerEventWithKey)
-> Namespace TraceForkerEvent -> Namespace TraceForkerEventWithKey
forall a b. (a -> b) -> a -> b
$ TraceForkerEvent -> Namespace TraceForkerEvent
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceForkerEvent
ev
  severityFor :: Namespace TraceForkerEventWithKey
-> Maybe TraceForkerEventWithKey -> Maybe SeverityS
severityFor Namespace TraceForkerEventWithKey
ns (Just (LedgerDB.TraceForkerEventWithKey ForkerKey
_ TraceForkerEvent
ev)) =
    Namespace TraceForkerEvent
-> Maybe TraceForkerEvent -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace TraceForkerEventWithKey -> Namespace TraceForkerEvent
forall a b. Namespace a -> Namespace b
nsCast Namespace TraceForkerEventWithKey
ns) (TraceForkerEvent -> Maybe TraceForkerEvent
forall a. a -> Maybe a
Just TraceForkerEvent
ev)
  severityFor (Namespace [Text]
out [Text]
tl) Maybe TraceForkerEventWithKey
Nothing =
    Namespace TraceForkerEvent
-> Maybe TraceForkerEvent -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace LedgerDB.TraceForkerEvent) Maybe TraceForkerEvent
forall a. Maybe a
Nothing
  documentFor :: Namespace TraceForkerEventWithKey -> Maybe Text
documentFor = forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor @LedgerDB.TraceForkerEvent (Namespace TraceForkerEvent -> Maybe Text)
-> (Namespace TraceForkerEventWithKey
    -> Namespace TraceForkerEvent)
-> Namespace TraceForkerEventWithKey
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace TraceForkerEventWithKey -> Namespace TraceForkerEvent
forall a b. Namespace a -> Namespace b
nsCast
  allNamespaces :: [Namespace TraceForkerEventWithKey]
allNamespaces = (Namespace TraceForkerEvent -> Namespace TraceForkerEventWithKey)
-> [Namespace TraceForkerEvent]
-> [Namespace TraceForkerEventWithKey]
forall a b. (a -> b) -> [a] -> [b]
map Namespace TraceForkerEvent -> Namespace TraceForkerEventWithKey
forall a b. Namespace a -> Namespace b
nsCast ([Namespace TraceForkerEvent]
 -> [Namespace TraceForkerEventWithKey])
-> [Namespace TraceForkerEvent]
-> [Namespace TraceForkerEventWithKey]
forall a b. (a -> b) -> a -> b
$ forall a. MetaTrace a => [Namespace a]
allNamespaces @LedgerDB.TraceForkerEvent

instance MetaTrace LedgerDB.TraceForkerEvent where
  namespaceFor :: TraceForkerEvent -> Namespace TraceForkerEvent
namespaceFor TraceForkerEvent
LedgerDB.ForkerOpen = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Open"]
  namespaceFor LedgerDB.ForkerReadTables{} = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Read"]
  namespaceFor LedgerDB.ForkerRangeReadTables{} = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RangeRead"]
  namespaceFor TraceForkerEvent
LedgerDB.ForkerReadStatistics = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Statistics"]
  namespaceFor LedgerDB.ForkerPush{} = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Push"]
  namespaceFor LedgerDB.ForkerClose{} = [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Close"]

  severityFor :: Namespace TraceForkerEvent
-> Maybe TraceForkerEvent -> Maybe SeverityS
severityFor Namespace TraceForkerEvent
_ Maybe TraceForkerEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug

  documentFor :: Namespace TraceForkerEvent -> Maybe Text
documentFor (Namespace [Text]
_ (Text
"Open" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A forker is being opened"
  documentFor (Namespace [Text]
_ (Text
"Read" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A forker is reading values"
  documentFor (Namespace [Text]
_ (Text
"RangeRead" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A forker is range reading values"
  documentFor (Namespace [Text]
_ (Text
"Statistics" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Statistics were gathered from the forker"
  documentFor (Namespace [Text]
_ (Text
"Push" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A forker is pushing a new ledger state"
  documentFor (Namespace [Text]
_ (Text
"Close" : [Text]
_tl)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A forker was closed"
  documentFor Namespace TraceForkerEvent
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace TraceForkerEvent]
allNamespaces =
    [ [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Open"]
    , [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Read"]
    , [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RangeRead"]
    , [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Statistics"]
    , [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Push"]
    , [Text] -> [Text] -> Namespace TraceForkerEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Close"]
    ]

--------------------------------------------------------------------------------
-- Flavor specific trace
--------------------------------------------------------------------------------

instance LogFormatting LedgerDB.FlavorImplSpecificTrace where
  forMachine :: DetailLevel -> FlavorImplSpecificTrace -> Object
forMachine DetailLevel
dtal (LedgerDB.FlavorImplSpecificTraceV2 LedgerDBV2Trace
ev) = DetailLevel -> LedgerDBV2Trace -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal LedgerDBV2Trace
ev

  forHuman :: FlavorImplSpecificTrace -> Text
forHuman (LedgerDB.FlavorImplSpecificTraceV2 LedgerDBV2Trace
ev) = LedgerDBV2Trace -> Text
forall a. LogFormatting a => a -> Text
forHuman LedgerDBV2Trace
ev

instance MetaTrace LedgerDB.FlavorImplSpecificTrace where
  namespaceFor :: FlavorImplSpecificTrace -> Namespace FlavorImplSpecificTrace
namespaceFor (LedgerDB.FlavorImplSpecificTraceV2 LedgerDBV2Trace
ev) =
    Text
-> Namespace LedgerDBV2Trace -> Namespace FlavorImplSpecificTrace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"V2" (LedgerDBV2Trace -> Namespace LedgerDBV2Trace
forall a. MetaTrace a => a -> Namespace a
namespaceFor LedgerDBV2Trace
ev)

  severityFor :: Namespace FlavorImplSpecificTrace
-> Maybe FlavorImplSpecificTrace -> Maybe SeverityS
severityFor (Namespace [Text]
out (Text
"V2" : [Text]
tl)) Maybe FlavorImplSpecificTrace
Nothing =
    Namespace LedgerDBV2Trace
-> Maybe LedgerDBV2Trace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace V2.LedgerDBV2Trace) Maybe LedgerDBV2Trace
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
out (Text
"V2" : [Text]
tl)) (Just (LedgerDB.FlavorImplSpecificTraceV2 LedgerDBV2Trace
ev)) =
    Namespace LedgerDBV2Trace
-> Maybe LedgerDBV2Trace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace V2.LedgerDBV2Trace) (LedgerDBV2Trace -> Maybe LedgerDBV2Trace
forall a. a -> Maybe a
Just LedgerDBV2Trace
ev)
  severityFor Namespace FlavorImplSpecificTrace
_ Maybe FlavorImplSpecificTrace
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace FlavorImplSpecificTrace -> Maybe Text
documentFor (Namespace [Text]
out (Text
"V2" : [Text]
tl)) =
    Namespace LedgerDBV2Trace -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace V2.LedgerDBV2Trace)
  documentFor Namespace FlavorImplSpecificTrace
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace FlavorImplSpecificTrace]
allNamespaces =
    (Namespace LedgerDBV2Trace -> Namespace FlavorImplSpecificTrace)
-> [Namespace LedgerDBV2Trace]
-> [Namespace FlavorImplSpecificTrace]
forall a b. (a -> b) -> [a] -> [b]
map
      (Text
-> Namespace LedgerDBV2Trace -> Namespace FlavorImplSpecificTrace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"V2")
      ([Namespace LedgerDBV2Trace]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace V2.LedgerDBV2Trace])

{-------------------------------------------------------------------------------
  V2
-------------------------------------------------------------------------------}

instance LogFormatting EnclosingTimed where
  forMachine :: DetailLevel -> Enclosing' DiffTime -> Object
forMachine DetailLevel
_dtal = Enclosing' DiffTime -> Object
forall a. ToJSON a => Enclosing' a -> Object
enclosingObject

  forHuman :: Enclosing' DiffTime -> Text
forHuman Enclosing' DiffTime
RisingEdge = Text
"Starting"
  forHuman (FallingEdgeWith DiffTime
a) = Text
"Completed in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
showT DiffTime
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds"

enclosingObject :: ToJSON a => Enclosing' a -> Object
enclosingObject :: forall a. ToJSON a => Enclosing' a -> Object
enclosingObject Enclosing' a
RisingEdge = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"edge" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Starting"]
enclosingObject (FallingEdgeWith a
a) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"edge" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a]

enclosingValue :: ToJSON a => Enclosing' a -> Value
enclosingValue :: forall a. ToJSON a => Enclosing' a -> Value
enclosingValue = Object -> Value
Object (Object -> Value)
-> (Enclosing' a -> Object) -> Enclosing' a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enclosing' a -> Object
forall a. ToJSON a => Enclosing' a -> Object
enclosingObject

instance LogFormatting V2.LedgerDBV2Trace where
  forMachine :: DetailLevel -> LedgerDBV2Trace -> Object
forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandleCreate Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandleCreate", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandleClose Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandleClose", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (V2.BackendTrace SomeBackendTrace
ev) = DetailLevel -> SomeBackendTrace -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal SomeBackendTrace
ev
  forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandleRead Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandleRead", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandleDuplicate Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandleDuplicate", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandleCreateFirst Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandleCreateFirst", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (V2.TraceLedgerTablesHandlePush Enclosing' DiffTime
enc) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerTablesHandlePush", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]

  forHuman :: LedgerDBV2Trace -> Text
forHuman (V2.TraceLedgerTablesHandleCreate Enclosing' DiffTime
enc) = Text
"Created a new 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (V2.TraceLedgerTablesHandleClose Enclosing' DiffTime
enc) = Text
"Closed a 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (V2.BackendTrace SomeBackendTrace
ev) = SomeBackendTrace -> Text
forall a. LogFormatting a => a -> Text
forHuman SomeBackendTrace
ev
  forHuman (V2.TraceLedgerTablesHandleRead Enclosing' DiffTime
enc) = Text
"Read from a 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (V2.TraceLedgerTablesHandleDuplicate Enclosing' DiffTime
enc) = Text
"Duplicating a 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (V2.TraceLedgerTablesHandleCreateFirst Enclosing' DiffTime
enc) = Text
"Creating the first 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (V2.TraceLedgerTablesHandlePush Enclosing' DiffTime
enc) = Text
"Pushing to 'LedgerTablesHandle': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc

instance MetaTrace V2.LedgerDBV2Trace where
  namespaceFor :: LedgerDBV2Trace -> Namespace LedgerDBV2Trace
namespaceFor V2.TraceLedgerTablesHandleCreate{} =
    [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleCreate"]
  namespaceFor V2.TraceLedgerTablesHandleClose{} =
    [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleClose"]
  namespaceFor (V2.BackendTrace SomeBackendTrace
ev) = Text -> Namespace SomeBackendTrace -> Namespace LedgerDBV2Trace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"BackendTrace" (SomeBackendTrace -> Namespace SomeBackendTrace
forall a. MetaTrace a => a -> Namespace a
namespaceFor SomeBackendTrace
ev)
  namespaceFor V2.TraceLedgerTablesHandleRead{} = [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleRead"]
  namespaceFor V2.TraceLedgerTablesHandleDuplicate{} = [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleDuplicate"]
  namespaceFor V2.TraceLedgerTablesHandleCreateFirst{} = [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleCreateFirst"]
  namespaceFor V2.TraceLedgerTablesHandlePush{} = [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandlePush"]

  severityFor :: Namespace LedgerDBV2Trace
-> Maybe LedgerDBV2Trace -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandleCreate"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandleClose"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandleRead"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandleDuplicate"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandleCreateFirst"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LedgerTablesHandlePush"]) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ (Text
"BackendTrace" : [Text]
_)) Maybe LedgerDBV2Trace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace LedgerDBV2Trace
_ Maybe LedgerDBV2Trace
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace LedgerDBV2Trace -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandleCreate"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Created a ledger tables handle"
  documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandleClose"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Closed a ledger tables handle"
  documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandleRead"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Reading from ledger tables handle"
  documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandlePush"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Pushing to a ledger tables handle"
  documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandleCreateFirst"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Creating the first ledger tables handle"
  documentFor (Namespace [Text]
_ [Text
"LedgerTablesHandleDuplicate"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Duplicating a ledger tables handle"
  documentFor (Namespace [Text]
out (Text
"BackendTrace" : [Text]
tl)) =
    Namespace SomeBackendTrace -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace SomeBackendTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace V2.SomeBackendTrace)
  documentFor Namespace LedgerDBV2Trace
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace LedgerDBV2Trace]
allNamespaces =
    [ [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleCreate"]
    , [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleClose"]
    , [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleRead"]
    , [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleDuplicate"]
    , [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandleCreateFirst"]
    , [Text] -> [Text] -> Namespace LedgerDBV2Trace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerTablesHandlePush"]
    ]
      [Namespace LedgerDBV2Trace]
-> [Namespace LedgerDBV2Trace] -> [Namespace LedgerDBV2Trace]
forall a. [a] -> [a] -> [a]
++ (Namespace SomeBackendTrace -> Namespace LedgerDBV2Trace)
-> [Namespace SomeBackendTrace] -> [Namespace LedgerDBV2Trace]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Namespace SomeBackendTrace -> Namespace LedgerDBV2Trace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"BackendTrace") ([Namespace SomeBackendTrace]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace V2.SomeBackendTrace])

instance LogFormatting V2.SomeBackendTrace where
  forMachine :: DetailLevel -> SomeBackendTrace -> Object
forMachine DetailLevel
dtal (V2.SomeBackendTrace Trace backend
ev) = (Trace LSM -> Object) -> Trace backend -> Object
forall a backend.
Typeable backend =>
(Trace LSM -> a) -> Trace backend -> a
unwrapV2Trace (DetailLevel -> Trace LSM -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) Trace backend
ev

  forHuman :: SomeBackendTrace -> Text
forHuman (V2.SomeBackendTrace Trace backend
ev) = (Trace LSM -> Text) -> Trace backend -> Text
forall a backend.
Typeable backend =>
(Trace LSM -> a) -> Trace backend -> a
unwrapV2Trace Trace LSM -> Text
forall a. LogFormatting a => a -> Text
forHuman Trace backend
ev

instance MetaTrace V2.SomeBackendTrace where
  namespaceFor :: SomeBackendTrace -> Namespace SomeBackendTrace
namespaceFor (V2.SomeBackendTrace Trace backend
ev) =
    (Trace LSM -> Namespace SomeBackendTrace)
-> Trace backend -> Namespace SomeBackendTrace
forall a backend.
Typeable backend =>
(Trace LSM -> a) -> Trace backend -> a
unwrapV2Trace (Text -> Namespace (Trace LSM) -> Namespace SomeBackendTrace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"LSM" (Namespace (Trace LSM) -> Namespace SomeBackendTrace)
-> (Trace LSM -> Namespace (Trace LSM))
-> Trace LSM
-> Namespace SomeBackendTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace LSM -> Namespace (Trace LSM)
forall a. MetaTrace a => a -> Namespace a
namespaceFor) Trace backend
ev

  severityFor :: Namespace SomeBackendTrace
-> Maybe SomeBackendTrace -> Maybe SeverityS
severityFor (Namespace [Text]
_ (Text
"LSM" : [Text]
_)) Maybe SomeBackendTrace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace SomeBackendTrace
_ Maybe SomeBackendTrace
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace SomeBackendTrace -> Maybe Text
documentFor (Namespace [Text]
out (Text
"LSM" : [Text]
tl)) = forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor @(V2.Trace LSM.LSM) ([Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl)
  documentFor Namespace SomeBackendTrace
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace SomeBackendTrace]
allNamespaces =
    (Namespace (Trace LSM) -> Namespace SomeBackendTrace)
-> [Namespace (Trace LSM)] -> [Namespace SomeBackendTrace]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Namespace (Trace LSM) -> Namespace SomeBackendTrace
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"LSM") ([Namespace (Trace LSM)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (V2.Trace LSM.LSM)])

instance LogFormatting (V2.Trace LSM.LSM) where
  forMachine :: DetailLevel -> Trace LSM -> Object
forMachine DetailLevel
_dtal (LSM.LSMTreeTrace LSMTreeTrace
ev) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LSMTreeTrace", Key
"content" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LSMTreeTrace -> Text
forall a. Show a => a -> Text
showT LSMTreeTrace
ev]
  forMachine DetailLevel
dtal (LSM.LSMLookup Enclosing' DiffTime
enc) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LSMLookup", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (LSM.LSMUpdate Enclosing' DiffTime
enc) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LSMUpdate", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (LSM.LSMSnap Enclosing' DiffTime
enc) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LSMSnap", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]
  forMachine DetailLevel
dtal (LSM.LSMOpenSession Enclosing' DiffTime
enc) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LSMOpenSession", Key
"enclosing" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Enclosing' DiffTime -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Enclosing' DiffTime
enc]

  forHuman :: Trace LSM -> Text
forHuman (LSM.LSMTreeTrace LSMTreeTrace
ev) = LSMTreeTrace -> Text
forall a. Show a => a -> Text
showT LSMTreeTrace
ev
  forHuman (LSM.LSMLookup Enclosing' DiffTime
enc) = Text
"Looking up in LSM database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (LSM.LSMUpdate Enclosing' DiffTime
enc) = Text
"Updating the LSM database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (LSM.LSMSnap Enclosing' DiffTime
enc) = Text
"Snapshotting the LSM database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc
  forHuman (LSM.LSMOpenSession Enclosing' DiffTime
enc) = Text
"Opening the LSM session: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Enclosing' DiffTime -> Text
forall a. LogFormatting a => a -> Text
forHuman Enclosing' DiffTime
enc

instance MetaTrace (V2.Trace LSM.LSM) where
  namespaceFor :: Trace LSM -> Namespace (Trace LSM)
namespaceFor LSM.LSMTreeTrace{} = [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMTrace"]
  namespaceFor LSM.LSMLookup{} = [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMLookup"]
  namespaceFor LSM.LSMUpdate{} = [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMUpdate"]
  namespaceFor LSM.LSMSnap{} = [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMSnap"]
  namespaceFor LSM.LSMOpenSession{} = [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMOpenSession"]

  severityFor :: Namespace (Trace LSM) -> Maybe (Trace LSM) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"LSMTrace"]) Maybe (Trace LSM)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LSMLookup"]) Maybe (Trace LSM)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LSMUpdate"]) Maybe (Trace LSM)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LSMSnap"]) Maybe (Trace LSM)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"LSMOpenSession"]) Maybe (Trace LSM)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (Trace LSM)
_ Maybe (Trace LSM)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (Trace LSM) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"LSMTrace"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A trace from the LSM-trees backend"
  documentFor (Namespace [Text]
_ [Text
"LSMLookup"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Looking up in the LSM-trees backend"
  documentFor (Namespace [Text]
_ [Text
"LSMUpdate"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Updating the LSM-trees backend"
  documentFor (Namespace [Text]
_ [Text
"LSMSnap"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Snapshotting the LSM-trees backend"
  documentFor (Namespace [Text]
_ [Text
"LSMOpenSession"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Opening the LSM-trees backend session"
  documentFor Namespace (Trace LSM)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (Trace LSM)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMTrace"]
    , [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMLookup"]
    , [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMUpdate"]
    , [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMSnap"]
    , [Text] -> [Text] -> Namespace (Trace LSM)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LSMOpenSession"]
    ]

unwrapV2Trace ::
  forall a backend. Typeable backend => (V2.Trace LSM.LSM -> a) -> V2.Trace backend -> a
unwrapV2Trace :: forall a backend.
Typeable backend =>
(Trace LSM -> a) -> Trace backend -> a
unwrapV2Trace Trace LSM -> a
g Trace backend
ev =
  case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @(V2.Trace backend) @(V2.Trace InMemory.Mem) Trace backend
ev of
    Just (InMemory.NoTrace Void
v) -> Void -> a
forall a. Void -> a
absurd Void
v
    Maybe (Trace Mem)
Nothing ->
      case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast @(V2.Trace backend) @(V2.Trace LSM.LSM) Trace backend
ev of
        Just Trace LSM
t -> Trace LSM -> a
g Trace LSM
t
        Maybe (Trace LSM)
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"blah"

--------------------------------------------------------------------------------
-- ImmDB.TraceEvent
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ValidatedLastLocation"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"immTip" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DeletingAfter"
      , Key
"immTipHash" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DBClosed"]
  forMachine DetailLevel
dtal (ImmDB.TraceCacheEvent TraceCacheEvent
cacheEv) =
    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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChunkFileDoesntFit"
      , Key
"expectedPrevHash"
          Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
                )
                ChainHash blk
expectPrevHash
            )
      , Key
"actualPrevHash"
          Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash (forall t. Proxy t
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Migrating"
      , Key
"info" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 (ChunkNo -> Int
chunkNoToInt ChunkNo
chunkNo) (ChunkNo -> Int
chunkNoToInt ChunkNo
outOf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ChunkNo -> Int
chunkNoToInt ChunkNo
outOf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        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 MetaTrace (ImmDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor ImmDB.NoValidLastLocation{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoValidLastLocation"]
  namespaceFor ImmDB.ValidatedLastLocation{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedLastLocation"]
  namespaceFor (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev) =
    Text
-> Namespace (TraceChunkValidation blk ChunkNo)
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ChunkValidation" (TraceChunkValidation blk ChunkNo
-> Namespace (TraceChunkValidation blk ChunkNo)
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceChunkValidation blk ChunkNo
ev)
  namespaceFor ImmDB.ChunkFileDoesntFit{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChunkFileDoesntFit"]
  namespaceFor ImmDB.Migrating{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Migrating"]
  namespaceFor ImmDB.DeletingAfter{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DeletingAfter"]
  namespaceFor ImmDB.DBAlreadyClosed{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBAlreadyClosed"]
  namespaceFor ImmDB.DBClosed{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBClosed"]
  namespaceFor (ImmDB.TraceCacheEvent TraceCacheEvent
ev) =
    Text -> Namespace TraceCacheEvent -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"CacheEvent" (TraceCacheEvent -> Namespace TraceCacheEvent
forall a. MetaTrace a => a -> Namespace a
namespaceFor TraceCacheEvent
ev)

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"NoValidLastLocation"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ValidatedLastLocation"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor
    (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl))
    (Just (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev')) =
      Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceChunkValidation blk ChunkNo
-> Maybe (TraceChunkValidation blk ChunkNo)
forall a. a -> Maybe a
Just TraceChunkValidation blk ChunkNo
ev')
  severityFor (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo)) Maybe (TraceChunkValidation blk ChunkNo)
forall a. Maybe a
Nothing
  severityFor (Namespace [Text]
_ [Text
"ChunkFileDoesntFit"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"Migrating"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"DeletingAfter"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"DBAlreadyClosed"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
  severityFor (Namespace [Text]
_ [Text
"DBClosed"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor
    (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl))
    (Just (ImmDB.TraceCacheEvent TraceCacheEvent
ev')) =
      Namespace TraceCacheEvent
-> Maybe TraceCacheEvent -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCacheEvent -> Maybe TraceCacheEvent
forall a. a -> Maybe a
Just TraceCacheEvent
ev')
  severityFor (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace TraceCacheEvent
-> Maybe TraceCacheEvent -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace ImmDB.TraceCacheEvent) Maybe TraceCacheEvent
forall a. Maybe a
Nothing
  severityFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  privacyFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe Privacy
privacyFor
    (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl))
    (Just (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev')) =
      Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceChunkValidation blk ChunkNo
-> Maybe (TraceChunkValidation blk ChunkNo)
forall a. a -> Maybe a
Just TraceChunkValidation blk ChunkNo
ev')
  privacyFor (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo)) Maybe (TraceChunkValidation blk ChunkNo)
forall a. Maybe a
Nothing
  privacyFor
    (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl))
    (Just (ImmDB.TraceCacheEvent TraceCacheEvent
ev')) =
      Namespace TraceCacheEvent -> Maybe TraceCacheEvent -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCacheEvent -> Maybe TraceCacheEvent
forall a. a -> Maybe a
Just TraceCacheEvent
ev')
  privacyFor (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace TraceCacheEvent -> Maybe TraceCacheEvent -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace ImmDB.TraceCacheEvent) Maybe TraceCacheEvent
forall a. Maybe a
Nothing
  privacyFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public

  detailsFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe DetailLevel
detailsFor
    (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl))
    (Just (ImmDB.ChunkValidationEvent TraceChunkValidation blk ChunkNo
ev')) =
      Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceChunkValidation blk ChunkNo
-> Maybe (TraceChunkValidation blk ChunkNo)
forall a. a -> Maybe a
Just TraceChunkValidation blk ChunkNo
ev')
  detailsFor (Namespace [Text]
out (Text
"ChunkValidation" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace (TraceChunkValidation blk ChunkNo)
-> Maybe (TraceChunkValidation blk ChunkNo) -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk ChunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo)) Maybe (TraceChunkValidation blk ChunkNo)
forall a. Maybe a
Nothing
  detailsFor
    (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl))
    (Just (ImmDB.TraceCacheEvent TraceCacheEvent
ev')) =
      Namespace TraceCacheEvent
-> Maybe TraceCacheEvent -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl) (TraceCacheEvent -> Maybe TraceCacheEvent
forall a. a -> Maybe a
Just TraceCacheEvent
ev')
  detailsFor (Namespace [Text]
out (Text
"CacheEvent" : [Text]
tl)) Maybe (TraceEvent blk)
Nothing =
    Namespace TraceCacheEvent
-> Maybe TraceCacheEvent -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
out [Text]
tl :: Namespace ImmDB.TraceCacheEvent) Maybe TraceCacheEvent
forall a. Maybe a
Nothing
  detailsFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"NoValidLastLocation"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"No valid last location was found"
  documentFor (Namespace [Text]
_ [Text
"ValidatedLastLocation"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The last location was validatet"
  documentFor (Namespace [Text]
o (Text
"ChunkValidation" : [Text]
tl)) =
    Namespace (TraceChunkValidation blk (ZonkAny 0)) -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace (ImmDB.TraceChunkValidation blk chunkNo))
  documentFor (Namespace [Text]
_ [Text
"ChunkFileDoesntFit"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The hash of the last block in the previous epoch doesn't match the"
        , Text
" previous hash of the first block in the current epoch"
        ]
  documentFor (Namespace [Text]
_ [Text
"Migrating"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Performing a migration of the on-disk files."
  documentFor (Namespace [Text]
_ [Text
"DeletingAfter"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Delete after"
  documentFor (Namespace [Text]
_ [Text
"DBAlreadyClosed"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"DBClosed"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Closing the immutable DB"
  documentFor (Namespace [Text]
o (Text
"CacheEvent" : [Text]
tl)) =
    Namespace TraceCacheEvent -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor ([Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
tl :: Namespace ImmDB.TraceCacheEvent)
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoValidLastLocation"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedLastLocation"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChunkFileDoesntFit"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Migrating"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DeletingAfter"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBAlreadyClosed"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBClosed"]
    ]
      [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace (TraceChunkValidation blk (ZonkAny 1))
 -> Namespace (TraceEvent blk))
-> [Namespace (TraceChunkValidation blk (ZonkAny 1))]
-> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
-> Namespace (TraceChunkValidation blk (ZonkAny 1))
-> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"ChunkValidation")
        ([Namespace (TraceChunkValidation blk chunkNo)]
forall {chunkNo}. [Namespace (TraceChunkValidation blk chunkNo)]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace (ImmDB.TraceChunkValidation blk chunkNo)])
      [Namespace (TraceEvent blk)]
-> [Namespace (TraceEvent blk)] -> [Namespace (TraceEvent blk)]
forall a. [a] -> [a] -> [a]
++ (Namespace TraceCacheEvent -> Namespace (TraceEvent blk))
-> [Namespace TraceCacheEvent] -> [Namespace (TraceEvent blk)]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text -> Namespace TraceCacheEvent -> Namespace (TraceEvent blk)
forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
"CacheEvent")
        ([Namespace TraceCacheEvent]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace ImmDB.TraceCacheEvent])

--------------------------------------------------------------------------------
-- ImmDB.TraceChunkValidation
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.RewriteSecondaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.RewritePrimaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingPrimaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingSecondaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidPrimaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidSecondaryIndex"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch"
        , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
        , Key
"hashPrevBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash (forall t. Proxy t
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash (forall t. Proxy t
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"block" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.ValidatedChunk"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.MissingChunkFile"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"error" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceImmutableDBEvent.StartedValidatingChunk"
      , Key
"initialChunk" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChunkNo -> Text
renderChunkNo ChunkNo
initialChunk
      , Key
"finalChunk" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChunkNo -> Text
renderChunkNo ChunkNo
finalChunk
      ]

instance MetaTrace (ImmDB.TraceChunkValidation blk chunkNo) where
  namespaceFor :: TraceChunkValidation blk chunkNo
-> Namespace (TraceChunkValidation blk chunkNo)
namespaceFor ImmDB.StartedValidatingChunk{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedValidatingChunk"]
  namespaceFor ImmDB.ValidatedChunk{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedChunk"]
  namespaceFor ImmDB.MissingChunkFile{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingChunkFile"]
  namespaceFor ImmDB.InvalidChunkFile{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidChunkFile"]
  namespaceFor ImmDB.MissingPrimaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingPrimaryIndex"]
  namespaceFor ImmDB.MissingSecondaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingSecondaryIndex"]
  namespaceFor ImmDB.InvalidPrimaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidPrimaryIndex"]
  namespaceFor ImmDB.InvalidSecondaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidSecondaryIndex"]
  namespaceFor ImmDB.RewritePrimaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RewritePrimaryIndex"]
  namespaceFor ImmDB.RewriteSecondaryIndex{} = [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RewriteSecondaryIndex"]

  severityFor :: Namespace (TraceChunkValidation blk chunkNo)
-> Maybe (TraceChunkValidation blk chunkNo) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"StartedValidatingChunk"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ValidatedChunk"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"MissingChunkFile"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"InvalidChunkFile"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"MissingPrimaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"MissingSecondaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"InvalidPrimaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"InvalidSecondaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"RewritePrimaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"RewriteSecondaryIndex"]) Maybe (TraceChunkValidation blk chunkNo)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor Namespace (TraceChunkValidation blk chunkNo)
_ Maybe (TraceChunkValidation blk chunkNo)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceChunkValidation blk chunkNo) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"StartedValidatingChunk"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"ValidatedChunk"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"MissingChunkFile"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"InvalidChunkFile"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"MissingPrimaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"MissingSecondaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"InvalidPrimaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"InvalidSecondaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"RewritePrimaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor (Namespace [Text]
_ [Text
"RewriteSecondaryIndex"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor Namespace (TraceChunkValidation blk chunkNo)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceChunkValidation blk chunkNo)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedValidatingChunk"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedChunk"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingChunkFile"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidChunkFile"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingPrimaryIndex"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MissingSecondaryIndex"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidPrimaryIndex"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidSecondaryIndex"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RewritePrimaryIndex"]
    , [Text] -> [Text] -> Namespace (TraceChunkValidation blk chunkNo)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RewriteSecondaryIndex"]
    ]

--------------------------------------------------------------------------------
-- ImmDB.TraceCacheEvent
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceCurrentChunkHit"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"noPastChunks" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TracePastChunkHit"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"noPastChunks" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TracePastChunkMiss"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"noPastChunks" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TracePastChunkEvict"
      , Key
"chunkNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ChunkNo -> Text
renderChunkNo ChunkNo
chunkNo)
      , Key
"noPastChunks" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TracePastChunksExpired"
      , Key
"chunkNos" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> ([Text] -> [Char]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Char]
forall a. Show a => a -> [Char]
show ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ChunkNo -> Text) -> [ChunkNo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ChunkNo -> Text
renderChunkNo [ChunkNo]
chunkNos)
      , Key
"noPastChunks" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Word32 -> Text
forall a. Show a => a -> Text
showT Word32
nbPastChunksInCache)
      ]

instance MetaTrace ImmDB.TraceCacheEvent where
  namespaceFor :: TraceCacheEvent -> Namespace TraceCacheEvent
namespaceFor ImmDB.TraceCurrentChunkHit{} = [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CurrentChunkHit"]
  namespaceFor ImmDB.TracePastChunkHit{} = [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkHit"]
  namespaceFor ImmDB.TracePastChunkMiss{} = [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkMiss"]
  namespaceFor ImmDB.TracePastChunkEvict{} = [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkEvict"]
  namespaceFor ImmDB.TracePastChunksExpired{} = [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkExpired"]

  severityFor :: Namespace TraceCacheEvent
-> Maybe TraceCacheEvent -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"CurrentChunkHit"]) Maybe TraceCacheEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PastChunkHit"]) Maybe TraceCacheEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PastChunkMiss"]) Maybe TraceCacheEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PastChunkEvict"]) Maybe TraceCacheEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PastChunkExpired"]) Maybe TraceCacheEvent
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace TraceCacheEvent
_ Maybe TraceCacheEvent
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace TraceCacheEvent -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"CurrentChunkHit"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Current chunk found in the cache."
  documentFor (Namespace [Text]
_ [Text
"PastChunkHit"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Past chunk found in the cache"
  documentFor (Namespace [Text]
_ [Text
"PastChunkMiss"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Past chunk was not found in the cache"
  documentFor (Namespace [Text]
_ [Text
"PastChunkEvict"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The least recently used past chunk was evicted because the cache"
        , Text
" was full."
        ]
  documentFor (Namespace [Text]
_ [Text
"PastChunkExpired"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
  documentFor Namespace TraceCacheEvent
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace TraceCacheEvent]
allNamespaces =
    [ [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CurrentChunkHit"]
    , [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkHit"]
    , [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkMiss"]
    , [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkEvict"]
    , [Text] -> [Text] -> Namespace TraceCacheEvent
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PastChunkExpired"]
    ]

--------------------------------------------------------------------------------
-- VolDb.TraceEvent
--------------------------------------------------------------------------------

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"BlockAlreadyHere"
      , Key
"blockId" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Truncate"
      , Key
"parserError" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"InvalidFileNames"
      , Key
"files" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> ([[Char]] -> [Char]) -> [[Char]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show ([[Char]] -> Text) -> [[Char]] -> Text
forall a b. (a -> b) -> a -> b
$ (FsPath -> [Char]) -> [FsPath] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map FsPath -> [Char]
forall a. Show a => a -> [Char]
show [FsPath]
fsPaths)
      ]
  forMachine DetailLevel
_dtal TraceEvent blk
VolDB.DBClosed =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DBClosed"]

instance MetaTrace (VolDB.TraceEvent blk) where
  namespaceFor :: TraceEvent blk -> Namespace (TraceEvent blk)
namespaceFor VolDB.DBAlreadyClosed{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBAlreadyClosed"]
  namespaceFor VolDB.BlockAlreadyHere{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockAlreadyHere"]
  namespaceFor VolDB.Truncate{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Truncate"]
  namespaceFor VolDB.InvalidFileNames{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidFileNames"]
  namespaceFor VolDB.DBClosed{} = [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBClosed"]

  severityFor :: Namespace (TraceEvent blk)
-> Maybe (TraceEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"DBAlreadyClosed"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"BlockAlreadyHere"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"Truncate"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"InvalidFileNames"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"DBClosed"]) Maybe (TraceEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor Namespace (TraceEvent blk)
_ Maybe (TraceEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"DBAlreadyClosed"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"When closing the DB it was found it is closed already."
  documentFor (Namespace [Text]
_ [Text
"BlockAlreadyHere"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A block was found to be already in the DB."
  documentFor (Namespace [Text]
_ [Text
"Truncate"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Truncates a file up to offset because of the error."
  documentFor (Namespace [Text]
_ [Text
"InvalidFileNames"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Reports a list of invalid file paths."
  documentFor (Namespace [Text]
_ [Text
"DBClosed"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Closing the volatile DB"
  documentFor Namespace (TraceEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBAlreadyClosed"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockAlreadyHere"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Truncate"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InvalidFileNames"]
    , [Text] -> [Text] -> Namespace (TraceEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DBClosed"]
    ]

--------------------------------------------------------------------------------
-- ChainInformation
--------------------------------------------------------------------------------

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

showProgressT :: Int -> Int -> Text
showProgressT :: Int -> Int -> Text
showProgressT Int
chunkNo Int
outOf =
  [Char] -> 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)
        [Char]
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
  , ChainInformation -> Text
tipBlockHash :: Text
  -- ^ Hash of the last adopted block.
  , ChainInformation -> Text
tipBlockParentHash :: Text
  -- ^ Hash of the parent block of the last adopted block.
  , ChainInformation -> BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
  -- ^ Hash of the last adopted block issuer's verification key.
  }

chainInformation ::
  forall blk.
  HasHeader (Header blk) =>
  HasIssuer blk =>
  ConvertRawHash blk =>
  ChainDB.SelectionChangedInfo blk ->
  AF.AnchoredFragment (Header blk) ->
  -- | New fragment.
  AF.AnchoredFragment (Header blk) ->
  Int64 ->
  ChainInformation
chainInformation :: forall blk.
(HasHeader (Header blk), HasIssuer blk, ConvertRawHash blk) =>
SelectionChangedInfo blk
-> AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation SelectionChangedInfo blk
selChangedInfo AnchoredFragment (Header blk)
oldFrag AnchoredFragment (Header blk)
frag Int64
blocksUncoupledDelta =
  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 = SelectionChangedInfo blk -> EpochNo
forall blk. SelectionChangedInfo blk -> EpochNo
ChainDB.newTipEpoch SelectionChangedInfo blk
selChangedInfo
    , slotInEpoch :: Word64
slotInEpoch = SelectionChangedInfo blk -> Word64
forall blk. SelectionChangedInfo blk -> Word64
ChainDB.newTipSlotInEpoch SelectionChangedInfo blk
selChangedInfo
    , blocksUncoupledDelta :: Int64
blocksUncoupledDelta = Int64
blocksUncoupledDelta
    , tipBlockHash :: Text
tipBlockHash = Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (HeaderHash blk -> Text) -> HeaderHash blk -> Text
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> HeaderHash blk
forall blk. RealPoint blk -> HeaderHash blk
realPointHash (SelectionChangedInfo blk -> RealPoint blk
forall blk. SelectionChangedInfo blk -> RealPoint blk
ChainDB.newTipPoint SelectionChangedInfo blk
selChangedInfo)
    , tipBlockParentHash :: Text
tipBlockParentHash =
        (HeaderHash (Header blk) -> Text) -> ChainHash (Header blk) -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (HeaderHash blk -> ByteString) -> HeaderHash blk -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
forall (proxy :: * -> *). proxy blk -> HeaderHash blk -> ByteString
toRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)) (ChainHash (Header blk) -> Text) -> ChainHash (Header blk) -> Text
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (Header blk) -> ChainHash (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> ChainHash block
AF.headHash AnchoredFragment (Header blk)
oldFrag
    , tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
tipBlockIssuerVerificationKeyHash = BlockIssuerVerificationKeyHash
tipIssuerVkHash
    }
 where
  tipIssuerVkHash :: BlockIssuerVerificationKeyHash
  tipIssuerVkHash :: BlockIssuerVerificationKeyHash
tipIssuerVkHash = (Anchor (Header blk) -> BlockIssuerVerificationKeyHash)
-> (Header blk -> BlockIssuerVerificationKeyHash)
-> Either (Anchor (Header blk)) (Header blk)
-> BlockIssuerVerificationKeyHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (BlockIssuerVerificationKeyHash
-> Anchor (Header blk) -> BlockIssuerVerificationKeyHash
forall a b. a -> b -> a
const BlockIssuerVerificationKeyHash
NoBlockIssuer) Header blk -> BlockIssuerVerificationKeyHash
forall blk.
HasIssuer blk =>
Header blk -> BlockIssuerVerificationKeyHash
getIssuerVerificationKeyHash (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.head AnchoredFragment (Header blk)
frag)

fragmentChainDensity ::
  HasHeader (Header blk) =>
  AF.AnchoredFragment (Header blk) -> Rational
fragmentChainDensity :: forall blk.
HasHeader (Header blk) =>
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 b c a. (b -> c) -> (a -> b) -> 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

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

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"snapshot"
      , Key
"snapshot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> [Char]
forall a. Show a => a -> [Char]
show DiskSnapshot
snap)
      ]
  forMachine DetailLevel
_ DiskSnapshot
_snap = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"snapshot"]

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HeaderProtocolError"
      , Key
"error" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HeaderEnvelopeError"
      , Key
"error" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedBlockNo"
      , Key
"expected" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo -> [Char]
forall a. Condense a => a -> [Char]
condense BlockNo
expect
      , Key
"actual" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo -> [Char]
forall a. Condense a => a -> [Char]
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedSlotNo"
      , Key
"expected" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> [Char]
forall a. Condense a => a -> [Char]
condense SlotNo
expect
      , Key
"actual" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> [Char]
forall a. Condense a => a -> [Char]
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnexpectedPrevHash"
      , Key
"expected" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ WithOrigin (HeaderHash blk) -> [Char]
forall a. Show a => a -> [Char]
show WithOrigin (HeaderHash blk)
expect)
      , Key
"actual" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ChainHash blk -> [Char]
forall a. Show a => a -> [Char]
show ChainHash blk
act)
      ]
  forMachine DetailLevel
_dtal (CheckpointMismatch BlockNo
blockNumber HeaderHash blk
hdrHashExpected HeaderHash blk
hdrHashActual) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CheckpointMismatch"
      , Key
"blockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ BlockNo -> [Char]
forall a. Show a => a -> [Char]
show BlockNo
blockNumber)
      , Key
"expected" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ HeaderHash blk -> [Char]
forall a. Show a => a -> [Char]
show HeaderHash blk
hdrHashExpected)
      , Key
"actual" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ HeaderHash blk -> [Char]
forall a. Show a => a -> [Char]
show HeaderHash blk
hdrHashActual)
      ]
  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)
  , Show (PerasError blk)
  ) =>
  LogFormatting (ExtValidationError blk)
  where
  -- The two Peras arms carry types with no 'LogFormatting' instance to defer
  -- to: 'PerasError' is a type family, so all we can rely on is its 'Show'.
  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
  forMachine DetailLevel
_dtal (ExtValidationErrorPerasEpochContextResolver PerasEpochContextNotFoundForRound
err) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ExtValidationErrorPerasEpochContextResolver"
      , Key
"error" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (PerasEpochContextNotFoundForRound -> Text
forall a. Show a => a -> Text
showT PerasEpochContextNotFoundForRound
err)
      ]
  forMachine DetailLevel
_dtal (ExtValidationErrorPerasCertInBlock PerasError blk
err) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ExtValidationErrorPerasCertInBlock"
      , Key
"error" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (PerasError blk -> Text
forall a. Show a => a -> Text
showT PerasError 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
  forHuman (ExtValidationErrorPerasEpochContextResolver PerasEpochContextNotFoundForRound
err) =
    Text
"Could not resolve the Peras epoch context: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasEpochContextNotFoundForRound -> Text
forall a. Show a => a -> Text
showT PerasEpochContextNotFoundForRound
err
  forHuman (ExtValidationErrorPerasCertInBlock PerasError blk
err) =
    Text
"Invalid Peras certificate in block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasError blk -> Text
forall a. Show a => a -> Text
showT PerasError 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
  asMetrics ExtValidationErrorPerasEpochContextResolver{} = []
  asMetrics ExtValidationErrorPerasCertInBlock{} = []

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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftInvalidSignature"
      , Key
"error" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftNotGenesisDelegate"
      , Key
"vk" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PBftVerKeyHash c -> [Char]
forall a. Show a => a -> [Char]
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftExceededSignThreshold"
      , Key
"vk" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PBftVerKeyHash c -> [Char]
forall a. Show a => a -> [Char]
show PBftVerKeyHash c
vkhash)
      , Key
"numForged" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack (Word64 -> [Char]
forall a. Show a => a -> [Char]
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e 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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftCannotForgeInvalidDelegation"
      , Key
"vk" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PBftVerKeyHash c -> [Char]
forall a. Show a => a -> [Char]
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 v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PBftCannotForgeThresholdExceeded"
      , Key
"numForged" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
numForged
      ]

-- ChainDB.TraceAddPerasCertEvent instances
instance ConvertRawHash blk => LogFormatting (ChainDB.TraceAddPerasCertEvent blk) where
  forHuman :: TraceAddPerasCertEvent blk -> Text
forHuman (ChainDB.AddedPerasCertToQueue PerasRoundNo
roundNo Point blk
boostedBlock Enclosing' Word
_queueSize) =
    Text
"Added Peras certificate for round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosting block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to queue"
  forHuman (ChainDB.PoppedPerasCertFromQueue PerasRoundNo
roundNo Point blk
boostedBlock) =
    Text
"Popped Peras certificate for round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosting block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from queue"
  forHuman (ChainDB.IgnorePerasCertTooOld PerasRoundNo
roundNo Point blk
boostedBlock Anchor blk
immutableSlot) =
    Text
"Ignored Peras certificate for round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosting block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (too old, immutable slot: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint (Anchor blk -> Point blk
forall block. Anchor block -> Point block
AF.anchorToPoint Anchor blk
immutableSlot)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  forHuman (ChainDB.PerasCertBoostsCurrentChain PerasRoundNo
roundNo Point blk
boostedBlock) =
    Text
"Peras certificate for round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosts current chain block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
  forHuman (ChainDB.PerasCertBoostsGenesis PerasRoundNo
roundNo) =
    Text
"Peras certificate for round " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosts Genesis"
  forHuman (ChainDB.PerasCertBoostsBlockNotYetReceived PerasRoundNo
roundNo Point blk
boostedBlock) =
    Text
"Peras certificate for round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosts block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not yet received"
  forHuman (ChainDB.ChainSelectionForBoostedBlock PerasRoundNo
roundNo Point blk
boostedBlock) =
    Text
"Chain selection for block "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" boosted by Peras certificate from round "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)

  forMachine :: DetailLevel -> TraceAddPerasCertEvent blk -> Object
forMachine DetailLevel
_dtal (ChainDB.AddedPerasCertToQueue PerasRoundNo
roundNo Point blk
boostedBlock Enclosing' Word
queueSize) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"AddedPerasCertToQueue"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      , Key
"queueSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Enclosing' Word -> Value
forall a. ToJSON a => Enclosing' a -> Value
enclosingValue Enclosing' Word
queueSize
      ]
  forMachine DetailLevel
_dtal (ChainDB.PoppedPerasCertFromQueue PerasRoundNo
roundNo Point blk
boostedBlock) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PoppedPerasCertFromQueue"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      ]
  forMachine DetailLevel
_dtal (ChainDB.IgnorePerasCertTooOld PerasRoundNo
roundNo Point blk
boostedBlock Anchor blk
immutableSlot) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"IgnorePerasCertTooOld"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      , Key
"immutableSlot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint (Anchor blk -> Point blk
forall block. Anchor block -> Point block
AF.anchorToPoint Anchor blk
immutableSlot))
      ]
  forMachine DetailLevel
_dtal (ChainDB.PerasCertBoostsCurrentChain PerasRoundNo
roundNo Point blk
boostedBlock) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasCertBoostsCurrentChain"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      ]
  forMachine DetailLevel
_dtal (ChainDB.PerasCertBoostsGenesis PerasRoundNo
roundNo) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasCertBoostsGenesis"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      ]
  forMachine DetailLevel
_dtal (ChainDB.PerasCertBoostsBlockNotYetReceived PerasRoundNo
roundNo Point blk
boostedBlock) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PerasCertBoostsBlockNotYetReceived"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      ]
  forMachine DetailLevel
_dtal (ChainDB.ChainSelectionForBoostedBlock PerasRoundNo
roundNo Point blk
boostedBlock) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSelectionForBoostedBlock"
      , Key
"round" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ PerasRoundNo -> [Char]
forall a. Show a => a -> [Char]
show PerasRoundNo
roundNo)
      , Key
"boostedBlock" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPoint Point blk
boostedBlock)
      ]

  asMetrics :: TraceAddPerasCertEvent blk -> [Metric]
asMetrics TraceAddPerasCertEvent blk
_ = []

-- ChainDB.TraceAddPerasCertEvent MetaTrace instance
instance MetaTrace (ChainDB.TraceAddPerasCertEvent blk) where
  namespaceFor :: TraceAddPerasCertEvent blk
-> Namespace (TraceAddPerasCertEvent blk)
namespaceFor ChainDB.AddedPerasCertToQueue{} = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedPerasCertToQueue"]
  namespaceFor (ChainDB.PoppedPerasCertFromQueue PerasRoundNo
_ Point blk
_) = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedPerasCertFromQueue"]
  namespaceFor ChainDB.IgnorePerasCertTooOld{} = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnorePerasCertTooOld"]
  namespaceFor (ChainDB.PerasCertBoostsCurrentChain PerasRoundNo
_ Point blk
_) = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsCurrentChain"]
  namespaceFor (ChainDB.PerasCertBoostsGenesis PerasRoundNo
_) = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsGenesis"]
  namespaceFor (ChainDB.PerasCertBoostsBlockNotYetReceived PerasRoundNo
_ Point blk
_) = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsBlockNotYetReceived"]
  namespaceFor (ChainDB.ChainSelectionForBoostedBlock PerasRoundNo
_ Point blk
_) = [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelectionForBoostedBlock"]

  severityFor :: Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"AddedPerasCertToQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"PoppedPerasCertFromQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"IgnorePerasCertTooOld"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"PerasCertBoostsCurrentChain"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"PerasCertBoostsGenesis"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"PerasCertBoostsBlockNotYetReceived"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"ChainSelectionForBoostedBlock"]) Maybe (TraceAddPerasCertEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor Namespace (TraceAddPerasCertEvent blk)
_ Maybe (TraceAddPerasCertEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  privacyFor :: Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe Privacy
privacyFor (Namespace [Text]
_ [Text
"AddedPerasCertToQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"PoppedPerasCertFromQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"IgnorePerasCertTooOld"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"PerasCertBoostsCurrentChain"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"PerasCertBoostsGenesis"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"PerasCertBoostsBlockNotYetReceived"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor (Namespace [Text]
_ [Text
"ChainSelectionForBoostedBlock"]) Maybe (TraceAddPerasCertEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  privacyFor Namespace (TraceAddPerasCertEvent blk)
_ Maybe (TraceAddPerasCertEvent blk)
_ = Maybe Privacy
forall a. Maybe a
Nothing

  detailsFor :: Namespace (TraceAddPerasCertEvent blk)
-> Maybe (TraceAddPerasCertEvent blk) -> Maybe DetailLevel
detailsFor (Namespace [Text]
_ [Text
"AddedPerasCertToQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DDetailed
  detailsFor (Namespace [Text]
_ [Text
"PoppedPerasCertFromQueue"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DDetailed
  detailsFor (Namespace [Text]
_ [Text
"IgnorePerasCertTooOld"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
_ [Text
"PerasCertBoostsCurrentChain"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
_ [Text
"PerasCertBoostsGenesis"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
_ [Text
"PerasCertBoostsBlockNotYetReceived"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor (Namespace [Text]
_ [Text
"ChainSelectionForBoostedBlock"]) Maybe (TraceAddPerasCertEvent blk)
_ = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal
  detailsFor Namespace (TraceAddPerasCertEvent blk)
_ Maybe (TraceAddPerasCertEvent blk)
_ = Maybe DetailLevel
forall a. Maybe a
Nothing

  documentFor :: Namespace (TraceAddPerasCertEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"AddedPerasCertToQueue"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate added to processing queue"
  documentFor (Namespace [Text]
_ [Text
"PoppedPerasCertFromQueue"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate popped from processing queue"
  documentFor (Namespace [Text]
_ [Text
"IgnorePerasCertTooOld"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate ignored as it is too old compared to immutable slot"
  documentFor (Namespace [Text]
_ [Text
"PerasCertBoostsCurrentChain"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate boosts a block on the current selection"
  documentFor (Namespace [Text]
_ [Text
"PerasCertBoostsGenesis"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate boosts the Genesis point"
  documentFor (Namespace [Text]
_ [Text
"PerasCertBoostsBlockNotYetReceived"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Peras certificate boosts a block not yet received"
  documentFor (Namespace [Text]
_ [Text
"ChainSelectionForBoostedBlock"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Perform chain selection for block boosted by Peras certificate"
  documentFor Namespace (TraceAddPerasCertEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (TraceAddPerasCertEvent blk)]
allNamespaces =
    [ [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedPerasCertToQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PoppedPerasCertFromQueue"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"IgnorePerasCertTooOld"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsCurrentChain"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsGenesis"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PerasCertBoostsBlockNotYetReceived"]
    , [Text] -> [Text] -> Namespace (TraceAddPerasCertEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ChainSelectionForBoostedBlock"]
    ]