{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Tracing.Consensus
( initialClientMetrics
, calculateBlockFetchClientMetrics
, servedBlockLatest
, ClientMetrics
, txsMempoolTimeoutSoftCounterName
, txsSyncDurationTotalCounterName
, impliesMempoolTimeoutSoft
) where
import qualified Cardano.KESAgent.Processes.ServiceClient as Agent
import Cardano.Logging
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.Exception (displayException)
import Control.Monad (guard)
import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=))
import qualified Data.Aeson as Aeson
import Data.Foldable (Foldable (toList))
import Data.Int (Int64)
import Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as Pq
import qualified Data.Text as Text
import Data.Time (NominalDiffTime)
import Data.Word (Word32, Word64)
import Network.TypedProtocol.Core
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime (SystemStart (..))
import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Genesis.Governor
( DensityBounds (..)
, GDDDebugInfo (..)
, TraceGDDEvent (..)
)
import Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpdate, LedgerWarning)
import Ouroboros.Consensus.Ledger.SupportsMempool
( ApplyTxErr
, ByteSize32 (..)
, HasTxId
, LedgerSupportsMempool
, TxMeasurePhase1Metrics (..)
, TxMeasurePhase2Metrics (..)
, txForgetValidated
, txId
)
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Mempool
( MempoolRejectionDetails (..)
, MempoolSize (..)
, TraceEventMempool (..)
, jsonMempoolRejectionDetails
)
import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
( TraceBlockFetchServerEvent (..)
)
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as ChainSync
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Jumping
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (JumpInfo (..))
import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
( TraceLocalTxSubmissionServerEvent (..)
)
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
( NumObjectsProcessed (..)
, TraceObjectDiffusionInbound (..)
)
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
( TraceObjectDiffusionOutbound (..)
)
import Ouroboros.Consensus.Node.GSM
import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize)
import Ouroboros.Consensus.Node.Tracers
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import Ouroboros.Consensus.Protocol.Praos.AgentClient
import Ouroboros.Consensus.Tracing.ConsensusStartupException ()
import Ouroboros.Consensus.Tracing.ConvertTxId (ConvertTxId (..))
import Ouroboros.Consensus.Tracing.Formatting ()
import Ouroboros.Consensus.Tracing.KESInfo (HasKESInfo (..))
import Ouroboros.Consensus.Tracing.Render
import Ouroboros.Consensus.Util.Enclose
import qualified Ouroboros.Network.AnchoredFragment as AF
import qualified Ouroboros.Network.AnchoredSeq as AS
import Ouroboros.Network.Block hiding (blockPrevHash)
import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..))
import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
import Ouroboros.Network.BlockFetch.Decision
import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..))
import Ouroboros.Network.OrphanInstances ()
import Ouroboros.Network.SizeInBytes (SizeInBytes (..))
enclosingValue :: ToJSON a => Enclosing' a -> Value
enclosingValue :: forall a. ToJSON a => Enclosing' a -> Value
enclosingValue Enclosing' a
RisingEdge = [(Key, Value)] -> Value
object [Key
"edge" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Starting"]
enclosingValue (FallingEdgeWith a
a) = [(Key, Value)] -> Value
object [Key
"edge" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a]
instance LogFormatting a => LogFormatting (TraceLabelCreds a) where
forMachine :: DetailLevel -> TraceLabelCreds a -> Object
forMachine DetailLevel
dtal (TraceLabelCreds Text
creds a
a) =
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Key
"credentials" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
creds) Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [DetailLevel -> a -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal a
a]
forHuman :: TraceLabelCreds a -> Text
forHuman (TraceLabelCreds Text
creds a
a) =
Text
"With label " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) Text
creds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. LogFormatting a => a -> Text
forHuman a
a
asMetrics :: TraceLabelCreds a -> [Metric]
asMetrics (TraceLabelCreds Text
_creds a
a) =
a -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics a
a
instance MetaTrace a => MetaTrace (TraceLabelCreds a) where
namespaceFor :: TraceLabelCreds a -> Namespace (TraceLabelCreds a)
namespaceFor (TraceLabelCreds Text
_label a
obj) = (Namespace a -> Namespace (TraceLabelCreds a)
forall a b. Namespace a -> Namespace b
nsCast (Namespace a -> Namespace (TraceLabelCreds a))
-> (a -> Namespace a) -> a -> Namespace (TraceLabelCreds a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Namespace a
forall a. MetaTrace a => a -> Namespace a
namespaceFor) a
obj
severityFor :: Namespace (TraceLabelCreds a)
-> Maybe (TraceLabelCreds a) -> Maybe SeverityS
severityFor Namespace (TraceLabelCreds a)
ns Maybe (TraceLabelCreds a)
Nothing = Namespace a -> Maybe a -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
severityFor Namespace (TraceLabelCreds a)
ns (Just (TraceLabelCreds Text
_label a
obj)) =
Namespace a -> Maybe a -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
privacyFor :: Namespace (TraceLabelCreds a)
-> Maybe (TraceLabelCreds a) -> Maybe Privacy
privacyFor Namespace (TraceLabelCreds a)
ns Maybe (TraceLabelCreds a)
Nothing = Namespace a -> Maybe a -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
privacyFor Namespace (TraceLabelCreds a)
ns (Just (TraceLabelCreds Text
_label a
obj)) =
Namespace a -> Maybe a -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
detailsFor :: Namespace (TraceLabelCreds a)
-> Maybe (TraceLabelCreds a) -> Maybe DetailLevel
detailsFor Namespace (TraceLabelCreds a)
ns Maybe (TraceLabelCreds a)
Nothing = Namespace a -> Maybe a -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
detailsFor Namespace (TraceLabelCreds a)
ns (Just (TraceLabelCreds Text
_label a
obj)) =
Namespace a -> Maybe a -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
documentFor :: Namespace (TraceLabelCreds a) -> Maybe Text
documentFor Namespace (TraceLabelCreds a)
ns = Namespace a -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a)
metricsDocFor :: Namespace (TraceLabelCreds a) -> [(Text, Text)]
metricsDocFor Namespace (TraceLabelCreds a)
ns = Namespace a -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor (Namespace (TraceLabelCreds a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelCreds a)
ns :: Namespace a)
allNamespaces :: [Namespace (TraceLabelCreds a)]
allNamespaces = (Namespace a -> Namespace (TraceLabelCreds a))
-> [Namespace a] -> [Namespace (TraceLabelCreds a)]
forall a b. (a -> b) -> [a] -> [b]
map Namespace a -> Namespace (TraceLabelCreds a)
forall a b. Namespace a -> Namespace b
nsCast ([Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a])
instance
(LogFormatting peer, Show peer, LogFormatting a) =>
LogFormatting (TraceLabelPeer peer a)
where
forMachine :: DetailLevel -> TraceLabelPeer peer a -> Object
forMachine DetailLevel
dtal (TraceLabelPeer peer
peerid a
a) =
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"peer" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
peerid] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> DetailLevel -> a -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal a
a
forHuman :: TraceLabelPeer peer a -> Text
forHuman (TraceLabelPeer peer
peerid a
a) =
Text
"Peer is: ("
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> peer -> Text
forall a. Show a => a -> Text
showT peer
peerid
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"). "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. LogFormatting a => a -> Text
forHuman a
a
asMetrics :: TraceLabelPeer peer a -> [Metric]
asMetrics (TraceLabelPeer peer
_peerid a
a) = a -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics a
a
instance MetaTrace a => MetaTrace (TraceLabelPeer label a) where
namespaceFor :: TraceLabelPeer label a -> Namespace (TraceLabelPeer label a)
namespaceFor (TraceLabelPeer label
_label a
obj) = (Namespace a -> Namespace (TraceLabelPeer label a)
forall a b. Namespace a -> Namespace b
nsCast (Namespace a -> Namespace (TraceLabelPeer label a))
-> (a -> Namespace a) -> a -> Namespace (TraceLabelPeer label a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Namespace a
forall a. MetaTrace a => a -> Namespace a
namespaceFor) a
obj
severityFor :: Namespace (TraceLabelPeer label a)
-> Maybe (TraceLabelPeer label a) -> Maybe SeverityS
severityFor Namespace (TraceLabelPeer label a)
ns Maybe (TraceLabelPeer label a)
Nothing = Namespace a -> Maybe a -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
severityFor Namespace (TraceLabelPeer label a)
ns (Just (TraceLabelPeer label
_label a
obj)) =
Namespace a -> Maybe a -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
privacyFor :: Namespace (TraceLabelPeer label a)
-> Maybe (TraceLabelPeer label a) -> Maybe Privacy
privacyFor Namespace (TraceLabelPeer label a)
ns Maybe (TraceLabelPeer label a)
Nothing = Namespace a -> Maybe a -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
privacyFor Namespace (TraceLabelPeer label a)
ns (Just (TraceLabelPeer label
_label a
obj)) =
Namespace a -> Maybe a -> Maybe Privacy
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe Privacy
privacyFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
detailsFor :: Namespace (TraceLabelPeer label a)
-> Maybe (TraceLabelPeer label a) -> Maybe DetailLevel
detailsFor Namespace (TraceLabelPeer label a)
ns Maybe (TraceLabelPeer label a)
Nothing = Namespace a -> Maybe a -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns :: Namespace a) Maybe a
forall a. Maybe a
Nothing
detailsFor Namespace (TraceLabelPeer label a)
ns (Just (TraceLabelPeer label
_label a
obj)) =
Namespace a -> Maybe a -> Maybe DetailLevel
forall a.
MetaTrace a =>
Namespace a -> Maybe a -> Maybe DetailLevel
detailsFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns) (a -> Maybe a
forall a. a -> Maybe a
Just a
obj)
documentFor :: Namespace (TraceLabelPeer label a) -> Maybe Text
documentFor Namespace (TraceLabelPeer label a)
ns = Namespace a -> Maybe Text
forall a. MetaTrace a => Namespace a -> Maybe Text
documentFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns :: Namespace a)
metricsDocFor :: Namespace (TraceLabelPeer label a) -> [(Text, Text)]
metricsDocFor Namespace (TraceLabelPeer label a)
ns = Namespace a -> [(Text, Text)]
forall a. MetaTrace a => Namespace a -> [(Text, Text)]
metricsDocFor (Namespace (TraceLabelPeer label a) -> Namespace a
forall a b. Namespace a -> Namespace b
nsCast Namespace (TraceLabelPeer label a)
ns :: Namespace a)
allNamespaces :: [Namespace (TraceLabelPeer label a)]
allNamespaces = (Namespace a -> Namespace (TraceLabelPeer label a))
-> [Namespace a] -> [Namespace (TraceLabelPeer label a)]
forall a b. (a -> b) -> [a] -> [b]
map Namespace a -> Namespace (TraceLabelPeer label a)
forall a b. Namespace a -> Namespace b
nsCast ([Namespace a]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace a])
instance
(LogFormatting (LedgerUpdate blk), LogFormatting (LedgerWarning blk)) =>
LogFormatting (LedgerEvent blk)
where
forMachine :: DetailLevel -> LedgerEvent blk -> Object
forMachine DetailLevel
dtal = \case
LedgerUpdate LedgerUpdate blk
update -> DetailLevel -> LedgerUpdate blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal LedgerUpdate blk
update
LedgerWarning LedgerWarning blk
warning -> DetailLevel -> LedgerWarning blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal LedgerWarning blk
warning
instance
(ConvertRawHash blk, ConvertRawHash (Header blk), LedgerSupportsProtocol blk) =>
LogFormatting (ChainSync.TraceChainSyncClientEvent blk)
where
forHuman :: TraceChainSyncClientEvent blk -> Text
forHuman = \case
ChainSync.TraceDownloadedHeader Header blk
pt ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"While following a candidate chain, we rolled forward by downloading a"
, Text
" header. "
, Point blk -> Text
forall a. Show a => a -> Text
showT (Header blk -> Point blk
forall blk. HasHeader (Header blk) => Header blk -> Point blk
headerPoint Header blk
pt)
]
ChainSync.TraceRolledBack Point blk
tip ->
Text
"While following a candidate chain, we rolled back to the given point: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall a. Show a => a -> Text
showT Point blk
tip
ChainSync.TraceException ChainSyncClientException
exc ->
Text
"An exception was thrown by the Chain Sync Client. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChainSyncClientException -> Text
forall a. Show a => a -> Text
showT ChainSyncClientException
exc
ChainSync.TraceFoundIntersection{} ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"We found an intersection between our chain fragment and the"
, Text
" candidate's chain."
]
ChainSync.TraceTermination ChainSyncClientResult
res ->
Text
"The client has terminated. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChainSyncClientResult -> Text
forall a. Show a => a -> Text
showT ChainSyncClientResult
res
ChainSync.TraceValidatedHeader Header blk
header ->
Text
"The header has been validated" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HeaderHash blk -> Text
forall a. Show a => a -> Text
showT (Header blk -> HeaderHash blk
forall blk. HasHeader (Header blk) => Header blk -> HeaderHash blk
headerHash Header blk
header)
ChainSync.TraceWaitingBeyondForecastHorizon SlotNo
slotNo ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"The slot number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Show a => a -> Text
showT SlotNo
slotNo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is beyond the forecast horizon, the ChainSync client"
, Text
" cannot yet validate a header in this slot and therefore is waiting"
]
ChainSync.TraceAccessingForecastHorizon SlotNo
slotNo ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"The slot number " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
forall a. Show a => a -> Text
showT SlotNo
slotNo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which was previously beyond the forecast horizon, has now"
, Text
" entered it, and we can resume processing."
]
ChainSync.TraceGaveLoPToken{} ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"Whether we added a token to the LoP bucket of the peer. Also carries"
, Text
"the considered header and the best block number known prior to this"
, Text
"header"
]
ChainSync.TraceOfferJump Point blk
point ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"ChainSync Jumping -- we are offering a jump to the server, to point: "
, Point blk -> Text
forall a. Show a => a -> Text
showT Point blk
point
]
ChainSync.TraceJumpResult (AcceptedJump JumpInstruction blk
instruction) ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"ChainSync Jumping -- the client accepted the jump to "
, Point (HeaderWithTime blk) -> Text
forall a. Show a => a -> Text
showT (JumpInstruction blk -> Point (HeaderWithTime blk)
jumpInstructionToPoint JumpInstruction blk
instruction)
]
ChainSync.TraceJumpResult (RejectedJump JumpInstruction blk
instruction) ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"ChainSync Jumping -- the client rejected the jump to "
, Point (HeaderWithTime blk) -> Text
forall a. Show a => a -> Text
showT (JumpInstruction blk -> Point (HeaderWithTime blk)
jumpInstructionToPoint JumpInstruction blk
instruction)
]
TraceChainSyncClientEvent blk
ChainSync.TraceJumpingWaitingForNextInstruction ->
Text
"ChainSync Jumping -- the client is blocked, waiting for its next instruction."
ChainSync.TraceJumpingInstructionIs Instruction blk
RunNormally ->
Text
"ChainSyncJumping -- the client is asked to run normally"
ChainSync.TraceJumpingInstructionIs Instruction blk
Restart ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"ChainSyncJumping -- the client is asked to restart. This is necessary"
, Text
"when disengaging a peer of which we know no point that we could set"
, Text
"the intersection of the ChainSync server to."
]
ChainSync.TraceJumpingInstructionIs (JumpInstruction JumpInstruction blk
instruction) ->
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"ChainSync Jumping -- the client is asked to jump to "
, Point (HeaderWithTime blk) -> Text
forall a. Show a => a -> Text
showT (JumpInstruction blk -> Point (HeaderWithTime blk)
jumpInstructionToPoint JumpInstruction blk
instruction)
]
ChainSync.TraceDrainingThePipe Nat n
n ->
Text
"ChainSync client is draining the pipe. Pipelined messages expected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT (Nat n -> Int
forall (n :: N). Nat n -> Int
natToInt Nat n
n)
where
jumpInstructionToPoint :: JumpInstruction blk -> Point (HeaderWithTime blk)
jumpInstructionToPoint =
AnchoredFragment (HeaderWithTime blk) -> Point (HeaderWithTime blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint (AnchoredFragment (HeaderWithTime blk)
-> Point (HeaderWithTime blk))
-> (JumpInstruction blk -> AnchoredFragment (HeaderWithTime blk))
-> JumpInstruction blk
-> Point (HeaderWithTime blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpInfo blk -> AnchoredFragment (HeaderWithTime blk)
forall blk. JumpInfo blk -> AnchoredFragment (HeaderWithTime blk)
jTheirFragment (JumpInfo blk -> AnchoredFragment (HeaderWithTime blk))
-> (JumpInstruction blk -> JumpInfo blk)
-> JumpInstruction blk
-> AnchoredFragment (HeaderWithTime blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
JumpTo JumpInfo blk
ji -> JumpInfo blk
ji
JumpToGoodPoint JumpInfo blk
ji -> JumpInfo blk
ji
forMachine :: DetailLevel -> TraceChainSyncClientEvent blk -> Object
forMachine DetailLevel
dtal = \case
ChainSync.TraceDownloadedHeader Header blk
h ->
[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
"DownloadedHeader"
, Tip (Header blk) -> Object
forall blk. ConvertRawHash blk => Tip blk -> Object
tipToObject (Header blk -> Tip (Header blk)
forall a. HasHeader a => a -> Tip a
tipFromHeader Header blk
h)
]
ChainSync.TraceRolledBack 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
"RolledBack"
, 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
]
ChainSync.TraceException ChainSyncClientException
exc ->
[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
"Exception"
, Key
"exception" 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 (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ChainSyncClientException -> String
forall a. Show a => a -> String
show ChainSyncClientException
exc)
]
ChainSync.TraceFoundIntersection{} ->
[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
"FoundIntersection"
]
ChainSync.TraceTermination ChainSyncClientResult
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
"Termination"
, 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 (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ChainSyncClientResult -> String
forall a. Show a => a -> String
show ChainSyncClientResult
reason)
]
ChainSync.TraceValidatedHeader Header blk
header ->
[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
"ValidatedHeader"
, Key
"headerHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk -> Text
forall a. Show a => a -> Text
showT (Header blk -> HeaderHash blk
forall blk. HasHeader (Header blk) => Header blk -> HeaderHash blk
headerHash Header blk
header)
]
ChainSync.TraceWaitingBeyondForecastHorizon 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
"WaitingBeyondForecastHorizon"
, Key
"slotNo" Key -> SlotNo -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
]
ChainSync.TraceAccessingForecastHorizon 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
"AccessingForecastHorizon"
, Key
"slotNo" Key -> SlotNo -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
]
ChainSync.TraceGaveLoPToken Bool
tokenAdded Header blk
header BlockNo
aBlockNo ->
[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
"TraceGaveLoPToken"
, Key
"tokenAdded" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
tokenAdded
, Key
"headerHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk -> Text
forall a. Show a => a -> Text
showT (Header blk -> HeaderHash blk
forall blk. HasHeader (Header blk) => Header blk -> HeaderHash blk
headerHash Header blk
header)
, Key
"blockNo" Key -> BlockNo -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo
aBlockNo
]
ChainSync.TraceOfferJump Point blk
point ->
[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
"TraceOfferJump"
, Key
"point" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Point blk -> Text
forall a. Show a => a -> Text
showT Point blk
point
]
ChainSync.TraceJumpResult JumpResult blk
jumpResult ->
[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
"TraceJumpResult"
, Key
"result" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case JumpResult blk
jumpResult of
AcceptedJump JumpInstruction blk
_ -> Text -> Value
String Text
"AcceptedJump"
RejectedJump JumpInstruction blk
_ -> Text -> Value
String Text
"RejectedJump"
]
TraceChainSyncClientEvent blk
ChainSync.TraceJumpingWaitingForNextInstruction ->
[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
"TraceJumpingWaitingForNextInstruction"
]
ChainSync.TraceJumpingInstructionIs Instruction blk
instruction ->
[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
"TraceJumpingInstructionIs"
, Key
"instr" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Instruction blk -> Object
instructionToObject Instruction blk
instruction
]
ChainSync.TraceDrainingThePipe Nat n
n ->
[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
"TraceDrainingThePipe"
, Key
"n" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Nat n -> Int
forall (n :: N). Nat n -> Int
natToInt Nat n
n
]
where
instructionToObject :: Instruction blk -> Aeson.Object
instructionToObject :: Instruction blk -> Object
instructionToObject = \case
Instruction blk
RunNormally ->
[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
"RunNormally"]
Instruction blk
Restart ->
[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
"Restart"]
JumpInstruction JumpInstruction blk
info ->
[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
"JumpInstruction"
, Key
"payload" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JumpInstruction blk -> Object
jumpInstructionToObject JumpInstruction blk
info
]
jumpInstructionToObject :: JumpInstruction blk -> Aeson.Object
jumpInstructionToObject :: JumpInstruction blk -> Object
jumpInstructionToObject = \case
JumpTo JumpInfo blk
info ->
[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
"JumpTo"
, Key
"point" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Point (HeaderWithTime blk) -> Text
forall a. Show a => a -> Text
showT (JumpInfo blk -> Point (HeaderWithTime blk)
jumpInfoToPoint JumpInfo blk
info)
]
JumpToGoodPoint JumpInfo blk
info ->
[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
"JumpToGoodPoint"
, Key
"point" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Point (HeaderWithTime blk) -> Text
forall a. Show a => a -> Text
showT (JumpInfo blk -> Point (HeaderWithTime blk)
jumpInfoToPoint JumpInfo blk
info)
]
jumpInfoToPoint :: JumpInfo blk -> Point (HeaderWithTime blk)
jumpInfoToPoint = AnchoredFragment (HeaderWithTime blk) -> Point (HeaderWithTime blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint (AnchoredFragment (HeaderWithTime blk)
-> Point (HeaderWithTime blk))
-> (JumpInfo blk -> AnchoredFragment (HeaderWithTime blk))
-> JumpInfo blk
-> Point (HeaderWithTime blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpInfo blk -> AnchoredFragment (HeaderWithTime blk)
forall blk. JumpInfo blk -> AnchoredFragment (HeaderWithTime blk)
jTheirFragment
tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object
tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Object
tipToObject = \case
Tip blk
TipGenesis ->
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
[ Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int
0 :: Int)
, 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 Text
"genesis"
, Key
"blockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ((-Int
1) :: Int)
]
Tip SlotNo
slot HeaderHash blk
hash BlockNo
blockno ->
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
[ Key
"slot" Key -> SlotNo -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
, 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 (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
hash)
, Key
"blockNo" Key -> BlockNo -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo
blockno
]
instance MetaTrace (ChainSync.TraceChainSyncClientEvent blk) where
namespaceFor :: TraceChainSyncClientEvent blk
-> Namespace (TraceChainSyncClientEvent blk)
namespaceFor = \case
ChainSync.TraceDownloadedHeader{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DownloadedHeader"]
ChainSync.TraceRolledBack{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RolledBack"]
ChainSync.TraceException{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Exception"]
ChainSync.TraceFoundIntersection{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FoundIntersection"]
ChainSync.TraceTermination{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Termination"]
ChainSync.TraceValidatedHeader{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedHeader"]
ChainSync.TraceWaitingBeyondForecastHorizon{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WaitingBeyondForecastHorizon"]
ChainSync.TraceAccessingForecastHorizon{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AccessingForecastHorizon"]
ChainSync.TraceGaveLoPToken{} ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GaveLoPToken"]
ChainSync.TraceOfferJump Point blk
_ ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OfferJump"]
ChainSync.TraceJumpResult JumpResult blk
_ ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpResult"]
TraceChainSyncClientEvent blk
ChainSync.TraceJumpingWaitingForNextInstruction ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpingWaitingForNextInstruction"]
ChainSync.TraceJumpingInstructionIs Instruction blk
_ ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpingInstructionIs"]
ChainSync.TraceDrainingThePipe Nat n
_ ->
[Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DrainingThePipe"]
severityFor :: Namespace (TraceChainSyncClientEvent blk)
-> Maybe (TraceChainSyncClientEvent blk) -> Maybe SeverityS
severityFor Namespace (TraceChainSyncClientEvent blk)
ns Maybe (TraceChainSyncClientEvent blk)
_ =
case Namespace (TraceChainSyncClientEvent blk)
ns of
Namespace [Text]
_ [Text
"DownloadedHeader"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"RolledBack"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"Exception"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
Namespace [Text]
_ [Text
"FoundIntersection"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"Termination"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"ValidatedHeader"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"WaitingBeyondForecastHorizon"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"AccessingForecastHorizon"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"GaveLoPToken"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"OfferJump"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"JumpResult"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"JumpingWaitingForNextInstruction"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"JumpingInstructionIs"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"DrainingThePipe"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace (TraceChainSyncClientEvent blk)
_ ->
Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceChainSyncClientEvent blk) -> Maybe Text
documentFor Namespace (TraceChainSyncClientEvent blk)
ns =
case Namespace (TraceChainSyncClientEvent blk)
ns of
Namespace [Text]
_ [Text
"DownloadedHeader"] ->
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
"While following a candidate chain, we rolled forward by downloading a"
, Text
" header."
]
Namespace [Text]
_ [Text
"RolledBack"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"While following a candidate chain, we rolled back to the given point."
Namespace [Text]
_ [Text
"Exception"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"An exception was thrown by the Chain Sync Client."
Namespace [Text]
_ [Text
"FoundIntersection"] ->
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 found an intersection between our chain fragment and the"
, Text
" candidate's chain."
]
Namespace [Text]
_ [Text
"Termination"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The client has terminated."
Namespace [Text]
_ [Text
"ValidatedHeader"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The header has been validated"
Namespace [Text]
_ [Text
"WaitingBeyondForecastHorizon"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The slot number is beyond the forecast horizon"
Namespace [Text]
_ [Text
"AccessingForecastHorizon"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The slot number, which was previously beyond the forecast horizon, has now entered it"
Namespace [Text]
_ [Text
"GaveLoPToken"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"May have added atoken to the LoP bucket of the peer"
Namespace [Text]
_ [Text
"OfferJump"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Offering a jump to the remote peer"
Namespace [Text]
_ [Text
"JumpResult"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Response to a jump offer (accept or reject)"
Namespace [Text]
_ [Text
"JumpingWaitingForNextInstruction"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The client is waiting for the next instruction"
Namespace [Text]
_ [Text
"JumpingInstructionIs"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The client got its next instruction"
Namespace [Text]
_ [Text
"DrainingThePipe"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The client is draining the pipe of messages"
Namespace (TraceChainSyncClientEvent blk)
_ ->
Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceChainSyncClientEvent blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DownloadedHeader"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RolledBack"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Exception"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"FoundIntersection"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Termination"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ValidatedHeader"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WaitingBeyondForecastHorizon"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AccessingForecastHorizon"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GaveLoPToken"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"OfferJump"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpResult"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpingWaitingForNextInstruction"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"JumpingInstructionIs"]
, [Text] -> [Text] -> Namespace (TraceChainSyncClientEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DrainingThePipe"]
]
instance
ConvertRawHash blk =>
LogFormatting (TraceChainSyncServerEvent blk)
where
forMachine :: DetailLevel -> TraceChainSyncServerEvent blk -> Object
forMachine DetailLevel
dtal (TraceChainSyncServerUpdate Tip blk
tip ChainUpdate blk (Point blk)
update BlockingType
blocking Enclosing
enclosing) =
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$
[ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainSyncServer.Update"
, Key
"tip" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tip blk -> Object
forall blk. ConvertRawHash blk => Tip blk -> Object
tipToObject Tip blk
tip
, case ChainUpdate blk (Point blk)
update of
AddBlock Point blk
pt -> Key
"addBlock" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
pt
RollBack Point blk
pt -> Key
"rollBackTo" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
pt
, Key
"blockingRead" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case BlockingType
blocking of BlockingType
Blocking -> Bool
True; BlockingType
NonBlocking -> Bool
False
]
[Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> [Key
"risingEdge" Key -> Bool -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True | Enclosing
RisingEdge <- [Enclosing
enclosing]]
asMetrics :: TraceChainSyncServerEvent blk -> [Metric]
asMetrics (TraceChainSyncServerUpdate Tip blk
_tip (AddBlock Point blk
_pt) BlockingType
_blocking Enclosing
FallingEdge) =
[Text -> Maybe Int -> Metric
CounterM Text
"served.header" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceChainSyncServerUpdate Tip blk
_tip (AddBlock Point blk
_pt) BlockingType
_blocking Enclosing
_) = []
asMetrics TraceChainSyncServerEvent blk
_ = []
instance MetaTrace (TraceChainSyncServerEvent blk) where
namespaceFor :: TraceChainSyncServerEvent blk
-> Namespace (TraceChainSyncServerEvent blk)
namespaceFor TraceChainSyncServerUpdate{} = [Text] -> [Text] -> Namespace (TraceChainSyncServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Update"]
severityFor :: Namespace (TraceChainSyncServerEvent blk)
-> Maybe (TraceChainSyncServerEvent blk) -> Maybe SeverityS
severityFor
(Namespace [Text]
_ [Text
"Update"])
(Just (TraceChainSyncServerUpdate Tip blk
_tip ChainUpdate blk (Point blk)
_upd BlockingType
_blocking Enclosing
enclosing)) =
case Enclosing
enclosing of
Enclosing
RisingEdge -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Enclosing
FallingEdge -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"Update"]) Maybe (TraceChainSyncServerEvent blk)
Nothing = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor Namespace (TraceChainSyncServerEvent blk)
_ Maybe (TraceChainSyncServerEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
metricsDocFor :: Namespace (TraceChainSyncServerEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"Update"]) =
[
( Text
"served.header"
, Text
"A counter triggered only on header event with falling edge"
)
]
metricsDocFor Namespace (TraceChainSyncServerEvent blk)
_ = []
documentFor :: Namespace (TraceChainSyncServerEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"Update"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"A server read has occurred, either for an add block or a rollback"
documentFor Namespace (TraceChainSyncServerEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceChainSyncServerEvent blk)]
allNamespaces = [[Text] -> [Text] -> Namespace (TraceChainSyncServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Update"]]
data CdfCounter = CdfCounter
{ CdfCounter -> Double
limit :: !Double
, CdfCounter -> Int64
counter :: !Int64
}
decCdf :: Double -> CdfCounter -> CdfCounter
decCdf :: Double -> CdfCounter -> CdfCounter
decCdf Double
v cdf :: CdfCounter
cdf@CdfCounter{Double
Int64
limit :: CdfCounter -> Double
counter :: CdfCounter -> Int64
limit :: Double
counter :: Int64
..}
| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
limit = CdfCounter
cdf{counter = counter - 1}
| Bool
otherwise = CdfCounter
cdf
incCdf :: Double -> CdfCounter -> CdfCounter
incCdf :: Double -> CdfCounter -> CdfCounter
incCdf Double
v cdf :: CdfCounter
cdf@CdfCounter{Double
Int64
limit :: CdfCounter -> Double
counter :: CdfCounter -> Int64
limit :: Double
counter :: Int64
..}
| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
limit = CdfCounter
cdf{counter = counter + 1}
| Bool
otherwise = CdfCounter
cdf
data ClientMetrics = ClientMetrics
{ ClientMetrics -> IntPSQ Word64 NominalDiffTime
cmSlotMap :: IntPSQ Word64 NominalDiffTime
, ClientMetrics -> CdfCounter
cmCdf1sVar :: !CdfCounter
, ClientMetrics -> CdfCounter
cmCdf3sVar :: !CdfCounter
, ClientMetrics -> CdfCounter
cmCdf5sVar :: !CdfCounter
, ClientMetrics -> Double
cmDelay :: Double
, ClientMetrics -> Word32
cmBlockSize :: Word32
, ClientMetrics -> Bool
cmTraceIt :: Bool
, ClientMetrics -> Bool
cmTraceVars :: Bool
}
instance LogFormatting ClientMetrics where
forMachine :: DetailLevel -> ClientMetrics -> Object
forMachine DetailLevel
_dtal ClientMetrics
_ = Object
forall a. Monoid a => a
mempty
asMetrics :: ClientMetrics -> [Metric]
asMetrics ClientMetrics{cmTraceIt :: ClientMetrics -> Bool
cmTraceIt = Bool
False} = []
asMetrics ClientMetrics{Bool
Double
Word32
IntPSQ Word64 NominalDiffTime
CdfCounter
cmSlotMap :: ClientMetrics -> IntPSQ Word64 NominalDiffTime
cmCdf1sVar :: ClientMetrics -> CdfCounter
cmCdf3sVar :: ClientMetrics -> CdfCounter
cmCdf5sVar :: ClientMetrics -> CdfCounter
cmDelay :: ClientMetrics -> Double
cmBlockSize :: ClientMetrics -> Word32
cmTraceIt :: ClientMetrics -> Bool
cmTraceVars :: ClientMetrics -> Bool
cmSlotMap :: IntPSQ Word64 NominalDiffTime
cmCdf1sVar :: CdfCounter
cmCdf3sVar :: CdfCounter
cmCdf5sVar :: CdfCounter
cmDelay :: Double
cmBlockSize :: Word32
cmTraceIt :: Bool
cmTraceVars :: Bool
..} =
[ Text -> Double -> Metric
DoubleM Text
"blockfetchclient.blockdelay" Double
cmDelay
, Text -> Integer -> Metric
IntM Text
"blockfetchclient.blocksize" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cmBlockSize)
]
[Metric] -> [Metric] -> [Metric]
forall a. [a] -> [a] -> [a]
++ [Metric]
lateBlockMetric
[Metric] -> [Metric] -> [Metric]
forall a. [a] -> [a] -> [a]
++ if Bool
cmTraceVars
then
[ Text -> CdfCounter -> Metric
cdfMetric Text
"blockfetchclient.blockdelay.cdfOne" CdfCounter
cmCdf1sVar
, Text -> CdfCounter -> Metric
cdfMetric Text
"blockfetchclient.blockdelay.cdfThree" CdfCounter
cmCdf3sVar
, Text -> CdfCounter -> Metric
cdfMetric Text
"blockfetchclient.blockdelay.cdfFive" CdfCounter
cmCdf5sVar
]
else []
where
size :: Int
size = IntPSQ Word64 NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ Word64 NominalDiffTime
cmSlotMap
cdfMetric :: Text -> CdfCounter -> Metric
cdfMetric Text
name CdfCounter
var = Text -> Double -> Metric
DoubleM Text
name (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CdfCounter -> Int64
counter CdfCounter
var) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
lateBlockMetric :: [Metric]
lateBlockMetric = [Text -> Maybe Int -> Metric
CounterM Text
"blockfetchclient.lateblocks" Maybe Int
forall a. Maybe a
Nothing | Double
cmDelay Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
5]
instance MetaTrace ClientMetrics where
namespaceFor :: ClientMetrics -> Namespace ClientMetrics
namespaceFor ClientMetrics
_ = [Text] -> [Text] -> Namespace ClientMetrics
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClientMetrics"]
severityFor :: Namespace ClientMetrics -> Maybe ClientMetrics -> Maybe SeverityS
severityFor Namespace ClientMetrics
_ Maybe ClientMetrics
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
documentFor :: Namespace ClientMetrics -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"ClientMetrics"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Block fetch client metrics, recomputed on every completed block fetch: the\
\ size and delay of the last block, how many fetches ran late, and the\
\ distribution of fetch delays."
documentFor Namespace ClientMetrics
_ = Maybe Text
forall a. Maybe a
Nothing
metricsDocFor :: Namespace ClientMetrics -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"ClientMetrics"]) =
[ (Text
"blockfetchclient.blockdelay", Text
"delay (s) of the latest block fetch")
, (Text
"blockfetchclient.blocksize", Text
"block size (bytes) of the latest block fetch")
, (Text
"blockfetchclient.lateblocks", Text
"number of block fetches that took longer than 5s")
, (Text
"blockfetchclient.blockdelay.cdfOne", Text
"probability for block fetch to complete within 1s")
, (Text
"blockfetchclient.blockdelay.cdfThree", Text
"probability for block fetch to complete within 3s")
, (Text
"blockfetchclient.blockdelay.cdfFive", Text
"probability for block fetch to complete within 5s")
]
metricsDocFor Namespace ClientMetrics
_ = []
allNamespaces :: [Namespace ClientMetrics]
allNamespaces =
[ [Text] -> [Text] -> Namespace ClientMetrics
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClientMetrics"]
]
initialClientMetrics :: ClientMetrics
initialClientMetrics :: ClientMetrics
initialClientMetrics =
IntPSQ Word64 NominalDiffTime
-> CdfCounter
-> CdfCounter
-> CdfCounter
-> Double
-> Word32
-> Bool
-> Bool
-> ClientMetrics
ClientMetrics
IntPSQ Word64 NominalDiffTime
forall p v. IntPSQ p v
Pq.empty
(Double -> Int64 -> CdfCounter
CdfCounter Double
1 Int64
0)
(Double -> Int64 -> CdfCounter
CdfCounter Double
3 Int64
0)
(Double -> Int64 -> CdfCounter
CdfCounter Double
5 Int64
0)
Double
0
Word32
0
Bool
False
Bool
False
calculateBlockFetchClientMetrics ::
ClientMetrics ->
LoggingContext ->
BlockFetch.TraceLabelPeer peer (BlockFetch.TraceFetchClientState header) ->
ClientMetrics
calculateBlockFetchClientMetrics :: forall peer header.
ClientMetrics
-> LoggingContext
-> TraceLabelPeer peer (TraceFetchClientState header)
-> ClientMetrics
calculateBlockFetchClientMetrics
cm :: ClientMetrics
cm@ClientMetrics{Bool
Double
Word32
IntPSQ Word64 NominalDiffTime
CdfCounter
cmSlotMap :: ClientMetrics -> IntPSQ Word64 NominalDiffTime
cmCdf1sVar :: ClientMetrics -> CdfCounter
cmCdf3sVar :: ClientMetrics -> CdfCounter
cmCdf5sVar :: ClientMetrics -> CdfCounter
cmDelay :: ClientMetrics -> Double
cmBlockSize :: ClientMetrics -> Word32
cmTraceIt :: ClientMetrics -> Bool
cmTraceVars :: ClientMetrics -> Bool
cmSlotMap :: IntPSQ Word64 NominalDiffTime
cmCdf1sVar :: CdfCounter
cmCdf3sVar :: CdfCounter
cmCdf5sVar :: CdfCounter
cmDelay :: Double
cmBlockSize :: Word32
cmTraceIt :: Bool
cmTraceVars :: Bool
..}
LoggingContext
_lc
(TraceLabelPeer peer
_ (BlockFetch.CompletedBlockFetch Point header
p PeerFetchInFlight header
_ PeerFetchInFlightLimits
_ PeerFetchStatus header
_ NominalDiffTime
forgeDelay SizeInBytes
blockSize)) =
case Point header -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point header
p of
WithOrigin SlotNo
Origin -> ClientMetrics
nothingToDo
At (SlotNo Word64
slotNo) ->
if IntPSQ Word64 NominalDiffTime -> Bool
forall p v. IntPSQ p v -> Bool
Pq.null IntPSQ Word64 NominalDiffTime
cmSlotMap Bool -> Bool -> Bool
&& NominalDiffTime
forgeDelay NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
20
then ClientMetrics
nothingToDo
else Word64 -> ClientMetrics
processSlot Word64
slotNo
where
nothingToDo :: ClientMetrics
nothingToDo = ClientMetrics
cm{cmTraceIt = False}
delay :: Double
delay = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
forgeDelay
processSlot :: Word64 -> ClientMetrics
processSlot Word64
slotNo
| Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotNo Int -> IntPSQ Word64 NominalDiffTime -> Bool
forall p v. Int -> IntPSQ p v -> Bool
`Pq.member` IntPSQ Word64 NominalDiffTime
cmSlotMap = ClientMetrics
nothingToDo
| Bool
otherwise =
let slotMap' :: IntPSQ Word64 NominalDiffTime
slotMap' = Int
-> Word64
-> NominalDiffTime
-> IntPSQ Word64 NominalDiffTime
-> IntPSQ Word64 NominalDiffTime
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
Pq.insert (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotNo) Word64
slotNo NominalDiffTime
forgeDelay IntPSQ Word64 NominalDiffTime
cmSlotMap
in if IntPSQ Word64 NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ Word64 NominalDiffTime
slotMap' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1080
then IntPSQ Word64 NominalDiffTime -> Word64 -> ClientMetrics
trimSlotMap IntPSQ Word64 NominalDiffTime
slotMap' Word64
slotNo
else IntPSQ Word64 NominalDiffTime -> ClientMetrics
updateMetrics IntPSQ Word64 NominalDiffTime
slotMap'
trimSlotMap :: IntPSQ Word64 NominalDiffTime -> Word64 -> ClientMetrics
trimSlotMap IntPSQ Word64 NominalDiffTime
slotMap' Word64
slotNo = case IntPSQ Word64 NominalDiffTime
-> Maybe
(Int, Word64, NominalDiffTime, IntPSQ Word64 NominalDiffTime)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
Pq.minView IntPSQ Word64 NominalDiffTime
slotMap' of
Maybe (Int, Word64, NominalDiffTime, IntPSQ Word64 NominalDiffTime)
Nothing -> ClientMetrics
nothingToDo
Just (Int
_, Word64
minSlotNo, NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> Double
minDelay, IntPSQ Word64 NominalDiffTime
slotMap'')
| Word64
minSlotNo Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
slotNo -> ClientMetrics
nothingToDo
| Bool
otherwise ->
ClientMetrics
cm
{ cmCdf1sVar = adjust minDelay cmCdf1sVar
, cmCdf3sVar = adjust minDelay cmCdf3sVar
, cmCdf5sVar = adjust minDelay cmCdf5sVar
, cmDelay = delay
, cmBlockSize = getSizeInBytes blockSize
, cmTraceVars = True
, cmTraceIt = True
, cmSlotMap = slotMap''
}
updateMetrics :: IntPSQ Word64 NominalDiffTime -> ClientMetrics
updateMetrics IntPSQ Word64 NominalDiffTime
slotMap' =
ClientMetrics
cm
{ cmCdf1sVar = update cmCdf1sVar
, cmCdf3sVar = update cmCdf3sVar
, cmCdf5sVar = update cmCdf5sVar
, cmDelay = delay
, cmBlockSize = getSizeInBytes blockSize
, cmTraceVars = Pq.size cmSlotMap >= 45
, cmTraceIt = True
, cmSlotMap = slotMap'
}
update :: CdfCounter -> CdfCounter
update = Double -> CdfCounter -> CdfCounter
incCdf Double
delay
adjust :: Double -> CdfCounter -> CdfCounter
adjust Double
d = CdfCounter -> CdfCounter
update (CdfCounter -> CdfCounter)
-> (CdfCounter -> CdfCounter) -> CdfCounter -> CdfCounter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CdfCounter -> CdfCounter
decCdf Double
d
calculateBlockFetchClientMetrics ClientMetrics
cm LoggingContext
_lc TraceLabelPeer peer (TraceFetchClientState header)
_ = ClientMetrics
cm
instance MetaTrace (TraceDecisionEvent peer (Header blk)) where
namespaceFor :: TraceDecisionEvent peer (Header blk)
-> Namespace (TraceDecisionEvent peer (Header blk))
namespaceFor PeersFetch{} = [Text]
-> [Text] -> Namespace (TraceDecisionEvent peer (Header blk))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeersFetch"]
namespaceFor PeerStarvedUs{} = [Text]
-> [Text] -> Namespace (TraceDecisionEvent peer (Header blk))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeerStarvedUs"]
severityFor :: Namespace (TraceDecisionEvent peer (Header blk))
-> Maybe (TraceDecisionEvent peer (Header blk)) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"PeersFetch"]) Maybe (TraceDecisionEvent peer (Header blk))
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"PeerStarvedUs"]) Maybe (TraceDecisionEvent peer (Header blk))
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor Namespace (TraceDecisionEvent peer (Header blk))
_ Maybe (TraceDecisionEvent peer (Header blk))
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceDecisionEvent peer (Header blk)) -> Maybe Text
documentFor (Namespace [] [Text
"PeersFetch"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"list of block-fetch decisions"
documentFor (Namespace [] [Text
"PeerStarvedUs"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"current peer starved us, the node will switch to a different peer"
documentFor Namespace (TraceDecisionEvent peer (Header blk))
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceDecisionEvent peer (Header blk))]
allNamespaces =
[[Text]
-> [Text] -> Namespace (TraceDecisionEvent peer (Header blk))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeersFetch"], [Text]
-> [Text] -> Namespace (TraceDecisionEvent peer (Header blk))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeerStarvedUs"]]
instance
(Show peer, ToJSON peer, LogFormatting peer, HasHeader blk) =>
LogFormatting (TraceDecisionEvent peer (Header blk))
where
forHuman :: TraceDecisionEvent peer (Header blk) -> Text
forHuman = String -> Text
Text.pack (String -> Text)
-> (TraceDecisionEvent peer (Header blk) -> String)
-> TraceDecisionEvent peer (Header blk)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceDecisionEvent peer (Header blk) -> String
forall a. Show a => a -> String
show
forMachine :: DetailLevel -> TraceDecisionEvent peer (Header blk) -> Object
forMachine DetailLevel
dtal (PeersFetch [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
xs) =
[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
"PeerFetch"
, Key
"decisions" Key -> [Object] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TraceLabelPeer peer (FetchDecision [Point (Header blk)])
-> Object)
-> [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel
-> TraceLabelPeer peer (FetchDecision [Point (Header blk)])
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
xs
]
forMachine DetailLevel
_dtal (PeerStarvedUs peer
peer) =
[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
"PeerStarvedUs"
, Key
"peer" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= peer -> Value
forall a. ToJSON a => a -> Value
toJSON peer
peer
]
instance LogFormatting (FetchDecision [Point header]) where
forMachine :: DetailLevel -> FetchDecision [Point header] -> Object
forMachine DetailLevel
_dtal (Left FetchDecline
decline) =
[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
"FetchDecision declined"
, Key
"declined" 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 (FetchDecline -> Text
forall a. Show a => a -> Text
showT FetchDecline
decline)
]
forMachine DetailLevel
_dtal (Right [Point header]
results) =
[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
"FetchDecision results"
, Key
"length" 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 (Int -> Text
forall a. Show a => a -> Text
showT (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Point header] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point header]
results)
]
instance
(HasHeader header, ConvertRawHash header) =>
LogFormatting (BlockFetch.TraceFetchClientState header)
where
forMachine :: DetailLevel -> TraceFetchClientState header -> Object
forMachine DetailLevel
_dtal BlockFetch.AddedFetchRequest{} =
[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
"AddedFetchRequest"]
forMachine DetailLevel
_dtal BlockFetch.AcknowledgedFetchRequest{} =
[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
"AcknowledgedFetchRequest"]
forMachine DetailLevel
dtal (BlockFetch.SendFetchRequest AnchoredFragment header
af PeerGSV
gsv) =
[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
"SendFetchRequest"
, Key
"head"
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 header -> Text) -> ChainHash header -> Text
forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash
(Proxy header -> HeaderHash header -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @header))
(AnchoredFragment header -> ChainHash header
forall block.
HasHeader block =>
AnchoredFragment block -> ChainHash block
AF.headHash AnchoredFragment header
af)
)
, Key
"length" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (AnchoredFragment header -> Int
fragmentLength' AnchoredFragment header
af)
]
[Object] -> [Object] -> [Object]
forall a. [a] -> [a] -> [a]
++ [Key
"deltaq" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PeerGSV -> Value
forall a. ToJSON a => a -> Value
toJSON PeerGSV
gsv | DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DDetailed]
where
fragmentLength' :: AF.AnchoredFragment header -> Int
fragmentLength' :: AnchoredFragment header -> Int
fragmentLength' AnchoredFragment header
f = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (BlockNo -> Word64) -> BlockNo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNo -> Word64
unBlockNo (BlockNo -> Int) -> BlockNo -> Int
forall a b. (a -> b) -> a -> b
$
case (AnchoredFragment header
f, AnchoredFragment header
f) of
(AS.Empty{}, AS.Empty{}) -> BlockNo
0
(header
firstHdr AS.:< AnchoredFragment header
_, AnchoredFragment header
_ AS.:> header
lastHdr) ->
header -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo header
lastHdr BlockNo -> BlockNo -> BlockNo
forall a. Num a => a -> a -> a
- header -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo header
firstHdr BlockNo -> BlockNo -> BlockNo
forall a. Num a => a -> a -> a
+ BlockNo
1
forMachine DetailLevel
_dtal (BlockFetch.CompletedBlockFetch Point header
pt PeerFetchInFlight header
_ PeerFetchInFlightLimits
_ PeerFetchStatus header
_ NominalDiffTime
delay SizeInBytes
blockSize) =
[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
"CompletedBlockFetch"
, Key
"delay" 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 b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
delay :: Double)
, Key
"size" Key -> Word32 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SizeInBytes -> Word32
getSizeInBytes SizeInBytes
blockSize
, 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
( case Point header
pt of
Point header
GenesisPoint -> Text
"Genesis"
BlockPoint SlotNo
_ HeaderHash header
h -> Proxy header -> HeaderHash header -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @header) HeaderHash header
h
)
]
forMachine DetailLevel
_dtal BlockFetch.CompletedFetchBatch{} =
[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
"CompletedFetchBatch"]
forMachine DetailLevel
_dtal BlockFetch.StartedFetchBatch{} =
[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
"StartedFetchBatch"]
forMachine DetailLevel
_dtal BlockFetch.RejectedFetchBatch{} =
[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
"RejectedFetchBatch"]
forMachine DetailLevel
_dtal (BlockFetch.ClientTerminating Int
outstanding) =
[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
"ClientTerminating"
, Key
"outstanding" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
outstanding
]
instance MetaTrace (BlockFetch.TraceFetchClientState header) where
namespaceFor :: TraceFetchClientState header
-> Namespace (TraceFetchClientState header)
namespaceFor BlockFetch.AddedFetchRequest{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedFetchRequest"]
namespaceFor BlockFetch.AcknowledgedFetchRequest{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AcknowledgedFetchRequest"]
namespaceFor BlockFetch.SendFetchRequest{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendFetchRequest"]
namespaceFor BlockFetch.StartedFetchBatch{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedFetchBatch"]
namespaceFor BlockFetch.CompletedFetchBatch{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CompletedFetchBatch"]
namespaceFor BlockFetch.CompletedBlockFetch{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CompletedBlockFetch"]
namespaceFor BlockFetch.RejectedFetchBatch{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedFetchBatch"]
namespaceFor BlockFetch.ClientTerminating{} =
[Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClientTerminating"]
severityFor :: Namespace (TraceFetchClientState header)
-> Maybe (TraceFetchClientState header) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"AddedFetchRequest"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"AcknowledgedFetchRequest"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"SendFetchRequest"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"StartedFetchBatch"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"CompletedFetchBatch"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"CompletedBlockFetch"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"RejectedFetchBatch"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"ClientTerminating"]) Maybe (TraceFetchClientState header)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
severityFor Namespace (TraceFetchClientState header)
_ Maybe (TraceFetchClientState header)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceFetchClientState header) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"AddedFetchRequest"]) =
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 fetch decision thread has added a new fetch instruction"
, Text
" consisting of one or more individual request ranges."
]
documentFor (Namespace [Text]
_ [Text
"AcknowledgedFetchRequest"]) =
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
"Mark the point when the fetch client picks up the request added"
, Text
" by the block fetch decision thread. Note that this event can happen"
, Text
" fewer times than the 'AddedFetchRequest' due to fetch request merging."
]
documentFor (Namespace [Text]
_ [Text
"SendFetchRequest"]) =
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
"Mark the point when fetch request for a fragment is actually sent"
, Text
" over the wire."
]
documentFor (Namespace [Text]
_ [Text
"StartedFetchBatch"]) =
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
"Mark the start of receiving a streaming batch of blocks. This will"
, Text
" be followed by one or more 'CompletedBlockFetch' and a final"
, Text
" 'CompletedFetchBatch'"
]
documentFor (Namespace [Text]
_ [Text
"CompletedFetchBatch"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Mark the successful end of receiving a streaming batch of blocks."
documentFor (Namespace [Text]
_ [Text
"CompletedBlockFetch"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
""
documentFor (Namespace [Text]
_ [Text
"RejectedFetchBatch"]) =
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
"If the other peer rejects our request then we have this event"
, Text
" instead of 'StartedFetchBatch' and 'CompletedFetchBatch'."
]
documentFor (Namespace [Text]
_ [Text
"ClientTerminating"]) =
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 client is terminating. Log the number of outstanding"
, Text
" requests."
]
documentFor Namespace (TraceFetchClientState header)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceFetchClientState header)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedFetchRequest"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AcknowledgedFetchRequest"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendFetchRequest"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartedFetchBatch"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CompletedFetchBatch"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CompletedBlockFetch"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedFetchBatch"]
, [Text] -> [Text] -> Namespace (TraceFetchClientState header)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ClientTerminating"]
]
instance ConvertRawHash blk => LogFormatting (TraceBlockFetchServerEvent blk) where
forMachine :: DetailLevel -> TraceBlockFetchServerEvent blk -> Object
forMachine DetailLevel
_dtal (TraceBlockFetchServerSendBlock Point blk
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
"BlockFetchServer"
, 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
( forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash
@blk
(Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk))
(ChainHash blk -> Text) -> ChainHash blk -> Text
forall a b. (a -> b) -> a -> b
$ Point blk -> ChainHash blk
forall {k} (block :: k). Point block -> ChainHash block
pointHash Point blk
blk
)
]
asMetrics :: TraceBlockFetchServerEvent blk -> [Metric]
asMetrics (TraceBlockFetchServerSendBlock Point blk
_p) =
[Text -> Maybe Int -> Metric
CounterM Text
"served.block" Maybe Int
forall a. Maybe a
Nothing]
instance MetaTrace (TraceBlockFetchServerEvent blk) where
namespaceFor :: TraceBlockFetchServerEvent blk
-> Namespace (TraceBlockFetchServerEvent blk)
namespaceFor TraceBlockFetchServerSendBlock{} =
[Text] -> [Text] -> Namespace (TraceBlockFetchServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendBlock"]
severityFor :: Namespace (TraceBlockFetchServerEvent blk)
-> Maybe (TraceBlockFetchServerEvent blk) -> Maybe SeverityS
severityFor (Namespace [] [Text
"SendBlock"]) Maybe (TraceBlockFetchServerEvent blk)
_ =
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just
SeverityS
Info
severityFor Namespace (TraceBlockFetchServerEvent blk)
_ Maybe (TraceBlockFetchServerEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
metricsDocFor :: Namespace (TraceBlockFetchServerEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [] [Text
"SendBlock"]) =
[ (Text
"served.block", Text
"This counter metric indicates how many blocks this node has served.")
,
( Text
"served.block.latest"
, Text
"This counter metric indicates how many chain tip blocks this node has served."
)
]
metricsDocFor Namespace (TraceBlockFetchServerEvent blk)
_ = []
documentFor :: Namespace (TraceBlockFetchServerEvent blk) -> Maybe Text
documentFor (Namespace [] [Text
"SendBlock"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The server sent a block to the peer."
documentFor Namespace (TraceBlockFetchServerEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceBlockFetchServerEvent blk)]
allNamespaces = [[Text] -> [Text] -> Namespace (TraceBlockFetchServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendBlock"]]
data ServedBlock = ServedBlock
{ ServedBlock -> SlotNo
maxSlotNo :: SlotNo
, ServedBlock -> Word64
localUp :: Word64
, ServedBlock -> Word64
servedBlocksLatest :: Word64
}
instance LogFormatting ServedBlock where
forMachine :: DetailLevel -> ServedBlock -> Object
forMachine DetailLevel
_mDtal ServedBlock{} = Object
forall a. Monoid a => a
mempty
asMetrics :: ServedBlock -> [Metric]
asMetrics ServedBlock{Word64
SlotNo
maxSlotNo :: ServedBlock -> SlotNo
localUp :: ServedBlock -> Word64
servedBlocksLatest :: ServedBlock -> Word64
maxSlotNo :: SlotNo
localUp :: Word64
servedBlocksLatest :: Word64
..} =
[Text -> Integer -> Metric
IntM Text
"served.block.latest" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
servedBlocksLatest)]
emptyServedBlocks :: ServedBlock
emptyServedBlocks :: ServedBlock
emptyServedBlocks = SlotNo -> Word64 -> Word64 -> ServedBlock
ServedBlock SlotNo
0 Word64
0 Word64
0
servedBlockLatest ::
Maybe (Trace IO FormattedMessage) ->
IO (Trace IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk)))
servedBlockLatest :: forall peer blk.
Maybe (Trace IO FormattedMessage)
-> IO
(Trace IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk)))
servedBlockLatest Maybe (Trace IO FormattedMessage)
mbTrEKG =
(ServedBlock
-> LoggingContext
-> TraceLabelPeer peer (TraceBlockFetchServerEvent blk)
-> IO ServedBlock)
-> ServedBlock
-> Trace
IO
(Folding
(TraceLabelPeer peer (TraceBlockFetchServerEvent blk)) ServedBlock)
-> IO
(Trace IO (TraceLabelPeer peer (TraceBlockFetchServerEvent blk)))
forall a acc (m :: * -> *).
MonadUnliftIO m =>
(acc -> LoggingContext -> a -> m acc)
-> acc -> Trace m (Folding a acc) -> m (Trace m a)
foldTraceM
ServedBlock
-> LoggingContext
-> TraceLabelPeer peer (TraceBlockFetchServerEvent blk)
-> IO ServedBlock
forall (m :: * -> *) peer blk.
Monad m =>
ServedBlock
-> LoggingContext
-> TraceLabelPeer peer (TraceBlockFetchServerEvent blk)
-> m ServedBlock
calculateServedBlockLatest
ServedBlock
emptyServedBlocks
( Trace IO FormattedMessage
-> Trace
IO
(Folding
(TraceLabelPeer peer (TraceBlockFetchServerEvent blk)) ServedBlock)
forall a (m :: * -> *).
(LogFormatting a, MonadIO m) =>
Trace m FormattedMessage -> Trace m a
metricsFormatter
(Maybe (Trace IO FormattedMessage) -> Trace IO FormattedMessage
mkMetricsTracer Maybe (Trace IO FormattedMessage)
mbTrEKG)
)
calculateServedBlockLatest ::
Monad m =>
ServedBlock ->
LoggingContext ->
TraceLabelPeer peer (TraceBlockFetchServerEvent blk) ->
m ServedBlock
calculateServedBlockLatest :: forall (m :: * -> *) peer blk.
Monad m =>
ServedBlock
-> LoggingContext
-> TraceLabelPeer peer (TraceBlockFetchServerEvent blk)
-> m ServedBlock
calculateServedBlockLatest ServedBlock{Word64
SlotNo
maxSlotNo :: ServedBlock -> SlotNo
localUp :: ServedBlock -> Word64
servedBlocksLatest :: ServedBlock -> Word64
maxSlotNo :: SlotNo
localUp :: Word64
servedBlocksLatest :: Word64
..} LoggingContext
_lc (TraceLabelPeer peer
_ (TraceBlockFetchServerSendBlock Point blk
p)) =
case Point blk -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point blk
p of
WithOrigin SlotNo
Origin -> ServedBlock -> m ServedBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServedBlock -> m ServedBlock) -> ServedBlock -> m ServedBlock
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64 -> Word64 -> ServedBlock
ServedBlock SlotNo
maxSlotNo Word64
localUp Word64
servedBlocksLatest
At SlotNo
slotNo ->
case SlotNo -> SlotNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SlotNo
maxSlotNo SlotNo
slotNo of
Ordering
LT -> ServedBlock -> m ServedBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServedBlock -> m ServedBlock) -> ServedBlock -> m ServedBlock
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64 -> Word64 -> ServedBlock
ServedBlock SlotNo
slotNo (Word64
localUp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (Word64
localUp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
Ordering
GT -> ServedBlock -> m ServedBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServedBlock -> m ServedBlock) -> ServedBlock -> m ServedBlock
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64 -> Word64 -> ServedBlock
ServedBlock SlotNo
maxSlotNo Word64
localUp Word64
servedBlocksLatest
Ordering
EQ -> ServedBlock -> m ServedBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ServedBlock -> m ServedBlock) -> ServedBlock -> m ServedBlock
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64 -> Word64 -> ServedBlock
ServedBlock SlotNo
maxSlotNo (Word64
localUp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (Word64
localUp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
instance
( LogFormatting peer
, HasHeader (Header blk)
, ConvertRawHash (Header blk)
) =>
LogFormatting (TraceGDDEvent peer blk)
where
forMachine :: DetailLevel -> TraceGDDEvent peer blk -> Object
forMachine DetailLevel
dtal (TraceGDDDebug (GDDDebugInfo{[peer]
[(peer, DensityBounds blk)]
[(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
GenesisWindow
AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
Anchor (Header blk)
bounds :: [(peer, DensityBounds blk)]
curChain :: AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
candidates :: [(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
candidateSuffixes :: [(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
losingPeers :: [peer]
loeHead :: Anchor (Header blk)
sgen :: GenesisWindow
bounds :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, DensityBounds blk)]
candidateSuffixes :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, AnchoredFragment (Header blk))]
candidates :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, AnchoredFragment (Header blk))]
curChain :: forall peer blk.
GDDDebugInfo peer blk -> AnchoredFragment (Header blk)
loeHead :: forall peer blk. GDDDebugInfo peer blk -> Anchor (Header blk)
losingPeers :: forall peer blk. GDDDebugInfo peer blk -> [peer]
sgen :: forall peer blk. GDDDebugInfo peer blk -> GenesisWindow
..})) =
[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
"TraceGDDDebugInfo"
, Key
"losingPeers" 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 ((peer -> Object) -> [peer] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) [peer]
losingPeers)
, Key
"loeHead" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Anchor (Header blk) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal Anchor (Header blk)
loeHead
, Key
"sgen" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (GenesisWindow -> Word64
unGenesisWindow GenesisWindow
sgen)
]
[Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> do
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DMaximum
[ Key
"bounds"
Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON
( ((peer, DensityBounds blk) -> Value)
-> [(peer, DensityBounds blk)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
( \(peer
peer, DensityBounds blk
density) ->
[(Key, Value)] -> Value
Aeson.object
[ Key
"kind" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PeerDensityBound"
, Key
"peer" 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 -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
peer
, Key
"densityBounds" 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 -> DensityBounds blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal DensityBounds blk
density
]
)
[(peer, DensityBounds blk)]
bounds
)
, Key
"curChain" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel
-> AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
curChain
, Key
"candidates"
Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON
( ((peer,
AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
-> Value)
-> [(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
( \(peer
peer, AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
frag) ->
[(Key, Value)] -> Value
Aeson.object
[ Key
"kind" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PeerCandidateFragment"
, Key
"peer" 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 -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
peer
, Key
"candidateFragment" 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
-> AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
frag
]
)
[(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
candidates
)
, Key
"candidateSuffixes"
Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON
( ((peer,
AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
-> Value)
-> [(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
( \(peer
peer, AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
frag) ->
[(Key, Value)] -> Value
Aeson.object
[ Key
"kind" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PeerCandidateSuffix"
, Key
"peer" 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 -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
peer
, Key
"candidateSuffix" 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
-> AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
frag
]
)
[(peer,
AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))]
candidateSuffixes
)
]
forMachine DetailLevel
dtal (TraceGDDDisconnected NonEmpty peer
peers) =
[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
"TraceGDDDisconnected"
, Key
"peers" 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 ((peer -> Object) -> [peer] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) (NonEmpty peer -> [peer]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty peer
peers))
]
instance MetaTrace (TraceGDDEvent peer blk) where
namespaceFor :: TraceGDDEvent peer blk -> Namespace (TraceGDDEvent peer blk)
namespaceFor TraceGDDEvent peer blk
_ = [Text] -> [Text] -> Namespace (TraceGDDEvent peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceGDDEvent"]
severityFor :: Namespace (TraceGDDEvent peer blk)
-> Maybe (TraceGDDEvent peer blk) -> Maybe SeverityS
severityFor Namespace (TraceGDDEvent peer blk)
_ Maybe (TraceGDDEvent peer blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
documentFor :: Namespace (TraceGDDEvent peer blk) -> Maybe Text
documentFor Namespace (TraceGDDEvent peer blk)
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The Genesis Density Disconnection governor has updated its state"
allNamespaces :: [Namespace (TraceGDDEvent peer blk)]
allNamespaces = [[Text] -> [Text] -> Namespace (TraceGDDEvent peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceGDDEvent"]]
instance
( HasHeader (Header blk)
, ConvertRawHash (Header blk)
) =>
LogFormatting (DensityBounds blk)
where
forMachine :: DetailLevel -> DensityBounds blk -> Object
forMachine DetailLevel
dtal DensityBounds{Bool
Word64
WithOrigin SlotNo
AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
clippedFragment :: AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
offersMoreThanK :: Bool
lowerBound :: Word64
upperBound :: Word64
hasBlockAfter :: Bool
latestSlot :: WithOrigin SlotNo
idling :: Bool
clippedFragment :: forall blk. DensityBounds blk -> AnchoredFragment (Header blk)
hasBlockAfter :: forall blk. DensityBounds blk -> Bool
idling :: forall blk. DensityBounds blk -> Bool
latestSlot :: forall blk. DensityBounds blk -> WithOrigin SlotNo
lowerBound :: forall blk. DensityBounds blk -> Word64
offersMoreThanK :: forall blk. DensityBounds blk -> Bool
upperBound :: forall blk. DensityBounds blk -> Word64
..} =
[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
"DensityBounds"
, Key
"clippedFragment" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel
-> AnchoredSeq
(WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
clippedFragment
, Key
"offersMoreThanK" 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 Bool
offersMoreThanK
, Key
"lowerBound" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
lowerBound
, Key
"upperBound" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
upperBound
, Key
"hasBlockAfter" 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 Bool
hasBlockAfter
, Key
"latestSlot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> Maybe SlotNo -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin SlotNo -> Maybe SlotNo
forall t. WithOrigin t -> Maybe t
withOriginToMaybe WithOrigin SlotNo
latestSlot)
, Key
"idling" 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 Bool
idling
]
instance MetaTrace SanityCheckIssue where
namespaceFor :: SanityCheckIssue -> Namespace SanityCheckIssue
namespaceFor SanityCheckIssue
_ = [Text] -> [Text] -> Namespace SanityCheckIssue
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SanityCheckIssue"]
severityFor :: Namespace SanityCheckIssue
-> Maybe SanityCheckIssue -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"SanityCheckIssue"]) Maybe SanityCheckIssue
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor Namespace SanityCheckIssue
_ Maybe SanityCheckIssue
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace SanityCheckIssue -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"SanityCheckIssue"]) =
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 sanity check on the node configuration found a suspicious setting at"
, Text
" startup. The `kind` field names the check that fired:"
, Text
" `InconsistentSecurityParam`, `SnapshotDelayRangeInverted`,"
, Text
" `SnapshotDelayRangeNegativeMinimum`, `SnapshotRateLimitDisabled`,"
, Text
" `SnapshotRateLimitSuspiciouslyLarge`, `SnapshotNumZero` or"
, Text
" `SnapshotIntervalNotDivisorOfEpoch`. These flag configurations that are"
, Text
" legal but almost certainly unintended; the node continues to run."
]
documentFor Namespace SanityCheckIssue
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace SanityCheckIssue]
allNamespaces = [[Text] -> [Text] -> Namespace SanityCheckIssue
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SanityCheckIssue"]]
instance LogFormatting SanityCheckIssue where
forMachine :: DetailLevel -> SanityCheckIssue -> Object
forMachine DetailLevel
_dtal (InconsistentSecurityParam NonEmpty SecurityParam
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
"InconsistentSecurityParam"
, 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 (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty SecurityParam -> String
forall a. Show a => a -> String
show NonEmpty SecurityParam
e)
]
forMachine DetailLevel
_dtal (SnapshotDelayRangeInverted DiffTime
mn DiffTime
mx) =
[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
"SnapshotDelayRangeInverted"
, Key
"minimumDelay" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
mn
, Key
"maximumDelay" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
mx
]
forMachine DetailLevel
_dtal (SnapshotDelayRangeNegativeMinimum DiffTime
mn) =
[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
"SnapshotDelayRangeNegativeMinimum"
, Key
"minimumDelay" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
mn
]
forMachine DetailLevel
_dtal SanityCheckIssue
SnapshotRateLimitDisabled =
[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
"SnapshotRateLimitDisabled"
]
forMachine DetailLevel
_dtal (SnapshotRateLimitSuspiciouslyLarge DiffTime
rl) =
[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
"SnapshotRateLimitSuspiciouslyLarge"
, Key
"rateLimit" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
rl
]
forMachine DetailLevel
_dtal SanityCheckIssue
SnapshotNumZero =
[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
"SnapshotNumZero"
]
forMachine DetailLevel
_dtal (SnapshotIntervalNotDivisorOfEpoch Word64
interval) =
[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
"SnapshotIntervalNotDivisorOfEpoch"
, Key
"interval" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
interval
]
forHuman :: SanityCheckIssue -> Text
forHuman = String -> Text
Text.pack (String -> Text)
-> (SanityCheckIssue -> String) -> SanityCheckIssue -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SanityCheckIssue -> String
forall e. Exception e => e -> String
displayException
instance LogFormatting (TraceLocalTxSubmissionServerEvent blk) where
forMachine :: DetailLevel -> TraceLocalTxSubmissionServerEvent blk -> Object
forMachine DetailLevel
_dtal (TraceReceivedTx GenTx blk
_gtx) =
[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
"ReceivedTx"]
instance MetaTrace (TraceLocalTxSubmissionServerEvent blk) where
namespaceFor :: TraceLocalTxSubmissionServerEvent blk
-> Namespace (TraceLocalTxSubmissionServerEvent blk)
namespaceFor TraceReceivedTx{} =
[Text]
-> [Text] -> Namespace (TraceLocalTxSubmissionServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReceivedTx"]
severityFor :: Namespace (TraceLocalTxSubmissionServerEvent blk)
-> Maybe (TraceLocalTxSubmissionServerEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"ReceivedTx"]) Maybe (TraceLocalTxSubmissionServerEvent blk)
_ =
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor Namespace (TraceLocalTxSubmissionServerEvent blk)
_ Maybe (TraceLocalTxSubmissionServerEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceLocalTxSubmissionServerEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"ReceivedTx"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"A transaction was received."
documentFor Namespace (TraceLocalTxSubmissionServerEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceLocalTxSubmissionServerEvent blk)]
allNamespaces =
[ [Text]
-> [Text] -> Namespace (TraceLocalTxSubmissionServerEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ReceivedTx"]
]
txsMempoolTimeoutSoftCounterName :: Text.Text
txsMempoolTimeoutSoftCounterName :: Text
txsMempoolTimeoutSoftCounterName = Text
"txsMempoolTimeoutSoft"
txsSyncDurationTotalCounterName :: Text.Text
txsSyncDurationTotalCounterName :: Text
txsSyncDurationTotalCounterName = Text
"txsSyncDurationTotal"
impliesMempoolTimeoutSoft :: TraceEventMempool blk -> Bool
impliesMempoolTimeoutSoft :: forall blk. TraceEventMempool blk -> Bool
impliesMempoolTimeoutSoft = \case
TraceMempoolRejectedTx GenTx blk
_tx ApplyTxErr blk
_txApplyErr MempoolRejectionDetails
details MempoolSize
_mpSz ->
case MempoolRejectionDetails
details of
MempoolRejectedByTimeoutSoft{} -> Bool
True
MempoolRejectionDetails
MempoolRejectedByLedger -> Bool
False
TraceEventMempool blk
_ -> Bool
False
instance
( LogFormatting (ApplyTxErr blk)
, LogFormatting (GenTx blk)
, ConvertTxId blk
, LedgerSupportsMempool blk
, ConvertRawHash blk
) =>
LogFormatting (TraceEventMempool blk)
where
forMachine :: DetailLevel -> TraceEventMempool blk -> Object
forMachine DetailLevel
dtal (TraceMempoolAddedTx Validated (GenTx blk)
tx MempoolSize
_mpSzBefore MempoolSize
mpSzAfter) =
[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
"TraceMempoolAddedTx"
, Key
"tx" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> GenTx blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated Validated (GenTx blk)
tx)
, Key
"mempoolSize" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> MempoolSize -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal MempoolSize
mpSzAfter
]
forMachine DetailLevel
dtal (TraceMempoolRejectedTx GenTx blk
tx ApplyTxErr blk
txApplyErr MempoolRejectionDetails
details MempoolSize
mpSz) =
[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
"TraceMempoolRejectedTx"
, Key
"tx" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> GenTx blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal GenTx blk
tx
, Key
"mempoolSize" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> MempoolSize -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal MempoolSize
mpSz
, Key
"errdetails" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MempoolRejectionDetails -> Value
jsonMempoolRejectionDetails MempoolRejectionDetails
details
]
[Object] -> [Object] -> [Object]
forall a. Semigroup a => a -> a -> a
<> if DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DDetailed
then []
else
[ Key
"err" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> ApplyTxErr blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ApplyTxErr blk
txApplyErr
]
forMachine DetailLevel
dtal (TraceMempoolRemoveTxs [(GenTx blk, ApplyTxErr blk)]
txs MempoolSize
mpSz) =
[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
"TraceMempoolRemoveTxs"
, Key
"txs"
Key -> [Value] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ((GenTx blk, ApplyTxErr blk) -> Value)
-> [(GenTx blk, ApplyTxErr blk)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
( \(GenTx blk
tx, ApplyTxErr blk
err) ->
[(Key, Value)] -> Value
Aeson.object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
[ Key
"tx" 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 -> GenTx blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal GenTx blk
tx
]
[(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [ Key
"err" 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 -> ApplyTxErr blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ApplyTxErr blk
err
| DetailLevel
dtal DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DDetailed
]
)
[(GenTx blk, ApplyTxErr blk)]
txs
, Key
"mempoolSize" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> MempoolSize -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal MempoolSize
mpSz
]
forMachine DetailLevel
dtal (TraceMempoolManuallyRemovedTxs NonEmpty (GenTxId blk)
txs0 [GenTx blk]
txs1 MempoolSize
mpSz) =
[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
"TraceMempoolManuallyRemovedTxs"
, Key
"txsRemoved" Key -> [Value] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (GenTxId blk -> Value) -> [GenTxId blk] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Value
String (Text -> Value) -> (GenTxId blk -> Text) -> GenTxId blk -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DetailLevel -> GenTxId blk -> Text
forall blk.
ConvertTxId blk =>
DetailLevel -> TxId (GenTx blk) -> Text
renderTxIdForDetails DetailLevel
dtal) (NonEmpty (GenTxId blk) -> [GenTxId blk]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (GenTxId blk)
txs0)
, Key
"txsInvalidated" Key -> [Object] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (GenTx blk -> Object) -> [GenTx blk] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> GenTx blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal) [GenTx blk]
txs1
, Key
"mempoolSize" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> MempoolSize -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal MempoolSize
mpSz
]
forMachine DetailLevel
dtal (TraceMempoolSyncNotNeeded Point blk
t) =
[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
"TraceMempoolSyncNotNeeded"
, 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
t
]
forMachine DetailLevel
dtal (TraceMempoolAttemptingAdd GenTx blk
tx) =
[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
"TraceMempoolAttemptingAdd"
, Key
"tx" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> GenTx blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal GenTx blk
tx
]
forMachine DetailLevel
_dtal (TraceMempoolSynced EnclosingTimed
et) =
[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
"TraceMempoolSynced"
, Key
"enclosingTime" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EnclosingTimed -> Value
forall a. ToJSON a => Enclosing' a -> Value
enclosingValue EnclosingTimed
et
]
forMachine DetailLevel
_dtal TraceEventMempool blk
TraceMempoolTipMovedBetweenSTMBlocks =
[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
"TraceMempoolTipMovedBetweenSTMBlocks"
]
forMachine DetailLevel
_dtal (TraceMempoolCapacityChanged TxMeasure blk
capBefore TxMeasure blk
capAfter) =
[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
"TraceMempoolCapacityChanged"
, Key
"capacityBefore" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxMeasure blk -> Value
forall m.
(TxMeasurePhase1Metrics m, TxMeasurePhase2Metrics m) =>
m -> Value
jsonTxMeasure TxMeasure blk
capBefore
, Key
"capacityAfter" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxMeasure blk -> Value
forall m.
(TxMeasurePhase1Metrics m, TxMeasurePhase2Metrics m) =>
m -> Value
jsonTxMeasure TxMeasure blk
capAfter
]
asMetrics :: TraceEventMempool blk -> [Metric]
asMetrics (TraceMempoolAddedTx Validated (GenTx blk)
_tx MempoolSize
_mpSzBefore MempoolSize
mpSz) =
[ Text -> Integer -> Metric
IntM Text
"txsInMempool" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize -> Word32
msNumTxs MempoolSize
mpSz)
, Text -> Integer -> Metric
IntM Text
"mempoolBytes" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> (MempoolSize -> Word32) -> MempoolSize -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32)
-> (MempoolSize -> ByteSize32) -> MempoolSize -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MempoolSize -> ByteSize32
msNumBytes (MempoolSize -> Integer) -> MempoolSize -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize
mpSz)
]
asMetrics ev :: TraceEventMempool blk
ev@(TraceMempoolRejectedTx GenTx blk
_tx ApplyTxErr blk
_txApplyErr MempoolRejectionDetails
_details MempoolSize
mpSz) =
[ Text -> Integer -> Metric
IntM Text
"txsInMempool" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize -> Word32
msNumTxs MempoolSize
mpSz)
, Text -> Integer -> Metric
IntM Text
"mempoolBytes" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> (MempoolSize -> Word32) -> MempoolSize -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32)
-> (MempoolSize -> ByteSize32) -> MempoolSize -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MempoolSize -> ByteSize32
msNumBytes (MempoolSize -> Integer) -> MempoolSize -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize
mpSz)
]
[Metric] -> [Metric] -> [Metric]
forall a. [a] -> [a] -> [a]
++ [ Text -> Maybe Int -> Metric
CounterM Text
txsMempoolTimeoutSoftCounterName Maybe Int
forall a. Maybe a
Nothing
| TraceEventMempool blk -> Bool
forall blk. TraceEventMempool blk -> Bool
impliesMempoolTimeoutSoft TraceEventMempool blk
ev
]
asMetrics (TraceMempoolRemoveTxs [(GenTx blk, ApplyTxErr blk)]
txs MempoolSize
mpSz) =
[ Text -> Integer -> Metric
IntM Text
"txsInMempool" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize -> Word32
msNumTxs MempoolSize
mpSz)
, Text -> Integer -> Metric
IntM Text
"mempoolBytes" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> (MempoolSize -> Word32) -> MempoolSize -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32)
-> (MempoolSize -> ByteSize32) -> MempoolSize -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MempoolSize -> ByteSize32
msNumBytes (MempoolSize -> Integer) -> MempoolSize -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize
mpSz)
, Text -> Maybe Int -> Metric
CounterM Text
"txsProcessedNum" (Int -> Maybe Int
forall a. a -> Maybe a
Just ([(GenTx blk, ApplyTxErr blk)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(GenTx blk, ApplyTxErr blk)]
txs))
]
asMetrics (TraceMempoolManuallyRemovedTxs NonEmpty (GenTxId blk)
_txs [GenTx blk]
_txs1 MempoolSize
mpSz) =
[ Text -> Integer -> Metric
IntM Text
"txsInMempool" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize -> Word32
msNumTxs MempoolSize
mpSz)
, Text -> Integer -> Metric
IntM Text
"mempoolBytes" (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> (MempoolSize -> Word32) -> MempoolSize -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32)
-> (MempoolSize -> ByteSize32) -> MempoolSize -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MempoolSize -> ByteSize32
msNumBytes (MempoolSize -> Integer) -> MempoolSize -> Integer
forall a b. (a -> b) -> a -> b
$ MempoolSize
mpSz)
]
asMetrics (TraceMempoolSynced (FallingEdgeWith DiffTime
duration)) =
let durationMs :: Integer
durationMs = DiffTime -> Integer
forall b. Integral b => DiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (DiffTime
1000 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
duration) :: Integer
in [ Text -> Integer -> Metric
IntM Text
"txsSyncDuration" Integer
durationMs
, Text -> Maybe Int -> Metric
CounterM Text
txsSyncDurationTotalCounterName (Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
durationMs))
]
asMetrics (TraceMempoolSynced EnclosingTimed
RisingEdge) = []
asMetrics TraceMempoolSyncNotNeeded{} = []
asMetrics TraceMempoolAttemptingAdd{} = []
asMetrics TraceMempoolTipMovedBetweenSTMBlocks{} = []
asMetrics TraceMempoolCapacityChanged{} = []
jsonTxMeasure :: (TxMeasurePhase1Metrics m, TxMeasurePhase2Metrics m) => m -> Value
jsonTxMeasure :: forall m.
(TxMeasurePhase1Metrics m, TxMeasurePhase2Metrics m) =>
m -> Value
jsonTxMeasure m
m =
[(Key, Value)] -> Value
Aeson.object
[ Key
"txSizeBytes" Key -> Word32 -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteSize32 -> Word32
unByteSize32 (m -> ByteSize32
forall msr. TxMeasurePhase1Metrics msr => msr -> ByteSize32
txMeasureMetricTxSizeBytes m
m)
, Key
"exUnitsMemory" Key -> Natural -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= m -> Natural
forall msr. TxMeasurePhase1Metrics msr => msr -> Natural
txMeasureMetricExUnitsMemory m
m
, Key
"exUnitsSteps" Key -> Natural -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= m -> Natural
forall msr. TxMeasurePhase1Metrics msr => msr -> Natural
txMeasureMetricExUnitsSteps m
m
, Key
"refScriptsSizeBytes" Key -> Word32 -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteSize32 -> Word32
unByteSize32 (m -> ByteSize32
forall msr. TxMeasurePhase2Metrics msr => msr -> ByteSize32
txMeasureMetricRefScriptsSizeBytes m
m)
]
instance LogFormatting MempoolSize where
forMachine :: DetailLevel -> MempoolSize -> Object
forMachine DetailLevel
_dtal MempoolSize{Word32
msNumTxs :: MempoolSize -> Word32
msNumTxs :: Word32
msNumTxs, ByteSize32
msNumBytes :: MempoolSize -> ByteSize32
msNumBytes :: ByteSize32
msNumBytes} =
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
[ Key
"numTxs" Key -> Word32 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
msNumTxs
, Key
"bytes" Key -> Word32 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteSize32 -> Word32
unByteSize32 ByteSize32
msNumBytes
]
instance MetaTrace (TraceEventMempool blk) where
namespaceFor :: TraceEventMempool blk -> Namespace (TraceEventMempool blk)
namespaceFor TraceMempoolAddedTx{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedTx"]
namespaceFor TraceMempoolRejectedTx{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedTx"]
namespaceFor TraceMempoolRemoveTxs{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RemoveTxs"]
namespaceFor TraceMempoolManuallyRemovedTxs{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ManuallyRemovedTxs"]
namespaceFor TraceMempoolSynced{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Synced"]
namespaceFor TraceMempoolSyncNotNeeded{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SyncNotNeeded"]
namespaceFor TraceMempoolAttemptingAdd{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AttemptAdd"]
namespaceFor TraceMempoolTipMovedBetweenSTMBlocks{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TipMovedBetweenSTMBlocks"]
namespaceFor TraceMempoolCapacityChanged{} = [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CapacityChanged"]
severityFor :: Namespace (TraceEventMempool blk)
-> Maybe (TraceEventMempool blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"AddedTx"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"RejectedTx"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"RemoveTxs"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"Synced"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"ManuallyRemovedTxs"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
severityFor (Namespace [Text]
_ [Text
"SyncNotNeeded"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"AttemptAdd"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [] [Text
"TipMovedBetweenSTMBlocks"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"CapacityChanged"]) Maybe (TraceEventMempool blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor Namespace (TraceEventMempool blk)
_ Maybe (TraceEventMempool blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
metricsDocFor :: Namespace (TraceEventMempool blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"AddedTx"]) =
[ (Text
"txsInMempool", Text
"Transactions in mempool")
, (Text
"mempoolBytes", Text
"Byte size of the mempool")
]
metricsDocFor (Namespace [Text]
_ [Text
"RejectedTx"]) =
[ (Text
"txsInMempool", Text
"Transactions in mempool")
, (Text
"mempoolBytes", Text
"Byte size of the mempool")
, (Text
txsMempoolTimeoutSoftCounterName, Text
"Transactions that soft timed out in mempool")
]
metricsDocFor (Namespace [Text]
_ [Text
"RemoveTxs"]) =
[ (Text
"txsInMempool", Text
"Transactions in mempool")
, (Text
"mempoolBytes", Text
"Byte size of the mempool")
]
metricsDocFor (Namespace [Text]
_ [Text
"ManuallyRemovedTxs"]) =
[ (Text
"txsInMempool", Text
"Transactions in mempool")
, (Text
"mempoolBytes", Text
"Byte size of the mempool")
, (Text
"txsProcessedNum", Text
"")
]
metricsDocFor (Namespace [Text]
_ [Text
"Synced"]) =
[ (Text
"txsSyncDuration", Text
"Latest time to sync the mempool in ms after block adoption")
,
( Text
txsSyncDurationTotalCounterName
, Text
"Cumulative time spent syncing the mempool in ms after block adoption"
)
]
metricsDocFor Namespace (TraceEventMempool blk)
_ = []
documentFor :: Namespace (TraceEventMempool blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"AddedTx"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"New, valid transaction that was added to the Mempool."
documentFor (Namespace [Text]
_ [Text
"RejectedTx"]) =
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
"New, invalid transaction that was rejected and thus not added to"
, Text
" the Mempool."
]
documentFor (Namespace [Text]
_ [Text
"RemoveTxs"]) =
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
"Previously valid transactions that are no longer valid because of"
, Text
" changes in the ledger state. These transactions have been removed"
, Text
" from the Mempool."
]
documentFor (Namespace [Text]
_ [Text
"ManuallyRemovedTxs"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Transactions that have been manually removed from the Mempool."
documentFor (Namespace [Text]
_ [Text
"SyncNotNeeded"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The mempool and the LedgerDB are in sync already."
documentFor (Namespace [Text]
_ [Text
"Synced"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The mempool and the LedgerDB are syncing or in sync depending on the argument on the trace."
documentFor (Namespace [Text]
_ [Text
"AttemptAdd"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Mempool is about to try to validate and add a transaction."
documentFor (Namespace [Text]
_ [Text
"TipMovedBetweenSTMBlocks"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"LedgerDB moved to an alternative fork between two reads during re-sync."
documentFor (Namespace [Text]
_ [Text
"CapacityChanged"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The mempool capacity has changed when re-syncing the mempool to the latest tip"
documentFor Namespace (TraceEventMempool blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceEventMempool blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedTx"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedTx"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RemoveTxs"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ManuallyRemovedTxs"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Synced"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SyncNotNeeded"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AttemptAdd"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TipMovedBetweenSTMBlocks"]
, [Text] -> [Text] -> Namespace (TraceEventMempool blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CapacityChanged"]
]
instance
( tx ~ GenTx blk
, ConvertRawHash blk
, GetHeader blk
, HasHeader blk
, HasKESInfo blk
, HasTxId (GenTx blk)
, LedgerSupportsProtocol blk
, LedgerSupportsMempool blk
, SerialiseNodeToNodeConstraints blk
, Show (ForgeStateUpdateError blk)
, Show (CannotForge blk)
, Show (TxId (GenTx blk))
, Show (PerasError blk)
, LogFormatting (CannotForge blk)
, LogFormatting (ExtValidationError blk)
, LogFormatting (ForgeStateUpdateError blk)
) =>
LogFormatting (TraceForgeEvent blk)
where
forMachine :: DetailLevel -> TraceForgeEvent blk -> Object
forMachine DetailLevel
_dtal (TraceStartLeadershipCheck 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
"TraceStartLeadershipCheck"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
dtal (TraceSlotIsImmutable SlotNo
slotNo Point blk
tipPoint BlockNo
tipBlkNo) =
[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
"TraceSlotIsImmutable"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"tip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
tipPoint
, Key
"tipBlockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo BlockNo
tipBlkNo)
]
forMachine DetailLevel
_dtal (TraceBlockFromFuture SlotNo
currentSlot SlotNo
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
"TraceBlockFromFuture"
, Key
"current slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
, Key
"tip" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
tip)
]
forMachine DetailLevel
dtal (TraceBlockContext SlotNo
currentSlot BlockNo
tipBlkNo Point blk
tipPoint) =
[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
"TraceBlockContext"
, Key
"current slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
, Key
"tip" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
tipPoint
, Key
"tipBlockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo BlockNo
tipBlkNo)
]
forMachine DetailLevel
_dtal (TraceNoLedgerState SlotNo
slotNo 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
"TraceNoLedgerState"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
_dtal (TraceLedgerState SlotNo
slotNo 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
"TraceLedgerState"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
_dtal (TraceNoLedgerView SlotNo
slotNo OutsideForecastRange
_) =
[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
"TraceNoLedgerView"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
_dtal (TraceLedgerView 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
"TraceLedgerView"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
dtal (TraceForgeStateUpdateError SlotNo
slotNo ForgeStateUpdateError 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
"TraceForgeStateUpdateError"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"reason" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> ForgeStateUpdateError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ForgeStateUpdateError blk
reason
]
forMachine DetailLevel
dtal (TraceNodeCannotForge SlotNo
slotNo CannotForge 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
"TraceNodeCannotForge"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"reason" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> CannotForge blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal CannotForge blk
reason
]
forMachine DetailLevel
_dtal (TraceNodeNotLeader 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
"TraceNodeNotLeader"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
_dtal (TraceNodeIsLeader 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
"TraceNodeIsLeader"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
dtal (TraceForgeTickedLedgerState SlotNo
slotNo Point blk
prevPt) =
[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
"TraceForgeTickedLedgerState"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"prev" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
prevPt
]
forMachine DetailLevel
dtal (TraceForgingMempoolSnapshot SlotNo
slotNo Point blk
prevPt ChainHash blk
mpHash SlotNo
mpSlot) =
[Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
[ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"TraceForgingMempoolSnapshot"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"prev" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> Point blk -> Text
forall blk. ConvertRawHash blk => DetailLevel -> Point blk -> Text
renderPointForDetails DetailLevel
dtal Point blk
prevPt
, Key
"mempoolHash" 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 (forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash @blk (Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)) ChainHash blk
mpHash)
, Key
"mempoolSlot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
mpSlot)
]
forMachine DetailLevel
_dtal (TraceForgedBlock SlotNo
slotNo Point blk
_ blk
blk MempoolSize
_ MempoolMeasure 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
"TraceForgedBlock"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"block" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (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
$ blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
, Key
"blockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (BlockNo -> Word64
unBlockNo (BlockNo -> Word64) -> BlockNo -> Word64
forall a b. (a -> b) -> a -> b
$ blk -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo blk
blk)
, Key
"blockPrev"
Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String
( forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash
@blk
(Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk))
(ChainHash blk -> Text) -> ChainHash blk -> Text
forall a b. (a -> b) -> a -> b
$ blk -> ChainHash blk
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash blk
blk
)
]
forMachine DetailLevel
_dtal (TraceDidntAdoptBlock SlotNo
slotNo 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
"TraceDidntAdoptBlock"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
]
forMachine DetailLevel
dtal (TraceForgedInvalidBlock SlotNo
slotNo blk
_ 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
"TraceForgedInvalidBlock"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"reason" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> ExtValidationError blk -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ExtValidationError blk
reason
]
forMachine DetailLevel
DDetailed (TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
txs) =
[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
"TraceAdoptedBlock"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"blockHash"
Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Proxy blk -> DetailLevel -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> DetailLevel -> HeaderHash blk -> Text
renderHeaderHashForDetails
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
DetailLevel
DDetailed
(blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
, Key
"blockSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (SizeInBytes -> Word32
getSizeInBytes (SizeInBytes -> Word32) -> SizeInBytes -> Word32
forall a b. (a -> b) -> a -> b
$ Header blk -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk))
, Key
"txIds" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [String] -> Value
forall a. ToJSON a => a -> Value
toJSON ((Validated (GenTx blk) -> String)
-> [Validated (GenTx blk)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (TxId (GenTx blk) -> String
forall a. Show a => a -> String
show (TxId (GenTx blk) -> String)
-> (Validated (GenTx blk) -> TxId (GenTx blk))
-> Validated (GenTx blk)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx blk -> TxId (GenTx blk)
forall tx. HasTxId tx => tx -> TxId tx
txId (GenTx blk -> TxId (GenTx blk))
-> (Validated (GenTx blk) -> GenTx blk)
-> Validated (GenTx blk)
-> TxId (GenTx blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated) [Validated (GenTx blk)]
txs)
]
forMachine DetailLevel
dtal (TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
_txs) =
[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
"TraceAdoptedBlock"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"blockHash"
Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Proxy blk -> DetailLevel -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> DetailLevel -> HeaderHash blk -> Text
renderHeaderHashForDetails
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
DetailLevel
dtal
(blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
, Key
"blockSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (SizeInBytes -> Word32
getSizeInBytes (SizeInBytes -> Word32) -> SizeInBytes -> Word32
forall a b. (a -> b) -> a -> b
$ Header blk -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk))
]
forMachine DetailLevel
dtal (TraceAdoptionThreadDied SlotNo
slotNo blk
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
"TraceAdoptionThreadDied"
, Key
"slot" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"blockHash"
Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Proxy blk -> DetailLevel -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> DetailLevel -> HeaderHash blk -> Text
renderHeaderHashForDetails
(forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
DetailLevel
dtal
(blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
, Key
"blockSize" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (SizeInBytes -> Word32
getSizeInBytes (SizeInBytes -> Word32) -> SizeInBytes -> Word32
forall a b. (a -> b) -> a -> b
$ Header blk -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk))
]
forHuman :: TraceForgeEvent blk -> Text
forHuman (TraceStartLeadershipCheck SlotNo
slotNo) =
Text
"Checking for leadership in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceSlotIsImmutable SlotNo
slotNo Point blk
immutableTipPoint BlockNo
immutableTipBlkNo) =
Text
"Couldn't forge block because current slot is immutable: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"immutable tip: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
immutableTipPoint
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", immutable tip block no: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (BlockNo -> Word64
unBlockNo BlockNo
immutableTipBlkNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceBlockFromFuture SlotNo
currentSlot SlotNo
tipSlot) =
Text
"Couldn't forge block because current tip is in the future: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"current tip slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
tipSlot)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
forHuman (TraceBlockContext SlotNo
currentSlot BlockNo
tipBlockNo Point blk
tipPoint) =
Text
"New block will fit onto: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"tip: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
tipPoint
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", tip block no: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (BlockNo -> Word64
unBlockNo BlockNo
tipBlockNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
currentSlot)
forHuman (TraceNoLedgerState SlotNo
slotNo Point blk
pt) =
Text
"Could not obtain ledger state for point "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
pt
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceLedgerState SlotNo
slotNo Point blk
pt) =
Text
"Obtained a ledger state for point "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
pt
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", current slot: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceNoLedgerView SlotNo
slotNo OutsideForecastRange
_) =
Text
"Could not obtain ledger view for slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceLedgerView SlotNo
slotNo) =
Text
"Obtained a ledger view for slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceForgeStateUpdateError SlotNo
slotNo ForgeStateUpdateError blk
reason) =
Text
"Updating the forge state in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed because: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ForgeStateUpdateError blk -> Text
forall a. Show a => a -> Text
showT ForgeStateUpdateError blk
reason
forHuman (TraceNodeCannotForge SlotNo
slotNo CannotForge blk
reason) =
Text
"We are the leader in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but we cannot forge because: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CannotForge blk -> Text
forall a. Show a => a -> Text
showT CannotForge blk
reason
forHuman (TraceNodeNotLeader SlotNo
slotNo) =
Text
"Not leading slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceNodeIsLeader SlotNo
slotNo) =
Text
"Leading slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceForgeTickedLedgerState SlotNo
slotNo Point blk
prevPt) =
Text
"While forging in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" we ticked the ledger state ahead from "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
prevPt
forHuman (TraceForgingMempoolSnapshot SlotNo
slotNo Point blk
prevPt ChainHash blk
mpHash SlotNo
mpSlot) =
Text
"While forging in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" we acquired a mempool snapshot valid against "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point blk -> Text
forall blk. ConvertRawHash blk => Point blk -> Text
renderPointAsPhrase Point blk
prevPt
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from a mempool that was prepared for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall blk. (HeaderHash blk -> Text) -> ChainHash blk -> Text
renderChainHash @blk (Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)) ChainHash blk
mpHash
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ticked to slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
mpSlot)
forHuman (TraceForgedBlock SlotNo
slotNo Point blk
_ blk
_ MempoolSize
_ MempoolMeasure blk
_) =
Text
"Forged block in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceDidntAdoptBlock SlotNo
slotNo blk
_) =
Text
"Didn't adopt forged block in slot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
forHuman (TraceForgedInvalidBlock SlotNo
slotNo blk
_ ExtValidationError blk
reason) =
Text
"Forged invalid block in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", reason: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtValidationError blk -> Text
forall a. Show a => a -> Text
showT ExtValidationError blk
reason
forHuman (TraceAdoptedBlock SlotNo
slotNo blk
blk [Validated (GenTx blk)]
_txs) =
Text
"Adopted block forged in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
forHuman (TraceAdoptionThreadDied SlotNo
slotNo blk
blk) =
Text
"Adoption thread died in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash blk
blk)
asMetrics :: TraceForgeEvent blk -> [Metric]
asMetrics (TraceForgeStateUpdateError SlotNo
slot ForgeStateUpdateError blk
reason) =
Text -> Integer -> Metric
IntM Text
"Forge.StateUpdateError" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)
Metric -> [Metric] -> [Metric]
forall a. a -> [a] -> [a]
: ( case Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
forall blk.
HasKESInfo blk =>
Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
getKESInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) ForgeStateUpdateError blk
reason of
Maybe KESInfo
Nothing -> []
Just KESInfo
kesInfo ->
[ Text -> Integer -> Metric
IntM
Text
"operationalCertificateStartKESPeriod"
(Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Integer) -> (KESInfo -> Word) -> KESInfo -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KESPeriod -> Word
unKESPeriod (KESPeriod -> Word) -> (KESInfo -> KESPeriod) -> KESInfo -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KESInfo -> KESPeriod
HotKey.kesStartPeriod (KESInfo -> Integer) -> KESInfo -> Integer
forall a b. (a -> b) -> a -> b
$ KESInfo
kesInfo)
, Text -> Integer -> Metric
IntM
Text
"operationalCertificateExpiryKESPeriod"
(Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Integer) -> (KESInfo -> Word) -> KESInfo -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KESPeriod -> Word
unKESPeriod (KESPeriod -> Word) -> (KESInfo -> KESPeriod) -> KESInfo -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KESInfo -> KESPeriod
HotKey.kesEndPeriod (KESInfo -> Integer) -> KESInfo -> Integer
forall a b. (a -> b) -> a -> b
$ KESInfo
kesInfo)
, Text -> Integer -> Metric
IntM
Text
"currentKESPeriod"
Integer
0
, Text -> Integer -> Metric
IntM
Text
"remainingKESPeriods"
Integer
0
]
)
asMetrics (TraceStartLeadershipCheck SlotNo
_slot) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.about-to-lead" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceSlotIsImmutable SlotNo
_slot Point blk
_tipPoint BlockNo
_tipBlkNo) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.slot-is-immutable" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceBlockFromFuture SlotNo
_slot SlotNo
_slotNo) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.block-from-future" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceNoLedgerState SlotNo
_slot Point blk
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.could-not-forge" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceNoLedgerView SlotNo
_slot OutsideForecastRange
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.could-not-forge" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceLedgerView SlotNo
_) = []
asMetrics TraceBlockContext{} = []
asMetrics (TraceLedgerState SlotNo
_ Point blk
_) = []
asMetrics (TraceNodeCannotForge SlotNo
_slot CannotForge blk
_reason) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.could-not-forge" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceNodeNotLeader SlotNo
_slot) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.node-not-leader" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceNodeIsLeader SlotNo
_slot) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.node-is-leader" Maybe Int
forall a. Maybe a
Nothing]
asMetrics TraceForgeTickedLedgerState{} = []
asMetrics TraceForgingMempoolSnapshot{} = []
asMetrics (TraceForgedBlock SlotNo
slot Point blk
_ blk
_ MempoolSize
_ MempoolMeasure blk
_) =
[ Text -> Integer -> Metric
IntM Text
"forgedSlotLast" (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)
, Text -> Maybe Int -> Metric
CounterM Text
"Forge.forged" Maybe Int
forall a. Maybe a
Nothing
]
asMetrics (TraceDidntAdoptBlock SlotNo
_slot blk
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.didnt-adopt" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceForgedInvalidBlock SlotNo
_slot blk
_ ExtValidationError blk
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.forged-invalid" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceAdoptedBlock SlotNo
_slot blk
_ [Validated (GenTx blk)]
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.adopted" Maybe Int
forall a. Maybe a
Nothing]
asMetrics (TraceAdoptionThreadDied SlotNo
_slot blk
_) =
[Text -> Maybe Int -> Metric
CounterM Text
"Forge.adoption-thread-died" Maybe Int
forall a. Maybe a
Nothing]
instance MetaTrace (TraceForgeEvent blk) where
namespaceFor :: TraceForgeEvent blk -> Namespace (TraceForgeEvent blk)
namespaceFor TraceStartLeadershipCheck{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartLeadershipCheck"]
namespaceFor TraceSlotIsImmutable{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SlotIsImmutable"]
namespaceFor TraceBlockFromFuture{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockFromFuture"]
namespaceFor TraceBlockContext{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockContext"]
namespaceFor TraceNoLedgerState{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLedgerState"]
namespaceFor TraceLedgerState{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerState"]
namespaceFor TraceNoLedgerView{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLedgerView"]
namespaceFor TraceLedgerView{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerView"]
namespaceFor TraceForgeStateUpdateError{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgeStateUpdateError"]
namespaceFor TraceNodeCannotForge{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeCannotForge"]
namespaceFor TraceNodeNotLeader{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeNotLeader"]
namespaceFor TraceNodeIsLeader{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeIsLeader"]
namespaceFor TraceForgeTickedLedgerState{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgeTickedLedgerState"]
namespaceFor TraceForgingMempoolSnapshot{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgingMempoolSnapshot"]
namespaceFor TraceForgedBlock{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedBlock"]
namespaceFor TraceDidntAdoptBlock{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DidntAdoptBlock"]
namespaceFor TraceForgedInvalidBlock{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedInvalidBlock"]
namespaceFor TraceAdoptedBlock{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AdoptedBlock"]
namespaceFor TraceAdoptionThreadDied{} =
[Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AdoptionThreadDied"]
severityFor :: Namespace (TraceForgeEvent blk)
-> Maybe (TraceForgeEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"StartLeadershipCheck"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"SlotIsImmutable"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"BlockFromFuture"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"BlockContext"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"NoLedgerState"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"LedgerState"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"NoLedgerView"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"LedgerView"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"ForgeStateUpdateError"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Critical
severityFor (Namespace [Text]
_ [Text
"NodeCannotForge"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"NodeNotLeader"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"NodeIsLeader"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"ForgeTickedLedgerState"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"ForgingMempoolSnapshot"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"ForgedBlock"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"DidntAdoptBlock"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"ForgedInvalidBlock"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor (Namespace [Text]
_ [Text
"AdoptedBlock"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"AdoptionThreadDied"]) Maybe (TraceForgeEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor Namespace (TraceForgeEvent blk)
_ Maybe (TraceForgeEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
privacyFor :: Namespace (TraceForgeEvent blk)
-> Maybe (TraceForgeEvent blk) -> Maybe Privacy
privacyFor (Namespace [Text]
_ [Text
"ForgeStateUpdateError"]) Maybe (TraceForgeEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Confidential
privacyFor Namespace (TraceForgeEvent blk)
_ Maybe (TraceForgeEvent blk)
_ = Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
metricsDocFor :: Namespace (TraceForgeEvent blk) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"StartLeadershipCheck"]) =
[(Text
"Forge.about-to-lead", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"SlotIsImmutable"]) =
[(Text
"Forge.slot-is-immutable", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"BlockFromFuture"]) =
[(Text
"Forge.block-from-future", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"BlockContext"]) = []
metricsDocFor (Namespace [Text]
_ [Text
"NoLedgerState"]) =
[(Text
"Forge.could-not-forge", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"LedgerState"]) = []
metricsDocFor (Namespace [Text]
_ [Text
"NoLedgerView"]) =
[(Text
"Forge.could-not-forge", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"LedgerView"]) = []
metricsDocFor (Namespace [Text]
_ [Text
"ForgeStateUpdateError"]) =
[ (Text
"operationalCertificateStartKESPeriod", Text
"")
, (Text
"operationalCertificateExpiryKESPeriod", Text
"")
, (Text
"currentKESPeriod", Text
"")
, (Text
"remainingKESPeriods", Text
"")
]
metricsDocFor (Namespace [Text]
_ [Text
"NodeCannotForge"]) =
[(Text
"Forge.could-not-forge", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"NodeNotLeader"]) =
[(Text
"Forge.node-not-leader", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"NodeIsLeader"]) =
[(Text
"Forge.node-is-leader", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"ForgeTickedLedgerState"]) = []
metricsDocFor (Namespace [Text]
_ [Text
"ForgingMempoolSnapshot"]) = []
metricsDocFor (Namespace [Text]
_ [Text
"ForgedBlock"]) =
[ (Text
"forgedSlotLast", Text
"Slot number of the last forged block")
, (Text
"Forge.forged", Text
"Counter of forged blocks")
]
metricsDocFor (Namespace [Text]
_ [Text
"DidntAdoptBlock"]) =
[(Text
"Forge.didnt-adopt", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"ForgedInvalidBlock"]) =
[(Text
"Forge.forged-invalid", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"AdoptedBlock"]) =
[(Text
"Forge.adopted", Text
"")]
metricsDocFor (Namespace [Text]
_ [Text
"AdoptionThreadDied"]) =
[(Text
"Forge.adoption-thread-died", Text
"")]
metricsDocFor Namespace (TraceForgeEvent blk)
_ = []
documentFor :: Namespace (TraceForgeEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"StartLeadershipCheck"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Start of the leadership check."
documentFor (Namespace [Text]
_ [Text
"SlotIsImmutable"]) =
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
"Leadership check failed: the tip of the ImmutableDB inhabits the"
, Text
" current slot"
, Text
" "
, Text
" This might happen in two cases."
, Text
" "
, Text
" 1. the clock moved backwards, on restart we ignored everything from the"
, Text
" VolatileDB since it's all in the future, and now the tip of the"
, Text
" ImmutableDB points to a block produced in the same slot we're trying"
, Text
" to produce a block in"
, Text
" "
, Text
" 2. k = 0 and we already adopted a block from another leader of the same"
, Text
" slot."
, Text
" "
, Text
" We record both the current slot number as well as the tip of the"
, Text
" ImmutableDB."
, Text
" "
, Text
" See also <https://github.com/IntersectMBO/ouroboros-consensus/issues/732>"
]
documentFor (Namespace [Text]
_ [Text
"BlockFromFuture"]) =
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
"Leadership check failed: the current chain contains a block from a slot"
, Text
" /after/ the current slot"
, Text
" "
, Text
" This can only happen if the system is under heavy load."
, Text
" "
, Text
" We record both the current slot number as well as the slot number of the"
, Text
" block at the tip of the chain."
, Text
" "
, Text
" See also <https://github.com/IntersectMBO/ouroboros-consensus/issues/732>"
]
documentFor (Namespace [Text]
_ [Text
"BlockContext"]) =
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 found out to which block we are going to connect the block we are about"
, Text
" to forge."
, Text
" "
, Text
" We record the current slot number, the block number of the block to"
, Text
" connect to and its point."
, Text
" "
, Text
" Note that block number of the block we will try to forge is one more than"
, Text
" the recorded block number."
]
documentFor (Namespace [Text]
_ [Text
"NoLedgerState"]) =
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
"Leadership check failed: we were unable to get the ledger state for the"
, Text
" point of the block we want to connect to"
, Text
" "
, Text
" This can happen if after choosing which block to connect to the node"
, Text
" switched to a different fork. We expect this to happen only rather"
, Text
" rarely, so this certainly merits a warning; if it happens a lot, that"
, Text
" merits an investigation."
, Text
" "
, Text
" We record both the current slot number as well as the point of the block"
, Text
" we attempt to connect the new block to (that we requested the ledger"
, Text
" state for)."
]
documentFor (Namespace [Text]
_ [Text
"LedgerState"]) =
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 obtained a ledger state for the point of the block we want to"
, Text
" connect to"
, Text
" "
, Text
" We record both the current slot number as well as the point of the block"
, Text
" we attempt to connect the new block to (that we requested the ledger"
, Text
" state for)."
]
documentFor (Namespace [Text]
_ [Text
"NoLedgerView"]) =
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
"Leadership check failed: we were unable to get the ledger view for the"
, Text
" current slot number"
, Text
" "
, Text
" This will only happen if there are many missing blocks between the tip of"
, Text
" our chain and the current slot."
, Text
" "
, Text
" We record also the failure returned by 'forecastFor'."
]
documentFor (Namespace [Text]
_ [Text
"LedgerView"]) =
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 obtained a ledger view for the current slot number"
, Text
" "
, Text
" We record the current slot number."
]
documentFor (Namespace [Text]
_ [Text
"ForgeStateUpdateError"]) =
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
"Updating the forge state failed."
, Text
" "
, Text
" For example, the KES key could not be evolved anymore."
, Text
" "
, Text
" We record the error returned by 'updateForgeState'."
]
documentFor (Namespace [Text]
_ [Text
"NodeCannotForge"]) =
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 did the leadership check and concluded that we should lead and forge"
, Text
" a block, but cannot."
, Text
" "
, Text
" This should only happen rarely and should be logged with warning severity."
, Text
" "
, Text
" Records why we cannot forge a block."
]
documentFor (Namespace [Text]
_ [Text
"NodeNotLeader"]) =
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 did the leadership check and concluded we are not the leader"
, Text
" "
, Text
" We record the current slot number"
]
documentFor (Namespace [Text]
_ [Text
"NodeIsLeader"]) =
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 did the leadership check and concluded we /are/ the leader"
, Text
"\n"
, Text
" The node will soon forge; it is about to read its transactions from the"
, Text
" Mempool. This will be followed by ForgedBlock."
]
documentFor (Namespace [Text]
_ [Text
"ForgeTickedLedgerState"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
documentFor (Namespace [Text]
_ [Text
"ForgingMempoolSnapshot"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
documentFor (Namespace [Text]
_ [Text
"ForgedBlock"]) =
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 forged a block."
, Text
"\n"
, Text
" We record the current slot number, the point of the predecessor, the block"
, Text
" itself, and the total size of the mempool snapshot at the time we produced"
, Text
" the block (which may be significantly larger than the block, due to"
, Text
" maximum block size)"
, Text
"\n"
, Text
" This will be followed by one of three messages:"
, Text
"\n"
, Text
" * AdoptedBlock (normally)"
, Text
"\n"
, Text
" * DidntAdoptBlock (rarely)"
, Text
"\n"
, Text
" * ForgedInvalidBlock (hopefully never, this would indicate a bug)"
]
documentFor (Namespace [Text]
_ [Text
"DidntAdoptBlock"]) =
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 did not adopt the block we produced, but the block was valid. We"
, Text
" must have adopted a block that another leader of the same slot produced"
, Text
" before we got the chance of adopting our own block. This is very rare,"
, Text
" this warrants a warning."
]
documentFor (Namespace [Text]
_ [Text
"ForgedInvalidBlock"]) =
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 forged a block that is invalid according to the ledger in the"
, Text
" ChainDB. This means there is an inconsistency between the mempool"
, Text
" validation and the ledger validation. This is a serious error!"
]
documentFor (Namespace [Text]
_ [Text
"AdoptedBlock"]) =
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 adopted the block we produced, we also trace the transactions"
, Text
" that were adopted."
]
documentFor (Namespace [Text]
_ [Text
"AdoptionThreadDied"]) =
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
"Block adoption thread died"]
documentFor Namespace (TraceForgeEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceForgeEvent blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartLeadershipCheck"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SlotIsImmutable"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockFromFuture"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockContext"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLedgerState"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerState"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLedgerView"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerView"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgeStateUpdateError"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeCannotForge"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeNotLeader"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NodeIsLeader"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgeTickedLedgerState"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgingMempoolSnapshot"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedBlock"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DidntAdoptBlock"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedInvalidBlock"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AdoptedBlock"]
, [Text] -> [Text] -> Namespace (TraceForgeEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AdoptionThreadDied"]
]
instance Show t => LogFormatting (TraceBlockchainTimeEvent t) where
forMachine :: DetailLevel -> TraceBlockchainTimeEvent t -> Object
forMachine DetailLevel
_dtal (TraceStartTimeInTheFuture (SystemStart UTCTime
start) NominalDiffTime
toWait) =
[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
"TStartTimeInTheFuture"
, Key
"systemStart" 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 (UTCTime -> Text
forall a. Show a => a -> Text
showT UTCTime
start)
, Key
"toWait" 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 (NominalDiffTime -> Text
forall a. Show a => a -> Text
showT NominalDiffTime
toWait)
]
forMachine DetailLevel
_dtal (TraceCurrentSlotUnknown t
time PastHorizonException
_) =
[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
"CurrentSlotUnknown"
, Key
"time" 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 (t -> Text
forall a. Show a => a -> Text
showT t
time)
]
forMachine DetailLevel
_dtal (TraceSystemClockMovedBack t
prevTime t
newTime) =
[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
"SystemClockMovedBack"
, Key
"prevTime" 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 (t -> Text
forall a. Show a => a -> Text
showT t
prevTime)
, Key
"newTime" 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 (t -> Text
forall a. Show a => a -> Text
showT t
newTime)
]
forHuman :: TraceBlockchainTimeEvent t -> Text
forHuman (TraceStartTimeInTheFuture (SystemStart UTCTime
start) NominalDiffTime
toWait) =
Text
"Waiting "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text)
-> (NominalDiffTime -> String) -> NominalDiffTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> String
forall a. Show a => a -> String
show) NominalDiffTime
toWait
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" until genesis start time at "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) UTCTime
start
forHuman (TraceCurrentSlotUnknown t
time PastHorizonException
_) =
Text
"Too far from the chain tip to determine the current slot number for the time "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (t -> String) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show) t
time
forHuman (TraceSystemClockMovedBack t
prevTime t
newTime) =
Text
"The system wall clock time moved backwards, but within our tolerance "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"threshold. Previous 'current' time: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (t -> String) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show) t
prevTime
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". New 'current' time: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (t -> String) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show) t
newTime
instance MetaTrace (TraceBlockchainTimeEvent t) where
namespaceFor :: TraceBlockchainTimeEvent t
-> Namespace (TraceBlockchainTimeEvent t)
namespaceFor TraceStartTimeInTheFuture{} = [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartTimeInTheFuture"]
namespaceFor TraceCurrentSlotUnknown{} = [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CurrentSlotUnknown"]
namespaceFor TraceSystemClockMovedBack{} = [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SystemClockMovedBack"]
severityFor :: Namespace (TraceBlockchainTimeEvent t)
-> Maybe (TraceBlockchainTimeEvent t) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"StartTimeInTheFuture"]) Maybe (TraceBlockchainTimeEvent t)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
severityFor (Namespace [Text]
_ [Text
"CurrentSlotUnknown"]) Maybe (TraceBlockchainTimeEvent t)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
severityFor (Namespace [Text]
_ [Text
"SystemClockMovedBack"]) Maybe (TraceBlockchainTimeEvent t)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
severityFor Namespace (TraceBlockchainTimeEvent t)
_ Maybe (TraceBlockchainTimeEvent t)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceBlockchainTimeEvent t) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"StartTimeInTheFuture"]) =
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 start time of the blockchain time is in the future"
, Text
"\n"
, Text
" We have to block (for 'NominalDiffTime') until that time comes."
]
documentFor (Namespace [Text]
_ [Text
"CurrentSlotUnknown"]) =
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
"Current slot is not yet known"
, Text
"\n"
, Text
" This happens when the tip of our current chain is so far in the past that"
, Text
" we cannot translate the current wallclock to a slot number, typically"
, Text
" during syncing. Until the current slot number is known, we cannot"
, Text
" produce blocks. Seeing this message during syncing therefore is"
, Text
" normal and to be expected."
, Text
"\n"
, Text
" We record the current time (the time we tried to translate to a 'SlotNo')"
, Text
" as well as the 'PastHorizonException', which provides detail on the"
, Text
" bounds between which we /can/ do conversions. The distance between the"
, Text
" current time and the upper bound should rapidly decrease with consecutive"
, Text
" 'CurrentSlotUnknown' messages during syncing."
]
documentFor (Namespace [Text]
_ [Text
"SystemClockMovedBack"]) =
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 system clock moved back an acceptable time span, e.g., because of"
, Text
" an NTP sync."
, Text
"\n"
, Text
" The system clock moved back such that the new current slot would be"
, Text
" smaller than the previous one. If this is within the configured limit, we"
, Text
" trace this warning but *do not change the current slot*. The current slot"
, Text
" never decreases, but the current slot may stay the same longer than"
, Text
" expected."
, Text
"\n"
, Text
" When the system clock moved back more than the configured limit, we shut"
, Text
" down with a fatal exception."
]
documentFor Namespace (TraceBlockchainTimeEvent t)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceBlockchainTimeEvent t)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StartTimeInTheFuture"]
, [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CurrentSlotUnknown"]
, [Text] -> [Text] -> Namespace (TraceBlockchainTimeEvent t)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SystemClockMovedBack"]
]
instance
( LogFormatting selection
, Show selection
) =>
LogFormatting (TraceGsmEvent selection)
where
forMachine :: DetailLevel -> TraceGsmEvent selection -> Object
forMachine DetailLevel
dtal =
\case
TraceGsmEvent selection
GsmEventInitializedInCaughtUp ->
[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
"GsmEventInitializedInCaughtUp"
]
TraceGsmEvent selection
GsmEventInitializedInPreSyncing ->
[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
"GsmEventInitializedInPreSyncing"
]
GsmEventEnterCaughtUp Int
i selection
s ->
[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
"GsmEventEnterCaughtUp"
, Key
"peerNumber" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
i
, Key
"currentSelection" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> selection -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal selection
s
]
GsmEventLeaveCaughtUp selection
s DurationFromNow
a ->
[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
"GsmEventLeaveCaughtUp"
, Key
"currentSelection" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> selection -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal selection
s
, Key
"age" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (DurationFromNow -> String
forall a. Show a => a -> String
show DurationFromNow
a)
]
TraceGsmEvent selection
GsmEventPreSyncingToSyncing ->
[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
"GsmEventPreSyncingToSyncing"
]
TraceGsmEvent selection
GsmEventSyncingToPreSyncing ->
[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
"GsmEventSyncingToPreSyncing"
]
forHuman :: TraceGsmEvent selection -> Text
forHuman = TraceGsmEvent selection -> Text
forall a. Show a => a -> Text
showT
asMetrics :: TraceGsmEvent selection -> [Metric]
asMetrics =
\case
GsmEventEnterCaughtUp{} -> [Metric
caughtUp]
GsmEventLeaveCaughtUp{} -> [Metric
preSyncing]
GsmEventPreSyncingToSyncing{} -> [Metric
syncing]
GsmEventSyncingToPreSyncing{} -> [Metric
preSyncing]
GsmEventInitializedInCaughtUp{} -> [Metric
caughtUp]
GsmEventInitializedInPreSyncing{} -> [Metric
preSyncing]
where
preSyncing :: Metric
preSyncing = Text -> Integer -> Metric
IntM Text
"GSM.state" Integer
0
syncing :: Metric
syncing = Text -> Integer -> Metric
IntM Text
"GSM.state" Integer
1
caughtUp :: Metric
caughtUp = Text -> Integer -> Metric
IntM Text
"GSM.state" Integer
2
instance MetaTrace (TraceGsmEvent selection) where
namespaceFor :: TraceGsmEvent selection -> Namespace (TraceGsmEvent selection)
namespaceFor =
\case
TraceGsmEvent selection
GsmEventInitializedInCaughtUp -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedInCaughtUp"]
TraceGsmEvent selection
GsmEventInitializedInPreSyncing -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedInPreSyncing"]
GsmEventEnterCaughtUp{} -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"EnterCaughtUp"]
GsmEventLeaveCaughtUp{} -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LeaveCaughtUp"]
GsmEventPreSyncingToSyncing{} -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PreSyncingToSyncing"]
GsmEventSyncingToPreSyncing{} -> [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SyncingToPreSyncing"]
severityFor :: Namespace (TraceGsmEvent selection)
-> Maybe (TraceGsmEvent selection) -> Maybe SeverityS
severityFor Namespace (TraceGsmEvent selection)
ns Maybe (TraceGsmEvent selection)
_ =
case Namespace (TraceGsmEvent selection)
ns of
Namespace [Text]
_ [Text
"InitializedInCaughtUp"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"InitializedInPreSyncing"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"EnterCaughtUp"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"LeaveCaughtUp"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
Namespace [Text]
_ [Text
"PreSyncingToSyncing"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text
"SyncingToPreSyncing"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
Namespace [Text]
_ [Text]
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceGsmEvent selection) -> Maybe Text
documentFor = \case
Namespace [Text]
_ [Text
"InitializedInCaughtUp"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The GSM was initialized in the 'CaughtUp' state"
Namespace [Text]
_ [Text
"InitializedInPreSyncing"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The GSM was initialized in the 'PreSyncing' state"
Namespace [Text]
_ [Text
"EnterCaughtUp"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Node is caught up"
Namespace [Text]
_ [Text
"LeaveCaughtUp"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Node is not caught up"
Namespace [Text]
_ [Text
"PreSyncingToSyncing"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The Honest Availability Assumption is now satisfied"
Namespace [Text]
_ [Text
"SyncingToPreSyncing"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The Honest Availability Assumption is no longer satisfied"
Namespace [Text]
_ [Text]
_ ->
Maybe Text
forall a. Maybe a
Nothing
metricsDocFor :: Namespace (TraceGsmEvent selection) -> [(Text, Text)]
metricsDocFor = \case
Namespace [Text]
_ [Text
"InitializedInCaughtUp"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text
"InitializedInPreSyncing"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text
"EnterCaughtUp"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text
"LeaveCaughtUp"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text
"PreSyncingToSyncing"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text
"SyncingToPreSyncing"] -> [(Text, Text)]
doc
Namespace [Text]
_ [Text]
_ -> []
where
doc :: [(Text, Text)]
doc =
[
( Text
"GSM.state"
, Text
"The state of the Genesis State Machine. 0 = PreSyncing, 1 = Syncing, 2 = CaughtUp."
)
]
allNamespaces :: [Namespace (TraceGsmEvent selection)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedInCaughtUp"]
, [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedInPreSyncing"]
, [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"EnterCaughtUp"]
, [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LeaveCaughtUp"]
, [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PreSyncingToSyncing"]
, [Text] -> [Text] -> Namespace (TraceGsmEvent selection)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SyncingToPreSyncing"]
]
instance
( LogFormatting peer
, ConvertRawHash blk
) =>
LogFormatting (Jumping.TraceEventCsj peer blk)
where
forMachine :: DetailLevel -> TraceEventCsj peer blk -> Object
forMachine DetailLevel
dtal = \case
BecomingObjector Maybe peer
prevObjector ->
[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
"BecomingObjector"
, Key
"previousObjector" Key -> Maybe Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (peer -> Object) -> Maybe peer -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe peer
prevObjector)
]
TraceEventCsj peer blk
BlockedOnJump ->
[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
"BlockedOnJump"
]
TraceEventCsj peer blk
InitializedAsDynamo ->
[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
"InitializedAsDynamo"
]
NoLongerDynamo Maybe peer
newDynamo TraceCsjReason
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
"NoLongerDynamo"
, Key
"newDynamo" Key -> Maybe Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (peer -> Object) -> Maybe peer -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe peer
newDynamo)
, Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TraceCsjReason -> Value
csjReasonToJSON TraceCsjReason
reason
]
NoLongerObjector Maybe peer
newObjector TraceCsjReason
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
"NoLongerObjector"
, Key
"newObjector" Key -> Maybe Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (peer -> Object) -> Maybe peer -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe peer
newObjector)
, Key
"reason" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TraceCsjReason -> Value
csjReasonToJSON TraceCsjReason
reason
]
SentJumpInstruction Point blk
jumpTarget ->
[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
"SentJumpInstruction"
, Key
"jumpTarget" 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
jumpTarget
]
where
csjReasonToJSON :: TraceCsjReason -> Value
csjReasonToJSON = \case
TraceCsjReason
BecauseCsjDisengage -> Text -> Value
String Text
"BecauseCsjDisengage"
TraceCsjReason
BecauseCsjDisconnect -> Text -> Value
String Text
"BecauseCsjDisconnect"
instance MetaTrace (Jumping.TraceEventCsj peer blk) where
namespaceFor :: TraceEventCsj peer blk -> Namespace (TraceEventCsj peer blk)
namespaceFor = \case
BecomingObjector{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BecomingObjector"]
BlockedOnJump{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockedOnJump"]
InitializedAsDynamo{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedAsDynamo"]
NoLongerDynamo{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLongerDynamo"]
NoLongerObjector{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLongerObjector"]
SentJumpInstruction{} -> [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SentJumpInstruction"]
severityFor :: Namespace (TraceEventCsj peer blk)
-> Maybe (TraceEventCsj peer blk) -> Maybe SeverityS
severityFor Namespace (TraceEventCsj peer blk)
ns Maybe (TraceEventCsj peer blk)
_ = case Namespace (TraceEventCsj peer blk)
ns of
Namespace [Text]
_ [Text
"BecomingObjector"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"BlockedOnJump"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"InitializedAsDynamo"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"NoLongerDynamo"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"NoLongerObjector"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text
"SentJumpInstruction"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [Text]
_ [Text]
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceEventCsj peer blk) -> Maybe Text
documentFor = \case
Namespace [Text]
_ [Text
"BecomingObjector"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer is becoming the CSJ objector"
Namespace [Text]
_ [Text
"BlockedOnJump"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer is blocked on a CSJ jump"
Namespace [Text]
_ [Text
"InitializedAsDynamo"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer has been initialized as the CSJ dynamo"
Namespace [Text]
_ [Text
"NoLongerDynamo"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer no longer is the CSJ dynamo"
Namespace [Text]
_ [Text
"NoLongerObjector"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer no longer is the CSJ objector"
Namespace [Text]
_ [Text
"SentJumpInstruction"] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This peer has been instructed to jump via CSJ"
Namespace [Text]
_ [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceEventCsj peer blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BecomingObjector"]
, [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"BlockedOnJump"]
, [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InitializedAsDynamo"]
, [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLongerDynamo"]
, [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoLongerObjector"]
, [Text] -> [Text] -> Namespace (TraceEventCsj peer blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SentJumpInstruction"]
]
instance
( LogFormatting peer
, Show peer
) =>
LogFormatting (Jumping.TraceEventDbf peer)
where
forMachine :: DetailLevel -> TraceEventDbf peer -> Object
forMachine DetailLevel
dtal =
\case
RotatedDynamo peer
oldPeer peer
newPeer ->
[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
"RotatedDynamo"
, Key
"oldPeer" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
oldPeer
, Key
"newPeer" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
newPeer
]
forHuman :: TraceEventDbf peer -> Text
forHuman (RotatedDynamo peer
fromPeer peer
toPeer) =
Text
"Rotated the dynamo from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> peer -> Text
forall a. Show a => a -> Text
showT peer
fromPeer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> peer -> Text
forall a. Show a => a -> Text
showT peer
toPeer
instance MetaTrace (Jumping.TraceEventDbf peer) where
namespaceFor :: TraceEventDbf peer -> Namespace (TraceEventDbf peer)
namespaceFor =
\case
RotatedDynamo{} -> [Text] -> [Text] -> Namespace (TraceEventDbf peer)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RotatedDynamo"]
severityFor :: Namespace (TraceEventDbf peer)
-> Maybe (TraceEventDbf peer) -> Maybe SeverityS
severityFor Namespace (TraceEventDbf peer)
ns Maybe (TraceEventDbf peer)
_ =
case Namespace (TraceEventDbf peer)
ns of
Namespace [Text]
_ [Text
"RotatedDynamo"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text]
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TraceEventDbf peer) -> Maybe Text
documentFor = \case
Namespace [Text]
_ [Text
"RotatedDynamo"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The ChainSync Jumping module has been asked to rotate its dynamo"
Namespace [Text]
_ [Text]
_ ->
Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TraceEventDbf peer)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TraceEventDbf peer)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RotatedDynamo"]
]
instance
( StandardHash blk
, ConvertRawHash blk
) =>
LogFormatting (Tip blk)
where
forMachine :: DetailLevel -> Tip blk -> Object
forMachine DetailLevel
_dtal Tip blk
TipGenesis =
[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
"TipGenesis"]
forMachine DetailLevel
_dtal (Tip SlotNo
slotNo HeaderHash blk
hash BlockNo
bNo) =
[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
"Tip"
, Key
"tipSlotNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Key
"tipHash" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= 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
hash
, Key
"tipBlockNo" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo -> Value
forall a. ToJSON a => a -> Value
toJSON BlockNo
bNo
]
forHuman :: Tip blk -> Text
forHuman = Tip blk -> Text
forall a. Show a => a -> Text
showT
instance LogFormatting Agent.ServiceClientTrace where
forMachine :: DetailLevel -> ServiceClientTrace -> Object
forMachine DetailLevel
_dtal = \case
Agent.ServiceClientVersionHandshakeTrace VersionHandshakeDriverTrace
_vhdt ->
[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
"ServiceClientVersionHandshakeTrace"]
ServiceClientTrace
Agent.ServiceClientVersionHandshakeFailed ->
[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
"ServiceClientVersionHandshakeFailed"]
Agent.ServiceClientDriverTrace ServiceDriverTrace
_sdt ->
[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
"ServiceClientDriverTrace"]
ServiceClientTrace
Agent.ServiceClientSocketClosed ->
[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
"ServiceClientSocketClosed"]
Agent.ServiceClientConnected String
_s ->
[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
"ServiceClientConnected"]
Agent.ServiceClientAttemptReconnect{} ->
[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
"ServiceClientAttemptReconnect"]
Agent.ServiceClientReceivedKey TaggedBundleTrace
_tbt ->
[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
"ServiceClientReceivedKey"]
Agent.ServiceClientDeclinedKey TaggedBundleTrace
_tbt ->
[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
"ServiceClientDeclinedKey"]
ServiceClientTrace
Agent.ServiceClientDroppedKey ->
[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
"ServiceClientDroppedKey"]
Agent.ServiceClientOpCertNumberCheck Word64
_ Word64
_ ->
[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
"ServiceClientOpCertNumberCheck"]
Agent.ServiceClientAbnormalTermination String
_s ->
[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
"ServiceClientAbnormalTermination"]
ServiceClientTrace
Agent.ServiceClientStopped ->
[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
"ServiceClientStopped"]
forHuman :: ServiceClientTrace -> Text
forHuman = ServiceClientTrace -> Text
forall a. Show a => a -> Text
showT
instance MetaTrace Agent.ServiceClientTrace where
namespaceFor :: ServiceClientTrace -> Namespace ServiceClientTrace
namespaceFor = \case
Agent.ServiceClientVersionHandshakeTrace VersionHandshakeDriverTrace
_vhdt ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientVersionHandshakeTrace"]
ServiceClientTrace
Agent.ServiceClientVersionHandshakeFailed ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientVersionHandshakeFailed"]
Agent.ServiceClientDriverTrace ServiceDriverTrace
_sdt ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDriverTrace"]
ServiceClientTrace
Agent.ServiceClientSocketClosed ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientSocketClosed"]
Agent.ServiceClientConnected String
_s ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientConnected"]
Agent.ServiceClientAttemptReconnect{} ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientAttemptReconnect"]
Agent.ServiceClientReceivedKey TaggedBundleTrace
_tbt ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientReceivedKey"]
Agent.ServiceClientDeclinedKey TaggedBundleTrace
_tbt ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDeclinedKey"]
ServiceClientTrace
Agent.ServiceClientDroppedKey ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDroppedKey"]
Agent.ServiceClientOpCertNumberCheck Word64
_ Word64
_ ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientOpCertNumberCheck"]
Agent.ServiceClientAbnormalTermination String
_s ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientAbnormalTermination"]
ServiceClientTrace
Agent.ServiceClientStopped ->
[Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientStopped"]
severityFor :: Namespace ServiceClientTrace
-> Maybe ServiceClientTrace -> Maybe SeverityS
severityFor Namespace ServiceClientTrace
ns Maybe ServiceClientTrace
_ = case Namespace ServiceClientTrace
ns of
Namespace [] [Text
"ServiceClientVersionHandshakeTrace"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [] [Text
"ServiceClientVersionHandshakeFailed"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
Namespace [] [Text
"ServiceClientDriverTrace"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [] [Text
"ServiceClientSocketClosed"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientConnected"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientAttemptReconnect"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientReceivedKey"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientDeclinedKey"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientDroppedKey"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [] [Text
"ServiceClientOpCertNumberCheck"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
Namespace [] [Text
"ServiceClientAbnormalTermination"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
Namespace [] [Text
"ServiceClientStopped"] ->
SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text]
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace ServiceClientTrace -> Maybe Text
documentFor Namespace ServiceClientTrace
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace ServiceClientTrace]
allNamespaces =
[ [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientVersionHandshakeTrace"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientVersionHandshakeFailed"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDriverTrace"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientSocketClosed"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientConnected"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientAttemptReconnect"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientReceivedKey"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDeclinedKey"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientDroppedKey"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientOpCertNumberCheck"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientAbnormalTermination"]
, [Text] -> [Text] -> Namespace ServiceClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ServiceClientStopped"]
]
instance LogFormatting KESAgentClientTrace where
forMachine :: DetailLevel -> KESAgentClientTrace -> Object
forMachine DetailLevel
dtal = \case
KESAgentClientException SomeException
ex ->
[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
"KESAgentClientException"
, Key
"exception" 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 (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
ex)
]
KESAgentClientTrace ServiceClientTrace
t ->
[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
"KESAgentClientTrace"
, Key
"trace" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> ServiceClientTrace -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal ServiceClientTrace
t
]
forHuman :: KESAgentClientTrace -> Text
forHuman = KESAgentClientTrace -> Text
forall a. Show a => a -> Text
showT
instance MetaTrace KESAgentClientTrace where
namespaceFor :: KESAgentClientTrace -> Namespace KESAgentClientTrace
namespaceFor = \case
KESAgentClientException SomeException
_ ->
[Text] -> [Text] -> Namespace KESAgentClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"KESAgentClientException"]
KESAgentClientTrace ServiceClientTrace
t -> Namespace ServiceClientTrace -> Namespace KESAgentClientTrace
forall a b. Namespace a -> Namespace b
nsCast (Namespace ServiceClientTrace -> Namespace KESAgentClientTrace)
-> Namespace ServiceClientTrace -> Namespace KESAgentClientTrace
forall a b. (a -> b) -> a -> b
$ ServiceClientTrace -> Namespace ServiceClientTrace
forall a. MetaTrace a => a -> Namespace a
namespaceFor ServiceClientTrace
t
severityFor :: Namespace KESAgentClientTrace
-> Maybe KESAgentClientTrace -> Maybe SeverityS
severityFor (Namespace [] [Text
"KESAgentClientException"]) Maybe KESAgentClientTrace
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor Namespace KESAgentClientTrace
ns (Just (KESAgentClientTrace ServiceClientTrace
t)) = Namespace ServiceClientTrace
-> Maybe ServiceClientTrace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace KESAgentClientTrace -> Namespace ServiceClientTrace
forall a b. Namespace a -> Namespace b
nsCast Namespace KESAgentClientTrace
ns) (ServiceClientTrace -> Maybe ServiceClientTrace
forall a. a -> Maybe a
Just ServiceClientTrace
t)
severityFor Namespace KESAgentClientTrace
ns Maybe KESAgentClientTrace
Nothing =
Namespace ServiceClientTrace
-> Maybe ServiceClientTrace -> Maybe SeverityS
forall a. MetaTrace a => Namespace a -> Maybe a -> Maybe SeverityS
severityFor (Namespace KESAgentClientTrace -> Namespace ServiceClientTrace
forall a b. Namespace a -> Namespace b
nsCast Namespace KESAgentClientTrace
ns :: Namespace Agent.ServiceClientTrace) Maybe ServiceClientTrace
forall a. Maybe a
Nothing
severityFor Namespace KESAgentClientTrace
_ Maybe KESAgentClientTrace
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace KESAgentClientTrace -> Maybe Text
documentFor Namespace KESAgentClientTrace
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace KESAgentClientTrace]
allNamespaces =
[Text] -> [Text] -> Namespace KESAgentClientTrace
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"KESAgentClientException"]
Namespace KESAgentClientTrace
-> [Namespace KESAgentClientTrace]
-> [Namespace KESAgentClientTrace]
forall a. a -> [a] -> [a]
: (Namespace ServiceClientTrace -> Namespace KESAgentClientTrace)
-> [Namespace ServiceClientTrace]
-> [Namespace KESAgentClientTrace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Namespace ServiceClientTrace -> Namespace KESAgentClientTrace
forall a b. Namespace a -> Namespace b
nsCast ([Namespace ServiceClientTrace]
forall a. MetaTrace a => [Namespace a]
allNamespaces :: [Namespace Agent.ServiceClientTrace])
perasCertMetricsPrefix, perasVoteMetricsPrefix :: Text.Text
perasCertMetricsPrefix :: Text
perasCertMetricsPrefix = Text
"perasCert"
perasVoteMetricsPrefix :: Text
perasVoteMetricsPrefix = Text
"perasVote"
forMachineObjectDiffusionInbound ::
TraceObjectDiffusionInbound objectId object ->
Aeson.Object
forMachineObjectDiffusionInbound :: forall objectId object.
TraceObjectDiffusionInbound objectId object -> Object
forMachineObjectDiffusionInbound = \case
TraceObjectDiffusionInboundCollectedObjects Int
payload ->
[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
"TraceObjectDiffusionInboundCollectedObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
payload)
]
TraceObjectDiffusionInboundAddedObjects NumObjectsProcessed
payload ->
[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
"TraceObjectDiffusionInboundAddedObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text)
-> (NumObjectsProcessed -> String) -> NumObjectsProcessed -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumObjectsProcessed -> String
forall a. Show a => a -> String
show (NumObjectsProcessed -> Text) -> NumObjectsProcessed -> Text
forall a b. (a -> b) -> a -> b
$ NumObjectsProcessed
payload)
]
TraceObjectDiffusionInboundRecvControlMessage ControlMessage
payload ->
[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
"TraceObjectDiffusionInboundRecvControlMessage"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text)
-> (ControlMessage -> String) -> ControlMessage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlMessage -> String
forall a. Show a => a -> String
show (ControlMessage -> Text) -> ControlMessage -> Text
forall a b. (a -> b) -> a -> b
$ ControlMessage
payload)
]
TraceObjectDiffusionInboundCanRequestMoreObjects Int
payload ->
[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
"TraceObjectDiffusionInboundCanRequestMoreObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
payload)
]
TraceObjectDiffusionInboundCannotRequestMoreObjects Int
payload ->
[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
"TraceObjectDiffusionInboundCannotRequestMoreObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
payload)
]
asMetricsObjectDiffusionInbound ::
Text.Text ->
TraceObjectDiffusionInbound objectId object ->
[Metric]
asMetricsObjectDiffusionInbound :: forall objectId object.
Text -> TraceObjectDiffusionInbound objectId object -> [Metric]
asMetricsObjectDiffusionInbound Text
prefix = \case
TraceObjectDiffusionInboundCollectedObjects Int
collected ->
[Text -> Integer -> Metric
IntM (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsCollected") (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
collected)]
TraceObjectDiffusionInboundAddedObjects (NumObjectsProcessed Word64
added) ->
[Text -> Maybe Int -> Metric
CounterM (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsAdded") (Int -> Maybe Int
forall a. a -> Maybe a
Just (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
added))]
TraceObjectDiffusionInbound objectId object
_ -> []
metricsDocForObjectDiffusionInbound ::
Text.Text ->
Namespace a ->
[(Text.Text, Text.Text)]
metricsDocForObjectDiffusionInbound :: forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionInbound Text
prefix = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCollectedObjects"] ->
[
( Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsCollected"
, Text
"number of objects about to be inserted into the pool"
)
]
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundAddedObjects"] ->
[
( Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsAdded"
, Text
"total number of objects accepted into the pool"
)
]
Namespace a
_ -> []
namespaceForObjectDiffusionInbound ::
TraceObjectDiffusionInbound objectId object ->
Namespace a
namespaceForObjectDiffusionInbound :: forall objectId object a.
TraceObjectDiffusionInbound objectId object -> Namespace a
namespaceForObjectDiffusionInbound = \case
TraceObjectDiffusionInboundCollectedObjects Int
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCollectedObjects"]
TraceObjectDiffusionInboundAddedObjects NumObjectsProcessed
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundAddedObjects"]
TraceObjectDiffusionInboundRecvControlMessage ControlMessage
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundRecvControlMessage"]
TraceObjectDiffusionInboundCanRequestMoreObjects Int
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCanRequestMoreObjects"]
TraceObjectDiffusionInboundCannotRequestMoreObjects Int
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCannotRequestMoreObjects"]
documentForObjectDiffusionInbound :: Namespace a -> Maybe Text.Text
documentForObjectDiffusionInbound :: forall a. Namespace a -> Maybe Text
documentForObjectDiffusionInbound = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCollectedObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The number of objects received from the peer that are about to be inserted\
\ into the object pool."
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundAddedObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The pass/fail breakdown of the objects just handed to the object pool."
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundRecvControlMessage"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"A control message was received from the outbound peer governor, and is\
\ about to be acted on."
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCanRequestMoreObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"There is room to request more objects from the peer; the payload is how\
\ many."
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCannotRequestMoreObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"No more objects can be requested from the peer for now; the payload is how\
\ many are already in flight."
Namespace a
_ -> Maybe Text
forall a. Maybe a
Nothing
severityForObjectDiffusionInbound :: Namespace a -> Maybe SeverityS
severityForObjectDiffusionInbound :: forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionInbound = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCollectedObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundAddedObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundRecvControlMessage"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCanRequestMoreObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionInboundCannotRequestMoreObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace a
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
allNamespacesObjectDiffusionInbound :: [Namespace a]
allNamespacesObjectDiffusionInbound :: forall a. [Namespace a]
allNamespacesObjectDiffusionInbound =
[ [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCollectedObjects"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundAddedObjects"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundRecvControlMessage"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCanRequestMoreObjects"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionInboundCannotRequestMoreObjects"]
]
instance LogFormatting (TraceObjectDiffusionInbound PerasRoundNo object) where
forMachine :: DetailLevel
-> TraceObjectDiffusionInbound PerasRoundNo object -> Object
forMachine DetailLevel
_ = TraceObjectDiffusionInbound PerasRoundNo object -> Object
forall objectId object.
TraceObjectDiffusionInbound objectId object -> Object
forMachineObjectDiffusionInbound
asMetrics :: TraceObjectDiffusionInbound PerasRoundNo object -> [Metric]
asMetrics = Text -> TraceObjectDiffusionInbound PerasRoundNo object -> [Metric]
forall objectId object.
Text -> TraceObjectDiffusionInbound objectId object -> [Metric]
asMetricsObjectDiffusionInbound Text
perasCertMetricsPrefix
instance MetaTrace (TraceObjectDiffusionInbound PerasRoundNo object) where
namespaceFor :: TraceObjectDiffusionInbound PerasRoundNo object
-> Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
namespaceFor = TraceObjectDiffusionInbound PerasRoundNo object
-> Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
forall objectId object a.
TraceObjectDiffusionInbound objectId object -> Namespace a
namespaceForObjectDiffusionInbound
severityFor :: Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> Maybe (TraceObjectDiffusionInbound PerasRoundNo object)
-> Maybe SeverityS
severityFor Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
ns Maybe (TraceObjectDiffusionInbound PerasRoundNo object)
_ = Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> Maybe SeverityS
forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionInbound Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
ns
documentFor :: Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> Maybe Text
documentFor = Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> Maybe Text
forall a. Namespace a -> Maybe Text
documentForObjectDiffusionInbound
metricsDocFor :: Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> [(Text, Text)]
metricsDocFor = Text
-> Namespace (TraceObjectDiffusionInbound PerasRoundNo object)
-> [(Text, Text)]
forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionInbound Text
perasCertMetricsPrefix
allNamespaces :: [Namespace (TraceObjectDiffusionInbound PerasRoundNo object)]
allNamespaces = [Namespace (TraceObjectDiffusionInbound PerasRoundNo object)]
forall a. [Namespace a]
allNamespacesObjectDiffusionInbound
instance LogFormatting (TraceObjectDiffusionInbound PerasVoteId object) where
forMachine :: DetailLevel
-> TraceObjectDiffusionInbound PerasVoteId object -> Object
forMachine DetailLevel
_ = TraceObjectDiffusionInbound PerasVoteId object -> Object
forall objectId object.
TraceObjectDiffusionInbound objectId object -> Object
forMachineObjectDiffusionInbound
asMetrics :: TraceObjectDiffusionInbound PerasVoteId object -> [Metric]
asMetrics = Text -> TraceObjectDiffusionInbound PerasVoteId object -> [Metric]
forall objectId object.
Text -> TraceObjectDiffusionInbound objectId object -> [Metric]
asMetricsObjectDiffusionInbound Text
perasVoteMetricsPrefix
instance MetaTrace (TraceObjectDiffusionInbound PerasVoteId object) where
namespaceFor :: TraceObjectDiffusionInbound PerasVoteId object
-> Namespace (TraceObjectDiffusionInbound PerasVoteId object)
namespaceFor = TraceObjectDiffusionInbound PerasVoteId object
-> Namespace (TraceObjectDiffusionInbound PerasVoteId object)
forall objectId object a.
TraceObjectDiffusionInbound objectId object -> Namespace a
namespaceForObjectDiffusionInbound
severityFor :: Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> Maybe (TraceObjectDiffusionInbound PerasVoteId object)
-> Maybe SeverityS
severityFor Namespace (TraceObjectDiffusionInbound PerasVoteId object)
ns Maybe (TraceObjectDiffusionInbound PerasVoteId object)
_ = Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> Maybe SeverityS
forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionInbound Namespace (TraceObjectDiffusionInbound PerasVoteId object)
ns
documentFor :: Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> Maybe Text
documentFor = Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> Maybe Text
forall a. Namespace a -> Maybe Text
documentForObjectDiffusionInbound
metricsDocFor :: Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> [(Text, Text)]
metricsDocFor = Text
-> Namespace (TraceObjectDiffusionInbound PerasVoteId object)
-> [(Text, Text)]
forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionInbound Text
perasVoteMetricsPrefix
allNamespaces :: [Namespace (TraceObjectDiffusionInbound PerasVoteId object)]
allNamespaces = [Namespace (TraceObjectDiffusionInbound PerasVoteId object)]
forall a. [Namespace a]
allNamespacesObjectDiffusionInbound
forMachineObjectDiffusionOutbound ::
( Show objectId
, Show object
) =>
TraceObjectDiffusionOutbound objectId object ->
Aeson.Object
forMachineObjectDiffusionOutbound :: forall objectId object.
(Show objectId, Show object) =>
TraceObjectDiffusionOutbound objectId object -> Object
forMachineObjectDiffusionOutbound = \case
TraceObjectDiffusionOutboundRecvMsgRequestObjectIds NumObjectIdsReq
payload ->
[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
"TraceObjectDiffusionOutboundRecvMsgRequestObjectIds"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text)
-> (NumObjectIdsReq -> String) -> NumObjectIdsReq -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumObjectIdsReq -> String
forall a. Show a => a -> String
show (NumObjectIdsReq -> Text) -> NumObjectIdsReq -> Text
forall a b. (a -> b) -> a -> b
$ NumObjectIdsReq
payload)
]
TraceObjectDiffusionOutboundSendMsgReplyObjectIds [objectId]
payload ->
[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
"TraceObjectDiffusionOutboundSendMsgReplyObjectIds"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> ([objectId] -> String) -> [objectId] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [objectId] -> String
forall a. Show a => a -> String
show ([objectId] -> Text) -> [objectId] -> Text
forall a b. (a -> b) -> a -> b
$ [objectId]
payload)
]
TraceObjectDiffusionOutboundRecvMsgRequestObjects [objectId]
payload ->
[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
"TraceObjectDiffusionOutboundRecvMsgRequestObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> ([objectId] -> String) -> [objectId] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [objectId] -> String
forall a. Show a => a -> String
show ([objectId] -> Text) -> [objectId] -> Text
forall a b. (a -> b) -> a -> b
$ [objectId]
payload)
]
TraceObjectDiffusionOutboundSendMsgReplyObjects [object]
payload ->
[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
"TraceObjectDiffusionOutboundSendMsgReplyObjects"
, Key
"payload" 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 (String -> Text
Text.pack (String -> Text) -> ([object] -> String) -> [object] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [object] -> String
forall a. Show a => a -> String
show ([object] -> Text) -> [object] -> Text
forall a b. (a -> b) -> a -> b
$ [object]
payload)
]
TraceObjectDiffusionOutbound objectId object
TraceObjectDiffusionOutboundTerminated ->
[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
"TraceObjectDiffusionOutboundTerminated"
]
asMetricsObjectDiffusionOutbound ::
Text.Text ->
TraceObjectDiffusionOutbound objectId object ->
[Metric]
asMetricsObjectDiffusionOutbound :: forall objectId object.
Text -> TraceObjectDiffusionOutbound objectId object -> [Metric]
asMetricsObjectDiffusionOutbound Text
prefix = \case
TraceObjectDiffusionOutboundSendMsgReplyObjects [object]
objects ->
[Text -> Maybe Int -> Metric
CounterM (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsSent") (Int -> Maybe Int
forall a. a -> Maybe a
Just ([object] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [object]
objects))]
TraceObjectDiffusionOutbound objectId object
_ -> []
metricsDocForObjectDiffusionOutbound ::
Text.Text ->
Namespace a ->
[(Text.Text, Text.Text)]
metricsDocForObjectDiffusionOutbound :: forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionOutbound Text
prefix = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjects"] ->
[
( Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ObjectsSent"
, Text
"total number of objects served to peers"
)
]
Namespace a
_ -> []
namespaceForObjectDiffusionOutbound ::
TraceObjectDiffusionOutbound objectId object ->
Namespace a
namespaceForObjectDiffusionOutbound :: forall objectId object a.
TraceObjectDiffusionOutbound objectId object -> Namespace a
namespaceForObjectDiffusionOutbound = \case
TraceObjectDiffusionOutboundRecvMsgRequestObjectIds NumObjectIdsReq
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjectIds"]
TraceObjectDiffusionOutboundSendMsgReplyObjectIds [objectId]
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjectIds"]
TraceObjectDiffusionOutboundRecvMsgRequestObjects [objectId]
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjects"]
TraceObjectDiffusionOutboundSendMsgReplyObjects [object]
_ ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjects"]
TraceObjectDiffusionOutbound objectId object
TraceObjectDiffusionOutboundTerminated ->
[Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundTerminated"]
documentForObjectDiffusionOutbound :: Namespace a -> Maybe Text.Text
documentForObjectDiffusionOutbound :: forall a. Namespace a -> Maybe Text
documentForObjectDiffusionOutbound = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjectIds"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The peer asked for object ids; the payload is how many it asked for."
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjectIds"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The object ids about to be sent to the peer in reply."
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The peer asked for the objects with these ids."
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjects"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The objects about to be sent to the peer in reply."
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundTerminated"] ->
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The peer sent MsgDone, ending the object diffusion session."
Namespace a
_ -> Maybe Text
forall a. Maybe a
Nothing
severityForObjectDiffusionOutbound :: Namespace a -> Maybe SeverityS
severityForObjectDiffusionOutbound :: forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionOutbound = \case
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjectIds"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjectIds"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjects"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace [Text]
_ [Text
"TraceObjectDiffusionOutboundTerminated"] -> SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
Namespace a
_ -> Maybe SeverityS
forall a. Maybe a
Nothing
allNamespacesObjectDiffusionOutbound :: [Namespace a]
allNamespacesObjectDiffusionOutbound :: forall a. [Namespace a]
allNamespacesObjectDiffusionOutbound =
[ [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjectIds"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjectIds"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundRecvMsgRequestObjects"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundSendMsgReplyObjects"]
, [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"TraceObjectDiffusionOutboundTerminated"]
]
instance
Show object =>
LogFormatting (TraceObjectDiffusionOutbound PerasRoundNo object)
where
forMachine :: DetailLevel
-> TraceObjectDiffusionOutbound PerasRoundNo object -> Object
forMachine DetailLevel
_ = TraceObjectDiffusionOutbound PerasRoundNo object -> Object
forall objectId object.
(Show objectId, Show object) =>
TraceObjectDiffusionOutbound objectId object -> Object
forMachineObjectDiffusionOutbound
asMetrics :: TraceObjectDiffusionOutbound PerasRoundNo object -> [Metric]
asMetrics = Text
-> TraceObjectDiffusionOutbound PerasRoundNo object -> [Metric]
forall objectId object.
Text -> TraceObjectDiffusionOutbound objectId object -> [Metric]
asMetricsObjectDiffusionOutbound Text
perasCertMetricsPrefix
instance MetaTrace (TraceObjectDiffusionOutbound PerasRoundNo object) where
namespaceFor :: TraceObjectDiffusionOutbound PerasRoundNo object
-> Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
namespaceFor = TraceObjectDiffusionOutbound PerasRoundNo object
-> Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
forall objectId object a.
TraceObjectDiffusionOutbound objectId object -> Namespace a
namespaceForObjectDiffusionOutbound
severityFor :: Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> Maybe (TraceObjectDiffusionOutbound PerasRoundNo object)
-> Maybe SeverityS
severityFor Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
ns Maybe (TraceObjectDiffusionOutbound PerasRoundNo object)
_ = Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> Maybe SeverityS
forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionOutbound Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
ns
documentFor :: Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> Maybe Text
documentFor = Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> Maybe Text
forall a. Namespace a -> Maybe Text
documentForObjectDiffusionOutbound
metricsDocFor :: Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> [(Text, Text)]
metricsDocFor = Text
-> Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)
-> [(Text, Text)]
forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionOutbound Text
perasCertMetricsPrefix
allNamespaces :: [Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)]
allNamespaces = [Namespace (TraceObjectDiffusionOutbound PerasRoundNo object)]
forall a. [Namespace a]
allNamespacesObjectDiffusionOutbound
instance
Show object =>
LogFormatting (TraceObjectDiffusionOutbound PerasVoteId object)
where
forMachine :: DetailLevel
-> TraceObjectDiffusionOutbound PerasVoteId object -> Object
forMachine DetailLevel
_ = TraceObjectDiffusionOutbound PerasVoteId object -> Object
forall objectId object.
(Show objectId, Show object) =>
TraceObjectDiffusionOutbound objectId object -> Object
forMachineObjectDiffusionOutbound
asMetrics :: TraceObjectDiffusionOutbound PerasVoteId object -> [Metric]
asMetrics = Text -> TraceObjectDiffusionOutbound PerasVoteId object -> [Metric]
forall objectId object.
Text -> TraceObjectDiffusionOutbound objectId object -> [Metric]
asMetricsObjectDiffusionOutbound Text
perasVoteMetricsPrefix
instance MetaTrace (TraceObjectDiffusionOutbound PerasVoteId object) where
namespaceFor :: TraceObjectDiffusionOutbound PerasVoteId object
-> Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
namespaceFor = TraceObjectDiffusionOutbound PerasVoteId object
-> Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
forall objectId object a.
TraceObjectDiffusionOutbound objectId object -> Namespace a
namespaceForObjectDiffusionOutbound
severityFor :: Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> Maybe (TraceObjectDiffusionOutbound PerasVoteId object)
-> Maybe SeverityS
severityFor Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
ns Maybe (TraceObjectDiffusionOutbound PerasVoteId object)
_ = Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> Maybe SeverityS
forall a. Namespace a -> Maybe SeverityS
severityForObjectDiffusionOutbound Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
ns
documentFor :: Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> Maybe Text
documentFor = Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> Maybe Text
forall a. Namespace a -> Maybe Text
documentForObjectDiffusionOutbound
metricsDocFor :: Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> [(Text, Text)]
metricsDocFor = Text
-> Namespace (TraceObjectDiffusionOutbound PerasVoteId object)
-> [(Text, Text)]
forall a. Text -> Namespace a -> [(Text, Text)]
metricsDocForObjectDiffusionOutbound Text
perasVoteMetricsPrefix
allNamespaces :: [Namespace (TraceObjectDiffusionOutbound PerasVoteId object)]
allNamespaces = [Namespace (TraceObjectDiffusionOutbound PerasVoteId object)]
forall a. [Namespace a]
allNamespacesObjectDiffusionOutbound
instance
Show (PerasCert blk) =>
LogFormatting (TracePerasCertInclusionEvent blk)
where
forMachine :: DetailLevel -> TracePerasCertInclusionEvent blk -> Object
forMachine DetailLevel
_dtal = \case
TracePerasCertInclusionNoCertToInclude 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
"TracePerasCertInclusionNoCertToInclude"
, 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 SlotNo
slotNo
]
TracePerasCertInclusionRulesDecision SlotNo
slotNo PerasRoundNo
roundNo PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
decision ->
[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
"TracePerasCertInclusionRulesDecision"
, 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 SlotNo
slotNo
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
, Key
"decision" 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 (PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
-> Text
forall a. Show a => a -> Text
showT PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
decision)
]
forHuman :: TracePerasCertInclusionEvent blk -> Text
forHuman = \case
TracePerasCertInclusionNoCertToInclude SlotNo
slotNo ->
Text
"No Peras certificate available to include in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
TracePerasCertInclusionRulesDecision SlotNo
slotNo PerasRoundNo
roundNo PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
decision ->
Text
"Peras certificate inclusion rules decided "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
-> Text
forall a. Show a => a -> Text
showT PerasCertInclusionRulesDecision
(WithArrivalTime (ValidatedPerasCert blk))
decision
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
instance MetaTrace (TracePerasCertInclusionEvent blk) where
namespaceFor :: TracePerasCertInclusionEvent blk
-> Namespace (TracePerasCertInclusionEvent blk)
namespaceFor TracePerasCertInclusionNoCertToInclude{} =
[Text] -> [Text] -> Namespace (TracePerasCertInclusionEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoCertToInclude"]
namespaceFor TracePerasCertInclusionRulesDecision{} =
[Text] -> [Text] -> Namespace (TracePerasCertInclusionEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RulesDecision"]
severityFor :: Namespace (TracePerasCertInclusionEvent blk)
-> Maybe (TracePerasCertInclusionEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"NoCertToInclude"]) Maybe (TracePerasCertInclusionEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"RulesDecision"]) Maybe (TracePerasCertInclusionEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor Namespace (TracePerasCertInclusionEvent blk)
_ Maybe (TracePerasCertInclusionEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TracePerasCertInclusionEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"NoCertToInclude"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"There is no Peras certificate available to include in the block being forged."
documentFor (Namespace [Text]
_ [Text
"RulesDecision"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The decision taken by the Peras certificate inclusion rules, i.e. whether a\
\ certificate is to be included in the block being forged, and why."
documentFor Namespace (TracePerasCertInclusionEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TracePerasCertInclusionEvent blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TracePerasCertInclusionEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoCertToInclude"]
, [Text] -> [Text] -> Namespace (TracePerasCertInclusionEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RulesDecision"]
]
instance
( StandardHash blk
, Show (PerasVote blk)
, Show (PerasCert blk)
) =>
LogFormatting (TracePerasVoteForgingEvent blk)
where
forMachine :: DetailLevel -> TracePerasVoteForgingEvent blk -> Object
forMachine DetailLevel
_dtal = \case
TracePerasVotingNoVoteAfterFirstSlotInRound PerasRoundNo
roundNo Word64
slotInRound ->
[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
"TracePerasVotingNoVoteAfterFirstSlotInRound"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
, Key
"slotInRound" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
slotInRound
]
TracePerasVotingNotAVoterInRound 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
"TracePerasVotingNotAVoterInRound"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
]
TracePerasVotingRulesDecision PerasRoundNo
roundNo PerasVotingRulesDecision blk
decision ->
[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
"TracePerasVotingRulesDecision"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
, Key
"decision" 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 (PerasVotingRulesDecision blk -> Text
forall a. Show a => a -> Text
showT PerasVotingRulesDecision blk
decision)
]
TracePerasVotingForgedVote PerasRoundNo
roundNo WithArrivalTime (ValidatedPerasVote blk)
vote ->
[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
"TracePerasVotingForgedVote"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
, Key
"vote" 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 (WithArrivalTime (ValidatedPerasVote blk) -> Text
forall a. Show a => a -> Text
showT WithArrivalTime (ValidatedPerasVote blk)
vote)
]
TracePerasVotingAddVoteResult PerasRoundNo
roundNo 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
"TracePerasVotingAddVoteResult"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo 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 (AddPerasVoteResult blk -> Text
forall a. Show a => a -> Text
showT AddPerasVoteResult blk
result)
]
TracePerasVotingAddCertChainSelOutcome PerasRoundNo
roundNo AddPerasCertChainSelOutcome
outcome ->
[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
"TracePerasVotingAddCertChainSelOutcome"
, Key
"round" Key -> Word64 -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo
, Key
"outcome" 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 (AddPerasCertChainSelOutcome -> Text
forall a. Show a => a -> Text
showT AddPerasCertChainSelOutcome
outcome)
]
TracePerasVotingCantReadEnv String
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
"TracePerasVotingCantReadEnv"
, 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 (String -> Text
Text.pack String
err)
]
forHuman :: TracePerasVoteForgingEvent blk -> Text
forHuman = \case
TracePerasVotingNoVoteAfterFirstSlotInRound PerasRoundNo
roundNo Word64
slotInRound ->
Text
"Not voting in Peras round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": past the first slot of the round (slot "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT Word64
slotInRound
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
TracePerasVotingNotAVoterInRound PerasRoundNo
roundNo ->
Text
"Not a voter in Peras round " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
TracePerasVotingRulesDecision PerasRoundNo
roundNo PerasVotingRulesDecision blk
decision ->
Text
"Peras voting rules decided "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PerasVotingRulesDecision blk -> Text
forall a. Show a => a -> Text
showT PerasVotingRulesDecision blk
decision
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
TracePerasVotingForgedVote PerasRoundNo
roundNo WithArrivalTime (ValidatedPerasVote blk)
vote ->
Text
"Forged Peras vote in round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WithArrivalTime (ValidatedPerasVote blk) -> Text
forall a. Show a => a -> Text
showT WithArrivalTime (ValidatedPerasVote blk)
vote
TracePerasVotingAddVoteResult PerasRoundNo
roundNo AddPerasVoteResult blk
result ->
Text
"Adding the Peras vote of round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the vote DB: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddPerasVoteResult blk -> Text
forall a. Show a => a -> Text
showT AddPerasVoteResult blk
result
TracePerasVotingAddCertChainSelOutcome PerasRoundNo
roundNo AddPerasCertChainSelOutcome
outcome ->
Text
"Adding the Peras certificate of round "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
showT (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the cert DB: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddPerasCertChainSelOutcome -> Text
forall a. Show a => a -> Text
showT AddPerasCertChainSelOutcome
outcome
TracePerasVotingCantReadEnv String
err ->
Text
"Could not read the Peras voting environment: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
instance MetaTrace (TracePerasVoteForgingEvent blk) where
namespaceFor :: TracePerasVoteForgingEvent blk
-> Namespace (TracePerasVoteForgingEvent blk)
namespaceFor TracePerasVotingNoVoteAfterFirstSlotInRound{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoVoteAfterFirstSlotInRound"]
namespaceFor TracePerasVotingNotAVoterInRound{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NotAVoterInRound"]
namespaceFor TracePerasVotingRulesDecision{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RulesDecision"]
namespaceFor TracePerasVotingForgedVote{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedVote"]
namespaceFor TracePerasVotingAddVoteResult{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddVoteResult"]
namespaceFor TracePerasVotingAddCertChainSelOutcome{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddCertChainSelOutcome"]
namespaceFor TracePerasVotingCantReadEnv{} =
[Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CantReadEnv"]
severityFor :: Namespace (TracePerasVoteForgingEvent blk)
-> Maybe (TracePerasVoteForgingEvent blk) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"NoVoteAfterFirstSlotInRound"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"NotAVoterInRound"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
severityFor (Namespace [Text]
_ [Text
"RulesDecision"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"ForgedVote"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"AddVoteResult"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"AddCertChainSelOutcome"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
severityFor (Namespace [Text]
_ [Text
"CantReadEnv"]) Maybe (TracePerasVoteForgingEvent blk)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
severityFor Namespace (TracePerasVoteForgingEvent blk)
_ Maybe (TracePerasVoteForgingEvent blk)
_ = Maybe SeverityS
forall a. Maybe a
Nothing
documentFor :: Namespace (TracePerasVoteForgingEvent blk) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"NoVoteAfterFirstSlotInRound"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"Votes are only cast in the first slot of a Peras round, and this slot is not it."
documentFor (Namespace [Text]
_ [Text
"NotAVoterInRound"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"This node was not elected to the voting committee of the current Peras round."
documentFor (Namespace [Text]
_ [Text
"RulesDecision"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The decision taken by the Peras voting rules, i.e. whether a vote is to be\
\ cast in the current round, and why."
documentFor (Namespace [Text]
_ [Text
"ForgedVote"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"A Peras vote was forged for the current round."
documentFor (Namespace [Text]
_ [Text
"AddVoteResult"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The result of adding the freshly forged vote to the Peras vote DB, which is\
\ where it may complete a quorum and yield a new certificate."
documentFor (Namespace [Text]
_ [Text
"AddCertChainSelOutcome"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The outcome of handing a certificate generated by the freshly forged vote to\
\ chain selection."
documentFor (Namespace [Text]
_ [Text
"CantReadEnv"]) =
Text -> Maybe Text
forall a. a -> Maybe a
Just
Text
"The Peras voting environment could not be read."
documentFor Namespace (TracePerasVoteForgingEvent blk)
_ = Maybe Text
forall a. Maybe a
Nothing
allNamespaces :: [Namespace (TracePerasVoteForgingEvent blk)]
allNamespaces =
[ [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NoVoteAfterFirstSlotInRound"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NotAVoterInRound"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RulesDecision"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ForgedVote"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddVoteResult"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddCertChainSelOutcome"]
, [Text] -> [Text] -> Namespace (TracePerasVoteForgingEvent blk)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CantReadEnv"]
]