From 00752d01f8a38fbb81f6ed5db923c15df4545fe2 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Wed, 15 May 2024 19:39:11 +0200 Subject: [PATCH 1/7] Update tracing after addition of the new BulkSync implementation --- .../src/Cardano/Node/Configuration/POM.hs | 17 ++ cardano-node/src/Cardano/Node/Parsers.hs | 1 + cardano-node/src/Cardano/Node/Run.hs | 18 +- .../src/Cardano/Node/Tracing/Consistency.hs | 21 +- .../src/Cardano/Node/Tracing/Documentation.hs | 6 +- .../src/Cardano/Node/Tracing/Tracers.hs | 9 +- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 62 ++++- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 259 +++++++++++++++--- .../src/Cardano/Node/Tracing/Tracers/Peer.hs | 6 +- cardano-node/src/Cardano/Tracing/Config.hs | 37 ++- .../Tracing/OrphanInstances/Consensus.hs | 124 ++++++++- .../Tracing/OrphanInstances/Network.hs | 22 ++ cardano-node/src/Cardano/Tracing/Peer.hs | 6 +- cardano-node/src/Cardano/Tracing/Tracers.hs | 35 ++- cardano-testnet/src/Testnet/Defaults.hs | 1 + 15 files changed, 528 insertions(+), 96 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 0cb4a22c2ef..010c3266e6a 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -162,6 +162,9 @@ data NodeConfiguration -- Enable Peer Sharing , ncPeerSharing :: PeerSharing + + -- Enable Genesis syncing protocol + , ncEnableGenesis :: Bool } deriving (Eq, Show) @@ -225,6 +228,9 @@ data PartialNodeConfiguration -- Peer Sharing , pncPeerSharing :: !(Last PeerSharing) + + -- Genesis syncing protocol + , pncEnableGenesis :: !(Last Bool) } deriving (Eq, Generic, Show) instance AdjustFilePaths PartialNodeConfiguration where @@ -321,6 +327,10 @@ instance FromJSON PartialNodeConfiguration where -- DISABLED BY DEFAULT pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just PeerSharingDisabled + -- Genesis syncing protocol + -- DISABLED BY DEFAULT + pncEnableGenesis <- Last <$> v .:? "EnableGenesis" .!= Just False + pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath @@ -355,6 +365,7 @@ instance FromJSON PartialNodeConfiguration where , pncTargetNumberOfActiveBigLedgerPeers , pncEnableP2P , pncPeerSharing + , pncEnableGenesis } where parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride @@ -531,6 +542,7 @@ defaultPartialNodeConfiguration = , pncTargetNumberOfActiveBigLedgerPeers = Last (Just 5) , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) + , pncEnableGenesis = Last (Just False) } lastOption :: Parser a -> Parser (Last a) @@ -596,6 +608,10 @@ makeNodeConfiguration pnc = do lastToEither "Missing PeerSharing" $ pncPeerSharing pnc + ncEnableGenesis <- + lastToEither "Missing EnableGenesis" + $ pncEnableGenesis pnc + -- TODO: This is not mandatory experimentalProtocols <- lastToEither "Missing ExperimentalProtocolsEnabled" $ @@ -643,6 +659,7 @@ makeNodeConfiguration pnc = do EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing + , ncEnableGenesis } ncProtocol :: NodeConfiguration -> Protocol diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index ba82f9f96db..95c3284abd2 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -126,6 +126,7 @@ nodeRunParser = do , pncTargetNumberOfActiveBigLedgerPeers = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty + , pncEnableGenesis = mempty } parseSocketPath :: Text -> Parser SocketPath diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 08b0feed168..993633a1656 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -6,9 +6,11 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-} @@ -45,7 +47,7 @@ import "contra-tracer" Control.Tracer import Data.Either (partitionEithers) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe, isJust) import Data.Monoid (Last (..)) import Data.Proxy (Proxy (..)) import Data.Text (Text, breakOn, pack) @@ -93,9 +95,11 @@ import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..)) import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) +import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as ChainSync.Client import Ouroboros.Consensus.Node (DiskPolicyArgs (..), NetworkP2PMode (..), RunNodeArgs (..), StdRunNodeArgs (..)) import qualified Ouroboros.Consensus.Node as Node (getChainDB, run) +import qualified Ouroboros.Consensus.Node.Genesis as Genesis import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Util.Orphans () @@ -476,6 +480,9 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = readTVar useBootstrapVar + , rnGenesisConfig = if ncEnableGenesis nc + then Genesis.enableGenesisConfigDefault + else Genesis.disableGenesisConfig } #ifdef UNIX -- initial `SIGHUP` handler, which only rereads the topology file but @@ -508,8 +515,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do rnNodeKernelHook nodeArgs registry nodeKernel } StdRunNodeArgs - { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc - , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc + { srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc , srnChainDbValidateOverride = ncValidateDB nc , srnDiskPolicyArgs = diskPolicyArgs , srnDatabasePath = dbPath @@ -559,6 +565,9 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers + , rnGenesisConfig = if ncEnableGenesis nc + then Genesis.enableGenesisConfigDefault + else Genesis.disableGenesisConfig } #ifdef UNIX -- initial `SIGHUP` handler; it only warns that neither updating of @@ -581,8 +590,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do rnNodeKernelHook nodeArgs registry nodeKernel } StdRunNodeArgs - { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc - , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc + { srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc , srnChainDbValidateOverride = ncValidateDB nc , srnDiskPolicyArgs = diskPolicyArgs , srnDatabasePath = dbPath diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index a2e4aa6bb35..46526e4a310 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -38,6 +38,7 @@ import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTim import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Ledger.Query (Query) +import Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId) import Ouroboros.Consensus.Mempool (TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server @@ -46,11 +47,13 @@ import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSy import Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent) import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server (TraceLocalTxSubmissionServerEvent (..)) +import Ouroboros.Consensus.Node.GSM (TraceGsmEvent) import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB +import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as CSJumping import Ouroboros.Network.Block (Point (..), SlotNo, Tip) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch -import Ouroboros.Network.BlockFetch.Decision +import Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId) import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..)) @@ -151,9 +154,7 @@ getAllNamespaces = chainSyncServerBlockNS = map (nsGetTuple . nsReplacePrefix ["ChainSync", "ServerBlock"]) (allNamespaces :: [Namespace (TraceChainSyncServerEvent blk)]) blockFetchDecisionNS = map (nsGetTuple . nsReplacePrefix ["BlockFetch", "Decision"]) - (allNamespaces :: [Namespace [BlockFetch.TraceLabelPeer - remotePeer - (FetchDecision [Point (Header blk)])]]) + (allNamespaces :: [Namespace (TraceDecisionEvent remotePeer (Header blk))]) blockFetchClientNS = map (nsGetTuple . nsReplacePrefix ["BlockFetch", "Client"]) (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer remotePeer @@ -185,6 +186,15 @@ getAllNamespaces = blockchainTimeNS = map (nsGetTuple . nsReplacePrefix ["BlockchainTime"]) (allNamespaces :: [Namespace (TraceBlockchainTimeEvent RelativeTime)]) + gsmEventNS = map (nsGetTuple . nsReplacePrefix ["GsmEvent"]) + (allNamespaces :: [Namespace (TraceGsmEvent selection)]) + + csjEventNS = map nsGetTuple + (allNamespaces :: [Namespace (CSJumping.TraceEvent peer)]) + + gddEventNS = map nsGetTuple + (allNamespaces :: [Namespace (TraceGDDEvent peer blk)]) + -- Node to client keepAliveClientNS = map (nsGetTuple . nsReplacePrefix ["Net"]) (allNamespaces :: [Namespace (TraceKeepAliveClient peer)]) @@ -390,6 +400,9 @@ getAllNamespaces = <> mempoolNS <> forgeNS <> blockchainTimeNS + <> gsmEventNS + <> csjEventNS + <> gddEventNS -- NodeToClient <> keepAliveClientNS <> chainSyncNS diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 676b8d021a9..a3ef7aca07b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -59,7 +59,7 @@ import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import Ouroboros.Network.Block (Point (..), Serialised, SlotNo, Tip) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch -import Ouroboros.Network.BlockFetch.Decision +import qualified Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId) import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..)) @@ -278,9 +278,7 @@ docTracersFirstPhase condConfigFileName = do ["BlockFetch", "Decision"] configureTracers configReflection trConfig [blockFetchDecisionTr] blockFetchDecisionTrDoc <- documentTracer (blockFetchDecisionTr :: - Trace IO [BlockFetch.TraceLabelPeer - remotePeer - (FetchDecision [Point (Header blk)])]) + Trace IO (BlockFetch.TraceDecisionEvent remotePeer (Header blk))) blockFetchClientTr <- mkCardanoTracer trBase trForward mbTrEKG diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 2eef28c0d34..a65c24bc6c8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -317,12 +317,17 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf !consensusStartupErrorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Consensus", "Startup"] + configureTracers configReflection trConfig [consensusStartupErrorTr] !consensusGsmTr <- mkCardanoTracer trBase trForward mbTrEKG ["Consensus", "GSM"] + configureTracers configReflection trConfig [consensusGsmTr] - configureTracers configReflection trConfig [consensusStartupErrorTr] + !consensusCsjTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "CSJ"] + configureTracers configReflection trConfig [consensusCsjTr] pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ @@ -361,6 +366,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr + , Consensus.gddTracer = Tracer $ \_ -> pure () -- TODO + , Consensus.csjTracer = Tracer $ traceWith consensusCsjTr } mkNodeToClientTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 46af0cf6250..bea6f0315dd 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -90,6 +90,7 @@ instance ( LogFormatting (Header blk) forHuman (ChainDB.TraceLedgerReplayEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceImmutableDBEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceVolatileDBEvent v) = forHumanOrMachine v + forHuman (ChainDB.TraceChainSelStarvationEvent v)= forHumanOrMachine v forMachine details (ChainDB.TraceAddBlockEvent v) = forMachine details v @@ -113,6 +114,8 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceVolatileDBEvent v) = forMachine details v + forMachine details (ChainDB.TraceChainSelStarvationEvent v) = + forMachine details v asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v @@ -125,6 +128,7 @@ instance ( LogFormatting (Header blk) asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceChainSelStarvationEvent v) = asMetrics v instance MetaTrace (ChainDB.TraceEvent blk) where @@ -150,6 +154,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "ImmDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceVolatileDBEvent ev) = nsPrependInner "VolatileDbEvent" (namespaceFor ev) + namespaceFor (ChainDB.TraceChainSelStarvationEvent ev) = + nsPrependInner "ChainSelStarvationEvent" (namespaceFor ev) severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = severityFor (Namespace out tl) (Just ev') @@ -195,6 +201,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("VolatileDbEvent" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) Nothing + severityFor (Namespace out ("ChainSelStarvationEvent" : tl)) (Just (ChainDB.TraceChainSelStarvationEvent ev')) = + severityFor (Namespace out tl) (Just ev') + severityFor (Namespace out ("ChainSelStarvationEvent" : tl)) Nothing = + severityFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk)) Nothing severityFor _ns _ = Nothing privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = @@ -287,6 +297,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("VolatileDbEvent" : tl)) Nothing = detailsFor (Namespace out tl :: (Namespace (VolDB.TraceEvent blk))) Nothing + detailsFor (Namespace out ("ChainSelStarvationEvent" : tl)) (Just (ChainDB.TraceChainSelStarvationEvent ev')) = + detailsFor (Namespace out tl) (Just ev') + detailsFor (Namespace out ("ChainSelStarvationEvent" : tl)) Nothing = + detailsFor (Namespace out tl :: (Namespace (ChainDB.TraceChainSelStarvationEvent blk))) Nothing detailsFor _ _ = Nothing metricsDocFor (Namespace out ("AddBlockEvent" : tl)) = @@ -311,6 +325,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where metricsDocFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk)) metricsDocFor (Namespace out ("VolatileDbEvent" : tl)) = metricsDocFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) + metricsDocFor (Namespace out ("ChainSelStarvationEvent" : tl)) = + metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk)) metricsDocFor _ = [] documentFor (Namespace out ("AddBlockEvent" : tl)) = @@ -335,6 +351,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where documentFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk)) documentFor (Namespace out ("VolatileDbEvent" : tl)) = documentFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) + documentFor (Namespace out ("ChainSelStarvationEvent" : tl)) = + documentFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk)) documentFor _ = Nothing allNamespaces = @@ -360,7 +378,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where (allNamespaces :: [Namespace (ImmDB.TraceEvent blk)]) ++ map (nsPrependInner "VolatileDbEvent") (allNamespaces :: [Namespace (VolDB.TraceEvent blk)]) - + ++ map (nsPrependInner "ChainSelStarvationEvent") + (allNamespaces :: [Namespace (ChainDB.TraceChainSelStarvationEvent blk)]) -------------------------------------------------------------------------------- -- AddBlockEvent @@ -1171,6 +1190,47 @@ instance MetaTrace (ChainDB.TraceValidationEvent blk) where , Namespace [] ["UpdateLedgerDb"] ] +-------------------------------------------------------------------------------- +-- TraceChainSelStarvationEvent +-------------------------------------------------------------------------------- + +instance ConvertRawHash blk + => LogFormatting (ChainDB.TraceChainSelStarvationEvent blk) where + forHuman (ChainDB.ChainSelStarvationStarted time) = + "Chain selection starvation started at " <> showT time + forHuman (ChainDB.ChainSelStarvationEnded time pt) = + "Chain selection starvation ended at " <> showT time <> + " because of " <> renderRealPointAsPhrase pt + + forMachine _dtal (ChainDB.ChainSelStarvationStarted time) = + mconcat [ "kind" .= String "ChainSelStarvationStarted" + , "time" .= String (showT time) ] + forMachine dtal (ChainDB.ChainSelStarvationEnded time pt) = + mconcat [ "kind" .= String "ChainSelStarvationEnded" + , "time" .= String (showT time) + , "point" .= forMachine dtal pt ] + +instance MetaTrace (ChainDB.TraceChainSelStarvationEvent blk) where + namespaceFor ChainDB.ChainSelStarvationStarted {} = + Namespace [] ["ChainSelStarvationStarted"] + namespaceFor ChainDB.ChainSelStarvationEnded {} = + Namespace [] ["ChainSelStarvationEnded"] + + severityFor (Namespace _ ["ChainSelStarvationStarted"]) _ = Just Debug + severityFor (Namespace _ ["ChainSelStarvationEnded"]) _ = Just Debug + severityFor _ _ = Nothing + + documentFor (Namespace _ ["ChainSelStarvationStarted"]) = Just + "Chain selection starvation started." + documentFor (Namespace _ ["ChainSelStarvationEnded"]) = Just + "Chain selection starvation ended." + documentFor _ = Nothing + + allNamespaces = + [ Namespace [] ["ChainSelStarvationStarted"] + , Namespace [] ["ChainSelStarvationEnded"] + ] + -------------------------------------------------------------------------------- -- TraceOpenEvent -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 0f84f4bb238..6efd6f347ed 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -45,11 +45,12 @@ import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping (Instruction (..), - JumpInstruction (..), JumpResult (..)) + JumpInstruction (..), JumpResult (..), TraceEvent(..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (JumpInfo (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Server import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server (TraceLocalTxSubmissionServerEvent (..)) +import Ouroboros.Consensus.Genesis.Governor import Ouroboros.Consensus.Node.GSM import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) import Ouroboros.Consensus.Node.Tracers @@ -61,6 +62,7 @@ import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision +import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) @@ -69,7 +71,7 @@ import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound import Control.Monad.Class.MonadTime.SI (Time (..)) -import Data.Aeson (ToJSON, Value (Number, String), toJSON, (.=)) +import Data.Aeson (ToJSON, Value (Number, Object, String), toJSON, (.=)) import qualified Data.Aeson as Aeson import Data.Foldable (Foldable (..)) import Data.Int (Int64) @@ -641,48 +643,61 @@ calculateBlockFetchClientMetrics cm _lc _ = pure cm -------------------------------------------------------------------------------- instance (LogFormatting peer, Show peer) => - LogFormatting [TraceLabelPeer peer (FetchDecision [Point header])] where - forMachine DMinimal _ = mempty - forMachine _ [] = mconcat + LogFormatting (TraceDecisionEvent peer header) where + forMachine DMinimal (PeersFetch _) = mempty + forMachine _ (PeersFetch []) = mconcat [ "kind" .= String "EmptyPeersFetch"] - forMachine _ xs = mconcat + forMachine _ (PeersFetch xs) = mconcat [ "kind" .= String "PeersFetch" , "peers" .= toJSON (foldl' (\acc x -> forMachine DDetailed x : acc) [] xs) ] + forMachine dtal (PeerStarvedUs peer) = mconcat + [ "kind" .= String "PeerStarvedUs" + , "peer" .= forMachine dtal peer ] - asMetrics peers = [IntM "BlockFetch.ConnectedPeers" (fromIntegral (length peers))] + asMetrics (PeersFetch peers) = [IntM "BlockFetch.ConnectedPeers" (fromIntegral (length peers))] + asMetrics _ = [] -instance MetaTrace [TraceLabelPeer peer (FetchDecision [Point header])] where - namespaceFor (a : _tl) = (nsCast . namespaceFor) a - namespaceFor [] = Namespace [] ["EmptyPeersFetch"] +instance MetaTrace (TraceDecisionEvent peer header) where + namespaceFor (PeersFetch (a : _tl)) = (nsCast . namespaceFor) a + namespaceFor (PeersFetch []) = Namespace [] ["EmptyPeersFetch"] + namespaceFor (PeerStarvedUs _) = Namespace [] ["PeerStarvedUs"] severityFor (Namespace [] ["EmptyPeersFetch"]) _ = Just Debug severityFor ns Nothing = severityFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - severityFor ns (Just []) = + severityFor ns (Just (PeersFetch [])) = severityFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - severityFor ns (Just ((TraceLabelPeer _ a) : _tl)) = + severityFor ns (Just (PeersFetch ((TraceLabelPeer _ a) : _tl))) = severityFor (nsCast ns) (Just a) + severityFor (Namespace [] ["PeerStarvedUs"]) _ = Just Debug + severityFor _ _ = Nothing privacyFor (Namespace _ ["EmptyPeersFetch"]) _ = Just Public privacyFor ns Nothing = privacyFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - privacyFor ns (Just []) = + privacyFor ns (Just (PeersFetch [])) = privacyFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - privacyFor ns (Just ((TraceLabelPeer _ a) : _tl)) = + privacyFor ns (Just (PeersFetch ((TraceLabelPeer _ a) : _tl))) = privacyFor (nsCast ns) (Just a) + privacyFor (Namespace _ ["PeerStarvedUs"]) _ = Just Public + privacyFor _ _ = Nothing detailsFor (Namespace _ ["EmptyPeersFetch"]) _ = Just DNormal detailsFor ns Nothing = detailsFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - detailsFor ns (Just []) = + detailsFor ns (Just (PeersFetch [])) = detailsFor (nsCast ns :: Namespace (FetchDecision [Point header])) Nothing - detailsFor ns (Just ((TraceLabelPeer _ a) : _tl)) = + detailsFor ns (Just (PeersFetch ((TraceLabelPeer _ a) : _tl))) = detailsFor (nsCast ns) (Just a) + detailsFor _ _ = Just DNormal + documentFor ns = documentFor (nsCast ns :: Namespace (FetchDecision [Point header])) metricsDocFor ns = metricsDocFor (nsCast ns :: Namespace (FetchDecision [Point header])) - allNamespaces = Namespace [] ["EmptyPeersFetch"] - : map nsCast (allNamespaces :: [Namespace (FetchDecision [Point header])]) + allNamespaces = + [ Namespace [] ["EmptyPeersFetch"] + , Namespace [] ["PeerStarvedUs"] + ] ++ map nsCast (allNamespaces :: [Namespace (FetchDecision [Point header])]) instance LogFormatting (FetchDecision [Point header]) where forMachine _dtal (Left decline) = @@ -722,28 +737,16 @@ instance MetaTrace (FetchDecision [Point header]) where -- BlockFetchClientState Tracer -------------------------------------------------------------------------------- -instance (HasHeader header, ConvertRawHash header) => +instance (HasHeader header, ConvertRawHash header, ConvertRawHash (Header header)) => LogFormatting (BlockFetch.TraceFetchClientState header) where forMachine _dtal BlockFetch.AddedFetchRequest {} = mconcat [ "kind" .= String "AddedFetchRequest" ] forMachine _dtal BlockFetch.AcknowledgedFetchRequest {} = mconcat [ "kind" .= String "AcknowledgedFetchRequest" ] - forMachine _dtal (BlockFetch.SendFetchRequest af _) = + forMachine dtal (BlockFetch.SendFetchRequest af _) = mconcat [ "kind" .= String "SendFetchRequest" - , "head" .= String (renderChainHash - (renderHeaderHash (Proxy @header)) - (AF.headHash af)) - , "length" .= toJSON (fragmentLength af)] - where - -- NOTE: this ignores the Byron era with its EBB complication: - -- the length would be underestimated by 1, if the AF is anchored - -- at the epoch boundary. - fragmentLength :: AF.AnchoredFragment header -> Int - fragmentLength f = fromIntegral . unBlockNo $ - case (f, f) of - (AS.Empty{}, AS.Empty{}) -> 0 - (firstHdr AS.:< _, _ AS.:> lastHdr) -> - blockNo lastHdr - blockNo firstHdr + 1 + , "fragment" .= forMachine dtal af + ] forMachine _dtal (BlockFetch.CompletedBlockFetch pt _ _ _ delay blockSize) = mconcat [ "kind" .= String "CompletedBlockFetch" , "delay" .= (realToFrac delay :: Double) @@ -753,12 +756,18 @@ instance (HasHeader header, ConvertRawHash header) => GenesisPoint -> "Genesis" BlockPoint _ h -> renderHeaderHash (Proxy @header) h) ] - forMachine _dtal BlockFetch.CompletedFetchBatch {} = - mconcat [ "kind" .= String "CompletedFetchBatch" ] - forMachine _dtal BlockFetch.StartedFetchBatch {} = - mconcat [ "kind" .= String "StartedFetchBatch" ] - forMachine _dtal BlockFetch.RejectedFetchBatch {} = - mconcat [ "kind" .= String "RejectedFetchBatch" ] + forMachine dtal (BlockFetch.CompletedFetchBatch range _ _ _) = + mconcat [ "kind" .= String "CompletedFetchBatch" + , "range" .= forMachine dtal range + ] + forMachine dtal (BlockFetch.StartedFetchBatch range _ _ _) = + mconcat [ "kind" .= String "StartedFetchBatch" + , "range" .= forMachine dtal range + ] + forMachine dtal (BlockFetch.RejectedFetchBatch range _ _ _) = + mconcat [ "kind" .= String "RejectedFetchBatch" + , "range" .= forMachine dtal range + ] forMachine _dtal (BlockFetch.ClientTerminating outstanding) = mconcat [ "kind" .= String "ClientTerminating" , "outstanding" .= outstanding @@ -835,6 +844,15 @@ instance MetaTrace (BlockFetch.TraceFetchClientState header) where , Namespace [] ["ClientTerminating"] ] +instance StandardHash blk => LogFormatting (BlockFetch.ChainRange (Point blk)) where + forMachine _dtal (BlockFetch.ChainRange start end) = + mconcat [ "kind" .= String "ChainRange" + , "start" .= (String $ showT start) + , "end" .= (String $ showT end) + ] + + forHuman = forHumanOrMachine + -------------------------------------------------------------------------------- -- BlockFetchServerEvent -------------------------------------------------------------------------------- @@ -2010,6 +2028,153 @@ instance MetaTrace (TraceGsmEvent selection) where , Namespace [] ["GsmEventSyncingToPreSyncing"] ] +-------------------------------------------------------------------------------- +-- CSJ Tracer +-------------------------------------------------------------------------------- + +instance ( LogFormatting peer, Show peer + ) => LogFormatting (TraceEvent peer) where + forMachine dtal = + \case + RotatedDynamo oldPeer newPeer -> + mconcat + [ "kind" .= String "RotatedDynamo" + , "oldPeer" .= forMachine dtal oldPeer + , "newPeer" .= forMachine dtal newPeer + ] + forHuman = showT + + +instance MetaTrace (TraceEvent peer) where + namespaceFor = + \case + RotatedDynamo {} -> Namespace [] ["RotatedDynamo"] + + severityFor ns _ = + case ns of + Namespace _ ["RotatedDynamo"] -> Just Info + Namespace _ _ -> Nothing + + documentFor = \case + Namespace _ ["RotatedDynamo"] -> + Just "The ChainSync Jumping module has been asked to rotate its dynamo" + Namespace _ _ -> + Nothing + + allNamespaces = + [ Namespace [] ["RotatedDynamo"] + ] + +-------------------------------------------------------------------------------- +-- GDD Tracer +-------------------------------------------------------------------------------- + +instance ( Show peer + , HasHeader blk + , HasHeader (Header blk) + , ConvertRawHash (Header blk) + ) => LogFormatting (TraceGDDEvent peer blk) where + forMachine dtal TraceGDDEvent {..} = mconcat + [ "kind" .= String "TraceGDDEvent" + , "bounds" .= toJSON ( + map + ( \(peer, density) -> Object $ mconcat + [ "kind" .= String "PeerDensityBound" + , "peer" .= (String $ showT peer) + , "densityBounds" .= forMachine dtal density + ] + ) + bounds + ) + , "curChain" .= forMachine dtal curChain + , "candidates" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateFragment" + , "peer" .= (String $ showT peer) + , "candidateFragment" .= forMachine dtal frag + ] + ) + candidates + ) + , "candidateSuffixes" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateSuffix" + , "peer" .= (String $ showT peer) + , "candidateSuffix" .= forMachine dtal frag + ] + ) + candidateSuffixes + ) + , "losingPeers".= (toJSON $ map (String . showT) losingPeers) + , "loeHead" .= (String $ showT loeHead) + , "sgen" .= (String $ showT $ unGenesisWindow sgen) + ] + + forHuman = forHumanOrMachine + +instance MetaTrace (TraceGDDEvent peer blk) where + namespaceFor _ = Namespace [] ["TraceGDDEvent"] + + severityFor _ _ = Just Debug + + documentFor _ = Just "The Genesis Density Disconnection governor has updated its state" + + allNamespaces = [Namespace [] ["TraceGDDEvent"]] + +instance ( HasHeader blk + , HasHeader (Header blk) + , ConvertRawHash (Header blk) + ) => LogFormatting (DensityBounds blk) where + forMachine dtal DensityBounds {..} = mconcat + [ "kind" .= String "DensityBounds" + , "clippedFragment" .= forMachine dtal clippedFragment + , "offersMoreThanK" .= toJSON offersMoreThanK + , "lowerBound" .= toJSON lowerBound + , "upperBound" .= toJSON upperBound + , "hasBlockAfter" .= toJSON hasBlockAfter + , "latestSlot" .= String (showT latestSlot) + , "idling" .= toJSON idling + ] + + forHuman = forHumanOrMachine + +-------------------------------------------------------------------------------- +-- AnchoredFragment tracer +-------------------------------------------------------------------------------- + +instance (HasHeader blk, ConvertRawHash (Header blk)) => + LogFormatting (AF.AnchoredFragment blk) where + forMachine _dtal frag = mconcat + [ "kind" .= String "AnchoredFragment" + , "anchorPoint" .= ( Object $ mconcat + [ "kind" .= String "AnchoredFragmentAnchorPoint" + , "hash" .= String (renderChainHash + (renderHeaderHash (Proxy @(Header blk))) + (AF.anchorToHash $ AF.anchor frag)) + , "slotNo" .= String (showT $ AF.anchorToSlotNo $ AF.anchor frag) + , "blockNo" .= String (showT $ AF.anchorToBlockNo $ AF.anchor frag) + ] + ) + , "headPoint" .= ( Object $ mconcat + [ "kind" .= String "AnchoredFragmentHeadPoint" + , "hash" .= String (renderChainHash + (renderHeaderHash (Proxy @(Header blk))) + (AF.headHash frag)) + , "slotNo" .= String (showT $ AF.headSlot frag) + , "blockNo" .= String (showT $ AF.headBlockNo frag) + ] + ) + , "length" .= toJSON (fragmentLength frag) + ] + + forHuman = forHumanOrMachine + +-------------------------------------------------------------------------------- +-- Chain tip tracer +-------------------------------------------------------------------------------- + instance ( StandardHash blk , ConvertRawHash blk ) => LogFormatting (Tip blk) where @@ -2023,3 +2188,17 @@ instance ( StandardHash blk ] forHuman = showT + +-------------------------------------------------------------------------------- +-- Utils +-------------------------------------------------------------------------------- + +-- NOTE: this ignores the Byron era with its EBB complication: +-- the length would be underestimated by 1, if the AF is anchored +-- at the epoch boundary. +fragmentLength :: HasHeader header => AF.AnchoredFragment header -> Int +fragmentLength f = fromIntegral . unBlockNo $ + case (f, f) of + (AS.Empty{}, AS.Empty{}) -> 0 + (firstHdr AS.:< _, _ AS.:> lastHdr) -> + blockNo lastHdr - blockNo firstHdr + 1 diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index f105e58c51b..ba11c93f229 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -15,8 +15,8 @@ import Cardano.Node.Orphans () import Cardano.Node.Queries import Ouroboros.Consensus.Block (Header) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (ChainSyncClientHandle, + ChainSyncClientHandleCollection(..), csCandidate, viewChainSyncState) -import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar) import Ouroboros.Consensus.Util.Orphans () import qualified Ouroboros.Network.AnchoredFragment as Net import Ouroboros.Network.Block (unSlotNo) @@ -104,7 +104,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: StrictTVar IO (Map peer (ChainSyncClientHandle IO blk)) + :: STM.STM IO (Map peer (ChainSyncClientHandle IO blk)) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) getCandidates handle = viewChainSyncState handle csCandidate @@ -116,7 +116,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd . Net.readFetchClientsStateVars . getFetchClientRegistry $ kernel ) - candidates <- STM.atomically . getCandidates . getChainSyncHandles $ kernel + candidates <- STM.atomically . getCandidates . cschcMap . getChainSyncHandles $ kernel let peers = flip Map.mapMaybeWithKey candidates $ \cid af -> maybe Nothing diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index fb93f72115a..ccde268c2c0 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -26,6 +26,7 @@ module Cardano.Tracing.Config , TraceBlockFetchServer , TraceChainDB , TraceChainSyncClient + , TraceChainSyncJumping , TraceChainSyncBlockServer , TraceChainSyncHeaderServer , TraceChainSyncProtocol @@ -122,6 +123,7 @@ instance Semigroup PartialTraceOptions where type TraceAcceptPolicy = ("TraceAcceptPolicy" :: Symbol) type TraceBlockchainTime = ("TraceBlockchainTime" :: Symbol) +type TraceChainSyncJumping = ("TraceChainSyncJumping" :: Symbol) type TraceBlockFetchClient = ("TraceBlockFetchClient" :: Symbol) type TraceBlockFetchDecisions = ("TraceBlockFetchDecisions" :: Symbol) type TraceBlockFetchProtocol = ("TraceBlockFetchProtocol" :: Symbol) @@ -143,6 +145,8 @@ type TraceDnsSubscription = ("TraceDnsSubscription" :: Symbol) type TraceErrorPolicy = ("TraceErrorPolicy" :: Symbol) type TraceForge = ("TraceForge" :: Symbol) type TraceForgeStateInfo = ("TraceForgeStateInfo" :: Symbol) +type TraceGdd = ("TraceGdd" :: Symbol) +type TraceGsm = ("TraceGsm" :: Symbol) type TraceHandshake = ("TraceHandshake" :: Symbol) type TraceIpSubscription = ("TraceIpSubscription" :: Symbol) type TraceKeepAliveClient = ("TraceKeepAliveClient" :: Symbol) @@ -173,7 +177,6 @@ type TraceTxInbound = ("TraceTxInbound" :: Symbol) type TraceTxOutbound = ("TraceTxOutbound" :: Symbol) type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) -type TraceGsm = ("TraceGsm" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -196,6 +199,7 @@ data TraceSelection , traceBlockFetchProtocolSerialised :: OnOff TraceBlockFetchProtocolSerialised , traceBlockFetchServer :: OnOff TraceBlockFetchServer , traceBlockchainTime :: OnOff TraceBlockchainTime + , traceChainSyncJumping :: OnOff TraceChainSyncJumping , traceChainDB :: OnOff TraceChainDB , traceChainSyncBlockServer :: OnOff TraceChainSyncBlockServer , traceChainSyncClient :: OnOff TraceChainSyncClient @@ -212,6 +216,8 @@ data TraceSelection , traceErrorPolicy :: OnOff TraceErrorPolicy , traceForge :: OnOff TraceForge , traceForgeStateInfo :: OnOff TraceForgeStateInfo + , traceGdd :: OnOff TraceGdd + , traceGsm :: OnOff TraceGsm , traceHandshake :: OnOff TraceHandshake , traceInboundGovernor :: OnOff TraceInboundGovernor , traceInboundGovernorCounters :: OnOff TraceInboundGovernorCounters @@ -242,7 +248,6 @@ data TraceSelection , traceTxOutbound :: OnOff TraceTxOutbound , traceTxSubmissionProtocol :: OnOff TraceTxSubmissionProtocol , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol - , traceGsm :: OnOff TraceGsm } deriving (Eq, Show) @@ -254,6 +259,7 @@ data PartialTraceSelection -- Per-trace toggles, alpha-sorted. , pTraceAcceptPolicy :: Last (OnOff TraceAcceptPolicy) , pTraceBlockchainTime :: Last (OnOff TraceBlockchainTime) + , pTraceChainSyncJumping :: Last (OnOff TraceChainSyncJumping) , pTraceBlockFetchClient :: Last (OnOff TraceBlockFetchClient) , pTraceBlockFetchDecisions :: Last (OnOff TraceBlockFetchDecisions) , pTraceBlockFetchProtocol :: Last (OnOff TraceBlockFetchProtocol) @@ -275,6 +281,8 @@ data PartialTraceSelection , pTraceErrorPolicy :: Last (OnOff TraceErrorPolicy) , pTraceForge :: Last (OnOff TraceForge) , pTraceForgeStateInfo :: Last (OnOff TraceForgeStateInfo) + , pTraceGdd :: Last (OnOff TraceGdd) + , pTraceGsm :: Last (OnOff TraceGsm) , pTraceHandshake :: Last (OnOff TraceHandshake) , pTraceInboundGovernor :: Last (OnOff TraceInboundGovernor) , pTraceInboundGovernorCounters :: Last (OnOff TraceInboundGovernorCounters) @@ -305,7 +313,6 @@ data PartialTraceSelection , pTraceTxOutbound :: Last (OnOff TraceTxOutbound) , pTraceTxSubmissionProtocol :: Last (OnOff TraceTxSubmissionProtocol) , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) - , pTraceGsm :: Last (OnOff TraceGsm) } deriving (Eq, Generic, Show) @@ -318,6 +325,7 @@ instance FromJSON PartialTraceSelection where <$> Last <$> v .:? "TracingVerbosity" <*> parseTracer (Proxy @TraceAcceptPolicy) v <*> parseTracer (Proxy @TraceBlockchainTime) v + <*> parseTracer (Proxy @TraceChainSyncJumping) v <*> parseTracer (Proxy @TraceBlockFetchClient) v <*> parseTracer (Proxy @TraceBlockFetchDecisions) v <*> parseTracer (Proxy @TraceBlockFetchProtocol) v @@ -339,6 +347,8 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceErrorPolicy) v <*> parseTracer (Proxy @TraceForge) v <*> parseTracer (Proxy @TraceForgeStateInfo) v + <*> parseTracer (Proxy @TraceGdd) v + <*> parseTracer (Proxy @TraceGsm) v <*> parseTracer (Proxy @TraceHandshake) v <*> parseTracer (Proxy @TraceInboundGovernor) v <*> parseTracer (Proxy @TraceInboundGovernorCounters) v @@ -369,7 +379,6 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxOutbound) v <*> parseTracer (Proxy @TraceTxSubmissionProtocol) v <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v - <*> parseTracer (Proxy @TraceGsm) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -379,6 +388,7 @@ defaultPartialTraceConfiguration = -- Per-trace toggles, alpha-sorted. , pTraceAcceptPolicy = pure $ OnOff False , pTraceBlockchainTime = pure $ OnOff False + , pTraceChainSyncJumping = pure $ OnOff False , pTraceBlockFetchClient = pure $ OnOff False , pTraceBlockFetchDecisions = pure $ OnOff True , pTraceBlockFetchProtocol = pure $ OnOff False @@ -400,6 +410,8 @@ defaultPartialTraceConfiguration = , pTraceErrorPolicy = pure $ OnOff True , pTraceForge = pure $ OnOff True , pTraceForgeStateInfo = pure $ OnOff True + , pTraceGdd = pure $ OnOff True + , pTraceGsm = pure $ OnOff True , pTraceHandshake = pure $ OnOff False , pTraceInboundGovernor = pure $ OnOff True , pTraceInboundGovernorCounters = pure $ OnOff True @@ -430,7 +442,6 @@ defaultPartialTraceConfiguration = , pTraceTxOutbound = pure $ OnOff False , pTraceTxSubmissionProtocol = pure $ OnOff False , pTraceTxSubmission2Protocol = pure $ OnOff False - , pTraceGsm = pure $ OnOff True } @@ -442,6 +453,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceVerbosity <- first Text.pack $ lastToEither "Default value not specified for TracingVerbosity" pTraceVerbosity traceAcceptPolicy <- proxyLastToEither (Proxy @TraceAcceptPolicy) pTraceAcceptPolicy traceBlockchainTime <- proxyLastToEither (Proxy @TraceBlockchainTime) pTraceBlockchainTime + traceChainSyncJumping <- proxyLastToEither (Proxy @TraceChainSyncJumping) pTraceChainSyncJumping traceBlockFetchClient <- proxyLastToEither (Proxy @TraceBlockFetchClient) pTraceBlockFetchClient traceBlockFetchDecisions <- proxyLastToEither (Proxy @TraceBlockFetchDecisions) pTraceBlockFetchDecisions traceBlockFetchProtocol <- proxyLastToEither (Proxy @TraceBlockFetchProtocol) pTraceBlockFetchProtocol @@ -463,6 +475,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceErrorPolicy <- proxyLastToEither (Proxy @TraceErrorPolicy) pTraceErrorPolicy traceForge <- proxyLastToEither (Proxy @TraceForge) pTraceForge traceForgeStateInfo <- proxyLastToEither (Proxy @TraceForgeStateInfo) pTraceForgeStateInfo + traceGdd <- proxyLastToEither (Proxy @TraceGdd) pTraceGdd + traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceHandshake <- proxyLastToEither (Proxy @TraceHandshake) pTraceHandshake traceInboundGovernor <- proxyLastToEither (Proxy @TraceInboundGovernor) pTraceInboundGovernor traceInboundGovernorCounters <- proxyLastToEither (Proxy @TraceInboundGovernorCounters) pTraceInboundGovernorCounters @@ -493,7 +507,6 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxOutbound <- proxyLastToEither (Proxy @TraceTxOutbound) pTraceTxOutbound traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol - traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -503,6 +516,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceBlockFetchProtocolSerialised = traceBlockFetchProtocolSerialised , traceBlockFetchServer = traceBlockFetchServer , traceBlockchainTime = traceBlockchainTime + , traceChainSyncJumping = traceChainSyncJumping , traceChainDB = traceChainDB , traceChainSyncBlockServer = traceChainSyncBlockServer , traceChainSyncClient = traceChainSyncClient @@ -519,6 +533,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceErrorPolicy = traceErrorPolicy , traceForge = traceForge , traceForgeStateInfo = traceForgeStateInfo + , traceGdd = traceGdd + , traceGsm = traceGsm , traceHandshake = traceHandshake , traceInboundGovernor = traceInboundGovernor , traceInboundGovernorCounters = traceInboundGovernorCounters @@ -549,7 +565,6 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxOutbound = traceTxOutbound , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol - , traceGsm = traceGsm } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -558,6 +573,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceVerbosity <- first Text.pack $ lastToEither "Default value not specified for TracingVerbosity" pTraceVerbosity traceAcceptPolicy <- proxyLastToEither (Proxy @TraceAcceptPolicy) pTraceAcceptPolicy traceBlockchainTime <- proxyLastToEither (Proxy @TraceBlockchainTime) pTraceBlockchainTime + traceChainSyncJumping <- proxyLastToEither (Proxy @TraceChainSyncJumping) pTraceChainSyncJumping traceBlockFetchClient <- proxyLastToEither (Proxy @TraceBlockFetchClient) pTraceBlockFetchClient traceBlockFetchDecisions <- proxyLastToEither (Proxy @TraceBlockFetchDecisions) pTraceBlockFetchDecisions traceBlockFetchProtocol <- proxyLastToEither (Proxy @TraceBlockFetchProtocol) pTraceBlockFetchProtocol @@ -579,6 +595,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceErrorPolicy <- proxyLastToEither (Proxy @TraceErrorPolicy) pTraceErrorPolicy traceForge <- proxyLastToEither (Proxy @TraceForge) pTraceForge traceForgeStateInfo <- proxyLastToEither (Proxy @TraceForgeStateInfo) pTraceForgeStateInfo + traceGdd <- proxyLastToEither (Proxy @TraceGdd) pTraceGdd + traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceHandshake <- proxyLastToEither (Proxy @TraceHandshake) pTraceHandshake traceInboundGovernor <- proxyLastToEither (Proxy @TraceInboundGovernor) pTraceInboundGovernor traceIpSubscription <- proxyLastToEither (Proxy @TraceIpSubscription) pTraceIpSubscription @@ -609,7 +627,6 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxOutbound <- proxyLastToEither (Proxy @TraceTxOutbound) pTraceTxOutbound traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol - traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -619,6 +636,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceBlockFetchProtocolSerialised = traceBlockFetchProtocolSerialised , traceBlockFetchServer = traceBlockFetchServer , traceBlockchainTime = traceBlockchainTime + , traceChainSyncJumping = traceChainSyncJumping , traceChainDB = traceChainDB , traceChainSyncBlockServer = traceChainSyncBlockServer , traceChainSyncClient = traceChainSyncClient @@ -635,6 +653,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceErrorPolicy = traceErrorPolicy , traceForge = traceForge , traceForgeStateInfo = traceForgeStateInfo + , traceGdd = traceGdd + , traceGsm = traceGsm , traceHandshake = traceHandshake , traceInboundGovernor = traceInboundGovernor , traceInboundGovernorCounters = traceInboundGovernorCounters @@ -665,7 +685,6 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxOutbound = traceTxOutbound , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol - , traceGsm = traceGsm } proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index a051411c5fc..f0fecbce438 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -6,6 +6,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -29,9 +30,10 @@ import Cardano.Tracing.Render (renderChainHash, renderChunkNo, renderH renderPointForVerbosity, renderRealPoint, renderRealPointAsPhrase, renderTipBlockNo, renderTipHash, renderWithOrigin) import Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol, CannotForge, - ConvertRawHash (..), ForgeStateUpdateError, Header, RealPoint, blockNo, - blockPoint, blockPrevHash, getHeader, headerPoint, pointHash, realPointHash, - realPointSlot) + ConvertRawHash (..), ForgeStateUpdateError, GenesisWindow (..), GetHeader, + Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, headerPoint, + pointHash, realPointHash, realPointSlot) +import Ouroboros.Consensus.Genesis.Governor import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended @@ -44,7 +46,7 @@ import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempoo import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..)) -import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as ChainSync.Client +import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as ChainSync.Client.Jumping import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State as ChainSync.Client import Ouroboros.Consensus.MiniProtocol.ChainSync.Server (BlockingType (..), TraceChainSyncServerEvent (..)) @@ -220,6 +222,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where VolDb.Truncate{} -> Error VolDb.InvalidFileNames{} -> Warning VolDb.DBClosed{} -> Info + getSeverityAnnotation (ChainDB.TraceChainSelStarvationEvent _ev) = Debug instance HasSeverityAnnotation (LedgerEvent blk) where getSeverityAnnotation (LedgerUpdate _) = Notice @@ -489,6 +492,11 @@ instance ( ConvertRawHash blk , InspectLedger blk) => HasTextFormatter (ChainDB.TraceEvent blk) where formatText tev _obj = case tev of + ChainDB.TraceChainSelStarvationEvent ev -> case ev of + ChainDB.ChainSelStarvationStarted time -> + "ChainSel starvation started at " <> showT time + ChainDB.ChainSelStarvationEnded time pt -> + "ChainSel starvation ended at " <> showT time <> " because of " <> renderRealPointAsPhrase pt ChainDB.TraceAddBlockEvent ev -> case ev of ChainDB.IgnoreBlockOlderThanK pt -> "Ignoring block older than K: " <> renderRealPointAsPhrase pt @@ -736,6 +744,14 @@ instance ( ConvertRawHash blk showProgressT chunkNo outOf = pack (showFFloat (Just 2) (100 * fromIntegral chunkNo / fromIntegral outOf :: Float) mempty) +instance HasPrivacyAnnotation (ChainSync.Client.Jumping.TraceEvent peer) where +instance HasSeverityAnnotation (ChainSync.Client.Jumping.TraceEvent peer) where + getSeverityAnnotation _ = Debug +instance ToObject peer + => Transformable Text IO (ChainSync.Client.Jumping.TraceEvent peer) where + trTransformer = trStructuredText +instance HasTextFormatter (ChainSync.Client.Jumping.TraceEvent peer) where + -- -- | instances of @ToObject@ -- @@ -1146,6 +1162,16 @@ instance ( ConvertRawHash blk , "currentBlock" .= renderRealPoint curr , "targetBlock" .= renderRealPoint goal ] + toObject _verb (ChainDB.TraceChainSelStarvationEvent ev) = case ev of + ChainDB.ChainSelStarvationStarted time -> + mconcat [ "kind" .= String "TraceChainSelStarvationEvent.ChainSelStarvationStarted" + , "time" .= String (showT time) + ] + ChainDB.ChainSelStarvationEnded time pt -> + mconcat [ "kind" .= String "TraceChainSelStarvationEvent.ChainSelStarvationEndedAt" + , "time" .= String (showT time) + , "point" .= String (Text.pack $ show $ renderRealPoint pt) + ] toObject _verb (ChainDB.TraceIteratorEvent ev) = case ev of ChainDB.UnknownRangeRequested unkRange -> @@ -1371,10 +1397,10 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) TraceJumpResult res -> mconcat [ "kind" .= String "ChainSyncClientEvent.TraceJumpResult" , "res" .= case res of - ChainSync.Client.AcceptedJump info -> Aeson.object + ChainSync.Client.Jumping.AcceptedJump info -> Aeson.object [ "kind" .= String "AcceptedJump" , "payload" .= toObject verb info ] - ChainSync.Client.RejectedJump info -> Aeson.object + ChainSync.Client.Jumping.RejectedJump info -> Aeson.object [ "kind" .= String "RejectedJump" , "payload" .= toObject verb info ] ] @@ -1388,25 +1414,25 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) instance ( LedgerSupportsProtocol blk, ConvertRawHash blk - ) => ToObject (ChainSync.Client.Instruction blk) where + ) => ToObject (ChainSync.Client.Jumping.Instruction blk) where toObject verb = \case - ChainSync.Client.RunNormally -> + ChainSync.Client.Jumping.RunNormally -> mconcat ["kind" .= String "RunNormally"] - ChainSync.Client.Restart -> + ChainSync.Client.Jumping.Restart -> mconcat ["kind" .= String "Restart"] - ChainSync.Client.JumpInstruction info -> + ChainSync.Client.Jumping.JumpInstruction info -> mconcat [ "kind" .= String "JumpInstruction" , "payload" .= toObject verb info ] instance ( LedgerSupportsProtocol blk, ConvertRawHash blk - ) => ToObject (ChainSync.Client.JumpInstruction blk) where + ) => ToObject (ChainSync.Client.Jumping.JumpInstruction blk) where toObject verb = \case - ChainSync.Client.JumpTo info -> + ChainSync.Client.Jumping.JumpTo info -> mconcat [ "kind" .= String "JumpTo" , "info" .= toObject verb info ] - ChainSync.Client.JumpToGoodPoint info -> + ChainSync.Client.Jumping.JumpToGoodPoint info -> mconcat [ "kind" .= String "JumpToGoodPoint" , "info" .= toObject verb info ] @@ -1661,6 +1687,70 @@ instance ToObject selection => ToObject (TraceGsmEvent selection) where [ "kind" .= String "GsmEventSyncingToPreSyncing" ] +instance HasPrivacyAnnotation (TraceGDDEvent peer blk) where +instance HasSeverityAnnotation (TraceGDDEvent peer blk) where + getSeverityAnnotation _ = Debug +instance (Show peer, GetHeader blk) => Transformable Text IO (TraceGDDEvent peer blk) where + trTransformer = trStructured + +instance (Show peer, GetHeader blk) => ToObject (TraceGDDEvent peer blk) where + toObject verb TraceGDDEvent {..} = mconcat + [ "kind" .= String "TraceGDDEvent" + , "bounds" .= toJSON ( + map + ( \(peer, density) -> Object $ mconcat + [ "kind" .= String "PeerDensityBound" + , "peer" .= (String $ showT peer) + , "densityBounds" .= toObject verb density + ] + ) + bounds + ) + , "curChain" .= toObject verb curChain + , "candidates" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateFragment" + , "peer" .= (String $ showT peer) + , "candidateFragment" .= toObject verb frag + ] + ) + candidates + ) + , "candidateSuffixes" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateSuffix" + , "peer" .= (String $ showT peer) + , "candidateSuffix" .= toObject verb frag + ] + ) + candidateSuffixes + ) + , "losingPeers".= (toJSON $ map (String . showT) losingPeers) + , "loeHead" .= (String $ showT loeHead) + , "sgen" .= (String $ showT $ unGenesisWindow sgen) + ] + +instance (GetHeader blk) => ToObject (DensityBounds blk) where + toObject verb DensityBounds {..} = mconcat + [ "kind" .= String "DensityBounds" + , "clippedFragment" .= toObject verb clippedFragment + , "offersMoreThanK" .= toJSON offersMoreThanK + , "lowerBound" .= toJSON lowerBound + , "upperBound" .= toJSON upperBound + , "hasBlockAfter" .= toJSON hasBlockAfter + , "latestSlot" .= String (showT latestSlot) + , "idling" .= toJSON idling + ] + +instance (GetHeader blk) => ToObject (AF.AnchoredFragment (Header blk)) where + toObject _ frag = mconcat + [ "kind" .= String "AnchoredFragment" + , "anchorPoint" .= (String $ showT $ AF.anchorPoint frag) + , "headPoint" .= (String $ showT $ AF.headPoint frag) + ] + instance ConvertRawHash blk => ToObject (Tip blk) where toObject _verb TipGenesis = mconcat [ "kind" .= String "TipGenesis" ] @@ -1670,3 +1760,11 @@ instance ConvertRawHash blk => ToObject (Tip blk) where , "tipHash" .= renderHeaderHash (Proxy @blk) hash , "tipBlockNo" .= toJSON bNo ] + +instance ToObject peer => ToObject (ChainSync.Client.Jumping.TraceEvent peer) where + toObject verb (ChainSync.Client.Jumping.RotatedDynamo oldPeer newPeer) = + mconcat + [ "kind" .= String "RotatedDynamo" + , "oldPeer" .= toObject verb oldPeer + , "newPeer" .= toObject verb newPeer + ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 1b89661c375..203650e5014 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -38,6 +38,7 @@ import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) +import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.ConnectionManager.Types (AbstractState (..), @@ -2632,3 +2633,24 @@ instance FromJSON PeerTrustable where instance ToJSON PeerTrustable where toJSON IsTrustable = Bool True toJSON IsNotTrustable = Bool False + + +instance HasPrivacyAnnotation (TraceDecisionEvent peer header) where +instance HasSeverityAnnotation (TraceDecisionEvent peer header) where + getSeverityAnnotation _ = Debug +instance ToObject peer + => Transformable Text IO (TraceDecisionEvent peer header) where + trTransformer = trStructuredText +instance HasTextFormatter (TraceDecisionEvent peer header) where + +instance ToObject peer => ToObject (TraceDecisionEvent peer header) where + toObject verb (PeersFetch decisions) = + mconcat + [ "kind" .= String "PeersFetch" + , "decisions" .= toObject verb decisions + ] + toObject verb (PeerStarvedUs peer) = + mconcat + [ "kind" .= String "PeerStarvedUs" + , "peer" .= toObject verb peer + ] diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index 6366a0d8be7..a7dc51fc389 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -18,8 +18,8 @@ import Cardano.Node.Orphans () import Cardano.Node.Queries import Ouroboros.Consensus.Block (Header) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (ChainSyncClientHandle, + ChainSyncClientHandleCollection(..), csCandidate, viewChainSyncState) -import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar) import Ouroboros.Consensus.Util.Orphans () import qualified Ouroboros.Network.AnchoredFragment as Net import Ouroboros.Network.Block (unSlotNo) @@ -97,7 +97,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd tuple3pop (a, b, _) = (a, b) getCandidates - :: StrictTVar IO (Map peer (ChainSyncClientHandle IO blk)) + :: STM.STM IO (Map peer (ChainSyncClientHandle IO blk)) -> STM.STM IO (Map peer (Net.AnchoredFragment (Header blk))) getCandidates handle = viewChainSyncState handle csCandidate @@ -109,7 +109,7 @@ getCurrentPeers nkd = mapNodeKernelDataIO extractPeers nkd . Net.readFetchClientsStateVars . getFetchClientRegistry $ kernel ) - candidates <- STM.atomically . getCandidates . getChainSyncHandles $ kernel + candidates <- STM.atomically . getCandidates . cschcMap . getChainSyncHandles $ kernel let peers = flip Map.mapMaybeWithKey candidates $ \cid af -> maybe Nothing diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 934a5091612..6e741d1e002 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -87,11 +87,12 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import Ouroboros.Consensus.Util.Enclose import qualified Ouroboros.Network.AnchoredFragment as AF -import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), HasHeader (..), Point, +import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), HasHeader (..), StandardHash, blockNo, pointSlot, unBlockNo) import Ouroboros.Network.BlockFetch.ClientState (TraceFetchClientState (..), TraceLabelPeer (..)) -import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecline (..)) +import Ouroboros.Network.BlockFetch.Decision (FetchDecline (..)) +import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) import Ouroboros.Network.ConnectionId (ConnectionId) import Ouroboros.Network.ConnectionManager.Types (ConnectionManagerCounters (..), ConnectionManagerTrace (..)) @@ -294,18 +295,20 @@ instance ElidingTracer (WithSeverity (ChainDB.TraceEvent blk)) where reportelided t tr ev count = defaultelidedreporting t tr ev count instance (StandardHash header, Eq peer) => ElidingTracer - (WithSeverity [TraceLabelPeer peer (FetchDecision [Point header])]) where + (WithSeverity (TraceDecisionEvent peer header)) where -- equivalent by type and severity isEquivalent (WithSeverity s1 _peers1) (WithSeverity s2 _peers2) = s1 == s2 -- the types to be elided - doelide (WithSeverity _ peers) = + doelide (WithSeverity _ (PeersFetch peers)) = let checkDecision :: TraceLabelPeer peer (Either FetchDecline result) -> Bool checkDecision (TraceLabelPeer _peer (Left FetchDeclineChainNotPlausible)) = True checkDecision (TraceLabelPeer _peer (Left (FetchDeclineConcurrencyLimit _ _))) = True checkDecision (TraceLabelPeer _peer (Left (FetchDeclinePeerBusy _ _ _))) = True checkDecision _ = False in any checkDecision peers + doelide _ = False + conteliding _tverb _tr _ (Nothing, _count) = return (Nothing, 0) conteliding tverb tr ev (_old, count) = do when (count > 0 && count `mod` 1000 == 0) $ -- report every 1000th message @@ -509,6 +512,8 @@ mkTracers _ _ _ _ _ enableP2P = , Consensus.blockchainTimeTracer = nullTracer , Consensus.consensusErrorTracer = nullTracer , Consensus.gsmTracer = nullTracer + , Consensus.gddTracer = nullTracer + , Consensus.csjTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -808,6 +813,8 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.consensusErrorTracer = Tracer $ \err -> traceWith (toLogObject tr) (ConsensusStartupException err) , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr + , Consensus.csjTracer = tracerOnOff (traceChainSyncJumping trSel) verb "ChainSync Jumping" tr + , Consensus.gddTracer = tracerOnOff (traceGdd trSel) verb "GDD" tr } where mkForgeTracers :: IO ForgeTracers @@ -1441,9 +1448,9 @@ teeTraceBlockFetchDecision , ToObject peer ) => TracingVerbosity - -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) + -> MVar (Maybe (WithSeverity (TraceDecisionEvent peer (Header blk))),Integer) -> Trace IO Text - -> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]) + -> Tracer IO (WithSeverity (TraceDecisionEvent peer (Header blk))) teeTraceBlockFetchDecision verb eliding tr = Tracer $ \ev -> do traceWith (teeTraceBlockFetchDecision' meTr) ev @@ -1454,12 +1461,14 @@ teeTraceBlockFetchDecision verb eliding tr = teeTraceBlockFetchDecision' :: Trace IO Text - -> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]) + -> Tracer IO (WithSeverity (TraceDecisionEvent peer (Header blk))) teeTraceBlockFetchDecision' tr = - Tracer $ \(WithSeverity _ peers) -> do - meta <- mkLOMeta Info Confidential - let tr' = appendName "peers" tr - traceNamedObject tr' (meta, LogValue "connectedPeers" . PureI $ fromIntegral $ length peers) + Tracer $ \case + WithSeverity _ (PeersFetch peers) -> do + meta <- mkLOMeta Info Confidential + let tr' = appendName "peers" tr + traceNamedObject tr' (meta, LogValue "connectedPeers" . PureI $ fromIntegral $ length peers) + WithSeverity _ _ -> pure () teeTraceBlockFetchDecisionElide :: ( Eq peer @@ -1468,9 +1477,9 @@ teeTraceBlockFetchDecisionElide , ToObject peer ) => TracingVerbosity - -> MVar (Maybe (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]),Integer) + -> MVar (Maybe (WithSeverity (TraceDecisionEvent peer (Header blk))),Integer) -> Trace IO Text - -> Tracer IO (WithSeverity [TraceLabelPeer peer (FetchDecision [Point (Header blk)])]) + -> Tracer IO (WithSeverity (TraceDecisionEvent peer (Header blk))) teeTraceBlockFetchDecisionElide = elideToLogObject -------------------------------------------------------------------------------- diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index eb31c0f3aa3..ca82fe62671 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -280,6 +280,7 @@ defaultYamlHardforkViaConfig era = , (proxyName (Proxy @TraceBlockFetchProtocolSerialised), Aeson.Bool False) , (proxyName (Proxy @TraceBlockFetchServer), Aeson.Bool False) , (proxyName (Proxy @TraceBlockchainTime), Aeson.Bool True) + , (proxyName (Proxy @TraceChainSyncJumping), Aeson.Bool False) , (proxyName (Proxy @TraceChainDB), Aeson.Bool True) , (proxyName (Proxy @TraceChainSyncClient), Aeson.Bool False) , (proxyName (Proxy @TraceChainSyncBlockServer), Aeson.Bool False) From 98404d943091bb8159ca40f93f1f819cf7d6220b Mon Sep 17 00:00:00 2001 From: Nicolas BACQUEY Date: Mon, 22 Jul 2024 19:09:57 +0200 Subject: [PATCH 2/7] Add low-level Genesis parameters in configuration file --- .../src/Cardano/Node/Configuration/POM.hs | 24 ++++++++++++++----- cardano-node/src/Cardano/Node/Orphans.hs | 13 ++++++++++ cardano-node/src/Cardano/Node/Parsers.hs | 1 + cardano-node/src/Cardano/Node/Run.hs | 8 ++----- configuration/cardano/mainnet-config.yaml | 13 ++++++++++ 5 files changed, 47 insertions(+), 12 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 010c3266e6a..a226f3e0ed6 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -34,6 +34,8 @@ import Cardano.Tracing.OrphanInstances.Network () import Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..), MempoolCapacityBytesOverride (..)) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) +import Ouroboros.Consensus.Node.Genesis (GenesisConfig, + GenesisConfigFlags (..), defaultGenesisConfigFlags, mkGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..)) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode (..)) @@ -163,8 +165,8 @@ data NodeConfiguration -- Enable Peer Sharing , ncPeerSharing :: PeerSharing - -- Enable Genesis syncing protocol - , ncEnableGenesis :: Bool + -- Genesis syncing protocol configuration + , ncGenesisConfig :: GenesisConfig } deriving (Eq, Show) @@ -230,7 +232,8 @@ data PartialNodeConfiguration , pncPeerSharing :: !(Last PeerSharing) -- Genesis syncing protocol - , pncEnableGenesis :: !(Last Bool) + , pncEnableGenesis :: !(Last Bool) + , pncGenesisConfigFlags :: !(Last GenesisConfigFlags) } deriving (Eq, Generic, Show) instance AdjustFilePaths PartialNodeConfiguration where @@ -329,7 +332,8 @@ instance FromJSON PartialNodeConfiguration where -- Genesis syncing protocol -- DISABLED BY DEFAULT - pncEnableGenesis <- Last <$> v .:? "EnableGenesis" .!= Just False + pncEnableGenesis <- Last <$> v .:? "EnableGenesis" .!= Just False + pncGenesisConfigFlags <- Last <$> v .:? "LowLevelGenesisOptions" pure PartialNodeConfiguration { pncProtocolConfig @@ -366,6 +370,7 @@ instance FromJSON PartialNodeConfiguration where , pncEnableP2P , pncPeerSharing , pncEnableGenesis + , pncGenesisConfigFlags } where parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride @@ -543,6 +548,7 @@ defaultPartialNodeConfiguration = , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) , pncEnableGenesis = Last (Just False) + , pncGenesisConfigFlags = Last (Just defaultGenesisConfigFlags) } lastOption :: Parser a -> Parser (Last a) @@ -608,10 +614,16 @@ makeNodeConfiguration pnc = do lastToEither "Missing PeerSharing" $ pncPeerSharing pnc - ncEnableGenesis <- + enableGenesis <- lastToEither "Missing EnableGenesis" $ pncEnableGenesis pnc + mGenesisConfigFlags <- if enableGenesis + then fmap Just <$> + lastToEither "Missing GenesisConfigFlags" + $ pncGenesisConfigFlags pnc + else pure Nothing + -- TODO: This is not mandatory experimentalProtocols <- lastToEither "Missing ExperimentalProtocolsEnabled" $ @@ -659,7 +671,7 @@ makeNodeConfiguration pnc = do EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing - , ncEnableGenesis + , ncGenesisConfig = mkGenesisConfig mGenesisConfigFlags } ncProtocol :: NodeConfiguration -> Protocol diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index 9435d87f890..13abfd6d46b 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -7,6 +7,7 @@ module Cardano.Node.Orphans () where import Cardano.Api () +import Ouroboros.Consensus.Node.Genesis (GenesisConfigFlags (..)) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) @@ -38,3 +39,15 @@ instance FromJSON AcceptedConnectionsLimit where <$> v .: "hardLimit" <*> v .: "softLimit" <*> v .: "delay" + +instance FromJSON GenesisConfigFlags where + parseJSON = withObject "GenesisConfigFlags" $ \v -> + GenesisConfigFlags + <$> v .:? "EnableCSJ" .!= True + <*> v .:? "EnableLoEAndGDD" .!= True + <*> v .:? "EnableLoP" .!= True + <*> v .:? "BulkSyncGracePeriod" + <*> v .:? "BucketCapacity" + <*> v .:? "BucketRate" + <*> v .:? "CSJJumpSize" + <*> v .:? "GDDRateLimit" diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 95c3284abd2..5e0cba21638 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -127,6 +127,7 @@ nodeRunParser = do , pncEnableP2P = mempty , pncPeerSharing = mempty , pncEnableGenesis = mempty + , pncGenesisConfigFlags = mempty } parseSocketPath :: Text -> Parser SocketPath diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 993633a1656..d1e9881c84f 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -480,9 +480,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = readTVar useBootstrapVar - , rnGenesisConfig = if ncEnableGenesis nc - then Genesis.enableGenesisConfigDefault - else Genesis.disableGenesisConfig + , rnGenesisConfig = ncGenesisConfig nc } #ifdef UNIX -- initial `SIGHUP` handler, which only rereads the topology file but @@ -565,9 +563,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers - , rnGenesisConfig = if ncEnableGenesis nc - then Genesis.enableGenesisConfigDefault - else Genesis.disableGenesisConfig + , rnGenesisConfig = ncGenesisConfig nc } #ifdef UNIX -- initial `SIGHUP` handler; it only warns that neither updating of diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index 0bf8428702a..3a771690ec3 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -288,3 +288,16 @@ hasPrometheus: # Examples: # MempoolCapacityBytesOverride: 1000000 (1MB) # MempoolCapacityBytesOverride: NoOverride (default) + +# # Enable or disable the Genesis syncing algorithm +# # All values are set to their default. +# EnableGenesis: False +# LowLevelGenesisOptions: +# EnableCSJ: True +# EnableLoEAndGDD: True +# EnableLoP: True +# BulkSyncGracePeriod: 10 # seconds +# BucketCapacity: 100000 # tokens +# BucketRate: 500 # tokens per second +# CSJJumpSize: 4320 # slots. This value is 2*k +# GDDRateLimit: 1.0 # seconds From ea2b9a1bcce04d1892d933df24fc24bc82f04b38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= Date: Wed, 7 Aug 2024 15:35:35 +0000 Subject: [PATCH 3/7] Point to back-ports for ouroboros-consensus and ouroboros-network --- cabal.project | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/cabal.project b/cabal.project index c6fe8379d23..31519b8e7e7 100644 --- a/cabal.project +++ b/cabal.project @@ -65,3 +65,28 @@ allow-newer: katip:Win32 -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network + -- back-port of BulkSync for genesis to ouroboros-network-0.16.1.1 + tag: fcb842fcd6f32b43a7cdf18a4301c1659a8bb879 + --sha256: kjwUrduwwxC+5QRQNJa4stEBzz7kqDJyyHOgGMfDw7s= + subdir: + ouroboros-network + ouroboros-network-api + ouroboros-network-protocols + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + -- back-port of BulkSync for genesis to ouroboros-consensus-0.20.0.0 + tag: 10ab97605c3b0e3205eb119a8b5b971123483415 + --sha256: hdMbzbPpWzPDAlR4lWAzdPt99BHD8vzdVXo/SnHz4BM= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core From d523ca1937ceca9d0a6eb893e10966cf5cb2bb56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= Date: Wed, 7 Aug 2024 15:42:11 +0000 Subject: [PATCH 4/7] Update change logs --- cardano-node/ChangeLog.md | 2 ++ cardano-testnet/CHANGELOG.md | 1 + 2 files changed, 3 insertions(+) diff --git a/cardano-node/ChangeLog.md b/cardano-node/ChangeLog.md index 747cf56d41c..adb8bcd18b2 100644 --- a/cardano-node/ChangeLog.md +++ b/cardano-node/ChangeLog.md @@ -9,6 +9,8 @@ - `--mempool-capacity-override` and `--no-mempool-capacity-override` can be set in the configuration file via the key `MempoolCapacityBytesOverride`. - `--snapshot-interval` can be set in the configuration file via the key `SnapshotInterval`. - `--num-of-disk-snapshots` can be set in the configuration file via the key `NumOfDiskSnapshots`. +- Update tracing with Genesis messages +- Update configuration with Genesis parameters ## 8.2.1 -- August 2023 diff --git a/cardano-testnet/CHANGELOG.md b/cardano-testnet/CHANGELOG.md index c2f218e929e..d0228620976 100644 --- a/cardano-testnet/CHANGELOG.md +++ b/cardano-testnet/CHANGELOG.md @@ -4,6 +4,7 @@ * Update `cardano-ping` dependency * Add `--num-dreps` parameter +* Update tracing configuration for ChainSync jumping ## 8.7.0 From e6967719fcce9d3ccc1cfbd87d98c3ded68c610a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= Date: Wed, 21 Aug 2024 17:07:29 +0000 Subject: [PATCH 5/7] Update configuration after recovering the BulkSync fetch mode --- cabal.project | 9 ++++----- cardano-node/src/Cardano/Node/Orphans.hs | 2 +- cardano-node/src/Cardano/Node/Run.hs | 6 ++++-- configuration/cardano/mainnet-config.yaml | 2 +- 4 files changed, 10 insertions(+), 9 deletions(-) diff --git a/cabal.project b/cabal.project index 31519b8e7e7..87d870e8375 100644 --- a/cabal.project +++ b/cabal.project @@ -69,9 +69,8 @@ allow-newer: katip:Win32 source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network - -- back-port of BulkSync for genesis to ouroboros-network-0.16.1.1 - tag: fcb842fcd6f32b43a7cdf18a4301c1659a8bb879 - --sha256: kjwUrduwwxC+5QRQNJa4stEBzz7kqDJyyHOgGMfDw7s= + tag: 5c304e5adbd27907c675bd60a2282264a65f117c + --sha256: Jn3Qqlsirlyu23bsFN2SO054LIe2rcsHUW1tN8Pm1Ks= subdir: ouroboros-network ouroboros-network-api @@ -81,8 +80,8 @@ source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus -- back-port of BulkSync for genesis to ouroboros-consensus-0.20.0.0 - tag: 10ab97605c3b0e3205eb119a8b5b971123483415 - --sha256: hdMbzbPpWzPDAlR4lWAzdPt99BHD8vzdVXo/SnHz4BM= + tag: 0874ad4a61854f50bf9303d9f662ae6b129fac6d + --sha256: iw9IWAnUz4SX6OIBfe4HsRukZr8adyLbCS36CJo+8OE= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index 13abfd6d46b..1d33366a183 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -46,7 +46,7 @@ instance FromJSON GenesisConfigFlags where <$> v .:? "EnableCSJ" .!= True <*> v .:? "EnableLoEAndGDD" .!= True <*> v .:? "EnableLoP" .!= True - <*> v .:? "BulkSyncGracePeriod" + <*> v .:? "BlockFetchGracePeriod" <*> v .:? "BucketCapacity" <*> v .:? "BucketRate" <*> v .:? "CSJJumpSize" diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index d1e9881c84f..8a53ee4886f 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -513,7 +513,8 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do rnNodeKernelHook nodeArgs registry nodeKernel } StdRunNodeArgs - { srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc + { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc + , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc , srnChainDbValidateOverride = ncValidateDB nc , srnDiskPolicyArgs = diskPolicyArgs , srnDatabasePath = dbPath @@ -586,7 +587,8 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do rnNodeKernelHook nodeArgs registry nodeKernel } StdRunNodeArgs - { srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc + { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc + , srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc , srnChainDbValidateOverride = ncValidateDB nc , srnDiskPolicyArgs = diskPolicyArgs , srnDatabasePath = dbPath diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index 3a771690ec3..e234ef6dbac 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -296,7 +296,7 @@ hasPrometheus: # EnableCSJ: True # EnableLoEAndGDD: True # EnableLoP: True -# BulkSyncGracePeriod: 10 # seconds +# BlockFetchGracePeriod: 10 # seconds # BucketCapacity: 100000 # tokens # BucketRate: 500 # tokens per second # CSJJumpSize: 4320 # slots. This value is 2*k From d2c8a00e0eabb5a9acdaa061a627d4187a18e279 Mon Sep 17 00:00:00 2001 From: Samuel Leathers Date: Sun, 1 Sep 2024 14:13:40 -0400 Subject: [PATCH 6/7] update cardano-ledger-shelley -> 1.12.3.0 only temporary for testing (remove this commit once we rebased on top of 9.1.1/9.2.0) --- bench/tx-generator/tx-generator.cabal | 2 +- cabal.project | 2 +- cardano-node/cardano-node.cabal | 6 +++--- flake.lock | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 139b2ecca83..dff56ba2410 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -141,7 +141,7 @@ library , ouroboros-network-framework , ouroboros-network-protocols , plutus-ledger-api - , plutus-tx + , plutus-tx ^>= 1.30 , random , serialise , streaming diff --git a/cabal.project b/cabal.project index 87d870e8375..1d378506ab7 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2024-06-23T23:01:13Z - , cardano-haskell-packages 2024-07-03T01:26:49Z + , cardano-haskell-packages 2024-09-01T03:50:08Z packages: cardano-node diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index cf91dfcaa1b..38fabf0886d 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -157,7 +157,7 @@ library , cardano-ledger-byron , cardano-ledger-conway , cardano-ledger-core - , cardano-ledger-shelley + , cardano-ledger-shelley >= 1.12.3.0 , cardano-prelude , cardano-protocol-tpraos >= 1.0.2 , cardano-slotting >= 0.2 @@ -175,10 +175,10 @@ library , generic-data , hostname , io-classes >= 1.4 - , iohk-monitoring + , iohk-monitoring ^>= 0.1 , iproute , lobemo-backend-aggregation - , lobemo-backend-ekg + , lobemo-backend-ekg ^>= 0.1 , lobemo-backend-monitoring , lobemo-backend-trace-forwarder , mtl diff --git a/flake.lock b/flake.lock index 627df048712..4d67ae05899 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1719971647, - "narHash": "sha256-Q/u1ZklzmymTSSY6/F48rGsWewVYf108torqR9+nFJU=", + "lastModified": 1725170790, + "narHash": "sha256-dByd5I847MxV5i9kps89yL1OAvi7iDyC95BU7EM2wtw=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "bfd6987c14410757c6cde47e6c45621e9664347f", + "rev": "3bed5fccc06ecc11d4a8427112f107876263e0f3", "type": "github" }, "original": { From b1373e99b6a0df5d57e72b8dd814dc0f5e5c0a3e Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Tue, 10 Sep 2024 11:46:30 +0200 Subject: [PATCH 7/7] TOSQUASH improve GDD tracing - Move most info to higher verbosity/detail level (to avoid spamming the logs) - Use structured logging instead of `Show` instances --- .../src/Cardano/Node/Tracing/Formatting.hs | 22 +++ .../src/Cardano/Node/Tracing/Tracers.hs | 8 +- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 127 ++++++------------ .../Tracing/OrphanInstances/Consensus.hs | 88 ++++++------ .../Tracing/OrphanInstances/Network.hs | 25 +++- 5 files changed, 134 insertions(+), 136 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Formatting.hs b/cardano-node/src/Cardano/Node/Tracing/Formatting.hs index 015fab921df..b2b77b1190d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Formatting.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Formatting.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -11,6 +13,7 @@ import Cardano.Logging (LogFormatting (..)) import Cardano.Node.Tracing.Render (renderHeaderHashForDetails) import Ouroboros.Consensus.Block (ConvertRawHash (..), RealPoint, realPointHash, realPointSlot) +import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block import Data.Aeson (Value (String), toJSON, (.=)) @@ -51,3 +54,22 @@ instance ConvertRawHash blk , "slot" .= unSlotNo (realPointSlot p) , "hash" .= renderHeaderHashForDetails (Proxy @blk) dtal (realPointHash p) ] + +instance (ConvertRawHash blk) => LogFormatting (AF.Anchor blk) where + forMachine dtal = \case + AF.AnchorGenesis -> mconcat + [ "kind" .= String "AnchorGenesis" ] + AF.Anchor slot hash bno -> mconcat + [ "kind" .= String "Anchor" + , "slot" .= toJSON (unSlotNo slot) + , "headerHash" .= renderHeaderHashForDetails (Proxy @blk) dtal hash + , "blockNo" .= toJSON (unBlockNo bno) + ] + +instance (ConvertRawHash blk, HasHeader blk) => LogFormatting (AF.AnchoredFragment blk) where + forMachine dtal frag = mconcat + [ "kind" .= String "AnchoredFragment" + , "anchor" .= forMachine dtal (AF.anchor frag) + , "headPoint" .= forMachine dtal (AF.headPoint frag) + , "length" .= toJSON (AF.length frag) + ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index a65c24bc6c8..4766cd7daa7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -34,7 +34,6 @@ import Cardano.Node.Tracing.Tracers.KESInfo import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () import Cardano.Node.Tracing.Tracers.NodeVersion (getNodeVersion) - import Cardano.Node.Tracing.Tracers.NonP2P () import Cardano.Node.Tracing.Tracers.P2P () import Cardano.Node.Tracing.Tracers.Peer () @@ -324,6 +323,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "GSM"] configureTracers configReflection trConfig [consensusGsmTr] + !consensusGddTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "GDD"] + configureTracers configReflection trConfig [consensusGddTr] + !consensusCsjTr <- mkCardanoTracer trBase trForward mbTrEKG ["Consensus", "CSJ"] @@ -366,7 +370,7 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr - , Consensus.gddTracer = Tracer $ \_ -> pure () -- TODO + , Consensus.gddTracer = Tracer $ traceWith consensusGddTr , Consensus.csjTracer = Tracer $ traceWith consensusCsjTr } diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 6efd6f347ed..e8e54cc7cd2 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -36,6 +36,7 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) import Ouroboros.Consensus.Cardano.Block +import Ouroboros.Consensus.Genesis.Governor import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpdate, LedgerWarning) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, HasTxId, LedgerSupportsMempool, txForgetValidated, txId) @@ -45,19 +46,17 @@ import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping (Instruction (..), - JumpInstruction (..), JumpResult (..), TraceEvent(..)) + JumpInstruction (..), JumpResult (..), TraceEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (JumpInfo (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Server import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server (TraceLocalTxSubmissionServerEvent (..)) -import Ouroboros.Consensus.Genesis.Governor import Ouroboros.Consensus.Node.GSM import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) import Ouroboros.Consensus.Node.Tracers import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import Ouroboros.Consensus.Util.Enclose import qualified Ouroboros.Network.AnchoredFragment as AF -import qualified Ouroboros.Network.AnchoredSeq as AS import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch @@ -70,6 +69,7 @@ import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import Control.Monad (guard) import Control.Monad.Class.MonadTime.SI (Time (..)) import Data.Aeson (ToJSON, Value (Number, Object, String), toJSON, (.=)) import qualified Data.Aeson as Aeson @@ -2069,48 +2069,50 @@ instance MetaTrace (TraceEvent peer) where -- GDD Tracer -------------------------------------------------------------------------------- -instance ( Show peer +instance ( LogFormatting peer , HasHeader blk , HasHeader (Header blk) , ConvertRawHash (Header blk) ) => LogFormatting (TraceGDDEvent peer blk) where - forMachine dtal TraceGDDEvent {..} = mconcat + forMachine dtal TraceGDDEvent {..} = mconcat $ [ "kind" .= String "TraceGDDEvent" - , "bounds" .= toJSON ( - map - ( \(peer, density) -> Object $ mconcat - [ "kind" .= String "PeerDensityBound" - , "peer" .= (String $ showT peer) - , "densityBounds" .= forMachine dtal density - ] - ) - bounds - ) - , "curChain" .= forMachine dtal curChain - , "candidates" .= toJSON ( - map - ( \(peer, frag) -> Object $ mconcat - [ "kind" .= String "PeerCandidateFragment" - , "peer" .= (String $ showT peer) - , "candidateFragment" .= forMachine dtal frag - ] - ) - candidates - ) - , "candidateSuffixes" .= toJSON ( - map - ( \(peer, frag) -> Object $ mconcat - [ "kind" .= String "PeerCandidateSuffix" - , "peer" .= (String $ showT peer) - , "candidateSuffix" .= forMachine dtal frag - ] - ) - candidateSuffixes - ) - , "losingPeers".= (toJSON $ map (String . showT) losingPeers) - , "loeHead" .= (String $ showT loeHead) - , "sgen" .= (String $ showT $ unGenesisWindow sgen) - ] + , "losingPeers".= toJSON (map (forMachine dtal) losingPeers) + , "loeHead" .= forMachine dtal loeHead + , "sgen" .= toJSON (unGenesisWindow sgen) + ] <> do + guard $ dtal >= DMaximum + [ "bounds" .= toJSON ( + map + ( \(peer, density) -> Object $ mconcat + [ "kind" .= String "PeerDensityBound" + , "peer" .= forMachine dtal peer + , "densityBounds" .= forMachine dtal density + ] + ) + bounds + ) + , "curChain" .= forMachine dtal curChain + , "candidates" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateFragment" + , "peer" .= forMachine dtal peer + , "candidateFragment" .= forMachine dtal frag + ] + ) + candidates + ) + , "candidateSuffixes" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateSuffix" + , "peer" .= forMachine dtal peer + , "candidateSuffix" .= forMachine dtal frag + ] + ) + candidateSuffixes + ) + ] forHuman = forHumanOrMachine @@ -2140,37 +2142,6 @@ instance ( HasHeader blk forHuman = forHumanOrMachine --------------------------------------------------------------------------------- --- AnchoredFragment tracer --------------------------------------------------------------------------------- - -instance (HasHeader blk, ConvertRawHash (Header blk)) => - LogFormatting (AF.AnchoredFragment blk) where - forMachine _dtal frag = mconcat - [ "kind" .= String "AnchoredFragment" - , "anchorPoint" .= ( Object $ mconcat - [ "kind" .= String "AnchoredFragmentAnchorPoint" - , "hash" .= String (renderChainHash - (renderHeaderHash (Proxy @(Header blk))) - (AF.anchorToHash $ AF.anchor frag)) - , "slotNo" .= String (showT $ AF.anchorToSlotNo $ AF.anchor frag) - , "blockNo" .= String (showT $ AF.anchorToBlockNo $ AF.anchor frag) - ] - ) - , "headPoint" .= ( Object $ mconcat - [ "kind" .= String "AnchoredFragmentHeadPoint" - , "hash" .= String (renderChainHash - (renderHeaderHash (Proxy @(Header blk))) - (AF.headHash frag)) - , "slotNo" .= String (showT $ AF.headSlot frag) - , "blockNo" .= String (showT $ AF.headBlockNo frag) - ] - ) - , "length" .= toJSON (fragmentLength frag) - ] - - forHuman = forHumanOrMachine - -------------------------------------------------------------------------------- -- Chain tip tracer -------------------------------------------------------------------------------- @@ -2188,17 +2159,3 @@ instance ( StandardHash blk ] forHuman = showT - --------------------------------------------------------------------------------- --- Utils --------------------------------------------------------------------------------- - --- NOTE: this ignores the Byron era with its EBB complication: --- the length would be underestimated by 1, if the AF is anchored --- at the epoch boundary. -fragmentLength :: HasHeader header => AF.AnchoredFragment header -> Int -fragmentLength f = fromIntegral . unBlockNo $ - case (f, f) of - (AS.Empty{}, AS.Empty{}) -> 0 - (firstHdr AS.:< _, _ AS.:> lastHdr) -> - blockNo lastHdr - blockNo firstHdr + 1 diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index f0fecbce438..a8312a0b418 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -77,6 +77,7 @@ import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) +import Control.Monad (guard) import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson import Data.Data (Proxy (..)) @@ -1690,49 +1691,51 @@ instance ToObject selection => ToObject (TraceGsmEvent selection) where instance HasPrivacyAnnotation (TraceGDDEvent peer blk) where instance HasSeverityAnnotation (TraceGDDEvent peer blk) where getSeverityAnnotation _ = Debug -instance (Show peer, GetHeader blk) => Transformable Text IO (TraceGDDEvent peer blk) where +instance (ToObject peer, ConvertRawHash blk, GetHeader blk) => Transformable Text IO (TraceGDDEvent peer blk) where trTransformer = trStructured -instance (Show peer, GetHeader blk) => ToObject (TraceGDDEvent peer blk) where - toObject verb TraceGDDEvent {..} = mconcat +instance (ToObject peer, ConvertRawHash blk, GetHeader blk) => ToObject (TraceGDDEvent peer blk) where + toObject verb TraceGDDEvent {..} = mconcat $ [ "kind" .= String "TraceGDDEvent" - , "bounds" .= toJSON ( - map - ( \(peer, density) -> Object $ mconcat - [ "kind" .= String "PeerDensityBound" - , "peer" .= (String $ showT peer) - , "densityBounds" .= toObject verb density - ] - ) - bounds - ) - , "curChain" .= toObject verb curChain - , "candidates" .= toJSON ( - map - ( \(peer, frag) -> Object $ mconcat - [ "kind" .= String "PeerCandidateFragment" - , "peer" .= (String $ showT peer) - , "candidateFragment" .= toObject verb frag - ] - ) - candidates - ) - , "candidateSuffixes" .= toJSON ( - map - ( \(peer, frag) -> Object $ mconcat - [ "kind" .= String "PeerCandidateSuffix" - , "peer" .= (String $ showT peer) - , "candidateSuffix" .= toObject verb frag - ] - ) - candidateSuffixes - ) - , "losingPeers".= (toJSON $ map (String . showT) losingPeers) - , "loeHead" .= (String $ showT loeHead) - , "sgen" .= (String $ showT $ unGenesisWindow sgen) - ] + , "losingPeers".= toJSON (map (toObject verb) losingPeers) + , "loeHead" .= toObject verb loeHead + , "sgen" .= toJSON (unGenesisWindow sgen) + ] <> do + guard $ verb >= MaximalVerbosity + [ "bounds" .= toJSON ( + map + ( \(peer, density) -> Object $ mconcat + [ "kind" .= String "PeerDensityBound" + , "peer" .= toObject verb peer + , "densityBounds" .= toObject verb density + ] + ) + bounds + ) + , "curChain" .= toObject verb curChain + , "candidates" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateFragment" + , "peer" .= toObject verb peer + , "candidateFragment" .= toObject verb frag + ] + ) + candidates + ) + , "candidateSuffixes" .= toJSON ( + map + ( \(peer, frag) -> Object $ mconcat + [ "kind" .= String "PeerCandidateSuffix" + , "peer" .= toObject verb peer + , "candidateSuffix" .= toObject verb frag + ] + ) + candidateSuffixes + ) + ] -instance (GetHeader blk) => ToObject (DensityBounds blk) where +instance (ConvertRawHash blk, GetHeader blk) => ToObject (DensityBounds blk) where toObject verb DensityBounds {..} = mconcat [ "kind" .= String "DensityBounds" , "clippedFragment" .= toObject verb clippedFragment @@ -1744,13 +1747,6 @@ instance (GetHeader blk) => ToObject (DensityBounds blk) where , "idling" .= toJSON idling ] -instance (GetHeader blk) => ToObject (AF.AnchoredFragment (Header blk)) where - toObject _ frag = mconcat - [ "kind" .= String "AnchoredFragment" - , "anchorPoint" .= (String $ showT $ AF.anchorPoint frag) - , "headPoint" .= (String $ showT $ AF.headPoint frag) - ] - instance ConvertRawHash blk => ToObject (Tip blk) where toObject _verb TipGenesis = mconcat [ "kind" .= String "TipGenesis" ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 203650e5014..317251b0c4c 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -62,9 +63,8 @@ import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), NodeToNode import qualified Ouroboros.Network.NodeToNode as NtN import Ouroboros.Network.PeerSelection.Bootstrap import Ouroboros.Network.PeerSelection.Governor (DebugPeerSelection (..), - DebugPeerSelectionState (..), PeerSelectionCounters, - PeerSelectionView (..), PeerSelectionState (..), - PeerSelectionTargets (..), TracePeerSelection (..), + DebugPeerSelectionState (..), PeerSelectionCounters, PeerSelectionState (..), + PeerSelectionTargets (..), PeerSelectionView (..), TracePeerSelection (..), peerSelectionStateToCounters) import Ouroboros.Network.PeerSelection.LedgerPeers import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) @@ -1171,6 +1171,25 @@ instance ToObject SlotNo where mconcat [ "kind" .= String "SlotNo" , "slot" .= toJSON (unSlotNo slot) ] +instance (ConvertRawHash blk) => ToObject (AF.Anchor blk) where + toObject verb = \case + AF.AnchorGenesis -> mconcat + [ "kind" .= String "AnchorGenesis" ] + AF.Anchor slot hash bno -> mconcat + [ "kind" .= String "Anchor" + , "slot" .= toJSON (unSlotNo slot) + , "headerHash" .= renderHeaderHashForVerbosity (Proxy @blk) verb hash + , "blockNo" .= toJSON (unBlockNo bno) + ] + +instance (ConvertRawHash blk, HasHeader blk) => ToObject (AF.AnchoredFragment blk) where + toObject verb frag = mconcat + [ "kind" .= String "AnchoredFragment" + , "anchor" .= toObject verb (AF.anchor frag) + , "headPoint" .= toObject verb (AF.headPoint frag) + , "length" .= toJSON (AF.length frag) + ] + instance ToJSON PeerGSV where toJSON PeerGSV { outboundGSV = GSV outboundG _ _ , inboundGSV = GSV inboundG _ _