diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs index 41b391ecb66..2b4fc7d6d3d 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Command.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Command.hs @@ -57,6 +57,7 @@ import GHC.Weak as Weak (deRefWeak) import System.Posix.Signals as Sig (Handler (CatchInfo), SignalInfo (..), SignalSpecificInfo (..), installHandler, sigINT, sigTERM) +import Foreign.C (Errno(..)) #if MIN_VERSION_base(4,18,0) import Data.Maybe as Maybe (fromMaybe) import GHC.Conc.Sync as Conc (threadLabel) @@ -64,6 +65,7 @@ import GHC.Conc.Sync as Conc (threadLabel) #endif #ifdef UNIX +deriving instance Show Errno deriving instance Show SignalInfo deriving instance Show SignalSpecificInfo #endif diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 08a21618e74..c7bda1ca783 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -11,8 +11,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} @@ -26,10 +24,11 @@ module Cardano.Benchmarking.GeneratorTx.SubmissionClient ) where import Cardano.Api hiding (Active) -import Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx) +import Cardano.Api.Shelley (Tx (..), fromShelleyTxId, toConsensusGenTx) import Cardano.Benchmarking.LogTypes import Cardano.Benchmarking.Types +import Cardano.Ledger.Core (sizeTxF) import Cardano.Logging import Cardano.Prelude hiding (ByteString, atomically, retry, state, threadDelay) import Cardano.Tracing.OrphanInstances.Byron () @@ -40,7 +39,7 @@ import Cardano.Tracing.OrphanInstances.Shelley () import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock) import qualified Ouroboros.Consensus.Cardano.Block as Block (TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdBabbage, GenTxIdConway, GenTxIdMary, GenTxIdShelley)) -import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, txInBlockSize) +import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId) import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId (ShelleyTxId)) @@ -57,6 +56,8 @@ import qualified Data.List as L import qualified Data.List.Extra as L import qualified Data.List.NonEmpty as NE import qualified Data.Text as T +import Lens.Micro.Extras (view) + type CardanoBlock = Consensus.CardanoBlock StandardCrypto data SubmissionThreadStats @@ -85,10 +86,9 @@ type LocalState era = (TxSource era, UnAcked (Tx era), SubmissionThreadStats) type EndOfProtocolCallback m = SubmissionThreadStats -> m () txSubmissionClient - :: forall m era tx. + :: forall m era . ( MonadIO m, MonadFail m , IsShelleyBasedEra era - , tx ~ Tx era ) => Trace m NodeToNodeSubmissionTrace -> Trace m (TraceBenchTxSubmit TxId) @@ -110,11 +110,11 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = traceWith bmtr $ SubmissionClientDiscardAcknowledged (getTxId . getTxBody <$> acked) return (txSource, UnAcked stillUnacked, newStats) - queueNewTxs :: [tx] -> LocalState era -> LocalState era + queueNewTxs :: [Tx era] -> LocalState era -> LocalState era queueNewTxs newTxs (txSource, UnAcked unAcked, stats) = (txSource, UnAcked (newTxs <> unAcked), stats) - client ::LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m () + client :: LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m () client localState = ClientStIdle { recvMsgRequestTxIds = requestTxIds localState @@ -177,11 +177,15 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = , stsUnavailable = stsUnavailable stats + Unav (length missIds)})) - txToIdSize :: tx -> (GenTxId CardanoBlock, SizeInBytes) - txToIdSize = (Mempool.txId &&& (SizeInBytes . txInBlockSize)) . toGenTx + txToIdSize :: Tx era -> (GenTxId CardanoBlock, SizeInBytes) + txToIdSize = (Mempool.txId . toGenTx) &&& (SizeInBytes . fromInteger . getTxSize) + where + getTxSize :: Tx era -> Integer + getTxSize (ShelleyTx sbe tx) = + shelleyBasedEraConstraints sbe $ view sizeTxF tx - toGenTx :: tx -> GenTx CardanoBlock - toGenTx tx = toConsensusGenTx $ TxInMode (shelleyBasedEra @era) tx + toGenTx :: Tx era -> GenTx CardanoBlock + toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx fromGenTxId :: GenTxId CardanoBlock -> TxId diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index c1fbc0cd1ed..b76a80382a6 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -157,6 +157,7 @@ library , transformers-except , unordered-containers , yaml + , microlens default-language: Haskell2010 default-extensions: OverloadedStrings diff --git a/cabal.project b/cabal.project index bb66fb516c2..9f883a28a00 100644 --- a/cabal.project +++ b/cabal.project @@ -67,3 +67,32 @@ allow-newer: -- 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: 1070ab4afc337bf2718e270768e24f263061554a + --sha256: sha256-ITwg+Hpw4MsoeYhXpe7rE6wDniOElOFxkKgnktKWMdo= + subdir: + cardano-client + cardano-ping + monoidal-synchronisation + network-mux + ntp-client + ouroboros-network-api + ouroboros-network-framework + ouroboros-network-mock + ouroboros-network-protocols + ouroboros-network-testing + ouroboros-network + quickcheck-monoids + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 35adef5a76b285029762a4013059c1b430604e9c + --sha256: sha256-FKCY2nFZyXnBR3Wkn80HXipiKlbyDOohU++aRBAq3fA= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 6d230b65185..620e6cd577e 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -38,6 +38,7 @@ import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..)) import Ouroboros.Network.Diffusion.Configuration as Configuration +import Ouroboros.Network.TxSubmission.Inbound.Server (EnableNewTxSubmissionProtocol (..)) import Control.Monad (when) import Data.Aeson @@ -148,6 +149,13 @@ data NodeConfiguration -- | Node AcceptedConnectionsLimit , ncAcceptedConnectionsLimit :: !AcceptedConnectionsLimit + -- Used to determine which set of peer targets to use + -- by the diffusion layer when syncing + , ncConsensusMode :: !ConsensusMode + -- Minimum number of active big ledger peers we must be connected to + -- in Genesis mode + , ncMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState + -- P2P governor targets , ncDeadlineTargetOfRootPeers :: !Int , ncDeadlineTargetOfKnownPeers :: !Int @@ -160,17 +168,15 @@ data NodeConfiguration , ncSyncTargetOfKnownBigLedgerPeers :: !Int , ncSyncTargetOfEstablishedBigLedgerPeers :: !Int , ncSyncTargetOfActiveBigLedgerPeers :: !Int - , ncSyncMinTrusted :: !MinBigLedgerPeersForTrustedState - - -- Used to determine which set of peer targets to use - -- by the diffusion layer when syncing - , ncConsensusMode :: !ConsensusMode -- Enable experimental P2P mode , ncEnableP2P :: SomeNetworkP2PMode -- Enable Peer Sharing , ncPeerSharing :: PeerSharing + + -- Enable new TX Submission Protocol + , ncEnableNewTxSubmissionProtocol :: EnableNewTxSubmissionProtocol } deriving (Eq, Show) @@ -220,6 +226,12 @@ data PartialNodeConfiguration -- AcceptedConnectionsLimit , pncAcceptedConnectionsLimit :: !(Last AcceptedConnectionsLimit) + -- Consensus mode for diffusion layer + , pncConsensusMode :: !(Last ConsensusMode) + -- Minimum number of active big ledger peers we must be connected to + -- in Genesis mode, otherwise syncing is halted temporarily + , pncMinBigLedgerPeersForTrustedState :: !(Last MinBigLedgerPeersForTrustedState) + -- P2P governor targets , pncDeadlineTargetOfRootPeers :: !(Last Int) , pncDeadlineTargetOfKnownPeers :: !(Last Int) @@ -232,16 +244,15 @@ data PartialNodeConfiguration , pncSyncTargetOfKnownBigLedgerPeers :: !(Last Int) , pncSyncTargetOfEstablishedBigLedgerPeers :: !(Last Int) , pncSyncTargetOfActiveBigLedgerPeers :: !(Last Int) - , pncSyncMinTrusted :: !(Last MinBigLedgerPeersForTrustedState) - - -- Consensus mode for diffusion layer - , pncConsensusMode :: !(Last ConsensusMode) -- Enable experimental P2P mode , pncEnableP2P :: !(Last NetworkP2PMode) -- Peer Sharing , pncPeerSharing :: !(Last PeerSharing) + + -- Enable new TX Submission Protocol + , pncEnableNewTxSubmissionProtocol :: !(Last EnableNewTxSubmissionProtocol) } deriving (Eq, Generic, Show) instance AdjustFilePaths PartialNodeConfiguration where @@ -316,6 +327,8 @@ instance FromJSON PartialNodeConfiguration where pncAcceptedConnectionsLimit <- Last <$> v .:? "AcceptedConnectionsLimit" + pncConsensusMode <- Last <$> v .:? "ConsensusMode" + -- P2P Governor parameters, with conservative defaults. pncDeadlineTargetOfRootPeers <- Last <$> v .:? "TargetNumberOfRootPeers" pncDeadlineTargetOfKnownPeers <- Last <$> v .:? "TargetNumberOfKnownPeers" @@ -328,9 +341,7 @@ instance FromJSON PartialNodeConfiguration where pncSyncTargetOfKnownBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfKnownBigLedgerPeers" pncSyncTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfEstablishedBigLedgerPeers" pncSyncTargetOfActiveBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfActiveBigLedgerPeers" - pncSyncMinTrusted <- Last <$> v .:? "SyncMinNumberOfBigLedgerPeersForTrustedState" - - pncConsensusMode <- Last <$> v .:? "ConsensusMode" + pncMinBigLedgerPeersForTrustedState <- Last <$> v .:? "MinBigLedgerPeersForTrustedState" pncChainSyncIdleTimeout <- Last <$> v .:? "ChainSyncIdleTimeout" @@ -346,6 +357,14 @@ instance FromJSON PartialNodeConfiguration where -- DISABLED BY DEFAULT pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just Configuration.PeerSharingDisabled + -- Enable new TX Submission Protocol + newTxSubmissionProtocol <- v .:? "EnableNewTxSubmissionProtocol" + let pncEnableNewTxSubmissionProtocol = + case newTxSubmissionProtocol of + Nothing -> Last $ Just EnableNewTxSubmissionProtocol -- defaultEnableNewTxSubmissionProtocol + Just False -> Last $ Just DisableNewTxSubmissionProtocol + Just True -> Last $ Just EnableNewTxSubmissionProtocol + pure PartialNodeConfiguration { pncProtocolConfig , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath @@ -382,10 +401,11 @@ instance FromJSON PartialNodeConfiguration where , pncSyncTargetOfKnownBigLedgerPeers , pncSyncTargetOfEstablishedBigLedgerPeers , pncSyncTargetOfActiveBigLedgerPeers - , pncSyncMinTrusted + , pncMinBigLedgerPeersForTrustedState , pncConsensusMode , pncEnableP2P , pncPeerSharing + , pncEnableNewTxSubmissionProtocol } where parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride @@ -564,10 +584,11 @@ defaultPartialNodeConfiguration = , pncSyncTargetOfKnownBigLedgerPeers = Last (Just syncBigKnown) , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just syncBigEst) , pncSyncTargetOfActiveBigLedgerPeers = Last (Just syncBigAct) - , pncSyncMinTrusted = Last (Just defaultMinBigLedgerPeersForTrustedState) + , pncMinBigLedgerPeersForTrustedState = Last (Just defaultMinBigLedgerPeersForTrustedState) , pncConsensusMode = mempty , pncEnableP2P = Last (Just EnabledP2PMode) , pncPeerSharing = Last (Just Configuration.PeerSharingDisabled) + , pncEnableNewTxSubmissionProtocol = Last (Just EnableNewTxSubmissionProtocol) -- defaultEnableNewTxSubmissionProtocol) } where Configuration.PeerSelectionTargets { @@ -637,9 +658,9 @@ makeNodeConfiguration pnc = do ncSyncTargetOfActiveBigLedgerPeers <- lastToEither "Missing SyncTargetNumberOfActiveBigLedgerPeers" $ pncSyncTargetOfActiveBigLedgerPeers pnc - ncSyncMinTrusted <- - lastToEither "Missing SyncMinNumberOfBigLedgerPeersForTrustedState" - $ pncSyncMinTrusted pnc + ncMinBigLedgerPeersForTrustedState <- + lastToEither "Missing MinBigLedgerPeersForTrustedState" + $ pncMinBigLedgerPeersForTrustedState pnc ncConsensusMode <- lastToEither "Missing ConsensusMode" $ pncConsensusMode pnc @@ -665,6 +686,10 @@ makeNodeConfiguration pnc = do lastToEither "Missing PeerSharing" $ pncPeerSharing pnc + ncEnableNewTxSubmissionProtocol <- + lastToEither "Missing EnableNewTxSubmissionProtocol" + $ pncEnableNewTxSubmissionProtocol pnc + -- TODO: This is not mandatory experimentalProtocols <- lastToEither "Missing ExperimentalProtocolsEnabled" $ @@ -712,12 +737,13 @@ makeNodeConfiguration pnc = do , ncSyncTargetOfKnownBigLedgerPeers , ncSyncTargetOfEstablishedBigLedgerPeers , ncSyncTargetOfActiveBigLedgerPeers - , ncSyncMinTrusted + , ncMinBigLedgerPeersForTrustedState , ncEnableP2P = case enableP2P of EnabledP2PMode -> SomeNetworkP2PMode Consensus.EnabledP2PMode DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing , ncConsensusMode + , ncEnableNewTxSubmissionProtocol } ncProtocol :: NodeConfiguration -> Protocol diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 4a44c906165..a66915bc994 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -20,7 +20,7 @@ import Cardano.Node.Configuration.Socket import Cardano.Node.Handlers.Shutdown import Cardano.Node.Types import Cardano.Prelude (ConvertText (..)) -import Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..)) +import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..)) import Ouroboros.Consensus.Node import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..), SnapshotInterval (..)) @@ -132,6 +132,9 @@ nodeRunParser = do , pncConsensusMode = mempty , pncEnableP2P = mempty , pncPeerSharing = mempty + , pncConsensusMode = mempty + , pncMinBigLedgerPeersForTrustedState = mempty + , pncEnableNewTxSubmissionProtocol = mempty } parseSocketPath :: Text -> Parser SocketPath @@ -217,7 +220,7 @@ parseMempoolCapacityOverride = parseOverride <|> parseNoOverride where parseOverride :: Parser MempoolCapacityBytesOverride parseOverride = - MempoolCapacityBytesOverride . MempoolCapacityBytes <$> + MempoolCapacityBytesOverride . ByteSize32 <$> Opt.option (auto @Word32) ( long "mempool-capacity-override" <> metavar "BYTES" diff --git a/cardano-node/src/Cardano/Node/Protocol/Types.hs b/cardano-node/src/Cardano/Node/Protocol/Types.hs index 26220b9999f..a762e250316 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Types.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Types.hs @@ -16,6 +16,7 @@ import qualified Cardano.Api as Api import Cardano.Node.Orphans () import Cardano.Node.Queries (HasKESInfo, HasKESMetricsData) import Cardano.Node.TraceConstraints (TraceConstraints) +import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Control.DeepSeq (NFData) import Data.Aeson @@ -45,6 +46,7 @@ data SomeConsensusProtocol where , HasKESMetricsData blk , HasKESInfo blk , TraceConstraints blk + , ToJSONKey (GenTxId blk) ) => Api.BlockType blk -> Api.ProtocolInfoArgs blk diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index b2b50c7430b..5c3dcdaf8ed 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -121,10 +121,13 @@ import GHC.Weak (deRefWeak) import System.Posix.Files import qualified System.Posix.Signals as Signals import System.Posix.Types (FileMode) -#else +#else import System.Win32.File #endif import Paths_cardano_node (version) +import Data.Aeson (ToJSONKey) +import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) +import Ouroboros.Network.TxSubmission.Inbound.Server (EnableNewTxSubmissionProtocol (..)) {- HLINT ignore "Fuse concatMap/map" -} @@ -197,6 +200,7 @@ installSigTermHandler = do handleNodeWithTracers :: ( TraceConstraints blk , Api.Protocol IO blk + , ToJSONKey (GenTxId blk) ) => PartialNodeConfiguration -> NodeConfiguration @@ -475,6 +479,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = readTVar useBootstrapVar + , rnEnableNewTxSubmissionProtocol = ncEnableNewTxSubmissionProtocol nc } #ifdef UNIX -- initial `SIGHUP` handler, which only rereads the topology file but @@ -566,6 +571,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers + , rnEnableNewTxSubmissionProtocol = EnableNewTxSubmissionProtocol } #ifdef UNIX -- initial `SIGHUP` handler; it only warns that neither updating of @@ -900,7 +906,7 @@ mkP2PArguments NodeConfiguration { ncSyncTargetOfKnownBigLedgerPeers, ncSyncTargetOfEstablishedBigLedgerPeers, ncSyncTargetOfActiveBigLedgerPeers, - ncSyncMinTrusted, + ncMinBigLedgerPeersForTrustedState, ncProtocolIdleTimeout, ncTimeWaitTimeout, ncPeerSharing, @@ -926,7 +932,7 @@ mkP2PArguments NodeConfiguration { , P2P.daBulkChurnInterval = Configuration.defaultBulkChurnInterval , P2P.daOwnPeerSharing = ncPeerSharing , P2P.daConsensusMode = ncConsensusMode - , P2P.daMinBigLedgerPeersForTrustedState = ncSyncMinTrusted + , P2P.daMinBigLedgerPeersForTrustedState = ncMinBigLedgerPeersForTrustedState } where deadlineTargets = Configuration.defaultDeadlineTargets { diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index cf8f182411b..a5e847e3308 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -22,6 +22,7 @@ import Cardano.Node.Tracing.Tracers.Peer (startPeerTracer) import Cardano.Node.Tracing.Tracers.Resources (startResourceTracer) import Cardano.Node.Types import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent) +import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent) import Ouroboros.Consensus.Node (NetworkP2PMode) import Ouroboros.Consensus.Node.GSM @@ -35,6 +36,7 @@ import Prelude import "contra-tracer" Control.Tracer (traceWith) import "trace-dispatcher" Control.Tracer (nullTracer) +import Data.Aeson (ToJSONKey) import Data.Bifunctor (first) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) @@ -49,6 +51,7 @@ initTraceDispatcher :: , LogFormatting (TraceLabelPeer (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk)) , LogFormatting (TraceGsmEvent (Tip blk)) + , ToJSONKey (GenTxId blk) ) => NodeConfiguration -> SomeConsensusProtocol diff --git a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs b/cardano-node/src/Cardano/Node/Tracing/StateRep.hs index bbd32fa6aa3..dca8cd1932a 100644 --- a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs +++ b/cardano-node/src/Cardano/Node/Tracing/StateRep.hs @@ -60,7 +60,7 @@ deriving instance (NFData OpeningDbs) data Replays = ReplayFromGenesis (WithOrigin SlotNo) - | ReplayFromSnapshot SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo) + | ReplayFromSnapshot (WithOrigin SlotNo) (WithOrigin SlotNo) | ReplayedBlock SlotNo (WithOrigin SlotNo) (WithOrigin SlotNo) deriving (Generic, FromJSON, ToJSON) @@ -219,8 +219,8 @@ traceNodeStateChainDB _scp tr ev = case ev' of LgrDb.ReplayFromGenesis (LgrDb.ReplayGoal p) -> traceWith tr $ NodeReplays $ ReplayFromGenesis (pointSlot p) - LgrDb.ReplayFromSnapshot _ (RP.RealPoint s _) (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) -> - traceWith tr $ NodeReplays $ ReplayFromSnapshot s (pointSlot rs) (pointSlot rp) + LgrDb.ReplayFromSnapshot _ (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) -> + traceWith tr $ NodeReplays $ ReplayFromSnapshot (pointSlot rs) (pointSlot rp) LgrDb.ReplayedBlock (RP.RealPoint s _) _ (LgrDb.ReplayStart rs) (LgrDb.ReplayGoal rp) -> traceWith tr $ NodeReplays $ ReplayedBlock s (pointSlot rs) (pointSlot rp) ChainDB.TraceInitChainSelEvent ev' -> diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index b105e66bc08..7c32f31b5e6 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -40,6 +40,7 @@ import Cardano.Node.Tracing.Tracers.Peer () import Cardano.Node.Tracing.Tracers.Shutdown () import Cardano.Node.Tracing.Tracers.Startup () import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent) +import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent) import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient import qualified Ouroboros.Consensus.Network.NodeToClient as NtC @@ -64,6 +65,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress) import Codec.CBOR.Read (DeserialiseFailure) import Control.Monad (unless) import "contra-tracer" Control.Tracer (Tracer (..)) +import Data.Aeson (ToJSONKey) import Data.Proxy (Proxy (..)) import Network.Mux.Trace (TraceLabelPeer (..)) @@ -81,6 +83,7 @@ mkDispatchTracers (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk)) , LogFormatting (TraceGsmEvent (Tip blk)) , MetaTrace (TraceGsmEvent (Tip blk)) + , ToJSONKey (GenTxId blk) ) => NodeKernelData blk -> Trace IO FormattedMessage @@ -208,6 +211,7 @@ mkConsensusTracers :: forall blk. (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk)) , LogFormatting (TraceGsmEvent (Tip blk)) , MetaTrace (TraceGsmEvent (Tip blk)) + , ToJSONKey (GenTxId blk) ) => ConfigReflection -> Trace IO FormattedMessage @@ -333,6 +337,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "GSM"] configureTracers configReflection trConfig [consensusGsmTr] + !txLogicTracers <- mkCardanoTracer + trBase trForward mbTrEKG + ["TxSubmission", "TxLogic"] + configureTracers configReflection trConfig [txLogicTracers] + pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ traceWith chainSyncClientTr @@ -374,6 +383,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr + , Consensus.txLogicTracer = Tracer $ + traceWith txLogicTracers } mkNodeToClientTracers :: forall blk. @@ -423,7 +434,9 @@ mkNodeToClientTracers configReflection trBase trForward mbTrEKG _trDataPoint trC mkNodeToNodeTracers :: forall blk. ( Consensus.RunNode blk - , TraceConstraints blk) + , TraceConstraints blk + , ToJSONKey (GenTxId blk) + ) => ConfigReflection -> Trace IO FormattedMessage -> Trace IO FormattedMessage @@ -458,6 +471,11 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon ["TxSubmission", "Remote"] configureTracers configReflection trConfig [txSubmission2Tracer] + !txLogicTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["TxSubmission", "TxLogic"] + configureTracers configReflection trConfig [txSubmission2Tracer] + pure $ NtN.Tracers { NtN.tChainSyncTracer = Tracer $ traceWith chainSyncTracer @@ -469,6 +487,8 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon traceWith blockFetchSerialisedTr , NtN.tTxSubmission2Tracer = Tracer $ traceWith txSubmission2Tracer + , NtN.tTxLogicTracer = Tracer $ + traceWith txLogicTracer } mkDiffusionTracers diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 0486292e199..3b3038e24ad 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -32,7 +32,8 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmDB import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (chunkNoToInt) import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB -import Ouroboros.Consensus.Storage.LedgerDB (UpdateLedgerDbTraceEvent (..)) +import Ouroboros.Consensus.Storage.LedgerDB (ReplayStart (..), + UpdateLedgerDbTraceEvent (..)) import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB import Ouroboros.Consensus.Util.Condense (condense) @@ -1572,9 +1573,9 @@ instance (StandardHash blk, ConvertRawHash blk) => LogFormatting (LedgerDB.TraceReplayEvent blk) where forHuman (LedgerDB.ReplayFromGenesis _replayTo) = "Replaying ledger from genesis" - forHuman (LedgerDB.ReplayFromSnapshot snap tip' _ _) = + forHuman (LedgerDB.ReplayFromSnapshot snap (ReplayStart tip') _) = "Replaying ledger from snapshot " <> showT snap <> " at " <> - renderRealPointAsPhrase tip' + renderPointAsPhrase tip' forHuman (LedgerDB.ReplayedBlock pt _ledgerEvents @@ -1596,7 +1597,7 @@ instance (StandardHash blk, ConvertRawHash blk) forMachine _dtal (LedgerDB.ReplayFromGenesis _replayTo) = mconcat [ "kind" .= String "ReplayFromGenesis" ] - forMachine dtal (LedgerDB.ReplayFromSnapshot snap tip' _ _) = + forMachine dtal (LedgerDB.ReplayFromSnapshot snap tip' _) = mconcat [ "kind" .= String "ReplayFromSnapshot" , "snapshot" .= forMachine dtal snap , "tip" .= show tip' ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 63019777937..0e63feb3d81 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -25,6 +25,7 @@ module Cardano.Node.Tracing.Tracers.Consensus import Cardano.Logging import Cardano.Node.Queries (HasKESInfo (..)) +import Cardano.Node.Tracing.Compat (fromDetailLevel) import Cardano.Node.Tracing.Era.Byron () import Cardano.Node.Tracing.Era.Shelley () import Cardano.Node.Tracing.Formatting () @@ -33,14 +34,16 @@ import Cardano.Node.Tracing.Tracers.ConsensusStartupException () import Cardano.Node.Tracing.Tracers.StartLeadershipCheck import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) import Cardano.Slotting.Slot (WithOrigin (..)) +import Cardano.Tracing.OrphanInstances.Common (ToObject (..)) import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) import Ouroboros.Consensus.Cardano.Block -import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), TraceGDDEvent (..)) +import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), + TraceGDDEvent (..)) import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpdate, LedgerWarning) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, HasTxId, - LedgerSupportsMempool, txForgetValidated, txId) +import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, ByteSize32 (..), GenTxId, + HasTxId, LedgerSupportsMempool, txForgetValidated, txId) import Ouroboros.Consensus.Ledger.SupportsProtocol import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server @@ -74,6 +77,7 @@ import Control.Monad (guard) import Control.Monad.Class.MonadTime.SI (Time (..)) import Data.Aeson (ToJSON, Value (Number, String), toJSON, (.=)) import qualified Data.Aeson as Aeson +import Data.Foldable (Foldable (..)) import Data.Int (Int64) import Data.IntPSQ (IntPSQ) import qualified Data.IntPSQ as Pq @@ -881,8 +885,12 @@ instance ( LogFormatting peer , HasHeader (Header blk) , ConvertRawHash (Header blk) ) => LogFormatting (TraceGDDEvent peer blk) where - forMachine dtal TraceGDDEvent {..} = mconcat $ - [ "kind" .= String "TraceGDDEvent" + forMachine dtal (TraceGDDDisconnected peers) = mconcat + [ "kind" .= String "TraceGDDDisconnected" + , "peers" .= toJSON (map (forMachine dtal) (toList peers)) + ] + forMachine dtal (TraceGDDDebug GDDDebugInfo {..}) = mconcat $ + [ "kind" .= String "TraceGDDDebug" , "losingPeers".= toJSON (map (forMachine dtal) losingPeers) , "loeHead" .= forMachine dtal loeHead , "sgen" .= toJSON (unGenesisWindow sgen) @@ -979,7 +987,7 @@ instance LogFormatting SanityCheckIssue where -- TxInbound Tracer -------------------------------------------------------------------------------- -instance LogFormatting (TraceTxSubmissionInbound txid tx) where +instance (ToJSON txid, ToObject tx) => LogFormatting (TraceTxSubmissionInbound txid tx) where forMachine _dtal (TraceTxSubmissionCollected count) = mconcat [ "kind" .= String "TraceTxSubmissionCollected" @@ -1005,6 +1013,16 @@ instance LogFormatting (TraceTxSubmissionInbound txid tx) where [ "kind" .= String "TraceTxInboundCannotRequestMoreTxs" , "count" .= toJSON count ] + forMachine _dtal (TraceTxInboundAddedToMempool txids) = + mconcat + [ "kind" .= String "TraceTxInboundAddedToMempool" + , "txids" .= txids + ] + forMachine dtal (TraceTxInboundDecision td) = + mconcat + [ "kind" .= String "TraceTxInboundDecision" + , "decision" .= toObject (fromDetailLevel dtal) td + ] asMetrics (TraceTxSubmissionCollected count)= [CounterM "submissions.submitted" (Just count)] @@ -1022,12 +1040,16 @@ instance MetaTrace (TraceTxSubmissionInbound txid tx) where namespaceFor TraceTxInboundTerminated {} = Namespace [] ["Terminated"] namespaceFor TraceTxInboundCanRequestMoreTxs {} = Namespace [] ["CanRequestMoreTxs"] namespaceFor TraceTxInboundCannotRequestMoreTxs {} = Namespace [] ["CannotRequestMoreTxs"] + namespaceFor TraceTxInboundAddedToMempool {} = Namespace [] ["TxInboundAddedToMempool"] + namespaceFor TraceTxInboundDecision {} = Namespace [] ["TxInboundDecision"] severityFor (Namespace _ ["Collected"]) _ = Just Debug severityFor (Namespace _ ["Processed"]) _ = Just Debug severityFor (Namespace _ ["Terminated"]) _ = Just Notice severityFor (Namespace _ ["CanRequestMoreTxs"]) _ = Just Debug severityFor (Namespace _ ["CannotRequestMoreTxs"]) _ = Just Debug + severityFor (Namespace _ ["TxInboundAddedToMempool"]) _ = Just Debug + severityFor (Namespace _ ["TxInboundDecision "]) _ = Just Debug severityFor _ _ = Nothing metricsDocFor (Namespace _ ["Collected"]) = @@ -1054,6 +1076,13 @@ instance MetaTrace (TraceTxSubmissionInbound txid tx) where , " txids. Since this is the only thing to do now, we make this a" , " blocking call." ] + documentFor (Namespace _ ["TxInboundAddedToMempool"]) = Just $ mconcat + [ "Transaction ids that made it into the mempool" + ] + documentFor (Namespace _ ["TxInboundDecision"]) = Just $ mconcat + [ "Current decision made by the decision logic thread" + , " to guide the TX Submission protocol" + ] documentFor _ = Nothing allNamespaces = [ @@ -1062,6 +1091,8 @@ instance MetaTrace (TraceTxSubmissionInbound txid tx) where , Namespace [] ["Terminated"] , Namespace [] ["CanRequestMoreTxs"] , Namespace [] ["CannotRequestMoreTxs"] + , Namespace [] ["TxInboundAddedToMempool"] + , Namespace [] ["TxInboundDecision"] ] -------------------------------------------------------------------------------- @@ -1201,25 +1232,35 @@ instance asMetrics (TraceMempoolAddedTx _tx _mpSzBefore mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) - , IntM "mempoolBytes" (fromIntegral $ msNumBytes mpSz) + , IntM "mempoolBytes" (fromIntegral w) ] + where + ByteSize32 w = msNumBytes mpSz asMetrics (TraceMempoolRejectedTx _tx _txApplyErr mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) - , IntM "mempoolBytes" (fromIntegral $ msNumBytes mpSz) + , IntM "mempoolBytes" (fromIntegral w) ] + where + ByteSize32 w = msNumBytes mpSz asMetrics (TraceMempoolRemoveTxs _txs mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) - , IntM "mempoolBytes" (fromIntegral $ msNumBytes mpSz) + , IntM "mempoolBytes" (fromIntegral w) ] + where + ByteSize32 w = msNumBytes mpSz asMetrics (TraceMempoolManuallyRemovedTxs [] _txs1 mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) - , IntM "mempoolBytes" (fromIntegral $ msNumBytes mpSz) + , IntM "mempoolBytes" (fromIntegral w) ] + where + ByteSize32 w = msNumBytes mpSz asMetrics (TraceMempoolManuallyRemovedTxs txs _txs1 mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) - , IntM "mempoolBytes" (fromIntegral $ msNumBytes mpSz) + , IntM "mempoolBytes" (fromIntegral w) , CounterM "txsProcessedNum" (Just (fromIntegral $ length txs)) ] + where + ByteSize32 w = msNumBytes mpSz instance LogFormatting MempoolSize where forMachine _dtal MempoolSize{msNumTxs, msNumBytes} = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 152c9ace66d..5d7ac9a7ee7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -59,6 +59,9 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Text (pack) import Network.Socket (SockAddr (..)) +import Ouroboros.Network.TxSubmission.Inbound.Types (TraceTxLogic (..)) +import Cardano.Tracing.OrphanInstances.Common (ToObject(..)) +import Cardano.Node.Tracing.Compat (fromDetailLevel) @@ -778,7 +781,7 @@ instance MetaTrace (TracePeerSelection SockAddr) where documentFor (Namespace [] ["DebugState"]) = Just "peer selection internal state" documentFor (Namespace [] ["VerifyPeerSnapshot"]) = Just - "Big ledger peer snapshot file failed integrity check against the ledger" + "Big ledger peer snapshot file verification result" documentFor _ = Nothing metricsDocFor (Namespace [] ["ChurnAction"]) = @@ -1903,3 +1906,51 @@ instance MetaTrace NtN.AcceptConnectionsPolicyTrace where , Namespace [] ["ConnectionHardLimit"] , Namespace [] ["ConnectionLimitResume"] ] + +-------------------------------------------------------------------------------- +-- TxLogic Tracer +-------------------------------------------------------------------------------- + +instance ( ToJSON txid + , ToObject tx + , ToJSONKey peer + , ToJSONKey txid + , Show peer + , Show txid + , Show tx + ) => LogFormatting (TraceTxLogic peer txid tx) where + forMachine dtal (TraceTxDecisions td) = + mconcat [ "kind" .= String "TxDecisions" + , "decisions" .= fmap (toObject (fromDetailLevel dtal)) td + ] + forMachine dtal (TraceSharedTxState s st) = + mconcat [ "kind" .= String "SharedTxState" + , "name" .= s + , "sharedState" .= toObject (fromDetailLevel dtal) st + ] + forHuman = showT + +instance MetaTrace (TraceTxLogic peer txid tx) where + namespaceFor TraceTxDecisions {} = + Namespace [] ["TxDecisions"] + namespaceFor TraceSharedTxState {} = + Namespace [] ["SharedTxState"] + + severityFor (Namespace _ ["TxDecisions"]) _ = Just Debug + severityFor (Namespace _ ["SharedTxState"]) _ = Just Debug + severityFor _ _ = Nothing + + documentFor (Namespace _ ["TxDecisions"]) = Just $ mconcat + [ "Current decision made by the decision logic thread" + , " to guide the TX Submission protocol" + ] + documentFor (Namespace _ ["SharedTxState"]) = Just $ mconcat + [ "Shared state as seen by the decision logict thread." + , " This state guides the TX Submission protocol" + ] + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["TxDecisions"] + , Namespace [] ["SharedTxState"] + ] diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 2dd739efd0e..0d0a616b1e1 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -176,6 +176,7 @@ type TraceTxOutbound = ("TraceTxOutbound" :: Symbol) type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) +type TraceTxLogic = ("TraceTxLogic" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -247,6 +248,7 @@ data TraceSelection , traceTxSubmissionProtocol :: OnOff TraceTxSubmissionProtocol , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol , traceGsm :: OnOff TraceGsm + , traceTxLogic :: OnOff TraceTxLogic } deriving (Eq, Show) @@ -312,6 +314,7 @@ data PartialTraceSelection , pTraceTxSubmissionProtocol :: Last (OnOff TraceTxSubmissionProtocol) , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) , pTraceGsm :: Last (OnOff TraceGsm) + , pTraceTxLogic :: Last (OnOff TraceTxLogic) } deriving (Eq, Generic, Show) @@ -378,6 +381,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxSubmissionProtocol) v <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v <*> parseTracer (Proxy @TraceGsm) v + <*> parseTracer (Proxy @TraceTxLogic) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -441,6 +445,7 @@ defaultPartialTraceConfiguration = , pTraceTxSubmissionProtocol = pure $ OnOff False , pTraceTxSubmission2Protocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True + , pTraceTxLogic = pure $ OnOff False } @@ -506,6 +511,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceTxLogic <- proxyLastToEither (Proxy @TraceTxLogic) pTraceTxLogic Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -564,6 +570,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceGsm = traceGsm + , traceTxLogic = traceTxLogic } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -626,6 +633,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceTxLogic <- proxyLastToEither (Proxy @TraceTxLogic) pTraceTxLogic Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -684,6 +692,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxSubmissionProtocol = traceTxSubmissionProtocol , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceGsm = traceGsm + , traceTxLogic = traceTxLogic } 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 c7491304090..096c6299957 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -33,14 +33,16 @@ import Ouroboros.Consensus.Block (BlockProtocol, BlockSupportsProtocol ConvertRawHash (..), ForgeStateUpdateError, GenesisWindow (..), GetHeader (..), Header, RealPoint, blockNo, blockPoint, blockPrevHash, getHeader, headerPoint, pointHash, realPointHash, realPointSlot, withOriginToMaybe) -import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), TraceGDDEvent (..)) +import Ouroboros.Consensus.Block.SupportsSanityCheck +import Ouroboros.Consensus.Genesis.Governor (DensityBounds (..), GDDDebugInfo (..), + TraceGDDEvent (..)) import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent (..), LedgerUpdate, LedgerWarning) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxId, - LedgerSupportsMempool, TxId, txForgetValidated, txId) +import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, ByteSize32 (..), GenTx, + GenTxId, HasTxId, LedgerSupportsMempool, TxId, txForgetValidated, txId) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server @@ -64,12 +66,12 @@ import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..), chunkNoToInt) import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB -import Ouroboros.Consensus.Storage.LedgerDB (PushGoal (..), PushStart (..), Pushing (..)) +import Ouroboros.Consensus.Storage.LedgerDB (PushGoal (..), PushStart (..), Pushing (..), + ReplayStart (..)) import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb import Ouroboros.Consensus.Util.Condense import Ouroboros.Consensus.Util.Enclose -import Ouroboros.Consensus.Block.SupportsSanityCheck import Ouroboros.Consensus.Util.Orphans () import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo (..), StandardHash, @@ -79,7 +81,7 @@ import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Control.Monad (guard) -import Data.Aeson (Value (..)) +import Data.Aeson (FromJSON (..), Value (..)) import qualified Data.Aeson as Aeson import Data.Data (Proxy (..)) import Data.Foldable (Foldable (..)) @@ -376,6 +378,11 @@ condenseT = pack . condense showT :: Show a => a -> Text showT = pack . show +instance ToJSON ByteSize32 where + toJSON (ByteSize32 w) = toJSON w + +instance FromJSON ByteSize32 where + parseJSON v = ByteSize32 <$> parseJSON v instance ( tx ~ GenTx blk , HasTxId tx @@ -589,9 +596,9 @@ instance ( ConvertRawHash blk ChainDB.TraceLedgerReplayEvent ev -> case ev of LedgerDB.ReplayFromGenesis _replayTo -> "Replaying ledger from genesis" - LedgerDB.ReplayFromSnapshot _ tip' _ _ -> + LedgerDB.ReplayFromSnapshot _ (ReplayStart tip') _ -> "Replaying ledger from snapshot at " <> - renderRealPointAsPhrase tip' + renderPointAsPhrase tip' LedgerDB.ReplayedBlock pt _ledgerEvents (LedgerDB.ReplayStart replayFrom) (LedgerDB.ReplayGoal replayTo) -> let fromSlot = withOrigin 0 Prelude.id $ unSlotNo <$> pointSlot replayFrom atSlot = unSlotNo $ realPointSlot pt @@ -1077,7 +1084,7 @@ instance ( ConvertRawHash blk toObject verb (ChainDB.TraceLedgerReplayEvent ev) = case ev of LedgerDB.ReplayFromGenesis _replayTo -> mconcat [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromGenesis" ] - LedgerDB.ReplayFromSnapshot snap tip' _replayFrom _replayTo -> + LedgerDB.ReplayFromSnapshot snap tip' _replayFrom -> mconcat [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromSnapshot" , "snapshot" .= toObject verb snap , "tip" .= show tip' ] @@ -1704,8 +1711,12 @@ instance (ToObject peer, ConvertRawHash blk, GetHeader blk) => Transformable Tex trTransformer = trStructured instance (ToObject peer, ConvertRawHash blk, GetHeader blk) => ToObject (TraceGDDEvent peer blk) where - toObject verb TraceGDDEvent {..} = mconcat $ - [ "kind" .= String "TraceGDDEvent" + toObject verb (TraceGDDDisconnected peer) = mconcat + [ "kind" .= String "TraceGDDDisconnected" + , "peer" .= toJSON (map (toObject verb) $ toList peer) + ] + toObject verb (TraceGDDDebug GDDDebugInfo {..}) = mconcat $ + [ "kind" .= String "TraceGDDDebug" , "losingPeers".= toJSON (map (toObject verb) losingPeers) , "loeHead" .= toObject verb loeHead , "sgen" .= toJSON (unGenesisWindow sgen) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 2853c64b941..4751a6c942a 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -92,6 +92,8 @@ instance All (Compose ToJSON WrapGenTxId) xs => ToJSON (TxId (GenTx (HardForkBl . getOneEraGenTxId . getHardForkGenTxId +instance All (Compose ToJSON WrapGenTxId) xs => ToJSONKey (TxId (GenTx (HardForkBlock xs))) + instance ToJSON (TxId (GenTx blk)) => ToJSON (WrapGenTxId blk) where toJSON = toJSON . unwrapGenTxId diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index dae2020633e..78260cb6997 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -126,6 +126,7 @@ import Network.Mux (MiniProtocolNum (..), MuxTrace (..), WithMuxBearer import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) import Network.TypedProtocol.Core (PeerHasAgency (..)) +import Ouroboros.Network.TxSubmission.Inbound.Types (TxDecision(..), TraceTxLogic (..), SharedTxState (..), PeerTxState (..)) {- HLINT ignore "Use record patterns" -} @@ -211,6 +212,12 @@ instance HasSeverityAnnotation (TraceTxSubmissionInbound txid tx) where getSeverityAnnotation TraceTxInboundTerminated = Notice getSeverityAnnotation TraceTxInboundCannotRequestMoreTxs {} = Debug getSeverityAnnotation TraceTxInboundCanRequestMoreTxs {} = Debug + getSeverityAnnotation TraceTxInboundAddedToMempool {} = Debug + getSeverityAnnotation TraceTxInboundDecision {} = Debug + +instance HasPrivacyAnnotation (TraceTxLogic peer txid tx) +instance HasSeverityAnnotation (TraceTxLogic peer txid tx) where + getSeverityAnnotation _ = Debug instance HasPrivacyAnnotation (TraceTxSubmissionOutbound txid tx) @@ -245,7 +252,6 @@ instance HasSeverityAnnotation TraceLedgerPeers where TraceLedgerPeersFailure {} -> Debug UsingBigLedgerPeerSnapshot {} -> Debug - instance HasPrivacyAnnotation (WithAddr addr ErrorPolicyTrace) instance HasSeverityAnnotation (WithAddr addr ErrorPolicyTrace) where getSeverityAnnotation (WithAddr _ ev) = case ev of @@ -636,7 +642,7 @@ instance (ToObject peer, ToObject (AnyMessageAndAgency (TraceTxSubmissionInbound => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))) where trTransformer = trStructured -instance ToObject peer +instance (ToObject peer, ToJSON (GenTxId blk), ToObject (GenTx blk)) => Transformable Text IO (TraceLabelPeer peer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))) where trTransformer = trStructured @@ -668,12 +674,29 @@ instance (ToObject peer, Show (TxId (GenTx blk)), Show (GenTx blk)) => Transformable Text IO (TraceLabelPeer peer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))) where trTransformer = trStructured -instance Transformable Text IO (TraceTxSubmissionInbound txid tx) where - trTransformer = trStructuredText -instance HasTextFormatter (TraceTxSubmissionInbound txid tx) where +instance (ToJSON txid, ToObject tx) => Transformable Text IO (TraceTxSubmissionInbound txid tx) where + trTransformer = trStructured +instance (Show txid, Show tx) => HasTextFormatter (TraceTxSubmissionInbound txid tx) where formatText a _ = pack (show a) +instance ( ToJSON txid + , ToObject tx + , Aeson.ToJSONKey peer + , Aeson.ToJSONKey txid + ) => Transformable Text IO (TraceTxLogic peer txid tx) where + trTransformer = trStructured + +instance ( ToJSON txid + , ToObject tx + , ToObject peer + , Aeson.ToJSONKey peer + , Aeson.ToJSONKey txid + ) => Transformable Text IO (TraceLabelPeer peer (TraceTxLogic peer txid tx)) where + trTransformer = trStructured +instance (Show txid, Show tx, Show peer) => HasTextFormatter (TraceTxLogic peer txid tx) where + formatText a _ = pack (show a) + instance (Show tx, Show txid) => Transformable Text IO (TraceTxSubmissionOutbound txid tx) where trTransformer = trStructuredText @@ -1263,8 +1286,16 @@ instance ToObject (AnyMessageAndAgency ps) toObject verb (TraceRecvMsg m) = mconcat [ "kind" .= String "Recv" , "msg" .= toObject verb m ] +instance (ToJSON txid, ToObject tx) => ToObject (TxDecision txid tx) where + toObject verb (TxDecision idsToAck idsToReq pipeline txsToReq txsToMempool) = + mconcat [ "txIdsToAcknowledge" .= getNumTxIdsToAck idsToAck + , "txIdsToRequest" .= getNumTxIdsToReq idsToReq + , "pipelineTxIds" .= pipeline + , "txsToRequest" .= txsToReq + , "txsToMempool" .= toJSON (map (toObject verb) txsToMempool) + ] -instance ToObject (TraceTxSubmissionInbound txid tx) where +instance (ToJSON txid, ToObject tx) => ToObject (TraceTxSubmissionInbound txid tx) where toObject _verb (TraceTxSubmissionCollected count) = mconcat [ "kind" .= String "TxSubmissionCollected" @@ -1290,7 +1321,63 @@ instance ToObject (TraceTxSubmissionInbound txid tx) where [ "kind" .= String "TxInboundCannotRequestMoreTxs" , "count" .= toJSON count ] + toObject _verb (TraceTxInboundAddedToMempool txids) = + mconcat + [ "kind" .= String "TxInboundAddedToMempool" + , "txids" .= txids + ] + toObject verb (TraceTxInboundDecision td) = + mconcat + [ "kind" .= String "TxInboundDecision" + , "decision" .= toObject verb td + ] + +instance ( ToJSON txid + , ToObject tx + , Aeson.ToJSONKey txid + ) => ToJSON (PeerTxState txid tx) where + toJSON PeerTxState {..} = + Aeson.object + [ "kind" .= String "PeerTxState" + , "unacknowledgedTxIds" .= unacknowledgedTxIds + , "availableTxIds" .= fmap getSizeInBytes availableTxIds + , "requestedTxIdsInflight" .= getNumTxIdsToReq requestedTxIdsInflight + , "requestedTxsInflightSize" .= getSizeInBytes requestedTxsInflightSize + , "requestedTxsInflight" .= requestedTxsInflight + , "unknownTxs" .= unknownTxs + ] + +instance ( ToJSON txid + , ToObject tx + , Aeson.ToJSONKey peer + , Aeson.ToJSONKey txid + ) => ToObject (SharedTxState peer txid tx) where + toObject verb SharedTxState {..} = + mconcat + [ "kind" .= String "SharedTxState" + , "peerTxStates" .= peerTxStates + , "inflightTxs" .= inflightTxs + , "inflightTxsSize" .= getSizeInBytes inflightTxsSize + , "bufferedTxs" .= fmap (toObject verb <$>) bufferedTxs + , "referenceCounts" .= referenceCounts + ] +instance ( ToJSON txid + , ToObject tx + , Aeson.ToJSONKey peer + , Aeson.ToJSONKey txid + ) => ToObject (TraceTxLogic peer txid tx) where + toObject verb (TraceSharedTxState s st) = + mconcat + [ "kind" .= String "SharedTxState" + , "name" .= s + , "sharedState" .= toObject verb st + ] + toObject verb (TraceTxDecisions m) = + mconcat + [ "kind" .= String "TxDecisions" + , "decisions" .= fmap (toObject verb) m + ] instance Aeson.ToJSONKey SockAddr where diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 4ca0bf61f09..9b33b5e929b 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -71,7 +71,7 @@ import Ouroboros.Consensus.Ledger.Extended (ledgerState) import Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent) import Ouroboros.Consensus.Ledger.Query (BlockQuery) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs, - LedgerSupportsMempool) + LedgerSupportsMempool, ByteSize32 (..)) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server @@ -116,7 +116,7 @@ import qualified Control.Concurrent.STM as STM import Control.Monad (forM_, when) import "contra-tracer" Control.Tracer import Control.Tracer.Transformers -import Data.Aeson (ToJSON (..), Value (..)) +import Data.Aeson (ToJSON (..), Value (..), ToJSONKey) import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Base16 as B16 import Data.Functor ((<&>)) @@ -318,6 +318,8 @@ mkTracers :: forall blk p2p. ( Consensus.RunNode blk , TraceConstraints blk + , ToJSON (GenTxId blk) + , ToJSONKey (GenTxId blk) ) => BlockConfig blk -> TraceOptions @@ -511,6 +513,7 @@ mkTracers _ _ _ _ _ enableP2P = , Consensus.blockchainTimeTracer = nullTracer , Consensus.consensusErrorTracer = nullTracer , Consensus.gsmTracer = nullTracer + , Consensus.txLogicTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -524,6 +527,7 @@ mkTracers _ _ _ _ _ enableP2P = , NodeToNode.tBlockFetchTracer = nullTracer , NodeToNode.tBlockFetchSerialisedTracer = nullTracer , NodeToNode.tTxSubmission2Tracer = nullTracer + , NodeToNode.tTxLogicTracer = nullTracer } , diffusionTracers = Diffusion.nullTracers , diffusionTracersExtra = @@ -723,6 +727,7 @@ mkConsensusTracers , Eq peer , LedgerQueries blk , ToJSON (GenTxId blk) + , ToJSONKey (GenTxId blk) , ToObject (ApplyTxErr blk) , ToObject (CannotForge blk) , ToObject (GenTx blk) @@ -734,6 +739,7 @@ mkConsensusTracers , Consensus.RunNode blk , HasKESMetricsData blk , HasKESInfo blk + , ToJSONKey peer ) => Maybe EKGDirect -> TraceSelection @@ -795,6 +801,8 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do TraceLabelPeer _ TraceTxInboundTerminated -> return () TraceLabelPeer _ (TraceTxInboundCanRequestMoreTxs _) -> return () TraceLabelPeer _ (TraceTxInboundCannotRequestMoreTxs _) -> return () + TraceLabelPeer _ (TraceTxInboundAddedToMempool _) -> return () + TraceLabelPeer _ (TraceTxInboundDecision _) -> return () , Consensus.txOutboundTracer = tracerOnOff (traceTxOutbound trSel) verb "TxOutbound" tr , Consensus.localTxSubmissionServerTracer = tracerOnOff (traceLocalTxSubmissionServer trSel) verb "LocalTxSubmissionServer" tr @@ -811,6 +819,7 @@ 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.txLogicTracer = tracerOnOff (traceTxLogic trSel) verb "TxLogic" tr } where mkForgeTracers :: IO ForgeTracers @@ -1263,8 +1272,10 @@ mempoolMetricsTraceTransformer tr = Tracer $ \mempoolEvent -> do TraceMempoolManuallyRemovedTxs txs0 txs1 tot0 -> ( length txs0 + length txs1, tot0) logValue1 :: LOContent a logValue1 = LogValue "txsInMempool" $ PureI $ fromIntegral (msNumTxs tot) + + ByteSize32 w = msNumBytes tot logValue2 :: LOContent a - logValue2 = LogValue "mempoolBytes" $ PureI $ fromIntegral (msNumBytes tot) + logValue2 = LogValue "mempoolBytes" $ PureI $ fromIntegral w meta <- mkLOMeta Critical Confidential traceNamedObject tr' (meta, logValue1) traceNamedObject tr' (meta, logValue2) @@ -1412,7 +1423,11 @@ nodeToNodeTracers' , ConvertTxId blk , HasTxs blk , Show peer + , ToJSONKey peer , ToObject peer + , ToObject (GenTx blk) + , ToJSON (GenTxId blk) + , ToJSONKey (GenTxId blk) ) => TraceSelection -> TracingVerbosity @@ -1435,6 +1450,9 @@ nodeToNodeTracers' trSel verb tr = , NodeToNode.tTxSubmission2Tracer = tracerOnOff (traceTxSubmissionProtocol trSel) verb "TxSubmissionProtocol" tr + , NodeToNode.tTxLogicTracer = + tracerOnOff (traceTxLogic trSel) + verb "TxLogic" tr } teeTraceBlockFetchDecision diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index 3e46cbd6e86..98c947bb532 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -18,6 +18,7 @@ import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnaps SnapshotInterval (..)) import Ouroboros.Network.Block (SlotNo (..)) import Ouroboros.Network.Diffusion.Configuration +import Ouroboros.Network.TxSubmission.Inbound.Server (EnableNewTxSubmissionProtocol (..)) import Data.Monoid (Last (..)) import Data.Text (Text) @@ -147,7 +148,9 @@ testPartialYamlConfig = , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) - , pncConsensusMode = Last (Just PraosMode) + , pncConsensusMode = mempty + , pncMinBigLedgerPeersForTrustedState = mempty + , pncEnableNewTxSubmissionProtocol = mempty } -- | Example partial configuration theoretically created @@ -192,7 +195,9 @@ testPartialCliConfig = , pncGenesisTargetNumberOfActiveBigLedgerPeers = mempty , pncEnableP2P = Last (Just DisabledP2PMode) , pncPeerSharing = Last (Just PeerSharingDisabled) - , pncConsensusMode = Last (Just GenesisMode) + , pncConsensusMode = Last (Just PraosMode) + , pncMinBigLedgerPeersForTrustedState = Last (Just Configuration.defaultMinBigLedgerPeersForTrustedState) + , pncEnableNewTxSubmissionProtocol = Last (Just EnableNewTxSubmissionProtocol) } -- | Expected final NodeConfiguration @@ -243,7 +248,9 @@ eExpectedConfig = do , ncGenesisTargetNumberOfActiveBigLedgerPeers = 30 , ncEnableP2P = SomeNetworkP2PMode Consensus.DisabledP2PMode , ncPeerSharing = PeerSharingDisabled - , ncConsensusMode = GenesisMode + , ncConsensusMode = PraosMode + , ncMinBigLedgerPeersForTrustedState = Configuration.defaultMinBigLedgerPeersForTrustedState + , ncEnableNewTxSubmissionProtocol = EnableNewTxSubmissionProtocol } -- ----------------------------------------------------------------------------- diff --git a/nix/haskell.nix b/nix/haskell.nix index cf21a4cfd12..c8eb259ec68 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -126,6 +126,7 @@ let packages.cardano-protocol-tpraos.components.library.doHaddock = false; packages.ouroboros-consensus-cardano.components.library.doHaddock = false; packages.ouroboros-consensus.components.library.doHaddock = false; + packages.fs-api.components.library.doHaddock = false; }) ({ lib, pkgs, ...}: lib.mkIf (pkgs.stdenv.hostPlatform.isWindows) { # Remvoe this once mingwx is mapped to null in haskell.nix (haskell.nix#2032), and we bumped _past_ that.