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 c6fe8379d23..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 @@ -65,3 +65,27 @@ 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 + tag: 5c304e5adbd27907c675bd60a2282264a65f117c + --sha256: Jn3Qqlsirlyu23bsFN2SO054LIe2rcsHUW1tN8Pm1Ks= + 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: 0874ad4a61854f50bf9303d9f662ae6b129fac6d + --sha256: iw9IWAnUz4SX6OIBfe4HsRukZr8adyLbCS36CJo+8OE= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core 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-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/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 0cb4a22c2ef..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 (..)) @@ -162,6 +164,9 @@ data NodeConfiguration -- Enable Peer Sharing , ncPeerSharing :: PeerSharing + + -- Genesis syncing protocol configuration + , ncGenesisConfig :: GenesisConfig } deriving (Eq, Show) @@ -225,6 +230,10 @@ data PartialNodeConfiguration -- Peer Sharing , pncPeerSharing :: !(Last PeerSharing) + + -- Genesis syncing protocol + , pncEnableGenesis :: !(Last Bool) + , pncGenesisConfigFlags :: !(Last GenesisConfigFlags) } deriving (Eq, Generic, Show) instance AdjustFilePaths PartialNodeConfiguration where @@ -321,6 +330,11 @@ 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 + pncGenesisConfigFlags <- Last <$> v .:? "LowLevelGenesisOptions" + pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath @@ -355,6 +369,8 @@ instance FromJSON PartialNodeConfiguration where , pncTargetNumberOfActiveBigLedgerPeers , pncEnableP2P , pncPeerSharing + , pncEnableGenesis + , pncGenesisConfigFlags } where parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride @@ -531,6 +547,8 @@ defaultPartialNodeConfiguration = , pncTargetNumberOfActiveBigLedgerPeers = Last (Just 5) , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) + , pncEnableGenesis = Last (Just False) + , pncGenesisConfigFlags = Last (Just defaultGenesisConfigFlags) } lastOption :: Parser a -> Parser (Last a) @@ -596,6 +614,16 @@ makeNodeConfiguration pnc = do lastToEither "Missing PeerSharing" $ pncPeerSharing pnc + 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" $ @@ -643,6 +671,7 @@ makeNodeConfiguration pnc = do EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing + , 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..1d33366a183 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 .:? "BlockFetchGracePeriod" + <*> 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 ba82f9f96db..5e0cba21638 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -126,6 +126,8 @@ nodeRunParser = do , pncTargetNumberOfActiveBigLedgerPeers = mempty , 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 08b0feed168..8a53ee4886f 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,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = readTVar useBootstrapVar + , rnGenesisConfig = ncGenesisConfig nc } #ifdef UNIX -- initial `SIGHUP` handler, which only rereads the topology file but @@ -559,6 +564,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers + , rnGenesisConfig = ncGenesisConfig nc } #ifdef UNIX -- initial `SIGHUP` handler; it only warns that neither updating of 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/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 2eef28c0d34..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 () @@ -317,12 +316,22 @@ 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] + !consensusGddTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "GDD"] + configureTracers configReflection trConfig [consensusGddTr] + + !consensusCsjTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "CSJ"] + configureTracers configReflection trConfig [consensusCsjTr] pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ @@ -361,6 +370,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr + , Consensus.gddTracer = Tracer $ traceWith consensusGddTr + , 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..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,7 +46,7 @@ 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 @@ -56,11 +57,11 @@ 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 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 (..)) @@ -68,8 +69,9 @@ 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, 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,124 @@ 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 ( LogFormatting peer + , HasHeader blk + , HasHeader (Header blk) + , ConvertRawHash (Header blk) + ) => LogFormatting (TraceGDDEvent peer blk) where + forMachine dtal TraceGDDEvent {..} = mconcat $ + [ "kind" .= String "TraceGDDEvent" + , "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 + +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 + +-------------------------------------------------------------------------------- +-- Chain tip tracer +-------------------------------------------------------------------------------- + instance ( StandardHash blk , ConvertRawHash blk ) => LogFormatting (Tip blk) where 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..a8312a0b418 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 (..)) @@ -75,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 (..)) @@ -220,6 +223,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 +493,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 +745,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 +1163,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 +1398,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 +1415,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 +1688,65 @@ 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 (ToObject peer, ConvertRawHash blk, GetHeader blk) => Transformable Text IO (TraceGDDEvent peer blk) where + trTransformer = trStructured + +instance (ToObject peer, ConvertRawHash blk, GetHeader blk) => ToObject (TraceGDDEvent peer blk) where + toObject verb TraceGDDEvent {..} = mconcat $ + [ "kind" .= String "TraceGDDEvent" + , "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 (ConvertRawHash blk, 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 ConvertRawHash blk => ToObject (Tip blk) where toObject _verb TipGenesis = mconcat [ "kind" .= String "TipGenesis" ] @@ -1670,3 +1756,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..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 #-} @@ -38,6 +39,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 (..), @@ -61,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 (..)) @@ -1170,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 _ _ @@ -2632,3 +2652,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/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 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) diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index 0bf8428702a..e234ef6dbac 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 +# BlockFetchGracePeriod: 10 # seconds +# BucketCapacity: 100000 # tokens +# BucketRate: 500 # tokens per second +# CSJJumpSize: 4320 # slots. This value is 2*k +# GDDRateLimit: 1.0 # seconds 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": {