{-# 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

-- For tracing instances
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

{- HLINT ignore "Redundant bracket" -}
{- HLINT ignore "Use record patterns" -}

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
  -- equivalent by type and severity
  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
  -- the types to be elided
  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 -- report at most every 1250 ms
        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
  -- equivalent by type and severity
  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
  -- the types to be elided
  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
$  -- report every 1000th message
          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)

-- | Tracers for all system components.
--
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  -- for eliding messages in ChainDB tracer
  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
    -- TODO: startupTracer should ignore severity level (i.e. it should always
    -- be printed)!
    , 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
    -- The remaining tracers are completely unused by the legacy tracing:
    , 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
    }

--------------------------------------------------------------------------------
-- Chain DB Tracers
--------------------------------------------------------------------------------

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
      -- TODO this is executed each time the newFhain changes. How cheap is it?
      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

--------------------------------------------------------------------------------
-- Consensus Tracers
--------------------------------------------------------------------------------

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  -- for eliding messages in FetchDecision tr
  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
     -- We probably don't want to pay the extra IO cost per-counter-increment. -- sk
     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 ()


-- | CdfCounter tracks the number of time a value below 'limit' has been seen.
newtype CdfCounter (limit :: Nat) = CdfCounter Int64

-- | Estimates the CDF for a specific limit 'l' by counting the number of times
-- a value 'v' is below the limit.
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)


-- Add an observation to the CdfCounter.
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

-- Remove an observation from the CdfCounter.
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)


-- Track the fraction of times forgeDelay was above 1s, 3s, and 5s.
-- Only the first sample per slot number is counted.
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) -- During startup wait until we are in sync
     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 -- TODO k/2, should come from config file
            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) -- Err. We just inserted an element!
                   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) -- Nothing to do
                        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'
              -- Wait until we have at least 45 samples before we start providing
              -- cdf estimates.
              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) -- dupe, we only track the first

  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 () -- Nothing to do.
        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
            -- TODO: Revisit ekg counter access once there is a faster way.
            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
    -- Ignoring the credentials label for measurement and counters:
    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
    -- Consensus tracer -- here we track the label:
    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 ->
        -- KES-key cannot be evolved, but anyway trace KES-values.
        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
    -- Not is not a leader again, so now the number of blocks forged by this node
    -- should be equal to the number of slots when this node was a leader.
    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 ()


--------------------------------------------------------------------------------
-- Mempool Tracers
--------------------------------------------------------------------------------

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
    -- TraceMempoolRemoveTxs are previously valid transactions that are no longer valid because of
    -- changes in the ledger state. These transactions are already removed from the mempool,
    -- so we can treat them as completely processed.
    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)
  -- The rest of the constructors.
  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

--------------------------------------------------------------------------------
-- ForgeStateInfo Tracers
--------------------------------------------------------------------------------

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

            -- The KES period of the hot key is relative to the start KES
            -- period of the operational certificate.
            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

        -- Trace warning messages on the last 7 KES periods and, in the
        -- final and subsequent KES periods, trace alert messages.
        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

--------------------------------------------------------------------------------
-- NodeToClient Tracers
--------------------------------------------------------------------------------

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
  }

--------------------------------------------------------------------------------
-- NodeToNode Tracers
--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------
-- PeerSelection Tracers
--------------------------------------------------------------------------------

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