{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Tracing.Tracers
( Tracers (..)
, TraceOptions
, mkTracers
, nullTracersP2P
, nullTracersNonP2P
, traceCounter
) where
import Cardano.Prelude hiding (show)
import Prelude (String, show)
import GHC.Clock (getMonotonicTimeNSec)
import Codec.CBOR.Read (DeserialiseFailure)
import Data.Aeson (ToJSON (..), Value (..))
import Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as Pq
import qualified Data.Map.Strict as SMap
import qualified Data.Text as Text
import Data.Time (NominalDiffTime, UTCTime)
import qualified System.Metrics.Counter as Counter
import qualified System.Metrics.Gauge as Gauge
import qualified System.Metrics.Label as Label
import qualified System.Remote.Monitoring as EKG
import "contra-tracer" Control.Tracer
import Control.Tracer.Transformers
import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (..))
import Cardano.BM.Data.Aggregated (Measurable (..))
import Cardano.BM.Data.Tracer (WithSeverity (..), annotateSeverity)
import Cardano.BM.Data.Transformers
import Cardano.BM.Internal.ElidingTracer
import Cardano.BM.Trace (traceNamedObject)
import Cardano.BM.Tracing
import Ouroboros.Consensus.Block (BlockConfig, BlockProtocol, CannotForge, ConvertRawHash,
ForgeStateInfo, ForgeStateUpdateError, Header, realPointSlot)
import Ouroboros.Consensus.BlockchainTime (SystemStart (..),
TraceBlockchainTimeEvent (..))
import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError)
import Ouroboros.Consensus.Ledger.Abstract (LedgerErr, LedgerState)
import Ouroboros.Consensus.Ledger.Extended (ledgerState)
import Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent)
import Ouroboros.Consensus.Ledger.Query (BlockQuery)
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs,
LedgerSupportsMempool)
import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..))
import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient
import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode
import Ouroboros.Consensus.Node (NetworkP2PMode (..))
import qualified Ouroboros.Consensus.Node.Run as Consensus (RunNode)
import qualified Ouroboros.Consensus.Node.Tracers as Consensus
import Ouroboros.Consensus.Protocol.Abstract (ValidationErr)
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import Ouroboros.Consensus.Util.Enclose
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..),
HasHeader (..), Point, StandardHash, blockNo, pointSlot, unBlockNo)
import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..),
TraceLabelPeer (..))
import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..))
import Ouroboros.Network.ConnectionId (ConnectionId)
import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..))
import Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..))
import Ouroboros.Network.PeerSelection.Governor (PeerSelectionCounters (..))
import Ouroboros.Network.Point (fromWithOrigin)
import Ouroboros.Network.Protocol.LocalStateQuery.Type (ShowQuery)
import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..),
ConnectionManagerTrace (..))
import qualified Ouroboros.Network.Diffusion as Diffusion
import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P
import qualified Ouroboros.Network.Diffusion.P2P as P2P
import Ouroboros.Network.NodeToClient (LocalAddress)
import Ouroboros.Network.NodeToNode (RemoteAddress)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB
import Cardano.Tracing.Config
import Cardano.Tracing.Metrics
import Cardano.Tracing.Shutdown ()
import Cardano.Tracing.Startup ()
import Cardano.Node.Configuration.Logging
import Cardano.Node.TraceConstraints
import Cardano.Node.Tracing
import Cardano.Node.Protocol.Byron ()
import Cardano.Node.Protocol.Shelley ()
import Cardano.Node.Queries
import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import Ouroboros.Network.TxSubmission.Inbound
import qualified Cardano.Node.STM as STM
import qualified Control.Concurrent.STM as STM
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import qualified Data.Aeson.KeyMap as KeyMap
data ForgeTracers = ForgeTracers
{ ForgeTracers -> Trace IO Text
ftForged :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftForgeAboutToLead :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftCouldNotForge :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftAdopted :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftDidntAdoptBlock :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftForgedInvalid :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceNodeNotLeader :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceNodeCannotForge :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceForgeStateUpdateError :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceBlockFromFuture :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceSlotIsImmutable :: Trace IO Text
, ForgeTracers -> Trace IO Text
ftTraceNodeIsLeader :: Trace IO Text
}
nullTracersP2P :: Tracers peer localPeer blk 'Diffusion.P2P
nullTracersP2P :: Tracers peer localPeer blk 'P2P
nullTracersP2P = Tracers :: forall peer localPeer blk (p2p :: P2P).
Tracer IO (TraceEvent blk)
-> Tracers IO peer localPeer blk
-> Tracers IO peer blk DeserialiseFailure
-> Tracers IO localPeer blk DeserialiseFailure
-> Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Tracer IO (StartupTrace blk)
-> Tracer IO ShutdownTrace
-> Tracer IO NodeInfo
-> Tracer IO NodeState
-> Tracer IO ResourceStats
-> Tracer IO [PeerT blk]
-> Tracers peer localPeer blk p2p
Tracers
{ chainDBTracer :: Tracer IO (TraceEvent blk)
chainDBTracer = Tracer IO (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, consensusTracers :: Tracers IO peer localPeer blk
consensusTracers = Tracers IO peer localPeer blk
forall (m :: * -> *) remotePeer localPeer blk.
Monad m =>
Tracers m remotePeer localPeer blk
Consensus.nullTracers
, nodeToClientTracers :: Tracers IO localPeer blk DeserialiseFailure
nodeToClientTracers = Tracers IO localPeer blk DeserialiseFailure
forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
NodeToClient.nullTracers
, nodeToNodeTracers :: Tracers IO peer blk DeserialiseFailure
nodeToNodeTracers = Tracers IO peer blk DeserialiseFailure
forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
NodeToNode.nullTracers
, diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers = Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
forall (m :: * -> *) ntnAddr ntnVersion ntcAddr ntcVersion.
Applicative m =>
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
Diffusion.nullTracers
, diffusionTracersExtra :: ExtraTracers 'P2P
diffusionTracersExtra = TracersExtra
RemoteAddress
NodeToNodeVersion
NodeToNodeVersionData
LocalAddress
NodeToClientVersion
NodeToClientVersionData
IOException
IO
-> ExtraTracers 'P2P
Diffusion.P2PTracers TracersExtra
RemoteAddress
NodeToNodeVersion
NodeToNodeVersionData
LocalAddress
NodeToClientVersion
NodeToClientVersionData
IOException
IO
forall (m :: * -> *) ntnAddr ntnVersion ntnVersionData ntcAddr
ntcVersion ntcVersionData resolverError.
Applicative m =>
TracersExtra
ntnAddr
ntnVersion
ntnVersionData
ntcAddr
ntcVersion
ntcVersionData
resolverError
m
P2P.nullTracers
, startupTracer :: Tracer IO (StartupTrace blk)
startupTracer = Tracer IO (StartupTrace blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, shutdownTracer :: Tracer IO ShutdownTrace
shutdownTracer = Tracer IO ShutdownTrace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeInfoTracer :: Tracer IO NodeInfo
nodeInfoTracer = Tracer IO NodeInfo
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeStateTracer :: Tracer IO NodeState
nodeStateTracer = Tracer IO NodeState
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, resourcesTracer :: Tracer IO ResourceStats
resourcesTracer = Tracer IO ResourceStats
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, peersTracer :: Tracer IO [PeerT blk]
peersTracer = Tracer IO [PeerT blk]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
nullTracersNonP2P :: Tracers peer localPeer blk Diffusion.NonP2P
nullTracersNonP2P :: Tracers peer localPeer blk 'NonP2P
nullTracersNonP2P = Tracers :: forall peer localPeer blk (p2p :: P2P).
Tracer IO (TraceEvent blk)
-> Tracers IO peer localPeer blk
-> Tracers IO peer blk DeserialiseFailure
-> Tracers IO localPeer blk DeserialiseFailure
-> Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Tracer IO (StartupTrace blk)
-> Tracer IO ShutdownTrace
-> Tracer IO NodeInfo
-> Tracer IO NodeState
-> Tracer IO ResourceStats
-> Tracer IO [PeerT blk]
-> Tracers peer localPeer blk p2p
Tracers
{ chainDBTracer :: Tracer IO (TraceEvent blk)
chainDBTracer = Tracer IO (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, consensusTracers :: Tracers IO peer localPeer blk
consensusTracers = Tracers IO peer localPeer blk
forall (m :: * -> *) remotePeer localPeer blk.
Monad m =>
Tracers m remotePeer localPeer blk
Consensus.nullTracers
, nodeToClientTracers :: Tracers IO localPeer blk DeserialiseFailure
nodeToClientTracers = Tracers IO localPeer blk DeserialiseFailure
forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
NodeToClient.nullTracers
, nodeToNodeTracers :: Tracers IO peer blk DeserialiseFailure
nodeToNodeTracers = Tracers IO peer blk DeserialiseFailure
forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
NodeToNode.nullTracers
, diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers = Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
forall (m :: * -> *) ntnAddr ntnVersion ntcAddr ntcVersion.
Applicative m =>
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
Diffusion.nullTracers
, diffusionTracersExtra :: ExtraTracers 'NonP2P
diffusionTracersExtra = TracersExtra -> ExtraTracers 'NonP2P
Diffusion.NonP2PTracers TracersExtra
NonP2P.nullTracers
, startupTracer :: Tracer IO (StartupTrace blk)
startupTracer = Tracer IO (StartupTrace blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, shutdownTracer :: Tracer IO ShutdownTrace
shutdownTracer = Tracer IO ShutdownTrace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeInfoTracer :: Tracer IO NodeInfo
nodeInfoTracer = Tracer IO NodeInfo
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeStateTracer :: Tracer IO NodeState
nodeStateTracer = Tracer IO NodeState
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, resourcesTracer :: Tracer IO ResourceStats
resourcesTracer = Tracer IO ResourceStats
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, peersTracer :: Tracer IO [PeerT blk]
peersTracer = Tracer IO [PeerT blk]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
indexGCType :: ChainDB.TraceGCEvent a -> Int
indexGCType :: TraceGCEvent a -> Int
indexGCType ChainDB.ScheduledGC{} = Int
1
indexGCType ChainDB.PerformedGC{} = Int
2
indexReplType :: ChainDB.TraceReplayEvent a -> Int
indexReplType :: TraceReplayEvent a -> Int
indexReplType LedgerDB.ReplayFromGenesis{} = Int
1
indexReplType LedgerDB.ReplayFromSnapshot{} = Int
2
indexReplType LedgerDB.ReplayedBlock{} = Int
3
instance ElidingTracer (WithSeverity (ChainDB.TraceEvent blk)) where
isEquivalent :: WithSeverity (TraceEvent blk)
-> WithSeverity (TraceEvent blk) -> Bool
isEquivalent (WithSeverity Severity
s1 (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev1))
(WithSeverity Severity
s2 (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
ev2)) =
Severity
s1 Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
s2 Bool -> Bool -> Bool
&& TraceReplayEvent blk -> Int
forall a. TraceReplayEvent a -> Int
indexReplType TraceReplayEvent blk
ev1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== TraceReplayEvent blk -> Int
forall a. TraceReplayEvent a -> Int
indexReplType TraceReplayEvent blk
ev2
isEquivalent (WithSeverity Severity
s1 (ChainDB.TraceGCEvent TraceGCEvent blk
ev1))
(WithSeverity Severity
s2 (ChainDB.TraceGCEvent TraceGCEvent blk
ev2)) =
Severity
s1 Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
s2 Bool -> Bool -> Bool
&& TraceGCEvent blk -> Int
forall a. TraceGCEvent a -> Int
indexGCType TraceGCEvent blk
ev1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== TraceGCEvent blk -> Int
forall a. TraceGCEvent a -> Int
indexGCType TraceGCEvent blk
ev2
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceGCEvent TraceGCEvent blk
_ev1))
(WithSeverity Severity
_s2 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceGCEvent TraceGCEvent blk
_ev2)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceGCEvent TraceGCEvent blk
_ev1))
(WithSeverity Severity
_s2 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceGCEvent TraceGCEvent blk
_ev2)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_))
(WithSeverity Severity
_s2 (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_)) = Bool
True
isEquivalent (WithSeverity Severity
_s1 (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev1))
(WithSeverity Severity
_s2 (ChainDB.TraceInitChainSelEvent TraceInitChainSelEvent blk
ev2)) =
case (TraceInitChainSelEvent blk
ev1, TraceInitChainSelEvent blk
ev2) of
(ChainDB.InitChainSelValidation (
ChainDB.UpdateLedgerDbTraceEvent (
LedgerDB.StartedPushingBlockToTheLedgerDb PushStart blk
_ PushGoal blk
_ Pushing blk
_)),
ChainDB.InitChainSelValidation (
ChainDB.UpdateLedgerDbTraceEvent (
LedgerDB.StartedPushingBlockToTheLedgerDb PushStart blk
_ PushGoal blk
_ Pushing blk
_))) -> Bool
True
(TraceInitChainSelEvent blk, TraceInitChainSelEvent blk)
_ -> Bool
False
isEquivalent WithSeverity (TraceEvent blk)
_ WithSeverity (TraceEvent blk)
_ = Bool
False
doelide :: WithSeverity (TraceEvent blk) -> Bool
doelide (WithSeverity Severity
_ (ChainDB.TraceLedgerReplayEvent TraceReplayEvent blk
_)) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceGCEvent TraceGCEvent blk
_)) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreBlockOlderThanK RealPoint blk
_))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.IgnoreInvalidBlock RealPoint blk
_ InvalidBlockReason blk
_))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.BlockInTheFuture RealPoint blk
_ SlotNo
_))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.StoreButDontChange RealPoint blk
_))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.TrySwitchToAFork RealPoint blk
_ ChainDiff (HeaderFields blk)
_))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.SwitchedToAFork{}))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation (ChainDB.InvalidBlock ExtValidationError blk
_ RealPoint blk
_)))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation ChainDB.CandidateContainsFutureBlocksExceedingClockSkew{}))) = Bool
False
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.AddBlockValidation TraceValidationEvent blk
_))) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.AddedToCurrentChain [LedgerEvent blk]
events NewTipInfo blk
_ AnchoredFragment (Header blk)
_ AnchoredFragment (Header blk)
_))) = [LedgerEvent blk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerEvent blk]
events
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent (ChainDB.PipeliningEvent{}))) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_)) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_)) = Bool
True
doelide (WithSeverity Severity
_ (ChainDB.TraceInitChainSelEvent (ChainDB.InitChainSelValidation (ChainDB.UpdateLedgerDbTraceEvent{})))) = Bool
True
doelide WithSeverity (TraceEvent blk)
_ = Bool
False
conteliding :: TracingVerbosity
-> Trace IO t
-> WithSeverity (TraceEvent blk)
-> (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
conteliding TracingVerbosity
_tverb Trace IO t
_tr WithSeverity (TraceEvent blk)
_ (Maybe (WithSeverity (TraceEvent blk))
Nothing, Integer
_count) = (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (WithSeverity (TraceEvent blk))
forall a. Maybe a
Nothing, Integer
0)
conteliding TracingVerbosity
tverb Trace IO t
tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent ChainDB.AddedToCurrentChain{})) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
oldt) = do
Word64
tnow <- IO Word64
getMonotonicTimeNSec
let tnow' :: Integer
tnow' = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
tnow
deltat :: Integer
deltat = Integer
tnow' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
oldt
if Integer
deltat Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1250000000
then do
Tracer IO (WithSeverity (TraceEvent blk))
-> WithSeverity (TraceEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> Trace IO t -> Tracer IO (WithSeverity (TraceEvent blk))
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) WithSeverity (TraceEvent blk)
ev
(Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
tnow')
else (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
oldt)
conteliding TracingVerbosity
_tverb Trace IO t
_tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
_)) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
count) =
(Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
count)
conteliding TracingVerbosity
_tverb Trace IO t
_tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceCopyToImmutableDBEvent TraceCopyToImmutableDBEvent blk
_)) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
count) =
(Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
count)
conteliding TracingVerbosity
_tverb Trace IO t
_tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceGCEvent TraceGCEvent blk
_)) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
count) =
(Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
count)
conteliding TracingVerbosity
_tverb Trace IO t
_tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceLedgerReplayEvent (LedgerDB.ReplayedBlock {}))) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
count) = do
(Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
count)
conteliding TracingVerbosity
_tverb Trace IO t
_tr ev :: WithSeverity (TraceEvent blk)
ev@(WithSeverity Severity
_ (ChainDB.TraceInitChainSelEvent
(ChainDB.InitChainSelValidation
(ChainDB.UpdateLedgerDbTraceEvent
(LedgerDB.StartedPushingBlockToTheLedgerDb
PushStart blk
_ PushGoal blk
_ (LedgerDB.Pushing RealPoint blk
curr)))))) (Maybe (WithSeverity (TraceEvent blk))
_old, Integer
count) = (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer))
-> (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall a b. (a -> b) -> a -> b
$
let currSlot :: Integer
currSlot = 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 -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
curr in
if Integer
count Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
then (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
currSlot)
else if Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
10000 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
currSlot
then (Maybe (WithSeverity (TraceEvent blk))
forall a. Maybe a
Nothing, Integer
0)
else (WithSeverity (TraceEvent blk)
-> Maybe (WithSeverity (TraceEvent blk))
forall a. a -> Maybe a
Just WithSeverity (TraceEvent blk)
ev, Integer
count)
conteliding TracingVerbosity
_ Trace IO t
_ WithSeverity (TraceEvent blk)
_ (Maybe (WithSeverity (TraceEvent blk)), Integer)
_ = (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> IO (Maybe (WithSeverity (TraceEvent blk)), Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (WithSeverity (TraceEvent blk))
forall a. Maybe a
Nothing, Integer
0)
reportelided :: TracingVerbosity
-> Trace IO t -> WithSeverity (TraceEvent blk) -> Integer -> IO ()
reportelided TracingVerbosity
_tverb Trace IO t
_tr (WithSeverity Severity
_ (ChainDB.TraceLedgerReplayEvent (LedgerDB.ReplayedBlock{}))) Integer
_count = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
reportelided TracingVerbosity
t Trace IO t
tr WithSeverity (TraceEvent blk)
ev Integer
count = TracingVerbosity
-> Trace IO t -> WithSeverity (TraceEvent blk) -> Integer -> IO ()
forall t a.
(ToObject t, Transformable t IO a) =>
TracingVerbosity -> Trace IO t -> a -> Integer -> IO ()
defaultelidedreporting TracingVerbosity
t Trace IO t
tr WithSeverity (TraceEvent blk)
ev Integer
count
instance (StandardHash header, Eq peer) => ElidingTracer
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]) where
isEquivalent :: WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
-> WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]
-> Bool
isEquivalent (WithSeverity Severity
s1 [TraceLabelPeer peer (FetchDecision [Point header])]
_peers1)
(WithSeverity Severity
s2 [TraceLabelPeer peer (FetchDecision [Point header])]
_peers2) = Severity
s1 Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
s2
doelide :: WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
-> Bool
doelide (WithSeverity Severity
_ [TraceLabelPeer peer (FetchDecision [Point header])]
peers) =
let checkDecision :: TraceLabelPeer peer (Either FetchDecline result) -> Bool
checkDecision :: TraceLabelPeer peer (Either FetchDecline result) -> Bool
checkDecision (TraceLabelPeer peer
_peer (Left FetchDecline
FetchDeclineChainNotPlausible)) = Bool
True
checkDecision (TraceLabelPeer peer
_peer (Left (FetchDeclineConcurrencyLimit FetchMode
_ Word
_))) = Bool
True
checkDecision (TraceLabelPeer peer
_peer (Left (FetchDeclinePeerBusy SizeInBytes
_ SizeInBytes
_ SizeInBytes
_))) = Bool
True
checkDecision TraceLabelPeer peer (Either FetchDecline result)
_ = Bool
False
in (TraceLabelPeer peer (FetchDecision [Point header]) -> Bool)
-> [TraceLabelPeer peer (FetchDecision [Point header])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TraceLabelPeer peer (FetchDecision [Point header]) -> Bool
forall result.
TraceLabelPeer peer (Either FetchDecline result) -> Bool
checkDecision [TraceLabelPeer peer (FetchDecision [Point header])]
peers
conteliding :: TracingVerbosity
-> Trace IO t
-> WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]
-> (Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
-> IO
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
conteliding TracingVerbosity
_tverb Trace IO t
_tr WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
_ (Maybe
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
Nothing, Integer
_count) = (Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
-> IO
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
forall a. Maybe a
Nothing, Integer
0)
conteliding TracingVerbosity
tverb Trace IO t
tr WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
ev (Maybe
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
_old, Integer
count) = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
count Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
count Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
1000 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Tracer
IO
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
-> WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> Trace IO t
-> Tracer
IO
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO t
tr) WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
ev
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
-> IO
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point header])]),
Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
-> Maybe
(WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])])
forall a. a -> Maybe a
Just WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]
ev, Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
mkTracers
:: forall blk p2p.
( Consensus.RunNode blk
, TraceConstraints blk
)
=> BlockConfig blk
-> TraceOptions
-> Trace IO Text
-> NodeKernelData blk
-> Maybe EKGDirect
-> NetworkP2PMode p2p
-> IO (Tracers (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p)
mkTracers :: BlockConfig blk
-> TraceOptions
-> Trace IO Text
-> NodeKernelData blk
-> Maybe EKGDirect
-> NetworkP2PMode p2p
-> IO
(Tracers
(ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p)
mkTracers BlockConfig blk
blockConfig tOpts :: TraceOptions
tOpts@(TracingOnLegacy TraceSelection
trSel) Trace IO Text
tr NodeKernelData blk
nodeKern Maybe EKGDirect
ekgDirect NetworkP2PMode p2p
enableP2P = do
ForgingStats
fStats <- IO ForgingStats
mkForgingStats
Tracers'
(ConnectionId RemoteAddress)
(ConnectionId LocalAddress)
blk
(Tracer IO)
consensusTracers <- Maybe EKGDirect
-> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeKernelData blk
-> ForgingStats
-> IO
(Tracers'
(ConnectionId RemoteAddress)
(ConnectionId LocalAddress)
blk
(Tracer IO))
forall blk peer localPeer.
(Show peer, Eq peer, LedgerQueries blk, ToJSON (GenTxId blk),
ToObject (ApplyTxErr blk), ToObject (CannotForge blk),
ToObject (GenTx blk), ToObject (LedgerErr (LedgerState blk)),
ToObject (OtherHeaderEnvelopeError blk),
ToObject (ValidationErr (BlockProtocol blk)),
ToObject (ForgeStateUpdateError blk), ToObject peer, RunNode blk,
HasKESMetricsData blk, HasKESInfo blk) =>
Maybe EKGDirect
-> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeKernelData blk
-> ForgingStats
-> IO (Tracers' peer localPeer blk (Tracer IO))
mkConsensusTracers Maybe EKGDirect
ekgDirect TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr NodeKernelData blk
nodeKern ForgingStats
fStats
MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
elidedChainDB <- IO (MVar (Maybe (WithSeverity (TraceEvent blk)), Integer))
forall a. ElidingTracer a => IO (MVar (Maybe a, Integer))
newstate
TVar Word64
tForks <- Word64 -> IO (TVar Word64)
forall a. a -> IO (TVar a)
STM.newTVarIO Word64
0
Tracers
(ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p
-> IO
(Tracers
(ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tracers :: forall peer localPeer blk (p2p :: P2P).
Tracer IO (TraceEvent blk)
-> Tracers IO peer localPeer blk
-> Tracers IO peer blk DeserialiseFailure
-> Tracers IO localPeer blk DeserialiseFailure
-> Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Tracer IO (StartupTrace blk)
-> Tracer IO ShutdownTrace
-> Tracer IO NodeInfo
-> Tracer IO NodeState
-> Tracer IO ResourceStats
-> Tracer IO [PeerT blk]
-> Tracers peer localPeer blk p2p
Tracers
{ chainDBTracer :: Tracer IO (TraceEvent blk)
chainDBTracer = OnOff TraceChainDB
-> Tracer IO (TraceEvent blk) -> Tracer IO (TraceEvent blk)
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceChainDB
traceChainDB TraceSelection
trSel) (Tracer IO (TraceEvent blk) -> Tracer IO (TraceEvent blk))
-> Tracer IO (TraceEvent blk) -> Tracer IO (TraceEvent blk)
forall a b. (a -> b) -> a -> b
$
Tracer IO (WithSeverity (TraceEvent blk))
-> Tracer IO (TraceEvent blk)
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity (Tracer IO (WithSeverity (TraceEvent blk))
-> Tracer IO (TraceEvent blk))
-> Tracer IO (WithSeverity (TraceEvent blk))
-> Tracer IO (TraceEvent blk)
forall a b. (a -> b) -> a -> b
$ BlockConfig blk
-> ForgingStats
-> TraceOptions
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Maybe EKGDirect
-> TVar Word64
-> Trace IO Text
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
forall blk.
(ConvertRawHash blk, LedgerSupportsProtocol blk, InspectLedger blk,
ToObject (Header blk), ToObject (LedgerEvent blk)) =>
BlockConfig blk
-> ForgingStats
-> TraceOptions
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Maybe EKGDirect
-> TVar Word64
-> Trace IO Text
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
teeTraceChainTip
BlockConfig blk
blockConfig
ForgingStats
fStats
TraceOptions
tOpts MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
elidedChainDB
Maybe EKGDirect
ekgDirect
TVar Word64
tForks
(Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"ChainDB" Trace IO Text
tr)
(Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tr)
, consensusTracers :: Tracers'
(ConnectionId RemoteAddress)
(ConnectionId LocalAddress)
blk
(Tracer IO)
consensusTracers = Tracers'
(ConnectionId RemoteAddress)
(ConnectionId LocalAddress)
blk
(Tracer IO)
consensusTracers
, nodeToClientTracers :: Tracers IO (ConnectionId LocalAddress) blk DeserialiseFailure
nodeToClientTracers = TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers IO (ConnectionId LocalAddress) blk DeserialiseFailure
forall localPeer blk.
(ToObject localPeer, ShowQuery (BlockQuery blk)) =>
TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers' localPeer blk DeserialiseFailure (Tracer IO)
nodeToClientTracers' TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr
, nodeToNodeTracers :: Tracers IO (ConnectionId RemoteAddress) blk DeserialiseFailure
nodeToNodeTracers = TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers IO (ConnectionId RemoteAddress) blk DeserialiseFailure
forall blk peer.
(RunNode blk, ConvertTxId blk, HasTxs blk, Show peer,
ToObject peer) =>
TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers' peer blk DeserialiseFailure (Tracer IO)
nodeToNodeTracers' TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr
, Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers
, diffusionTracersExtra :: ExtraTracers p2p
diffusionTracersExtra = NetworkP2PMode p2p -> ExtraTracers p2p
diffusionTracersExtra' NetworkP2PMode p2p
enableP2P
, startupTracer :: Tracer IO (StartupTrace blk)
startupTracer = TracingVerbosity -> Trace IO Text -> Tracer IO (StartupTrace blk)
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
verb (Trace IO Text -> Tracer IO (StartupTrace blk))
-> Trace IO Text -> Tracer IO (StartupTrace blk)
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"startup" Trace IO Text
tr
, shutdownTracer :: Tracer IO ShutdownTrace
shutdownTracer = TracingVerbosity -> Trace IO Text -> Tracer IO ShutdownTrace
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
verb (Trace IO Text -> Tracer IO ShutdownTrace)
-> Trace IO Text -> Tracer IO ShutdownTrace
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"shutdown" Trace IO Text
tr
, nodeInfoTracer :: Tracer IO NodeInfo
nodeInfoTracer = Tracer IO NodeInfo
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeStateTracer :: Tracer IO NodeState
nodeStateTracer = Tracer IO NodeState
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, resourcesTracer :: Tracer IO ResourceStats
resourcesTracer = Tracer IO ResourceStats
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, peersTracer :: Tracer IO [PeerT blk]
peersTracer = Tracer IO [PeerT blk]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
where
diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers = Tracers :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
-> Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
-> Tracer m TraceLedgerPeers
-> Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
Diffusion.Tracers
{ dtMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
Diffusion.dtMuxTracer = Tracer IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
muxTracer
, dtHandshakeTracer :: Tracer IO (HandshakeTr RemoteAddress NodeToNodeVersion)
Diffusion.dtHandshakeTracer = Tracer IO (HandshakeTr RemoteAddress NodeToNodeVersion)
handshakeTracer
, dtLocalMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
Diffusion.dtLocalMuxTracer = Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
localMuxTracer
, dtLocalHandshakeTracer :: Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
Diffusion.dtLocalHandshakeTracer = Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
localHandshakeTracer
, dtDiffusionInitializationTracer :: Tracer IO (InitializationTracer RemoteAddress LocalAddress)
Diffusion.dtDiffusionInitializationTracer = Tracer IO (InitializationTracer RemoteAddress LocalAddress)
initializationTracer
, dtLedgerPeersTracer :: Tracer IO TraceLedgerPeers
Diffusion.dtLedgerPeersTracer = Tracer IO TraceLedgerPeers
ledgerPeersTracer
}
diffusionTracersExtra' :: NetworkP2PMode p2p -> ExtraTracers p2p
diffusionTracersExtra' NetworkP2PMode p2p
enP2P =
case NetworkP2PMode p2p
enP2P of
NetworkP2PMode p2p
EnabledP2PMode ->
TracersExtra
RemoteAddress
NodeToNodeVersion
NodeToNodeVersionData
LocalAddress
NodeToClientVersion
NodeToClientVersionData
IOException
IO
-> ExtraTracers 'P2P
Diffusion.P2PTracers TracersExtra :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
ntcVersionData resolverError (m :: * -> *).
Tracer m (TraceLocalRootPeers ntnAddr resolverError)
-> Tracer m TracePublicRootPeers
-> Tracer m (TracePeerSelection ntnAddr)
-> Tracer
m
(DebugPeerSelection
ntnAddr
(PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
-> Tracer
m
(DebugPeerSelection
ntnAddr
(PeerConnectionHandle
'InitiatorResponderMode ntnAddr ByteString m () ()))
-> Tracer m PeerSelectionCounters
-> Tracer m (PeerSelectionActionsTrace ntnAddr)
-> Tracer
m
(ConnectionManagerTrace
ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
-> Tracer m (AbstractTransitionTrace ntnAddr)
-> Tracer m (ServerTrace ntnAddr)
-> Tracer m (InboundGovernorTrace ntnAddr)
-> Tracer m (RemoteTransitionTrace ntnAddr)
-> Tracer
m
(ConnectionManagerTrace
ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
-> Tracer m (ServerTrace ntcAddr)
-> Tracer m (InboundGovernorTrace ntcAddr)
-> TracersExtra
ntnAddr
ntnVersion
ntnVersionData
ntcAddr
ntcVersion
ntcVersionData
resolverError
m
P2P.TracersExtra
{ dtTraceLocalRootPeersTracer :: Tracer IO (TraceLocalRootPeers RemoteAddress IOException)
P2P.dtTraceLocalRootPeersTracer =
OnOff TraceLocalRootPeers
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceLocalRootPeers RemoteAddress IOException)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalRootPeers
traceLocalRootPeers TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalRootPeers" Trace IO Text
tr
, dtTracePublicRootPeersTracer :: Tracer IO TracePublicRootPeers
P2P.dtTracePublicRootPeersTracer =
OnOff TracePublicRootPeers
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO TracePublicRootPeers
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TracePublicRootPeers
tracePublicRootPeers TraceSelection
trSel)
TracingVerbosity
verb Text
"PublicRootPeers" Trace IO Text
tr
, dtTracePeerSelectionTracer :: Tracer IO (TracePeerSelection RemoteAddress)
P2P.dtTracePeerSelectionTracer =
OnOff TracePeerSelection
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TracePeerSelection RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TracePeerSelection
tracePeerSelection TraceSelection
trSel)
TracingVerbosity
verb Text
"PeerSelection" Trace IO Text
tr
, dtDebugPeerSelectionInitiatorTracer :: Tracer
IO
(DebugPeerSelection
RemoteAddress
(PeerConnectionHandle
'InitiatorMode RemoteAddress ByteString IO () Void))
P2P.dtDebugPeerSelectionInitiatorTracer =
OnOff DebugPeerSelectionInitiator
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(DebugPeerSelection
RemoteAddress
(PeerConnectionHandle
'InitiatorMode RemoteAddress ByteString IO () Void))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff DebugPeerSelectionInitiator
traceDebugPeerSelectionInitiatorTracer TraceSelection
trSel)
TracingVerbosity
verb Text
"DebugPeerSelection" Trace IO Text
tr
, dtDebugPeerSelectionInitiatorResponderTracer :: Tracer
IO
(DebugPeerSelection
RemoteAddress
(PeerConnectionHandle
'InitiatorResponderMode RemoteAddress ByteString IO () ()))
P2P.dtDebugPeerSelectionInitiatorResponderTracer =
OnOff DebugPeerSelectionInitiatorResponder
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(DebugPeerSelection
RemoteAddress
(PeerConnectionHandle
'InitiatorResponderMode RemoteAddress ByteString IO () ()))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff DebugPeerSelectionInitiatorResponder
traceDebugPeerSelectionInitiatorResponderTracer TraceSelection
trSel)
TracingVerbosity
verb Text
"DebugPeerSelection" Trace IO Text
tr
, dtTracePeerSelectionCounters :: Tracer IO PeerSelectionCounters
P2P.dtTracePeerSelectionCounters =
OnOff TracePeerSelectionCounters
-> Maybe EKGDirect -> Tracer IO PeerSelectionCounters
tracePeerSelectionCountersMetrics
(TraceSelection -> OnOff TracePeerSelectionCounters
tracePeerSelectionCounters TraceSelection
trSel)
Maybe EKGDirect
ekgDirect
Tracer IO PeerSelectionCounters
-> Tracer IO PeerSelectionCounters
-> Tracer IO PeerSelectionCounters
forall a. Semigroup a => a -> a -> a
<> OnOff TracePeerSelectionCounters
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO PeerSelectionCounters
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TracePeerSelectionCounters
tracePeerSelectionCounters TraceSelection
trSel)
TracingVerbosity
verb Text
"PeerSelectionCounters" Trace IO Text
tr
, dtPeerSelectionActionsTracer :: Tracer IO (PeerSelectionActionsTrace RemoteAddress)
P2P.dtPeerSelectionActionsTracer =
OnOff TracePeerSelectionActions
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (PeerSelectionActionsTrace RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TracePeerSelectionActions
tracePeerSelectionActions TraceSelection
trSel)
TracingVerbosity
verb Text
"PeerSelectionActions" Trace IO Text
tr
, dtConnectionManagerTracer :: Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
P2P.dtConnectionManagerTracer =
OnOff TraceConnectionManagerCounters
-> Maybe EKGDirect
-> Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
forall peerAddr handlerTrace.
OnOff TraceConnectionManagerCounters
-> Maybe EKGDirect
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
traceConnectionManagerTraceMetrics
(TraceSelection -> OnOff TraceConnectionManagerCounters
traceConnectionManagerCounters TraceSelection
trSel)
Maybe EKGDirect
ekgDirect
Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
-> Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
-> Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
forall a. Semigroup a => a -> a -> a
<> OnOff TraceConnectionManager
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(ConnectionManagerTrace
RemoteAddress
(ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceConnectionManager
traceConnectionManager TraceSelection
trSel)
TracingVerbosity
verb Text
"ConnectionManager" Trace IO Text
tr
, dtConnectionManagerTransitionTracer :: Tracer IO (AbstractTransitionTrace RemoteAddress)
P2P.dtConnectionManagerTransitionTracer =
OnOff TraceConnectionManagerTransitions
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (AbstractTransitionTrace RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceConnectionManagerTransitions
traceConnectionManagerTransitions TraceSelection
trSel)
TracingVerbosity
verb Text
"ConnectionManagerTransition" Trace IO Text
tr
, dtServerTracer :: Tracer IO (ServerTrace RemoteAddress)
P2P.dtServerTracer =
OnOff TraceServer
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (ServerTrace RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceServer
traceServer TraceSelection
trSel) TracingVerbosity
verb Text
"Server" Trace IO Text
tr
, dtInboundGovernorTracer :: Tracer IO (InboundGovernorTrace RemoteAddress)
P2P.dtInboundGovernorTracer =
OnOff TraceInboundGovernorCounters
-> Maybe EKGDirect
-> Tracer IO (InboundGovernorTrace RemoteAddress)
forall addr.
OnOff TraceInboundGovernorCounters
-> Maybe EKGDirect -> Tracer IO (InboundGovernorTrace addr)
traceInboundGovernorCountersMetrics
(TraceSelection -> OnOff TraceInboundGovernorCounters
traceInboundGovernorCounters TraceSelection
trSel)
Maybe EKGDirect
ekgDirect
Tracer IO (InboundGovernorTrace RemoteAddress)
-> Tracer IO (InboundGovernorTrace RemoteAddress)
-> Tracer IO (InboundGovernorTrace RemoteAddress)
forall a. Semigroup a => a -> a -> a
<> OnOff TraceInboundGovernor
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (InboundGovernorTrace RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceInboundGovernor
traceInboundGovernor TraceSelection
trSel)
TracingVerbosity
verb Text
"InboundGovernor" Trace IO Text
tr
, dtInboundGovernorTransitionTracer :: Tracer IO (RemoteTransitionTrace RemoteAddress)
P2P.dtInboundGovernorTransitionTracer =
OnOff TraceInboundGovernorTransitions
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (RemoteTransitionTrace RemoteAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceInboundGovernorTransitions
traceInboundGovernorTransitions TraceSelection
trSel)
TracingVerbosity
verb Text
"InboundGovernorTransition" Trace IO Text
tr
, dtLocalConnectionManagerTracer :: Tracer
IO
(ConnectionManagerTrace
LocalAddress
(ConnectionHandlerTrace
NodeToClientVersion NodeToClientVersionData))
P2P.dtLocalConnectionManagerTracer =
OnOff TraceLocalConnectionManager
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(ConnectionManagerTrace
LocalAddress
(ConnectionHandlerTrace
NodeToClientVersion NodeToClientVersionData))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalConnectionManager
traceLocalConnectionManager TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalConnectionManager" Trace IO Text
tr
, dtLocalServerTracer :: Tracer IO (ServerTrace LocalAddress)
P2P.dtLocalServerTracer =
OnOff TraceLocalServer
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (ServerTrace LocalAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalServer
traceLocalServer TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalServer" Trace IO Text
tr
, dtLocalInboundGovernorTracer :: Tracer IO (InboundGovernorTrace LocalAddress)
P2P.dtLocalInboundGovernorTracer =
OnOff TraceLocalInboundGovernor
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (InboundGovernorTrace LocalAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalInboundGovernor
traceLocalInboundGovernor TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalInboundGovernor" Trace IO Text
tr
}
NetworkP2PMode p2p
DisabledP2PMode ->
TracersExtra -> ExtraTracers 'NonP2P
Diffusion.NonP2PTracers TracersExtra :: Tracer IO (WithIPList (SubscriptionTrace RemoteAddress))
-> Tracer IO (WithDomainName (SubscriptionTrace RemoteAddress))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr RemoteAddress ErrorPolicyTrace)
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
-> Tracer IO AcceptConnectionsPolicyTrace
-> TracersExtra
NonP2P.TracersExtra
{ dtIpSubscriptionTracer :: Tracer IO (WithIPList (SubscriptionTrace RemoteAddress))
NonP2P.dtIpSubscriptionTracer =
OnOff TraceIpSubscription
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithIPList (SubscriptionTrace RemoteAddress))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceIpSubscription
traceIpSubscription TraceSelection
trSel) TracingVerbosity
verb Text
"IpSubscription" Trace IO Text
tr
, dtDnsSubscriptionTracer :: Tracer IO (WithDomainName (SubscriptionTrace RemoteAddress))
NonP2P.dtDnsSubscriptionTracer =
OnOff TraceDnsSubscription
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithDomainName (SubscriptionTrace RemoteAddress))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceDnsSubscription
traceDnsSubscription TraceSelection
trSel) TracingVerbosity
verb Text
"DnsSubscription" Trace IO Text
tr
, dtDnsResolverTracer :: Tracer IO (WithDomainName DnsTrace)
NonP2P.dtDnsResolverTracer =
OnOff TraceDnsResolver
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithDomainName DnsTrace)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceDnsResolver
traceDnsResolver TraceSelection
trSel) TracingVerbosity
verb Text
"DnsResolver" Trace IO Text
tr
, dtErrorPolicyTracer :: Tracer IO (WithAddr RemoteAddress ErrorPolicyTrace)
NonP2P.dtErrorPolicyTracer =
OnOff TraceErrorPolicy
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithAddr RemoteAddress ErrorPolicyTrace)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceErrorPolicy
traceErrorPolicy TraceSelection
trSel) TracingVerbosity
verb Text
"ErrorPolicy" Trace IO Text
tr
, dtLocalErrorPolicyTracer :: Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
NonP2P.dtLocalErrorPolicyTracer =
OnOff TraceLocalErrorPolicy
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithAddr LocalAddress ErrorPolicyTrace)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalErrorPolicy
traceLocalErrorPolicy TraceSelection
trSel) TracingVerbosity
verb Text
"LocalErrorPolicy" Trace IO Text
tr
, dtAcceptPolicyTracer :: Tracer IO AcceptConnectionsPolicyTrace
NonP2P.dtAcceptPolicyTracer =
OnOff TraceAcceptPolicy
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO AcceptConnectionsPolicyTrace
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceAcceptPolicy
traceAcceptPolicy TraceSelection
trSel) TracingVerbosity
verb Text
"AcceptPolicy" Trace IO Text
tr
}
verb :: TracingVerbosity
verb :: TracingVerbosity
verb = TraceSelection -> TracingVerbosity
traceVerbosity TraceSelection
trSel
muxTracer :: Tracer IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
muxTracer =
OnOff TraceMux
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceMux
traceMux TraceSelection
trSel) TracingVerbosity
verb Text
"Mux" Trace IO Text
tr
localMuxTracer :: Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
localMuxTracer =
OnOff TraceLocalMux
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalMux
traceLocalMux TraceSelection
trSel) TracingVerbosity
verb Text
"MuxLocal" Trace IO Text
tr
localHandshakeTracer :: Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
localHandshakeTracer =
OnOff TraceLocalHandshake
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (HandshakeTr LocalAddress NodeToClientVersion)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalHandshake
traceLocalHandshake TraceSelection
trSel) TracingVerbosity
verb Text
"LocalHandshake" Trace IO Text
tr
handshakeTracer :: Tracer IO (HandshakeTr RemoteAddress NodeToNodeVersion)
handshakeTracer =
OnOff TraceHandshake
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (HandshakeTr RemoteAddress NodeToNodeVersion)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceHandshake
traceHandshake TraceSelection
trSel) TracingVerbosity
verb Text
"Handshake" Trace IO Text
tr
ledgerPeersTracer :: Tracer IO TraceLedgerPeers
ledgerPeersTracer =
OnOff TraceLedgerPeers
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO TraceLedgerPeers
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLedgerPeers
traceLedgerPeers TraceSelection
trSel) TracingVerbosity
verb Text
"LedgerPeers" Trace IO Text
tr
initializationTracer :: Tracer IO (InitializationTracer RemoteAddress LocalAddress)
initializationTracer =
OnOff TraceDiffusionInitialization
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (InitializationTracer RemoteAddress LocalAddress)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceDiffusionInitialization
traceDiffusionInitialization TraceSelection
trSel) TracingVerbosity
verb
Text
"DiffusionInitializationTracer" Trace IO Text
tr
mkTracers BlockConfig blk
_ TraceOptions
_ Trace IO Text
_ NodeKernelData blk
_ Maybe EKGDirect
_ NetworkP2PMode p2p
enableP2P =
Tracers
(ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p
-> IO
(Tracers
(ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tracers :: forall peer localPeer blk (p2p :: P2P).
Tracer IO (TraceEvent blk)
-> Tracers IO peer localPeer blk
-> Tracers IO peer blk DeserialiseFailure
-> Tracers IO localPeer blk DeserialiseFailure
-> Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Tracer IO (StartupTrace blk)
-> Tracer IO ShutdownTrace
-> Tracer IO NodeInfo
-> Tracer IO NodeState
-> Tracer IO ResourceStats
-> Tracer IO [PeerT blk]
-> Tracers peer localPeer blk p2p
Tracers
{ chainDBTracer :: Tracer IO (TraceEvent blk)
chainDBTracer = Tracer IO (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, consensusTracers :: Tracers'
(ConnectionId RemoteAddress)
(ConnectionId LocalAddress)
blk
(Tracer IO)
consensusTracers = Tracers :: forall remotePeer localPeer blk (f :: * -> *).
f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> f (TraceChainSyncServerEvent blk)
-> f (TraceChainSyncServerEvent blk)
-> f [TraceLabelPeer
remotePeer (FetchDecision [Point (Header blk)])]
-> f (TraceLabelPeer
remotePeer (TraceFetchClientState (Header blk)))
-> f (TraceBlockFetchServerEvent blk)
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> f (TraceLocalTxSubmissionServerEvent blk)
-> f (TraceEventMempool blk)
-> f (TraceLabelCreds (TraceForgeEvent blk))
-> f (TraceBlockchainTimeEvent UTCTime)
-> f (TraceLabelCreds (ForgeStateInfo blk))
-> f (TraceKeepAliveClient remotePeer)
-> Tracers' remotePeer localPeer blk f
Consensus.Tracers
{ chainSyncClientTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk))
Consensus.chainSyncClientTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, chainSyncServerHeaderTracer :: Tracer IO (TraceChainSyncServerEvent blk)
Consensus.chainSyncServerHeaderTracer = Tracer IO (TraceChainSyncServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, chainSyncServerBlockTracer :: Tracer IO (TraceChainSyncServerEvent blk)
Consensus.chainSyncServerBlockTracer = Tracer IO (TraceChainSyncServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, blockFetchDecisionTracer :: Tracer
IO
[TraceLabelPeer
(ConnectionId RemoteAddress) (FetchDecision [Point (Header blk)])]
Consensus.blockFetchDecisionTracer = Tracer
IO
[TraceLabelPeer
(ConnectionId RemoteAddress) (FetchDecision [Point (Header blk)])]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, blockFetchClientTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress) (TraceFetchClientState (Header blk)))
Consensus.blockFetchClientTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress) (TraceFetchClientState (Header blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, blockFetchServerTracer :: Tracer IO (TraceBlockFetchServerEvent blk)
Consensus.blockFetchServerTracer = Tracer IO (TraceBlockFetchServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, keepAliveClientTracer :: Tracer IO (TraceKeepAliveClient (ConnectionId RemoteAddress))
Consensus.keepAliveClientTracer = Tracer IO (TraceKeepAliveClient (ConnectionId RemoteAddress))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, forgeStateInfoTracer :: Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
Consensus.forgeStateInfoTracer = Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, txInboundTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Consensus.txInboundTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, txOutboundTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
Consensus.txOutboundTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, localTxSubmissionServerTracer :: Tracer IO (TraceLocalTxSubmissionServerEvent blk)
Consensus.localTxSubmissionServerTracer = Tracer IO (TraceLocalTxSubmissionServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, mempoolTracer :: Tracer IO (TraceEventMempool blk)
Consensus.mempoolTracer = Tracer IO (TraceEventMempool blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, forgeTracer :: Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
Consensus.forgeTracer = Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, blockchainTimeTracer :: Tracer IO (TraceBlockchainTimeEvent UTCTime)
Consensus.blockchainTimeTracer = Tracer IO (TraceBlockchainTimeEvent UTCTime)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
, nodeToClientTracers :: Tracers IO (ConnectionId LocalAddress) blk DeserialiseFailure
nodeToClientTracers = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracers' peer blk e f
NodeToClient.Tracers
{ tChainSyncTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
NodeToClient.tChainSyncTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxMonitorTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
NodeToClient.tTxMonitorTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxSubmissionTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
NodeToClient.tTxSubmissionTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tStateQueryTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
NodeToClient.tStateQueryTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId LocalAddress)
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
, nodeToNodeTracers :: Tracers IO (ConnectionId RemoteAddress) blk DeserialiseFailure
nodeToNodeTracers = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracers' peer blk e f
NodeToNode.Tracers
{ tChainSyncTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
NodeToNode.tChainSyncTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tChainSyncSerialisedTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
NodeToNode.tChainSyncSerialisedTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tBlockFetchTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (BlockFetch blk (Point blk))))
NodeToNode.tBlockFetchTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (BlockFetch blk (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tBlockFetchSerialisedTracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
NodeToNode.tBlockFetchSerialisedTracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxSubmission2Tracer :: Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
NodeToNode.tTxSubmission2Tracer = Tracer
IO
(TraceLabelPeer
(ConnectionId RemoteAddress)
(TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
, diffusionTracers :: Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
diffusionTracers = Tracers
RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
forall (m :: * -> *) ntnAddr ntnVersion ntcAddr ntcVersion.
Applicative m =>
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
Diffusion.nullTracers
, diffusionTracersExtra :: ExtraTracers p2p
diffusionTracersExtra =
case NetworkP2PMode p2p
enableP2P of
NetworkP2PMode p2p
EnabledP2PMode -> TracersExtra
RemoteAddress
NodeToNodeVersion
NodeToNodeVersionData
LocalAddress
NodeToClientVersion
NodeToClientVersionData
IOException
IO
-> ExtraTracers 'P2P
Diffusion.P2PTracers TracersExtra
RemoteAddress
NodeToNodeVersion
NodeToNodeVersionData
LocalAddress
NodeToClientVersion
NodeToClientVersionData
IOException
IO
forall (m :: * -> *) ntnAddr ntnVersion ntnVersionData ntcAddr
ntcVersion ntcVersionData resolverError.
Applicative m =>
TracersExtra
ntnAddr
ntnVersion
ntnVersionData
ntcAddr
ntcVersion
ntcVersionData
resolverError
m
P2P.nullTracers
NetworkP2PMode p2p
DisabledP2PMode -> TracersExtra -> ExtraTracers 'NonP2P
Diffusion.NonP2PTracers TracersExtra
NonP2P.nullTracers
, startupTracer :: Tracer IO (StartupTrace blk)
startupTracer = Tracer IO (StartupTrace blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, shutdownTracer :: Tracer IO ShutdownTrace
shutdownTracer = Tracer IO ShutdownTrace
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeInfoTracer :: Tracer IO NodeInfo
nodeInfoTracer = Tracer IO NodeInfo
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, nodeStateTracer :: Tracer IO NodeState
nodeStateTracer = Tracer IO NodeState
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, resourcesTracer :: Tracer IO ResourceStats
resourcesTracer = Tracer IO ResourceStats
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, peersTracer :: Tracer IO [PeerT blk]
peersTracer = Tracer IO [PeerT blk]
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
teeTraceChainTip
:: ( ConvertRawHash blk
, LedgerSupportsProtocol blk
, InspectLedger blk
, ToObject (Header blk)
, ToObject (LedgerEvent blk)
)
=> BlockConfig blk
-> ForgingStats
-> TraceOptions
-> MVar (Maybe (WithSeverity (ChainDB.TraceEvent blk)), Integer)
-> Maybe EKGDirect
-> STM.TVar Word64
-> Trace IO Text
-> Trace IO Text
-> Tracer IO (WithSeverity (ChainDB.TraceEvent blk))
teeTraceChainTip :: BlockConfig blk
-> ForgingStats
-> TraceOptions
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Maybe EKGDirect
-> TVar Word64
-> Trace IO Text
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
teeTraceChainTip BlockConfig blk
_ ForgingStats
_ TraceOptions
TracingOff MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
_ Maybe EKGDirect
_ TVar Word64
_ Trace IO Text
_ Trace IO Text
_ = Tracer IO (WithSeverity (TraceEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
teeTraceChainTip BlockConfig blk
_ ForgingStats
_ TraceDispatcher{} MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
_ Maybe EKGDirect
_ TVar Word64
_ Trace IO Text
_ Trace IO Text
_ = Tracer IO (WithSeverity (TraceEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
teeTraceChainTip BlockConfig blk
blockConfig ForgingStats
fStats (TracingOnLegacy TraceSelection
trSel) MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
elided Maybe EKGDirect
ekgDirect TVar Word64
tFork Trace IO Text
trTrc Trace IO Text
trMet =
(WithSeverity (TraceEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceEvent blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity (TraceEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceEvent blk)))
-> (WithSeverity (TraceEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceEvent blk))
forall a b. (a -> b) -> a -> b
$ \WithSeverity (TraceEvent blk)
ev -> do
Tracer IO (WithSeverity (TraceEvent blk))
-> WithSeverity (TraceEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
forall blk.
(ConvertRawHash blk, LedgerSupportsProtocol blk, InspectLedger blk,
ToObject (Header blk), ToObject (LedgerEvent blk)) =>
TracingVerbosity
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
teeTraceChainTipElide (TraceSelection -> TracingVerbosity
traceVerbosity TraceSelection
trSel) MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
elided Trace IO Text
trTrc) WithSeverity (TraceEvent blk)
ev
Tracer IO (WithSeverity (TraceEvent blk))
-> WithSeverity (TraceEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracer IO (TraceEvent blk)
-> Tracer IO (WithSeverity (TraceEvent blk))
forall a. Tracer IO a -> Tracer IO (WithSeverity a)
ignoringSeverity (Maybe EKGDirect
-> TVar Word64
-> BlockConfig blk
-> ForgingStats
-> Trace IO Text
-> Tracer IO (TraceEvent blk)
forall blk.
HasHeader (Header blk) =>
Maybe EKGDirect
-> TVar Word64
-> BlockConfig blk
-> ForgingStats
-> Trace IO Text
-> Tracer IO (TraceEvent blk)
traceChainMetrics Maybe EKGDirect
ekgDirect TVar Word64
tFork BlockConfig blk
blockConfig ForgingStats
fStats Trace IO Text
trMet)) WithSeverity (TraceEvent blk)
ev
teeTraceChainTipElide
:: ( ConvertRawHash blk
, LedgerSupportsProtocol blk
, InspectLedger blk
, ToObject (Header blk)
, ToObject (LedgerEvent blk)
)
=> TracingVerbosity
-> MVar (Maybe (WithSeverity (ChainDB.TraceEvent blk)), Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity (ChainDB.TraceEvent blk))
teeTraceChainTipElide :: TracingVerbosity
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
teeTraceChainTipElide = TracingVerbosity
-> MVar (Maybe (WithSeverity (TraceEvent blk)), Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEvent blk))
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> MVar (Maybe a, Integer) -> Trace IO t -> Tracer IO a
elideToLogObject
{-# INLINE teeTraceChainTipElide #-}
ignoringSeverity :: Tracer IO a -> Tracer IO (WithSeverity a)
ignoringSeverity :: Tracer IO a -> Tracer IO (WithSeverity a)
ignoringSeverity Tracer IO a
tr = (WithSeverity a -> IO ()) -> Tracer IO (WithSeverity a)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity a -> IO ()) -> Tracer IO (WithSeverity a))
-> (WithSeverity a -> IO ()) -> Tracer IO (WithSeverity a)
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Severity
_ a
ev) -> Tracer IO a -> a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO a
tr a
ev
{-# INLINE ignoringSeverity #-}
traceChainMetrics
:: forall blk. ()
=> HasHeader (Header blk)
=> Maybe EKGDirect
-> STM.TVar Word64
-> BlockConfig blk
-> ForgingStats
-> Trace IO Text
-> Tracer IO (ChainDB.TraceEvent blk)
traceChainMetrics :: Maybe EKGDirect
-> TVar Word64
-> BlockConfig blk
-> ForgingStats
-> Trace IO Text
-> Tracer IO (TraceEvent blk)
traceChainMetrics Maybe EKGDirect
Nothing TVar Word64
_ BlockConfig blk
_ ForgingStats
_ Trace IO Text
_ = Tracer IO (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
traceChainMetrics (Just EKGDirect
_ekgDirect) TVar Word64
tForks BlockConfig blk
_blockConfig ForgingStats
_fStats Trace IO Text
tr = do
(TraceEvent blk -> IO ()) -> Tracer IO (TraceEvent blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceEvent blk -> IO ()) -> Tracer IO (TraceEvent blk))
-> (TraceEvent blk -> IO ()) -> Tracer IO (TraceEvent blk)
forall a b. (a -> b) -> a -> b
$ \TraceEvent blk
ev ->
IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Maybe (IO ()) -> IO ()) -> Maybe (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ChainInformation -> IO ()
doTrace (ChainInformation -> IO ())
-> Maybe ChainInformation -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TraceEvent blk -> Maybe ChainInformation
chainTipInformation TraceEvent blk
ev
where
chainTipInformation :: ChainDB.TraceEvent blk -> Maybe ChainInformation
chainTipInformation :: TraceEvent blk -> Maybe ChainInformation
chainTipInformation = \case
ChainDB.TraceAddBlockEvent TraceAddBlockEvent blk
ev -> case TraceAddBlockEvent blk
ev of
ChainDB.SwitchedToAFork [LedgerEvent blk]
_warnings NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
oldChain AnchoredFragment (Header blk)
newChain ->
let fork :: Bool
fork = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point (Header blk) -> AnchoredFragment (Header blk) -> Bool
forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
AF.withinFragmentBounds (AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint AnchoredFragment (Header blk)
oldChain)
AnchoredFragment (Header blk)
newChain in
ChainInformation -> Maybe ChainInformation
forall a. a -> Maybe a
Just (ChainInformation -> Maybe ChainInformation)
-> ChainInformation -> Maybe ChainInformation
forall a b. (a -> b) -> a -> b
$ NewTipInfo blk
-> Bool
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
HasHeader (Header blk) =>
NewTipInfo blk
-> Bool
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation NewTipInfo blk
newTipInfo Bool
fork AnchoredFragment (Header blk)
newChain Int64
0
ChainDB.AddedToCurrentChain [LedgerEvent blk]
_warnings NewTipInfo blk
newTipInfo AnchoredFragment (Header blk)
_oldChain AnchoredFragment (Header blk)
newChain ->
ChainInformation -> Maybe ChainInformation
forall a. a -> Maybe a
Just (ChainInformation -> Maybe ChainInformation)
-> ChainInformation -> Maybe ChainInformation
forall a b. (a -> b) -> a -> b
$ NewTipInfo blk
-> Bool
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
forall blk.
HasHeader (Header blk) =>
NewTipInfo blk
-> Bool
-> AnchoredFragment (Header blk)
-> Int64
-> ChainInformation
chainInformation NewTipInfo blk
newTipInfo Bool
False AnchoredFragment (Header blk)
newChain Int64
0
TraceAddBlockEvent blk
_ -> Maybe ChainInformation
forall a. Maybe a
Nothing
TraceEvent blk
_ -> Maybe ChainInformation
forall a. Maybe a
Nothing
doTrace :: ChainInformation -> IO ()
doTrace :: ChainInformation -> IO ()
doTrace
ChainInformation { Word64
slots :: ChainInformation -> Word64
slots :: Word64
slots, Word64
blocks :: ChainInformation -> Word64
blocks :: Word64
blocks, Rational
density :: ChainInformation -> Rational
density :: Rational
density, EpochNo
epoch :: ChainInformation -> EpochNo
epoch :: EpochNo
epoch, Word64
slotInEpoch :: ChainInformation -> Word64
slotInEpoch :: Word64
slotInEpoch, Bool
fork :: ChainInformation -> Bool
fork :: Bool
fork } = do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Public
Trace IO Text -> LOMeta -> Text -> Double -> IO ()
forall a. Trace IO a -> LOMeta -> Text -> Double -> IO ()
traceD Trace IO Text
tr LOMeta
meta Text
"density" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
density)
Trace IO Text -> LOMeta -> Text -> Word64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
tr LOMeta
meta Text
"slotNum" Word64
slots
Trace IO Text -> LOMeta -> Text -> Word64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
tr LOMeta
meta Text
"blockNum" Word64
blocks
Trace IO Text -> LOMeta -> Text -> Word64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
tr LOMeta
meta Text
"slotInEpoch" Word64
slotInEpoch
Trace IO Text -> LOMeta -> Text -> Word64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
tr LOMeta
meta Text
"epoch" (EpochNo -> Word64
unEpochNo EpochNo
epoch)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fork (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Trace IO Text -> LOMeta -> Text -> Word64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
tr LOMeta
meta Text
"forks" (Word64 -> IO ()) -> IO Word64 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar Word64 -> (Word64 -> Word64) -> IO Word64
forall a. TVar a -> (a -> a) -> IO a
STM.modifyReadTVarIO TVar Word64
tForks Word64 -> Word64
forall a. Enum a => a -> a
succ
traceD :: Trace IO a -> LOMeta -> Text -> Double -> IO ()
traceD :: Trace IO a -> LOMeta -> Text -> Double -> IO ()
traceD Trace IO a
tr LOMeta
meta Text
msg Double
d = Trace IO a -> (LOMeta, LOContent a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO a
tr (LOMeta
meta, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
msg (Double -> Measurable
PureD Double
d))
traceI :: Integral i => Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI :: Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO a
tr LOMeta
meta Text
msg i
i = Trace IO a -> (LOMeta, LOContent a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO a
tr (LOMeta
meta, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
msg (Integer -> Measurable
PureI (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i)))
sendEKGDirectCounter :: EKGDirect -> Text -> IO ()
sendEKGDirectCounter :: EKGDirect -> Text -> IO ()
sendEKGDirectCounter EKGDirect
ekgDirect Text
name = do
MVar (Map Text Counter)
-> (Map Text Counter -> IO (Map Text Counter)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EKGDirect -> MVar (Map Text Counter)
ekgCounters EKGDirect
ekgDirect) ((Map Text Counter -> IO (Map Text Counter)) -> IO ())
-> (Map Text Counter -> IO (Map Text Counter)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Text Counter
registeredMap -> do
case Text -> Map Text Counter -> Maybe Counter
forall k a. Ord k => k -> Map k a -> Maybe a
SMap.lookup Text
name Map Text Counter
registeredMap of
Just Counter
counter -> do
Counter -> IO ()
Counter.inc Counter
counter
Map Text Counter -> IO (Map Text Counter)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Counter
registeredMap
Maybe Counter
Nothing -> do
Counter
counter <- Text -> Server -> IO Counter
EKG.getCounter Text
name (EKGDirect -> Server
ekgServer EKGDirect
ekgDirect)
Counter -> IO ()
Counter.inc Counter
counter
Map Text Counter -> IO (Map Text Counter)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Counter -> IO (Map Text Counter))
-> Map Text Counter -> IO (Map Text Counter)
forall a b. (a -> b) -> a -> b
$ Text -> Counter -> Map Text Counter -> Map Text Counter
forall k a. Ord k => k -> a -> Map k a -> Map k a
SMap.insert Text
name Counter
counter Map Text Counter
registeredMap
sendEKGDirectInt :: Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt :: EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect Text
name a
val = do
MVar (Map Text Gauge)
-> (Map Text Gauge -> IO (Map Text Gauge)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EKGDirect -> MVar (Map Text Gauge)
ekgGauges EKGDirect
ekgDirect) ((Map Text Gauge -> IO (Map Text Gauge)) -> IO ())
-> (Map Text Gauge -> IO (Map Text Gauge)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Text Gauge
registeredMap -> do
case Text -> Map Text Gauge -> Maybe Gauge
forall k a. Ord k => k -> Map k a -> Maybe a
SMap.lookup Text
name Map Text Gauge
registeredMap of
Just Gauge
gauge -> do
Gauge -> Int64 -> IO ()
Gauge.set Gauge
gauge (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val)
Map Text Gauge -> IO (Map Text Gauge)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Gauge
registeredMap
Maybe Gauge
Nothing -> do
Gauge
gauge <- Text -> Server -> IO Gauge
EKG.getGauge Text
name (EKGDirect -> Server
ekgServer EKGDirect
ekgDirect)
Gauge -> Int64 -> IO ()
Gauge.set Gauge
gauge (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val)
Map Text Gauge -> IO (Map Text Gauge)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Gauge -> IO (Map Text Gauge))
-> Map Text Gauge -> IO (Map Text Gauge)
forall a b. (a -> b) -> a -> b
$ Text -> Gauge -> Map Text Gauge -> Map Text Gauge
forall k a. Ord k => k -> a -> Map k a -> Map k a
SMap.insert Text
name Gauge
gauge Map Text Gauge
registeredMap
sendEKGDirectDouble :: EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble :: EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble EKGDirect
ekgDirect Text
name Double
val = do
MVar (Map Text Label)
-> (Map Text Label -> IO (Map Text Label)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EKGDirect -> MVar (Map Text Label)
ekgLabels EKGDirect
ekgDirect) ((Map Text Label -> IO (Map Text Label)) -> IO ())
-> (Map Text Label -> IO (Map Text Label)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Text Label
registeredMap -> do
case Text -> Map Text Label -> Maybe Label
forall k a. Ord k => k -> Map k a -> Maybe a
SMap.lookup Text
name Map Text Label
registeredMap of
Just Label
label -> do
Label -> Text -> IO ()
Label.set Label
label (String -> Text
Text.pack (Double -> String
forall a. Show a => a -> String
show Double
val))
Map Text Label -> IO (Map Text Label)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Label
registeredMap
Maybe Label
Nothing -> do
Label
label <- Text -> Server -> IO Label
EKG.getLabel Text
name (EKGDirect -> Server
ekgServer EKGDirect
ekgDirect)
Label -> Text -> IO ()
Label.set Label
label (String -> Text
Text.pack (Double -> String
forall a. Show a => a -> String
show Double
val))
Map Text Label -> IO (Map Text Label)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Label -> IO (Map Text Label))
-> Map Text Label -> IO (Map Text Label)
forall a b. (a -> b) -> a -> b
$ Text -> Label -> Map Text Label -> Map Text Label
forall k a. Ord k => k -> a -> Map k a -> Map k a
SMap.insert Text
name Label
label Map Text Label
registeredMap
isRollForward :: TraceChainSyncServerEvent blk -> Bool
isRollForward :: TraceChainSyncServerEvent blk -> Bool
isRollForward (TraceChainSyncServerUpdate Tip blk
_tip (AddBlock Point blk
_pt) BlockingType
_blocking Enclosing' ()
FallingEdge) = Bool
True
isRollForward TraceChainSyncServerEvent blk
_ = Bool
False
mkConsensusTracers
:: forall blk peer localPeer.
( Show peer
, Eq peer
, LedgerQueries blk
, ToJSON (GenTxId blk)
, ToObject (ApplyTxErr blk)
, ToObject (CannotForge blk)
, ToObject (GenTx blk)
, ToObject (LedgerErr (LedgerState blk))
, ToObject (OtherHeaderEnvelopeError blk)
, ToObject (ValidationErr (BlockProtocol blk))
, ToObject (ForgeStateUpdateError blk)
, ToObject peer
, Consensus.RunNode blk
, HasKESMetricsData blk
, HasKESInfo blk
)
=> Maybe EKGDirect
-> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeKernelData blk
-> ForgingStats
-> IO (Consensus.Tracers' peer localPeer blk (Tracer IO))
mkConsensusTracers :: Maybe EKGDirect
-> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeKernelData blk
-> ForgingStats
-> IO (Tracers' peer localPeer blk (Tracer IO))
mkConsensusTracers Maybe EKGDirect
mbEKGDirect TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr NodeKernelData blk
nodeKern ForgingStats
fStats = do
let trmet :: Trace IO Text
trmet = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tr
MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
elidedFetchDecision <- IO
(MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer))
forall a. ElidingTracer a => IO (MVar (Maybe a, Integer))
newstate
ForgeTracers
forgeTracers <- IO ForgeTracers
mkForgeTracers
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Public
TVar Int64
tBlocksServed <- Int64 -> IO (TVar Int64)
forall a. a -> IO (TVar a)
STM.newTVarIO Int64
0
TVar Int64
tLocalUp <- Int64 -> IO (TVar Int64)
forall a. a -> IO (TVar a)
STM.newTVarIO Int64
0
TVar SlotNo
tMaxSlotNo <- SlotNo -> IO (TVar SlotNo)
forall a. a -> IO (TVar a)
STM.newTVarIO (SlotNo -> IO (TVar SlotNo)) -> SlotNo -> IO (TVar SlotNo)
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0
TVar Int
tSubmissionsCollected <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
STM.newTVarIO Int
0
TVar Int
tSubmissionsAccepted <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
STM.newTVarIO Int
0
TVar Int
tSubmissionsRejected <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
STM.newTVarIO Int
0
TVar (IntPSQ Word64 NominalDiffTime)
tBlockDelayM <- IntPSQ Word64 NominalDiffTime
-> IO (TVar (IntPSQ Word64 NominalDiffTime))
forall a. a -> IO (TVar a)
STM.newTVarIO IntPSQ Word64 NominalDiffTime
forall p v. IntPSQ p v
Pq.empty
TVar (CdfCounter 1)
tBlockDelayCDF1s <- CdfCounter 1 -> IO (TVar (CdfCounter 1))
forall a. a -> IO (TVar a)
STM.newTVarIO (CdfCounter 1 -> IO (TVar (CdfCounter 1)))
-> CdfCounter 1 -> IO (TVar (CdfCounter 1))
forall a b. (a -> b) -> a -> b
$ Int64 -> CdfCounter 1
forall (limit :: Nat). Int64 -> CdfCounter limit
CdfCounter Int64
0
TVar (CdfCounter 3)
tBlockDelayCDF3s <- CdfCounter 3 -> IO (TVar (CdfCounter 3))
forall a. a -> IO (TVar a)
STM.newTVarIO (CdfCounter 3 -> IO (TVar (CdfCounter 3)))
-> CdfCounter 3 -> IO (TVar (CdfCounter 3))
forall a b. (a -> b) -> a -> b
$ Int64 -> CdfCounter 3
forall (limit :: Nat). Int64 -> CdfCounter limit
CdfCounter Int64
0
TVar (CdfCounter 5)
tBlockDelayCDF5s <- CdfCounter 5 -> IO (TVar (CdfCounter 5))
forall a. a -> IO (TVar a)
STM.newTVarIO (CdfCounter 5 -> IO (TVar (CdfCounter 5)))
-> CdfCounter 5 -> IO (TVar (CdfCounter 5))
forall a b. (a -> b) -> a -> b
$ Int64 -> CdfCounter 5
forall (limit :: Nat). Int64 -> CdfCounter limit
CdfCounter Int64
0
Tracers' peer localPeer blk (Tracer IO)
-> IO (Tracers' peer localPeer blk (Tracer IO))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tracers :: forall remotePeer localPeer blk (f :: * -> *).
f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> f (TraceChainSyncServerEvent blk)
-> f (TraceChainSyncServerEvent blk)
-> f [TraceLabelPeer
remotePeer (FetchDecision [Point (Header blk)])]
-> f (TraceLabelPeer
remotePeer (TraceFetchClientState (Header blk)))
-> f (TraceBlockFetchServerEvent blk)
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> f (TraceLocalTxSubmissionServerEvent blk)
-> f (TraceEventMempool blk)
-> f (TraceLabelCreds (TraceForgeEvent blk))
-> f (TraceBlockchainTimeEvent UTCTime)
-> f (TraceLabelCreds (ForgeStateInfo blk))
-> f (TraceKeepAliveClient remotePeer)
-> Tracers' remotePeer localPeer blk f
Consensus.Tracers
{ chainSyncClientTracer :: Tracer IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk))
Consensus.chainSyncClientTracer = OnOff TraceChainSyncClient
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceLabelPeer peer (TraceChainSyncClientEvent blk))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceChainSyncClient
traceChainSyncClient TraceSelection
trSel) TracingVerbosity
verb Text
"ChainSyncClient" Trace IO Text
tr
, chainSyncServerHeaderTracer :: Tracer IO (TraceChainSyncServerEvent blk)
Consensus.chainSyncServerHeaderTracer =
(TraceChainSyncServerEvent blk -> IO ())
-> Tracer IO (TraceChainSyncServerEvent blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceChainSyncServerEvent blk -> IO ())
-> Tracer IO (TraceChainSyncServerEvent blk))
-> (TraceChainSyncServerEvent blk -> IO ())
-> Tracer IO (TraceChainSyncServerEvent blk)
forall a b. (a -> b) -> a -> b
$ \TraceChainSyncServerEvent blk
ev -> do
Tracer IO (TraceChainSyncServerEvent blk)
-> TraceChainSyncServerEvent blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracer IO (WithSeverity (TraceChainSyncServerEvent blk))
-> Tracer IO (TraceChainSyncServerEvent blk)
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity (Tracer IO (WithSeverity (TraceChainSyncServerEvent blk))
-> Tracer IO (TraceChainSyncServerEvent blk))
-> (Trace IO Text
-> Tracer IO (WithSeverity (TraceChainSyncServerEvent blk)))
-> Trace IO Text
-> Tracer IO (TraceChainSyncServerEvent blk)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceChainSyncServerEvent blk))
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
verb (Trace IO Text -> Tracer IO (TraceChainSyncServerEvent blk))
-> Trace IO Text -> Tracer IO (TraceChainSyncServerEvent blk)
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"ChainSyncHeaderServer"
(OnOff TraceChainSyncHeaderServer -> Trace IO Text -> Trace IO Text
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceChainSyncHeaderServer
traceChainSyncHeaderServer TraceSelection
trSel) Trace IO Text
tr)) TraceChainSyncServerEvent blk
ev
Maybe EKGDirect -> TraceChainSyncServerEvent blk -> IO ()
traceServedCount Maybe EKGDirect
mbEKGDirect TraceChainSyncServerEvent blk
ev
, chainSyncServerBlockTracer :: Tracer IO (TraceChainSyncServerEvent blk)
Consensus.chainSyncServerBlockTracer = OnOff TraceChainSyncBlockServer
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceChainSyncServerEvent blk)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceChainSyncBlockServer
traceChainSyncBlockServer TraceSelection
trSel) TracingVerbosity
verb Text
"ChainSyncBlockServer" Trace IO Text
tr
, blockFetchDecisionTracer :: Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
Consensus.blockFetchDecisionTracer = OnOff TraceBlockFetchDecisions
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceBlockFetchDecisions
traceBlockFetchDecisions TraceSelection
trSel) (Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
forall a b. (a -> b) -> a -> b
$
Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity (Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> Tracer
IO [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
forall a b. (a -> b) -> a -> b
$ TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall peer blk.
(Eq peer, HasHeader blk, Show peer, ToObject peer) =>
TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision TracingVerbosity
verb MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
elidedFetchDecision Trace IO Text
tr
, blockFetchClientTracer :: Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
Consensus.blockFetchClientTracer = Maybe EKGDirect
-> TVar (IntPSQ Word64 NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
forall blk remotePeer.
Maybe EKGDirect
-> TVar (IntPSQ Word64 NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
-> Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
traceBlockFetchClientMetrics Maybe EKGDirect
mbEKGDirect TVar (IntPSQ Word64 NominalDiffTime)
tBlockDelayM
TVar (CdfCounter 1)
tBlockDelayCDF1s TVar (CdfCounter 3)
tBlockDelayCDF3s TVar (CdfCounter 5)
tBlockDelayCDF5s (Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk))))
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
forall a b. (a -> b) -> a -> b
$
OnOff TraceBlockFetchClient
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO (TraceLabelPeer peer (TraceFetchClientState (Header blk)))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceBlockFetchClient
traceBlockFetchClient TraceSelection
trSel) TracingVerbosity
verb Text
"BlockFetchClient" Trace IO Text
tr
, blockFetchServerTracer :: Tracer IO (TraceBlockFetchServerEvent blk)
Consensus.blockFetchServerTracer = Trace IO Text
-> LOMeta
-> TVar Int64
-> TVar Int64
-> TVar SlotNo
-> Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk)
forall blk.
Trace IO Text
-> LOMeta
-> TVar Int64
-> TVar Int64
-> TVar SlotNo
-> Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk)
traceBlockFetchServerMetrics Trace IO Text
trmet LOMeta
meta TVar Int64
tBlocksServed
TVar Int64
tLocalUp TVar SlotNo
tMaxSlotNo (Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk))
-> Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk)
forall a b. (a -> b) -> a -> b
$ OnOff TraceBlockFetchServer
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceBlockFetchServerEvent blk)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceBlockFetchServer
traceBlockFetchServer TraceSelection
trSel) TracingVerbosity
verb Text
"BlockFetchServer" Trace IO Text
tr
, keepAliveClientTracer :: Tracer IO (TraceKeepAliveClient peer)
Consensus.keepAliveClientTracer = OnOff TraceKeepAliveClient
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceKeepAliveClient peer)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceKeepAliveClient
traceKeepAliveClient TraceSelection
trSel) TracingVerbosity
verb Text
"KeepAliveClient" Trace IO Text
tr
, forgeStateInfoTracer :: Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
Consensus.forgeStateInfoTracer = OnOff TraceForgeStateInfo
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceForgeStateInfo
traceForgeStateInfo TraceSelection
trSel) (Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk)))
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a b. (a -> b) -> a -> b
$
Proxy blk
-> TraceSelection
-> Trace IO Text
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall blk.
(HasKESMetricsData blk, Show (ForgeStateInfo blk)) =>
Proxy blk
-> TraceSelection
-> Trace IO Text
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer (Proxy blk
forall k (t :: k). Proxy t
Proxy @ blk) TraceSelection
trSel Trace IO Text
tr
, txInboundTracer :: Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Consensus.txInboundTracer = OnOff TraceTxInbound
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceTxInbound
traceTxInbound TraceSelection
trSel) (Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a b. (a -> b) -> a -> b
$
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> IO ())
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> IO ())
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> (TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> IO ())
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a b. (a -> b) -> a -> b
$ \TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
ev -> do
Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracer
IO
(WithSeverity
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity (Tracer
IO
(WithSeverity
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> (Trace IO Text
-> Tracer
IO
(WithSeverity
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))))
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TracingVerbosity
-> Trace IO Text
-> Tracer
IO
(WithSeverity
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
verb (Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))))
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"TxInbound" Trace IO Text
tr) TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
ev
case TraceLabelPeer
peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
ev of
TraceLabelPeer peer
_ (TraceTxSubmissionCollected Int
collected) ->
Trace IO Text -> LOMeta -> Text -> Int -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
trmet LOMeta
meta Text
"submissions.submitted.count" (Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
TVar Int -> (Int -> Int) -> IO Int
forall a. TVar a -> (a -> a) -> IO a
STM.modifyReadTVarIO TVar Int
tSubmissionsCollected (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
collected)
TraceLabelPeer peer
_ (TraceTxSubmissionProcessed ProcessedTxCount
processed) -> do
Trace IO Text -> LOMeta -> Text -> Int -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
trmet LOMeta
meta Text
"submissions.accepted.count" (Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
TVar Int -> (Int -> Int) -> IO Int
forall a. TVar a -> (a -> a) -> IO a
STM.modifyReadTVarIO TVar Int
tSubmissionsAccepted (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ProcessedTxCount -> Int
ptxcAccepted ProcessedTxCount
processed)
Trace IO Text -> LOMeta -> Text -> Int -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
trmet LOMeta
meta Text
"submissions.rejected.count" (Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
TVar Int -> (Int -> Int) -> IO Int
forall a. TVar a -> (a -> a) -> IO a
STM.modifyReadTVarIO TVar Int
tSubmissionsRejected (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ProcessedTxCount -> Int
ptxcRejected ProcessedTxCount
processed)
TraceLabelPeer peer
_ TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
TraceTxInboundTerminated -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TraceLabelPeer peer
_ (TraceTxInboundCanRequestMoreTxs Int
_) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TraceLabelPeer peer
_ (TraceTxInboundCannotRequestMoreTxs Int
_) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, txOutboundTracer :: Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
Consensus.txOutboundTracer = OnOff TraceTxOutbound
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceTxOutbound
traceTxOutbound TraceSelection
trSel) TracingVerbosity
verb Text
"TxOutbound" Trace IO Text
tr
, localTxSubmissionServerTracer :: Tracer IO (TraceLocalTxSubmissionServerEvent blk)
Consensus.localTxSubmissionServerTracer = OnOff TraceLocalTxSubmissionServer
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer IO (TraceLocalTxSubmissionServerEvent blk)
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalTxSubmissionServer
traceLocalTxSubmissionServer TraceSelection
trSel) TracingVerbosity
verb Text
"LocalTxSubmissionServer" Trace IO Text
tr
, mempoolTracer :: Tracer IO (TraceEventMempool blk)
Consensus.mempoolTracer = OnOff TraceMempool
-> Tracer IO (TraceEventMempool blk)
-> Tracer IO (TraceEventMempool blk)
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceMempool
traceMempool TraceSelection
trSel) (Tracer IO (TraceEventMempool blk)
-> Tracer IO (TraceEventMempool blk))
-> Tracer IO (TraceEventMempool blk)
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ TraceSelection
-> Trace IO Text
-> ForgingStats
-> Tracer IO (TraceEventMempool blk)
forall blk.
(ToJSON (GenTxId blk), ToObject (ApplyTxErr blk),
ToObject (GenTx blk), LedgerSupportsMempool blk) =>
TraceSelection
-> Trace IO Text
-> ForgingStats
-> Tracer IO (TraceEventMempool blk)
mempoolTracer TraceSelection
trSel Trace IO Text
tr ForgingStats
fStats
, forgeTracer :: Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
Consensus.forgeTracer = OnOff TraceForge
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceForge
traceForge TraceSelection
trSel) (Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$
(TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk)))
-> (TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ \tlcev :: TraceLabelCreds (TraceForgeEvent blk)
tlcev@Consensus.TraceLabelCreds{} -> do
Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> TraceLabelCreds (TraceForgeEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity
(Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ ForgeTracers
-> NodeKernelData blk
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall blk.
(RunNode blk, LedgerQueries blk) =>
ForgeTracers
-> NodeKernelData blk
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
traceLeadershipChecks ForgeTracers
forgeTracers NodeKernelData blk
nodeKern TracingVerbosity
verb Trace IO Text
tr) TraceLabelCreds (TraceForgeEvent blk)
tlcev
Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> TraceLabelCreds (TraceForgeEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> Trace IO Text
-> ForgeTracers
-> ForgingStats
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall blk.
(RunNode blk, ToObject (CannotForge blk),
ToObject (LedgerErr (LedgerState blk)),
ToObject (OtherHeaderEnvelopeError blk),
ToObject (ValidationErr (BlockProtocol blk)),
ToObject (ForgeStateUpdateError blk), HasKESInfo blk) =>
TracingVerbosity
-> Trace IO Text
-> ForgeTracers
-> ForgingStats
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer TracingVerbosity
verb Trace IO Text
tr ForgeTracers
forgeTracers ForgingStats
fStats) TraceLabelCreds (TraceForgeEvent blk)
tlcev
, blockchainTimeTracer :: Tracer IO (TraceBlockchainTimeEvent UTCTime)
Consensus.blockchainTimeTracer = OnOff TraceBlockchainTime
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
forall (b :: Symbol) a. OnOff b -> Tracer IO a -> Tracer IO a
tracerOnOff' (TraceSelection -> OnOff TraceBlockchainTime
traceBlockchainTime TraceSelection
trSel) (Tracer IO (TraceBlockchainTimeEvent UTCTime)
-> Tracer IO (TraceBlockchainTimeEvent UTCTime))
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
forall a b. (a -> b) -> a -> b
$
(TraceBlockchainTimeEvent UTCTime -> IO ())
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceBlockchainTimeEvent UTCTime -> IO ())
-> Tracer IO (TraceBlockchainTimeEvent UTCTime))
-> (TraceBlockchainTimeEvent UTCTime -> IO ())
-> Tracer IO (TraceBlockchainTimeEvent UTCTime)
forall a b. (a -> b) -> a -> b
$ \TraceBlockchainTimeEvent UTCTime
ev ->
Tracer IO Text -> Text -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Trace IO Text -> Tracer IO Text
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
Trace m a -> Tracer m b
toLogObject Trace IO Text
tr) (TraceBlockchainTimeEvent UTCTime -> Text
readableTraceBlockchainTimeEvent TraceBlockchainTimeEvent UTCTime
ev)
}
where
mkForgeTracers :: IO ForgeTracers
mkForgeTracers :: IO ForgeTracers
mkForgeTracers = do
LOMeta
staticMeta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Confidential
let Text
name :: LoggerName = Text
"metrics.Forge"
Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers
ForgeTracers
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"forged" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"forge-about-to-lead" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"could-not-forge" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"adopted" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"didnt-adopt" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"forged-invalid" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"node-not-leader" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> Trace IO Text
-> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text
-> Trace IO Text -> Trace IO Text -> Trace IO Text -> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"cannot-forge" Trace IO Text
tr)
IO
(Trace IO Text
-> Trace IO Text -> Trace IO Text -> Trace IO Text -> ForgeTracers)
-> IO (Trace IO Text)
-> IO
(Trace IO Text -> Trace IO Text -> Trace IO Text -> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"forge-state-update-error" Trace IO Text
tr)
IO
(Trace IO Text -> Trace IO Text -> Trace IO Text -> ForgeTracers)
-> IO (Trace IO Text)
-> IO (Trace IO Text -> Trace IO Text -> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"block-from-future" Trace IO Text
tr)
IO (Trace IO Text -> Trace IO Text -> ForgeTracers)
-> IO (Trace IO Text) -> IO (Trace IO Text -> ForgeTracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"slot-is-immutable" Trace IO Text
tr)
IO (Trace IO Text -> ForgeTracers)
-> IO (Trace IO Text) -> IO ForgeTracers
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Counting (Text, LogObject Text)) -> IO (Trace IO Text)
forall (m :: * -> *) a.
MonadIO m =>
Tracer m (Counting a) -> m (Tracer m a)
counting (LOMeta
-> Text
-> Text
-> Trace IO Text
-> Tracer IO (Counting (Text, LogObject Text))
forall (m :: * -> *) a.
LOMeta
-> Text
-> Text
-> Trace m a
-> Tracer m (Counting (Text, LogObject a))
liftCounting LOMeta
staticMeta Text
name Text
"node-is-leader" Trace IO Text
tr)
traceServedCount :: Maybe EKGDirect -> TraceChainSyncServerEvent blk -> IO ()
traceServedCount :: Maybe EKGDirect -> TraceChainSyncServerEvent blk -> IO ()
traceServedCount Maybe EKGDirect
Nothing TraceChainSyncServerEvent blk
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
traceServedCount (Just EKGDirect
ekgDirect) TraceChainSyncServerEvent blk
ev =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TraceChainSyncServerEvent blk -> Bool
forall blk. TraceChainSyncServerEvent blk -> Bool
isRollForward TraceChainSyncServerEvent blk
ev) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EKGDirect -> Text -> IO ()
sendEKGDirectCounter EKGDirect
ekgDirect
Text
"cardano.node.metrics.served.header.counter.int"
traceBlockFetchServerMetrics
:: forall blk. ()
=> Tracer IO (LoggerName, LogObject Text)
-> LOMeta
-> STM.TVar Int64
-> STM.TVar Int64
-> STM.TVar SlotNo
-> Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk)
traceBlockFetchServerMetrics :: Trace IO Text
-> LOMeta
-> TVar Int64
-> TVar Int64
-> TVar SlotNo
-> Tracer IO (TraceBlockFetchServerEvent blk)
-> Tracer IO (TraceBlockFetchServerEvent blk)
traceBlockFetchServerMetrics Trace IO Text
trMeta LOMeta
meta TVar Int64
tBlocksServed TVar Int64
tLocalUp TVar SlotNo
tMaxSlotNo Tracer IO (TraceBlockFetchServerEvent blk)
tracer = (TraceBlockFetchServerEvent blk -> IO ())
-> Tracer IO (TraceBlockFetchServerEvent blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer TraceBlockFetchServerEvent blk -> IO ()
bsTracer
where
bsTracer :: TraceBlockFetchServerEvent blk -> IO ()
bsTracer :: TraceBlockFetchServerEvent blk -> IO ()
bsTracer e :: TraceBlockFetchServerEvent blk
e@(TraceBlockFetchServerSendBlock Point blk
p) = do
Tracer IO (TraceBlockFetchServerEvent blk)
-> TraceBlockFetchServerEvent blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (TraceBlockFetchServerEvent blk)
tracer TraceBlockFetchServerEvent blk
e
(Int64
served, Maybe Int64
mbLocalUpstreamyness) <- STM (Int64, Maybe Int64) -> IO (Int64, Maybe Int64)
forall a. STM a -> IO a
atomically (STM (Int64, Maybe Int64) -> IO (Int64, Maybe Int64))
-> STM (Int64, Maybe Int64) -> IO (Int64, Maybe Int64)
forall a b. (a -> b) -> a -> b
$ do
Int64
served <- TVar Int64 -> (Int64 -> Int64) -> STM Int64
forall a. TVar a -> (a -> a) -> STM a
STM.modifyReadTVar' TVar Int64
tBlocksServed (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
SlotNo
maxSlotNo <- TVar SlotNo -> STM SlotNo
forall a. TVar a -> STM a
STM.readTVar TVar SlotNo
tMaxSlotNo
case Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point blk
p of
WithOrigin SlotNo
Origin -> (Int64, Maybe Int64) -> STM (Int64, Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
served, Maybe Int64
forall a. Maybe a
Nothing)
At SlotNo
slotNo ->
case SlotNo -> SlotNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SlotNo
maxSlotNo SlotNo
slotNo of
Ordering
LT -> do
TVar SlotNo -> SlotNo -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar SlotNo
tMaxSlotNo SlotNo
slotNo
Int64
lu <- TVar Int64 -> (Int64 -> Int64) -> STM Int64
forall a. TVar a -> (a -> a) -> STM a
STM.modifyReadTVar' TVar Int64
tLocalUp (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
(Int64, Maybe Int64) -> STM (Int64, Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
served, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
lu)
Ordering
GT -> do
(Int64, Maybe Int64) -> STM (Int64, Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
served, Maybe Int64
forall a. Maybe a
Nothing)
Ordering
EQ -> do
Int64
lu <- TVar Int64 -> (Int64 -> Int64) -> STM Int64
forall a. TVar a -> (a -> a) -> STM a
STM.modifyReadTVar' TVar Int64
tLocalUp (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1)
(Int64, Maybe Int64) -> STM (Int64, Maybe Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
served, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
lu)
Trace IO Text -> LOMeta -> Text -> Int64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
trMeta LOMeta
meta Text
"served.block.count" Int64
served
case Maybe Int64
mbLocalUpstreamyness of
Just Int64
localUpstreamyness ->
Trace IO Text -> LOMeta -> Text -> Int64 -> IO ()
forall i a.
Integral i =>
Trace IO a -> LOMeta -> Text -> i -> IO ()
traceI Trace IO Text
trMeta LOMeta
meta Text
"served.block.latest.count" Int64
localUpstreamyness
Maybe Int64
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newtype CdfCounter (limit :: Nat) = CdfCounter Int64
cdfCounter :: forall a l.
( Num a, Ord a
, KnownNat l)
=> a -> Int -> Int64 -> STM.TVar (CdfCounter l) -> STM Double
cdfCounter :: a -> Int -> Int64 -> TVar (CdfCounter l) -> STM Double
cdfCounter a
v !Int
size !Int64
step TVar (CdfCounter l)
tCdf= do
Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lim) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
TVar (CdfCounter l) -> (CdfCounter l -> CdfCounter l) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar' TVar (CdfCounter l)
tCdf (\(CdfCounter Int64
c) -> Int64 -> CdfCounter l
forall (limit :: Nat). Int64 -> CdfCounter limit
CdfCounter (Int64 -> CdfCounter l) -> Int64 -> CdfCounter l
forall a b. (a -> b) -> a -> b
$ Int64
c Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
step)
(CdfCounter Int64
cdf) <- TVar (CdfCounter l) -> STM (CdfCounter l)
forall a. TVar a -> STM a
STM.readTVar TVar (CdfCounter l)
tCdf
Double -> STM Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> STM Double) -> Double -> STM Double
forall a b. (a -> b) -> a -> b
$! (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
cdf Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
where
lim :: a
lim :: a
lim = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Proxy l -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l)
incCdfCounter :: Ord a => Num a => KnownNat l => a -> Int -> STM.TVar (CdfCounter l) -> STM Double
incCdfCounter :: a -> Int -> TVar (CdfCounter l) -> STM Double
incCdfCounter a
v Int
size = a -> Int -> Int64 -> TVar (CdfCounter l) -> STM Double
forall a (l :: Nat).
(Num a, Ord a, KnownNat l) =>
a -> Int -> Int64 -> TVar (CdfCounter l) -> STM Double
cdfCounter a
v Int
size Int64
1
decCdfCounter :: Ord a => Num a => KnownNat l => a -> Int -> STM.TVar (CdfCounter l) -> STM Double
decCdfCounter :: a -> Int -> TVar (CdfCounter l) -> STM Double
decCdfCounter a
v Int
size = a -> Int -> Int64 -> TVar (CdfCounter l) -> STM Double
forall a (l :: Nat).
(Num a, Ord a, KnownNat l) =>
a -> Int -> Int64 -> TVar (CdfCounter l) -> STM Double
cdfCounter a
v Int
size (-Int64
1)
cdf135Counters
:: Integral a
=> STM.TVar (IntPSQ a NominalDiffTime)
-> STM.TVar (CdfCounter 1)
-> STM.TVar (CdfCounter 3)
-> STM.TVar (CdfCounter 5)
-> a
-> NominalDiffTime
-> STM (Bool, Double, Double, Double)
cdf135Counters :: TVar (IntPSQ a NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> a
-> NominalDiffTime
-> STM (Bool, Double, Double, Double)
cdf135Counters TVar (IntPSQ a NominalDiffTime)
slotMapVar TVar (CdfCounter 1)
cdf1sVar TVar (CdfCounter 3)
cdf3sVar TVar (CdfCounter 5)
cdf5sVar a
slotNo NominalDiffTime
forgeDelay = do
IntPSQ a NominalDiffTime
slotMap <- TVar (IntPSQ a NominalDiffTime) -> STM (IntPSQ a NominalDiffTime)
forall a. TVar a -> STM a
STM.readTVar TVar (IntPSQ a NominalDiffTime)
slotMapVar
if IntPSQ a NominalDiffTime -> Bool
forall p v. IntPSQ p v -> Bool
Pq.null IntPSQ a NominalDiffTime
slotMap Bool -> Bool -> Bool
&& NominalDiffTime
forgeDelay NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
20
then (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Double
0, Double
0, Double
0)
else case Int -> IntPSQ a NominalDiffTime -> Maybe (a, NominalDiffTime)
forall p v. Int -> IntPSQ p v -> Maybe (p, v)
Pq.lookup (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
slotNo) IntPSQ a NominalDiffTime
slotMap of
Maybe (a, NominalDiffTime)
Nothing -> do
let slotMap' :: IntPSQ a NominalDiffTime
slotMap' = Int
-> a
-> NominalDiffTime
-> IntPSQ a NominalDiffTime
-> IntPSQ a NominalDiffTime
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
Pq.insert (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
slotNo) a
slotNo NominalDiffTime
forgeDelay IntPSQ a NominalDiffTime
slotMap
if IntPSQ a NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ a NominalDiffTime
slotMap' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1080
then
case IntPSQ a NominalDiffTime
-> Maybe (Int, a, NominalDiffTime, IntPSQ a NominalDiffTime)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
Pq.minView IntPSQ a NominalDiffTime
slotMap' of
Maybe (Int, a, NominalDiffTime, IntPSQ a NominalDiffTime)
Nothing -> (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Double
0, Double
0, Double
0)
Just (Int
_, a
minSlotNo, NominalDiffTime
minDelay, IntPSQ a NominalDiffTime
slotMap'') ->
if a
minSlotNo a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
slotNo
then (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Double
0, Double
0, Double
0)
else do
NominalDiffTime -> Int -> STM ()
decCdfs NominalDiffTime
minDelay (IntPSQ a NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ a NominalDiffTime
slotMap'')
(Double
cdf1s, Double
cdf3s, Double
cdf5s) <- NominalDiffTime -> Int -> STM (Double, Double, Double)
incCdfs NominalDiffTime
forgeDelay (IntPSQ a NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ a NominalDiffTime
slotMap'')
TVar (IntPSQ a NominalDiffTime)
-> IntPSQ a NominalDiffTime -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (IntPSQ a NominalDiffTime)
slotMapVar IntPSQ a NominalDiffTime
slotMap''
(Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Double
cdf1s, Double
cdf3s, Double
cdf5s)
else do
(Double
cdf1s, Double
cdf3s, Double
cdf5s) <- NominalDiffTime -> Int -> STM (Double, Double, Double)
incCdfs NominalDiffTime
forgeDelay (IntPSQ a NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ a NominalDiffTime
slotMap')
TVar (IntPSQ a NominalDiffTime)
-> IntPSQ a NominalDiffTime -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (IntPSQ a NominalDiffTime)
slotMapVar IntPSQ a NominalDiffTime
slotMap'
if IntPSQ a NominalDiffTime -> Int
forall p v. IntPSQ p v -> Int
Pq.size IntPSQ a NominalDiffTime
slotMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
45
then (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Double
cdf1s, Double
cdf3s, Double
cdf5s)
else (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, -Double
1, -Double
1, -Double
1)
Just (a, NominalDiffTime)
_ -> (Bool, Double, Double, Double)
-> STM (Bool, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Double
0, Double
0, Double
0)
where
incCdfs :: NominalDiffTime -> Int -> STM (Double, Double, Double)
incCdfs :: NominalDiffTime -> Int -> STM (Double, Double, Double)
incCdfs NominalDiffTime
delay Int
size = do
Double
cdf1s <- NominalDiffTime -> Int -> TVar (CdfCounter 1) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
incCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 1)
cdf1sVar
Double
cdf3s <- NominalDiffTime -> Int -> TVar (CdfCounter 3) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
incCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 3)
cdf3sVar
Double
cdf5s <- NominalDiffTime -> Int -> TVar (CdfCounter 5) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
incCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 5)
cdf5sVar
(Double, Double, Double) -> STM (Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
cdf1s, Double
cdf3s, Double
cdf5s)
decCdfs :: NominalDiffTime -> Int -> STM ()
decCdfs :: NominalDiffTime -> Int -> STM ()
decCdfs NominalDiffTime
delay Int
size =
NominalDiffTime -> Int -> TVar (CdfCounter 1) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
decCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 1)
cdf1sVar
STM Double -> STM Double -> STM Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NominalDiffTime -> Int -> TVar (CdfCounter 3) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
decCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 3)
cdf3sVar
STM Double -> STM Double -> STM Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NominalDiffTime -> Int -> TVar (CdfCounter 5) -> STM Double
forall a (l :: Nat).
(Ord a, Num a, KnownNat l) =>
a -> Int -> TVar (CdfCounter l) -> STM Double
decCdfCounter NominalDiffTime
delay Int
size TVar (CdfCounter 5)
cdf5sVar
STM Double -> STM () -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceBlockFetchClientMetrics
:: forall blk remotePeer.
( )
=> Maybe EKGDirect
-> STM.TVar (IntPSQ Word64 NominalDiffTime)
-> STM.TVar (CdfCounter 1)
-> STM.TVar (CdfCounter 3)
-> STM.TVar (CdfCounter 5)
-> Tracer IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
-> Tracer IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
traceBlockFetchClientMetrics :: Maybe EKGDirect
-> TVar (IntPSQ Word64 NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
-> Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
traceBlockFetchClientMetrics Maybe EKGDirect
Nothing TVar (IntPSQ Word64 NominalDiffTime)
_ TVar (CdfCounter 1)
_ TVar (CdfCounter 3)
_ TVar (CdfCounter 5)
_ Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
tracer = Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
tracer
traceBlockFetchClientMetrics (Just EKGDirect
ekgDirect) TVar (IntPSQ Word64 NominalDiffTime)
slotMapVar TVar (CdfCounter 1)
cdf1sVar TVar (CdfCounter 3)
cdf3sVar TVar (CdfCounter 5)
cdf5sVar Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
tracer = (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
-> IO ())
-> Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
-> IO ()
bfTracer
where
bfTracer :: TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)) -> IO ()
bfTracer :: TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
-> IO ()
bfTracer e :: TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
e@(TraceLabelPeer remotePeer
_ (CompletedBlockFetch Point (Header blk)
p PeerFetchInFlight (Header blk)
_ PeerFetchInFlightLimits
_ PeerFetchStatus (Header blk)
_ NominalDiffTime
delay SizeInBytes
blockSize)) = do
Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
-> TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
tracer TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
e
case Point (Header blk) -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot Point (Header blk)
p of
WithOrigin SlotNo
Origin -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
At SlotNo
slotNo -> do
(Bool
fresh, Double
cdf1s, Double
cdf3s, Double
cdf5s) <- STM (Bool, Double, Double, Double)
-> IO (Bool, Double, Double, Double)
forall a. STM a -> IO a
atomically (STM (Bool, Double, Double, Double)
-> IO (Bool, Double, Double, Double))
-> STM (Bool, Double, Double, Double)
-> IO (Bool, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$
TVar (IntPSQ Word64 NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> Word64
-> NominalDiffTime
-> STM (Bool, Double, Double, Double)
forall a.
Integral a =>
TVar (IntPSQ a NominalDiffTime)
-> TVar (CdfCounter 1)
-> TVar (CdfCounter 3)
-> TVar (CdfCounter 5)
-> a
-> NominalDiffTime
-> STM (Bool, Double, Double, Double)
cdf135Counters TVar (IntPSQ Word64 NominalDiffTime)
slotMapVar TVar (CdfCounter 1)
cdf1sVar TVar (CdfCounter 3)
cdf3sVar TVar (CdfCounter 5)
cdf5sVar (SlotNo -> Word64
slotMapKey SlotNo
slotNo) NominalDiffTime
delay
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fresh (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble EKGDirect
ekgDirect Text
"cardano.node.metrics.blockfetchclient.blockdelay.s"
(Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
delay
EKGDirect -> Text -> SizeInBytes -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect Text
"cardano.node.metrics.blockfetchclient.blocksize"
SizeInBytes
blockSize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
cdf1s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble EKGDirect
ekgDirect
Text
"cardano.node.metrics.blockfetchclient.blockdelay.cdfOne"
Double
cdf1s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
cdf3s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble EKGDirect
ekgDirect
Text
"cardano.node.metrics.blockfetchclient.blockdelay.cdfThree"
Double
cdf3s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
cdf5s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EKGDirect -> Text -> Double -> IO ()
sendEKGDirectDouble EKGDirect
ekgDirect
Text
"cardano.node.metrics.blockfetchclient.blockdelay.cdfFive"
Double
cdf5s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NominalDiffTime
delay NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
5) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
EKGDirect -> Text -> IO ()
sendEKGDirectCounter EKGDirect
ekgDirect Text
"cardano.node.metrics.blockfetchclient.lateblocks"
bfTracer TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
e =
Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
-> TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
IO (TraceLabelPeer remotePeer (TraceFetchClientState (Header blk)))
tracer TraceLabelPeer remotePeer (TraceFetchClientState (Header blk))
e
slotMapKey :: SlotNo -> Word64
slotMapKey :: SlotNo -> Word64
slotMapKey (SlotNo Word64
s) = Word64
s
traceLeadershipChecks ::
forall blk
. ( Consensus.RunNode blk
, LedgerQueries blk
)
=> ForgeTracers
-> NodeKernelData blk
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk)))
traceLeadershipChecks :: ForgeTracers
-> NodeKernelData blk
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
traceLeadershipChecks ForgeTracers
_ft NodeKernelData blk
nodeKern TracingVerbosity
_tverb Trace IO Text
tr = (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer
IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk))))
-> (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall a b. (a -> b) -> a -> b
$
\(WithSeverity Severity
sev (Consensus.TraceLabelCreds Text
creds TraceForgeEvent blk
event)) ->
case TraceForgeEvent blk
event of
Consensus.TraceStartLeadershipCheck SlotNo
slot -> do
!StrictMaybe (Int, Int, Rational)
query <- (NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO (Int, Int, Rational))
-> NodeKernelData blk -> IO (StrictMaybe (Int, Int, Rational))
forall blk a.
(NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO a)
-> NodeKernelData blk -> IO (StrictMaybe a)
mapNodeKernelDataIO
(\NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
nk ->
(,,)
(Int -> Int -> Rational -> (Int, Int, Rational))
-> IO Int -> IO (Int -> Rational -> (Int, Int, Rational))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExtLedgerState blk -> Int)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO Int
forall blk a.
IsLedger (LedgerState blk) =>
(ExtLedgerState blk -> a)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO a
nkQueryLedger (LedgerState blk -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize (LedgerState blk -> Int)
-> (ExtLedgerState blk -> LedgerState blk)
-> ExtLedgerState blk
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState) NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
nk
IO (Int -> Rational -> (Int, Int, Rational))
-> IO Int -> IO (Rational -> (Int, Int, Rational))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExtLedgerState blk -> Int)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO Int
forall blk a.
IsLedger (LedgerState blk) =>
(ExtLedgerState blk -> a)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO a
nkQueryLedger (LedgerState blk -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize (LedgerState blk -> Int)
-> (ExtLedgerState blk -> LedgerState blk)
-> ExtLedgerState blk
-> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState) NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
nk
IO (Rational -> (Int, Int, Rational))
-> IO Rational -> IO (Int, Int, Rational)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (AnchoredFragment (Header blk) -> Rational)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO Rational
forall blk a.
(AnchoredFragment (Header blk) -> a)
-> NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> IO a
nkQueryChain AnchoredFragment (Header blk) -> Rational
forall blk.
HasHeader (Header blk) =>
AnchoredFragment (Header blk) -> Rational
fragmentChainDensity NodeKernel
IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
nk)
NodeKernelData blk
nodeKern
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
Public
IO () -> StrictMaybe (IO ()) -> IO ()
forall a. a -> StrictMaybe a -> a
fromSMaybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (StrictMaybe (IO ()) -> IO ()) -> StrictMaybe (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
StrictMaybe (Int, Int, Rational)
query StrictMaybe (Int, Int, Rational)
-> ((Int, Int, Rational) -> IO ()) -> StrictMaybe (IO ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\(Int
utxoSize, Int
delegMapSize, Rational
_) -> do
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"utxoSize" Trace IO Text
tr Int
utxoSize
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"delegMapSize" Trace IO Text
tr Int
delegMapSize
Trace IO Text -> (LOMeta, LOContent Text) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject (Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"LeadershipCheck" Trace IO Text
tr)
( LOMeta
meta
, Object -> LOContent Text
forall a. Object -> LOContent a
LogStructured (Object -> LOContent Text) -> Object -> LOContent Text
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
[(Key
"kind", Text -> Value
String Text
"TraceStartLeadershipCheck")
,(Key
"credentials", Text -> Value
String Text
creds)
,(Key
"slot", Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (Word64 -> Value) -> Word64 -> Value
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)]
[(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ [(Key, Value)] -> StrictMaybe [(Key, Value)] -> [(Key, Value)]
forall a. a -> StrictMaybe a -> a
fromSMaybe []
(StrictMaybe (Int, Int, Rational)
query StrictMaybe (Int, Int, Rational)
-> ((Int, Int, Rational) -> [(Key, Value)])
-> StrictMaybe [(Key, Value)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\(Int
utxoSize, Int
delegMapSize, Rational
chainDensity) ->
[ (Key
"utxoSize", Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
utxoSize)
, (Key
"delegMapSize", Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
delegMapSize)
, (Key
"chainDensity", Float -> Value
forall a. ToJSON a => a -> Value
toJSON (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
chainDensity :: Float))
])
)
TraceForgeEvent blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
teeForge ::
forall blk
. ( Consensus.RunNode blk
, ToObject (CannotForge blk)
, ToObject (LedgerErr (LedgerState blk))
, ToObject (OtherHeaderEnvelopeError blk)
, ToObject (ValidationErr (BlockProtocol blk))
, ToObject (ForgeStateUpdateError blk)
)
=> ForgeTracers
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk)))
teeForge :: ForgeTracers
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
teeForge ForgeTracers
ft TracingVerbosity
tverb Trace IO Text
tr = (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer
IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk))))
-> (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ())
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall a b. (a -> b) -> a -> b
$
\ev :: WithSeverity (TraceLabelCreds (TraceForgeEvent blk))
ev@(WithSeverity Severity
sev (Consensus.TraceLabelCreds Text
_creds TraceForgeEvent blk
event)) -> do
(Tracer IO (WithSeverity (TraceForgeEvent blk))
-> WithSeverity (TraceForgeEvent blk) -> IO ())
-> WithSeverity (TraceForgeEvent blk)
-> Tracer IO (WithSeverity (TraceForgeEvent blk))
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tracer IO (WithSeverity (TraceForgeEvent blk))
-> WithSeverity (TraceForgeEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Severity
-> TraceForgeEvent blk -> WithSeverity (TraceForgeEvent blk)
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
sev TraceForgeEvent blk
event) (Tracer IO (WithSeverity (TraceForgeEvent blk)) -> IO ())
-> Tracer IO (WithSeverity (TraceForgeEvent blk)) -> IO ()
forall a b. (a -> b) -> a -> b
$ (WithSeverity (TraceForgeEvent blk)
-> Tracer IO (WithSeverity (TraceForgeEvent blk)))
-> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. (a -> Tracer m a) -> Tracer m a
fanning ((WithSeverity (TraceForgeEvent blk)
-> Tracer IO (WithSeverity (TraceForgeEvent blk)))
-> Tracer IO (WithSeverity (TraceForgeEvent blk)))
-> (WithSeverity (TraceForgeEvent blk)
-> Tracer IO (WithSeverity (TraceForgeEvent blk)))
-> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Severity
_ TraceForgeEvent blk
e) ->
case TraceForgeEvent blk
e of
Consensus.TraceStartLeadershipCheck{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftForgeAboutToLead ForgeTracers
ft)
Consensus.TraceSlotIsImmutable{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceSlotIsImmutable ForgeTracers
ft)
Consensus.TraceBlockFromFuture{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceBlockFromFuture ForgeTracers
ft)
Consensus.TraceBlockContext{} -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Consensus.TraceNoLedgerState{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftCouldNotForge ForgeTracers
ft)
Consensus.TraceLedgerState{} -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Consensus.TraceNoLedgerView{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftCouldNotForge ForgeTracers
ft)
Consensus.TraceLedgerView{} -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Consensus.TraceForgeStateUpdateError{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceForgeStateUpdateError ForgeTracers
ft)
Consensus.TraceNodeCannotForge {} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceNodeCannotForge ForgeTracers
ft)
Consensus.TraceNodeNotLeader{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceNodeNotLeader ForgeTracers
ft)
Consensus.TraceNodeIsLeader{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftTraceNodeIsLeader ForgeTracers
ft)
Consensus.TraceForgeTickedLedgerState{} -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Consensus.TraceForgingMempoolSnapshot{} -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
Consensus.TraceForgedBlock{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftForged ForgeTracers
ft)
Consensus.TraceDidntAdoptBlock{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftDidntAdoptBlock ForgeTracers
ft)
Consensus.TraceForgedInvalidBlock{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftForgedInvalid ForgeTracers
ft)
Consensus.TraceAdoptedBlock{} -> Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall blk.
Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' (ForgeTracers -> Trace IO Text
ftAdopted ForgeTracers
ft)
case TraceForgeEvent blk
event of
Consensus.TraceStartLeadershipCheck SlotNo
_slot -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TraceForgeEvent blk
_ -> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> WithSeverity (TraceLabelCreds (TraceForgeEvent blk)) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' TracingVerbosity
tverb Trace IO Text
tr) WithSeverity (TraceLabelCreds (TraceForgeEvent blk))
ev
teeForge'
:: Trace IO Text
-> Tracer IO (WithSeverity (Consensus.TraceForgeEvent blk))
teeForge' :: Trace IO Text -> Tracer IO (WithSeverity (TraceForgeEvent blk))
teeForge' Trace IO Text
tr =
(WithSeverity (TraceForgeEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity (TraceForgeEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceForgeEvent blk)))
-> (WithSeverity (TraceForgeEvent blk) -> IO ())
-> Tracer IO (WithSeverity (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Severity
_ TraceForgeEvent blk
ev) -> do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Confidential
Trace IO Text -> (LOMeta, LOContent Text) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject (Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tr) ((LOMeta, LOContent Text) -> IO ())
-> (LOContent Text -> (LOMeta, LOContent Text))
-> LOContent Text
-> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LOMeta
meta,) (LOContent Text -> IO ()) -> LOContent Text -> IO ()
forall a b. (a -> b) -> a -> b
$
case TraceForgeEvent blk
ev of
Consensus.TraceStartLeadershipCheck SlotNo
slot ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"aboutToLeadSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceSlotIsImmutable SlotNo
slot Point blk
_tipPoint BlockNo
_tipBlkNo ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"slotIsImmutable" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceBlockFromFuture SlotNo
slot SlotNo
_slotNo ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"blockFromFuture" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceBlockContext SlotNo
slot BlockNo
_tipBlkNo Point blk
_tipPoint ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"blockContext" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceNoLedgerState SlotNo
slot Point blk
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"couldNotForgeSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceLedgerState SlotNo
slot Point blk
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"ledgerState" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceNoLedgerView SlotNo
slot OutsideForecastRange
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"couldNotForgeSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceLedgerView SlotNo
slot ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"ledgerView" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceForgeStateUpdateError SlotNo
slot ForgeStateUpdateError blk
_reason ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"forgeStateUpdateError" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceNodeCannotForge SlotNo
slot CannotForge blk
_reason ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"nodeCannotForge" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceNodeNotLeader SlotNo
slot ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"nodeNotLeader" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceNodeIsLeader SlotNo
slot ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"nodeIsLeader" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceForgeTickedLedgerState SlotNo
slot Point blk
_prevPt ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"forgeTickedLedgerState" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceForgingMempoolSnapshot SlotNo
slot Point blk
_prevPt ChainHash blk
_mpHash SlotNo
_mpSlotNo ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"forgingMempoolSnapshot" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceForgedBlock SlotNo
slot Point blk
_ blk
_ MempoolSize
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"forgedSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceDidntAdoptBlock SlotNo
slot blk
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"notAdoptedSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceForgedInvalidBlock SlotNo
slot blk
_ InvalidBlockReason blk
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"forgedInvalidSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
Consensus.TraceAdoptedBlock SlotNo
slot blk
_ [Validated (GenTx blk)]
_ ->
Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"adoptedSlotLast" (Measurable -> LOContent Text) -> Measurable -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ 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
forgeTracer
:: forall blk.
( Consensus.RunNode blk
, ToObject (CannotForge blk)
, ToObject (LedgerErr (LedgerState blk))
, ToObject (OtherHeaderEnvelopeError blk)
, ToObject (ValidationErr (BlockProtocol blk))
, ToObject (ForgeStateUpdateError blk)
, HasKESInfo blk
)
=> TracingVerbosity
-> Trace IO Text
-> ForgeTracers
-> ForgingStats
-> Tracer IO (Consensus.TraceLabelCreds (Consensus.TraceForgeEvent blk))
forgeTracer :: TracingVerbosity
-> Trace IO Text
-> ForgeTracers
-> ForgingStats
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forgeTracer TracingVerbosity
verb Trace IO Text
tr ForgeTracers
forgeTracers ForgingStats
fStats =
(TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk)))
-> (TraceLabelCreds (TraceForgeEvent blk) -> IO ())
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ \tlcev :: TraceLabelCreds (TraceForgeEvent blk)
tlcev@(Consensus.TraceLabelCreds Text
_ TraceForgeEvent blk
ev) -> do
Tracer IO (TraceForgeEvent blk) -> TraceForgeEvent blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (ForgingStats -> Trace IO Text -> Tracer IO (TraceForgeEvent blk)
forall blk.
ForgingStats -> Trace IO Text -> Tracer IO (TraceForgeEvent blk)
notifyBlockForging ForgingStats
fStats Trace IO Text
tr) TraceForgeEvent blk
ev
Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
-> TraceLabelCreds (TraceForgeEvent blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity
(Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
-> Tracer IO (TraceLabelCreds (TraceForgeEvent blk))
forall a b. (a -> b) -> a -> b
$ ForgeTracers
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall blk.
(RunNode blk, ToObject (CannotForge blk),
ToObject (LedgerErr (LedgerState blk)),
ToObject (OtherHeaderEnvelopeError blk),
ToObject (ValidationErr (BlockProtocol blk)),
ToObject (ForgeStateUpdateError blk)) =>
ForgeTracers
-> TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
teeForge ForgeTracers
forgeTracers TracingVerbosity
verb
(Trace IO Text
-> Tracer
IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk))))
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceLabelCreds (TraceForgeEvent blk)))
forall a b. (a -> b) -> a -> b
$ Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"Forge" Trace IO Text
tr) TraceLabelCreds (TraceForgeEvent blk)
tlcev
TraceForgeEvent blk -> IO ()
traceKESInfoIfKESExpired TraceForgeEvent blk
ev
where
traceKESInfoIfKESExpired :: TraceForgeEvent blk -> IO ()
traceKESInfoIfKESExpired TraceForgeEvent blk
ev =
case TraceForgeEvent blk
ev of
Consensus.TraceForgeStateUpdateError SlotNo
_ ForgeStateUpdateError blk
reason ->
case Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
forall blk.
HasKESInfo blk =>
Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
getKESInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) ForgeStateUpdateError blk
reason of
Maybe KESInfo
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just KESInfo
kesInfo -> do
let logValues :: [LOContent a]
logValues :: [LOContent a]
logValues =
[ Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"operationalCertificateStartKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable)
-> (KESInfo -> Integer) -> KESInfo -> Measurable
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Integer) -> (KESInfo -> Word) -> KESInfo -> Integer
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KESPeriod -> Word
unKESPeriod (KESPeriod -> Word) -> (KESInfo -> KESPeriod) -> KESInfo -> Word
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KESInfo -> KESPeriod
HotKey.kesStartPeriod (KESInfo -> Measurable) -> KESInfo -> Measurable
forall a b. (a -> b) -> a -> b
$ KESInfo
kesInfo
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"operationalCertificateExpiryKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable)
-> (KESInfo -> Integer) -> KESInfo -> Measurable
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Integer) -> (KESInfo -> Word) -> KESInfo -> Integer
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KESPeriod -> Word
unKESPeriod (KESPeriod -> Word) -> (KESInfo -> KESPeriod) -> KESInfo -> Word
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KESInfo -> KESPeriod
HotKey.kesEndPeriod (KESInfo -> Measurable) -> KESInfo -> Measurable
forall a b. (a -> b) -> a -> b
$ KESInfo
kesInfo
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"currentKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI Integer
0
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"remainingKESPeriods"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI Integer
0
]
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Confidential
(LOContent Text -> IO ()) -> [LOContent Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Trace IO Text -> (LOMeta, LOContent Text) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject (Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tr) ((LOMeta, LOContent Text) -> IO ())
-> (LOContent Text -> (LOMeta, LOContent Text))
-> LOContent Text
-> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LOMeta
meta,)) [LOContent Text]
forall a. [LOContent a]
logValues
TraceForgeEvent blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
notifyBlockForging
:: ForgingStats
-> Trace IO Text
-> Tracer IO (Consensus.TraceForgeEvent blk)
notifyBlockForging :: ForgingStats -> Trace IO Text -> Tracer IO (TraceForgeEvent blk)
notifyBlockForging ForgingStats
fStats Trace IO Text
tr = (TraceForgeEvent blk -> IO ()) -> Tracer IO (TraceForgeEvent blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceForgeEvent blk -> IO ()) -> Tracer IO (TraceForgeEvent blk))
-> (TraceForgeEvent blk -> IO ())
-> Tracer IO (TraceForgeEvent blk)
forall a b. (a -> b) -> a -> b
$ \case
Consensus.TraceNodeCannotForge {} ->
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"nodeCannotForge" Trace IO Text
tr
(Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Int)) -> IO Int
forall a.
ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats
fStats
(\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsNodeCannotForgeNum :: Int
ftsNodeCannotForgeNum = ForgeThreadStats -> Int
ftsNodeCannotForgeNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 },
ForgeThreadStats -> Int
ftsNodeCannotForgeNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
(Consensus.TraceNodeIsLeader (SlotNo Word64
slot')) -> do
let slot :: Int
slot = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot'
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"nodeIsLeaderNum" Trace IO Text
tr
(Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Int)) -> IO Int
forall a.
ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats
fStats
(\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsNodeIsLeaderNum :: Int
ftsNodeIsLeaderNum = ForgeThreadStats -> Int
ftsNodeIsLeaderNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, ftsLastSlot :: Int
ftsLastSlot = Int
slot },
ForgeThreadStats -> Int
ftsNodeIsLeaderNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Consensus.TraceForgedBlock {} -> do
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"blocksForgedNum" Trace IO Text
tr
(Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Int)) -> IO Int
forall a.
ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats
fStats
(\ForgeThreadStats
fts -> (ForgeThreadStats
fts { ftsBlocksForgedNum :: Int
ftsBlocksForgedNum = ForgeThreadStats -> Int
ftsBlocksForgedNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 },
ForgeThreadStats -> Int
ftsBlocksForgedNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Consensus.TraceNodeNotLeader (SlotNo Word64
slot') -> do
let slot :: Int
slot = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot'
Bool
hasMissed <-
ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, Bool)) -> IO Bool
forall a.
ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats
fStats
(\ForgeThreadStats
fts ->
if ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int -> Int
forall a. Enum a => a -> a
succ (ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slot then
(ForgeThreadStats
fts { ftsLastSlot :: Int
ftsLastSlot = Int
slot }, Bool
False)
else
let missed :: Int
missed = ForgeThreadStats -> Int
ftsSlotsMissedNum ForgeThreadStats
fts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- ForgeThreadStats -> Int
ftsLastSlot ForgeThreadStats
fts)
in (ForgeThreadStats
fts { ftsLastSlot :: Int
ftsLastSlot = Int
slot, ftsSlotsMissedNum :: Int
ftsSlotsMissedNum = Int
missed }, Bool
True))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasMissed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Int
x <- [Int] -> Int
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> IO [Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForgingStats -> (ForgeThreadStats -> Int) -> IO [Int]
forall a. ForgingStats -> (ForgeThreadStats -> a) -> IO [a]
threadStatsProjection ForgingStats
fStats ForgeThreadStats -> Int
ftsSlotsMissedNum
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"slotsMissedNum" Trace IO Text
tr Int
x
TraceForgeEvent blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
notifyTxsProcessed :: ForgingStats -> Trace IO Text -> Tracer IO (TraceEventMempool blk)
notifyTxsProcessed :: ForgingStats -> Trace IO Text -> Tracer IO (TraceEventMempool blk)
notifyTxsProcessed ForgingStats
fStats Trace IO Text
tr = (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk))
-> (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ \case
TraceMempoolRemoveTxs [] MempoolSize
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TraceMempoolRemoveTxs [Validated (GenTx blk)]
txs MempoolSize
_ -> do
Int
updatedTxProcessed <- ForgingStats -> (Int -> Int) -> IO Int
mapForgingStatsTxsProcessed ForgingStats
fStats (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Validated (GenTx blk)] -> Int
forall a. HasLength a => a -> Int
length [Validated (GenTx blk)]
txs))
Text -> Trace IO Text -> Int -> IO ()
traceCounter Text
"txsProcessedNum" Trace IO Text
tr (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
updatedTxProcessed)
TraceEventMempool blk
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mempoolMetricsTraceTransformer :: Trace IO a -> Tracer IO (TraceEventMempool blk)
mempoolMetricsTraceTransformer :: Trace IO a -> Tracer IO (TraceEventMempool blk)
mempoolMetricsTraceTransformer Trace IO a
tr = (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk))
-> (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ \TraceEventMempool blk
mempoolEvent -> do
let tr' :: Trace IO a
tr' = Text -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO a
tr
(Int
_n, MempoolSize
tot) = case TraceEventMempool blk
mempoolEvent of
TraceMempoolAddedTx Validated (GenTx blk)
_tx0 MempoolSize
_ MempoolSize
tot0 -> (Int
1, MempoolSize
tot0)
TraceMempoolRejectedTx GenTx blk
_tx0 ApplyTxErr blk
_ MempoolSize
tot0 -> (Int
1, MempoolSize
tot0)
TraceMempoolRemoveTxs [Validated (GenTx blk)]
txs0 MempoolSize
tot0 -> ([Validated (GenTx blk)] -> Int
forall a. HasLength a => a -> Int
length [Validated (GenTx blk)]
txs0, MempoolSize
tot0)
TraceMempoolManuallyRemovedTxs [GenTxId blk]
txs0 [Validated (GenTx blk)]
txs1 MempoolSize
tot0 -> ( [GenTxId blk] -> Int
forall a. HasLength a => a -> Int
length [GenTxId blk]
txs0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Validated (GenTx blk)] -> Int
forall a. HasLength a => a -> Int
length [Validated (GenTx blk)]
txs1, MempoolSize
tot0)
logValue1 :: LOContent a
logValue1 :: LOContent a
logValue1 = Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"txsInMempool" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ SizeInBytes -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MempoolSize -> SizeInBytes
msNumTxs MempoolSize
tot)
logValue2 :: LOContent a
logValue2 :: LOContent a
logValue2 = Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"mempoolBytes" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ SizeInBytes -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MempoolSize -> SizeInBytes
msNumBytes MempoolSize
tot)
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Confidential
Trace IO a -> (LOMeta, LOContent a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO a
tr' (LOMeta
meta, LOContent a
forall a. LOContent a
logValue1)
Trace IO a -> (LOMeta, LOContent a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO a
tr' (LOMeta
meta, LOContent a
forall a. LOContent a
logValue2)
mempoolTracer
:: ( ToJSON (GenTxId blk)
, ToObject (ApplyTxErr blk)
, ToObject (GenTx blk)
, LedgerSupportsMempool blk
)
=> TraceSelection
-> Trace IO Text
-> ForgingStats
-> Tracer IO (TraceEventMempool blk)
mempoolTracer :: TraceSelection
-> Trace IO Text
-> ForgingStats
-> Tracer IO (TraceEventMempool blk)
mempoolTracer TraceSelection
tc Trace IO Text
tracer ForgingStats
fStats = (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk))
-> (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ \TraceEventMempool blk
ev -> do
Tracer IO (TraceEventMempool blk) -> TraceEventMempool blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Trace IO Text -> Tracer IO (TraceEventMempool blk)
forall a blk. Trace IO a -> Tracer IO (TraceEventMempool blk)
mempoolMetricsTraceTransformer Trace IO Text
tracer) TraceEventMempool blk
ev
Tracer IO (TraceEventMempool blk) -> TraceEventMempool blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (ForgingStats -> Trace IO Text -> Tracer IO (TraceEventMempool blk)
forall blk.
ForgingStats -> Trace IO Text -> Tracer IO (TraceEventMempool blk)
notifyTxsProcessed ForgingStats
fStats Trace IO Text
tracer) TraceEventMempool blk
ev
let tr :: Trace IO Text
tr = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"Mempool" Trace IO Text
tracer
Tracer IO (TraceEventMempool blk) -> TraceEventMempool blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TraceSelection
-> Trace IO Text -> Tracer IO (TraceEventMempool blk)
forall blk.
(ToJSON (GenTxId blk), ToObject (ApplyTxErr blk),
ToObject (GenTx blk), LedgerSupportsMempool blk) =>
TraceSelection
-> Trace IO Text -> Tracer IO (TraceEventMempool blk)
mpTracer TraceSelection
tc Trace IO Text
tr) TraceEventMempool blk
ev
mpTracer :: ( ToJSON (GenTxId blk)
, ToObject (ApplyTxErr blk)
, ToObject (GenTx blk)
, LedgerSupportsMempool blk
)
=> TraceSelection -> Trace IO Text -> Tracer IO (TraceEventMempool blk)
mpTracer :: TraceSelection
-> Trace IO Text -> Tracer IO (TraceEventMempool blk)
mpTracer TraceSelection
tc Trace IO Text
tr = Tracer IO (WithSeverity (TraceEventMempool blk))
-> Tracer IO (TraceEventMempool blk)
forall a (m :: * -> *).
HasSeverityAnnotation a =>
Tracer m (WithSeverity a) -> Tracer m a
annotateSeverity (Tracer IO (WithSeverity (TraceEventMempool blk))
-> Tracer IO (TraceEventMempool blk))
-> Tracer IO (WithSeverity (TraceEventMempool blk))
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ TracingVerbosity
-> Trace IO Text
-> Tracer IO (WithSeverity (TraceEventMempool blk))
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
TracingVerbosity -> Trace m a -> Tracer m b
toLogObject' (TraceSelection -> TracingVerbosity
traceVerbosity TraceSelection
tc) Trace IO Text
tr
forgeStateInfoMetricsTraceTransformer
:: forall a blk. HasKESMetricsData blk
=> Proxy blk
-> Trace IO a
-> Tracer IO (Consensus.TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoMetricsTraceTransformer :: Proxy blk
-> Trace IO a -> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoMetricsTraceTransformer Proxy blk
p Trace IO a
tr = (TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk)))
-> (TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a b. (a -> b) -> a -> b
$
\(Consensus.TraceLabelCreds Text
_ ForgeStateInfo blk
forgeStateInfo) -> do
case Proxy blk -> ForgeStateInfo blk -> KESMetricsData
forall blk.
HasKESMetricsData blk =>
Proxy blk -> ForgeStateInfo blk -> KESMetricsData
getKESMetricsData Proxy blk
p ForgeStateInfo blk
forgeStateInfo of
KESMetricsData
NoKESMetricsData -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TPraosKESMetricsData Word
kesPeriodOfKey
(MaxKESEvolutions Word64
maxKesEvos)
(OperationalCertStartKESPeriod Word
oCertStartKesPeriod) -> do
let metricsTr :: Trace IO a
metricsTr = Text -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO a
tr
currentKesPeriod :: Word
currentKesPeriod = Word
oCertStartKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
kesPeriodOfKey
oCertExpiryKesPeriod :: Word
oCertExpiryKesPeriod = Word
oCertStartKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
maxKesEvos
kesPeriodsUntilExpiry :: Word
kesPeriodsUntilExpiry =
Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
0 (Word
oCertExpiryKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
currentKesPeriod)
logValues :: [LOContent a]
logValues :: [LOContent a]
logValues =
[ Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"operationalCertificateStartKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI
(Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
oCertStartKesPeriod
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"operationalCertificateExpiryKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI
(Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
oCertExpiryKesPeriod
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"currentKESPeriod"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI
(Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
currentKesPeriod
, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue Text
"remainingKESPeriods"
(Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI
(Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
kesPeriodsUntilExpiry
]
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Critical PrivacyAnnotation
Confidential
(LOContent a -> IO ()) -> [LOContent a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Trace IO a -> (LOMeta, LOContent a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO a
metricsTr ((LOMeta, LOContent a) -> IO ())
-> (LOContent a -> (LOMeta, LOContent a)) -> LOContent a -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LOMeta
meta,)) [LOContent a]
logValues
LOMeta
metaWarning <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Warning PrivacyAnnotation
Public
LOMeta
metaAlert <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Alert PrivacyAnnotation
Public
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
kesPeriodsUntilExpiry Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
7) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Trace IO a -> (Text, LogObject a) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO a
tr
( Text
forall a. Monoid a => a
mempty
, Text -> LOMeta -> LOContent a -> LogObject a
forall a. Text -> LOMeta -> LOContent a -> LogObject a
LogObject
Text
forall a. Monoid a => a
mempty
(if Word
kesPeriodsUntilExpiry Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
1 then LOMeta
metaAlert else LOMeta
metaWarning)
(Object -> Text -> LOContent a
forall a. Object -> Text -> LOContent a
LogStructuredText Object
forall a. Monoid a => a
mempty (Word -> Text
expiryLogMessage Word
kesPeriodsUntilExpiry))
)
where
expiryLogMessage :: Word -> Text
expiryLogMessage :: Word -> Text
expiryLogMessage Word
kesPeriodsUntilExpiry =
Text
"Operational key will expire in "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack (String -> Text) -> (Word -> String) -> Word -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> String
forall a. Show a => a -> String
show) Word
kesPeriodsUntilExpiry
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" KES periods."
forgeStateInfoTracer
:: forall blk.
( HasKESMetricsData blk
, Show (ForgeStateInfo blk)
)
=> Proxy blk
-> TraceSelection
-> Trace IO Text
-> Tracer IO (Consensus.TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer :: Proxy blk
-> TraceSelection
-> Trace IO Text
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoTracer Proxy blk
p TraceSelection
_ts Trace IO Text
tracer = (TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk)))
-> (TraceLabelCreds (ForgeStateInfo blk) -> IO ())
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a b. (a -> b) -> a -> b
$ \TraceLabelCreds (ForgeStateInfo blk)
ev -> do
let tr :: Trace IO Text
tr = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"Forge" Trace IO Text
tracer
Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
-> TraceLabelCreds (ForgeStateInfo blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Proxy blk
-> Trace IO Text
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a blk.
HasKESMetricsData blk =>
Proxy blk
-> Trace IO a -> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forgeStateInfoMetricsTraceTransformer Proxy blk
p Trace IO Text
tracer) TraceLabelCreds (ForgeStateInfo blk)
ev
Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
-> TraceLabelCreds (ForgeStateInfo blk) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Trace IO Text -> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
fsTracer Trace IO Text
tr) TraceLabelCreds (ForgeStateInfo blk)
ev
where
fsTracer :: Trace IO Text -> Tracer IO (Consensus.TraceLabelCreds (ForgeStateInfo blk))
fsTracer :: Trace IO Text -> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
fsTracer Trace IO Text
tr = Tracer IO String
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing (Tracer IO String
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk)))
-> Tracer IO String
-> Tracer IO (TraceLabelCreds (ForgeStateInfo blk))
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> Tracer IO Text -> Tracer IO String
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap String -> Text
Text.pack (Tracer IO Text -> Tracer IO String)
-> Tracer IO Text -> Tracer IO String
forall a b. (a -> b) -> a -> b
$ Trace IO Text -> Tracer IO Text
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
Trace m a -> Tracer m b
toLogObject Trace IO Text
tr
nodeToClientTracers'
:: ( ToObject localPeer
, ShowQuery (BlockQuery blk)
)
=> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeToClient.Tracers' localPeer blk DeserialiseFailure (Tracer IO)
nodeToClientTracers' :: TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers' localPeer blk DeserialiseFailure (Tracer IO)
nodeToClientTracers' TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr =
Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracers' peer blk e f
NodeToClient.Tracers
{ tChainSyncTracer :: Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
NodeToClient.tChainSyncTracer =
OnOff TraceLocalChainSyncProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalChainSyncProtocol
traceLocalChainSyncProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalChainSyncProtocol" Trace IO Text
tr
, tTxMonitorTracer :: Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
NodeToClient.tTxMonitorTracer =
OnOff TraceLocalTxMonitorProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalTxMonitorProtocol
traceLocalTxMonitorProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalTxMonitorProtocol" Trace IO Text
tr
, tTxSubmissionTracer :: Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
NodeToClient.tTxSubmissionTracer =
OnOff TraceLocalTxSubmissionProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalTxSubmissionProtocol
traceLocalTxSubmissionProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalTxSubmissionProtocol" Trace IO Text
tr
, tStateQueryTracer :: Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
NodeToClient.tStateQueryTracer =
OnOff TraceLocalStateQueryProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
localPeer
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceLocalStateQueryProtocol
traceLocalStateQueryProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"LocalStateQueryProtocol" Trace IO Text
tr
}
nodeToNodeTracers'
:: ( Consensus.RunNode blk
, ConvertTxId blk
, HasTxs blk
, Show peer
, ToObject peer
)
=> TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> NodeToNode.Tracers' peer blk DeserialiseFailure (Tracer IO)
nodeToNodeTracers' :: TraceSelection
-> TracingVerbosity
-> Trace IO Text
-> Tracers' peer blk DeserialiseFailure (Tracer IO)
nodeToNodeTracers' TraceSelection
trSel TracingVerbosity
verb Trace IO Text
tr =
Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracers' peer blk e f
NodeToNode.Tracers
{ tChainSyncTracer :: Tracer
IO
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
NodeToNode.tChainSyncTracer =
OnOff TraceChainSyncProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceChainSyncProtocol
traceChainSyncProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"ChainSyncProtocol" Trace IO Text
tr
, tChainSyncSerialisedTracer :: Tracer
IO
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
NodeToNode.tChainSyncSerialisedTracer =
OnOff TraceChainSyncProtocol
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a (b :: Symbol).
(Show a, HasSeverityAnnotation a) =>
OnOff b -> Text -> Trace IO Text -> Tracer IO a
showOnOff (TraceSelection -> OnOff TraceChainSyncProtocol
traceChainSyncProtocol TraceSelection
trSel)
Text
"ChainSyncProtocolSerialised" Trace IO Text
tr
, tBlockFetchTracer :: Tracer
IO
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
NodeToNode.tBlockFetchTracer =
OnOff TraceBlockFetchProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceBlockFetchProtocol
traceBlockFetchProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"BlockFetchProtocol" Trace IO Text
tr
, tBlockFetchSerialisedTracer :: Tracer
IO
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
NodeToNode.tBlockFetchSerialisedTracer =
OnOff TraceBlockFetchProtocolSerialised
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a (b :: Symbol).
(Show a, HasSeverityAnnotation a) =>
OnOff b -> Text -> Trace IO Text -> Tracer IO a
showOnOff (TraceSelection -> OnOff TraceBlockFetchProtocolSerialised
traceBlockFetchProtocolSerialised TraceSelection
trSel)
Text
"BlockFetchProtocolSerialised" Trace IO Text
tr
, tTxSubmission2Tracer :: Tracer
IO
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
NodeToNode.tTxSubmission2Tracer =
OnOff TraceTxSubmissionProtocol
-> TracingVerbosity
-> Text
-> Trace IO Text
-> Tracer
IO
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a (b :: Symbol).
Transformable Text IO a =>
OnOff b -> TracingVerbosity -> Text -> Trace IO Text -> Tracer IO a
tracerOnOff (TraceSelection -> OnOff TraceTxSubmissionProtocol
traceTxSubmissionProtocol TraceSelection
trSel)
TracingVerbosity
verb Text
"TxSubmissionProtocol" Trace IO Text
tr
}
teeTraceBlockFetchDecision
:: ( Eq peer
, HasHeader blk
, Show peer
, ToObject peer
)
=> TracingVerbosity
-> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision :: TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision TracingVerbosity
verb MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
eliding Trace IO Text
tr =
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]))
-> (WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall a b. (a -> b) -> a -> b
$ \WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
ev -> do
Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall peer blk.
Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision' Trace IO Text
meTr) WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
ev
Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
-> WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall peer blk.
(Eq peer, HasHeader blk, Show peer, ToObject peer) =>
TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecisionElide TracingVerbosity
verb MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
eliding Trace IO Text
bfdTr) WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
ev
where
meTr :: Trace IO Text
meTr = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
tr
bfdTr :: Trace IO Text
bfdTr = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"BlockFetchDecision" Trace IO Text
tr
teeTraceBlockFetchDecision'
:: Trace IO Text
-> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision' :: Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecision' Trace IO Text
tr =
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]))
-> (WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
-> IO ())
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Severity
_ [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
peers) -> do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Info PrivacyAnnotation
Confidential
Trace IO Text -> (LOMeta, LOContent Text) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace IO Text
tr (LOMeta
meta, Text -> Measurable -> LOContent Text
forall a. Text -> Measurable -> LOContent a
LogValue Text
"connectedPeers" (Measurable -> LOContent Text)
-> (Integer -> Measurable) -> Integer -> LOContent Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Measurable
PureI (Integer -> LOContent Text) -> Integer -> LOContent Text
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [TraceLabelPeer peer (FetchDecision [Point (Header blk)])] -> Int
forall a. HasLength a => a -> Int
length [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]
peers)
teeTraceBlockFetchDecisionElide
:: ( Eq peer
, HasHeader blk
, Show peer
, ToObject peer
)
=> TracingVerbosity
-> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer)
-> Trace IO Text
-> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecisionElide :: TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
teeTraceBlockFetchDecisionElide = TracingVerbosity
-> MVar
(Maybe
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),
Integer)
-> Trace IO Text
-> Tracer
IO
(WithSeverity
[TraceLabelPeer peer (FetchDecision [Point (Header blk)])])
forall a t.
(ElidingTracer a, ToObject t, Transformable t IO a) =>
TracingVerbosity
-> MVar (Maybe a, Integer) -> Trace IO t -> Tracer IO a
elideToLogObject
traceConnectionManagerTraceMetrics
:: OnOff TraceConnectionManagerCounters
-> Maybe EKGDirect
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
traceConnectionManagerTraceMetrics :: OnOff TraceConnectionManagerCounters
-> Maybe EKGDirect
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
traceConnectionManagerTraceMetrics OnOff TraceConnectionManagerCounters
_ Maybe EKGDirect
Nothing = Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
traceConnectionManagerTraceMetrics (OnOff Bool
False) Maybe EKGDirect
_ = Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
traceConnectionManagerTraceMetrics (OnOff Bool
True) (Just EKGDirect
ekgDirect) = Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
forall peerAddr handlerTrace.
Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
cmtTracer
where
cmtTracer :: Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
cmtTracer :: Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
cmtTracer = (ConnectionManagerTrace peerAddr handlerTrace -> IO ())
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((ConnectionManagerTrace peerAddr handlerTrace -> IO ())
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace))
-> (ConnectionManagerTrace peerAddr handlerTrace -> IO ())
-> Tracer IO (ConnectionManagerTrace peerAddr handlerTrace)
forall a b. (a -> b) -> a -> b
$ \case
(TrConnectionManagerCounters
(ConnectionManagerCounters
Int
prunableConns
Int
duplexConns
Int
unidirectionalConns
Int
incomingConns
Int
outgoingConns
)
) -> do
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect
Text
"cardano.node.metrics.connectionManager.prunableConns"
Int
prunableConns
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect
Text
"cardano.node.metrics.connectionManager.duplexConns"
Int
duplexConns
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect
Text
"cardano.node.metrics.connectionManager.unidirectionalConns"
Int
unidirectionalConns
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect
Text
"cardano.node.metrics.connectionManager.incomingConns"
Int
incomingConns
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect
Text
"cardano.node.metrics.connectionManager.outgoingConns"
Int
outgoingConns
ConnectionManagerTrace peerAddr handlerTrace
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tracePeerSelectionCountersMetrics
:: OnOff TracePeerSelectionCounters
-> Maybe EKGDirect
-> Tracer IO PeerSelectionCounters
tracePeerSelectionCountersMetrics :: OnOff TracePeerSelectionCounters
-> Maybe EKGDirect -> Tracer IO PeerSelectionCounters
tracePeerSelectionCountersMetrics OnOff TracePeerSelectionCounters
_ Maybe EKGDirect
Nothing = Tracer IO PeerSelectionCounters
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
tracePeerSelectionCountersMetrics (OnOff Bool
False) Maybe EKGDirect
_ = Tracer IO PeerSelectionCounters
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
tracePeerSelectionCountersMetrics (OnOff Bool
True) (Just EKGDirect
ekgDirect) = Tracer IO PeerSelectionCounters
pscTracer
where
pscTracer :: Tracer IO PeerSelectionCounters
pscTracer :: Tracer IO PeerSelectionCounters
pscTracer = (PeerSelectionCounters -> IO ()) -> Tracer IO PeerSelectionCounters
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((PeerSelectionCounters -> IO ())
-> Tracer IO PeerSelectionCounters)
-> (PeerSelectionCounters -> IO ())
-> Tracer IO PeerSelectionCounters
forall a b. (a -> b) -> a -> b
$ \(PeerSelectionCounters Int
cold Int
warm Int
hot) -> do
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect Text
"cardano.node.metrics.peerSelection.cold" Int
cold
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect Text
"cardano.node.metrics.peerSelection.warm" Int
warm
EKGDirect -> Text -> Int -> IO ()
forall a. Integral a => EKGDirect -> Text -> a -> IO ()
sendEKGDirectInt EKGDirect
ekgDirect Text
"cardano.node.metrics.peerSelection.hot" Int
hot
traceInboundGovernorCountersMetrics
:: forall addr.
OnOff TraceInboundGovernorCounters
-> Maybe