From b53311020e6c5e850f692c228152e7a9b765bdd4 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Tue, 27 Jan 2026 07:08:56 -0800 Subject: [PATCH 1/3] Add txsMempoolTimeoutSoft and txsMempoolTimeoutHard counters --- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 20 +++++- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 50 +++++++++++++- cardano-node/src/Cardano/Tracing/Tracers.hs | 65 ++++++++++++++++--- .../Handlers/RTView/State/Historical.hs | 2 + .../Tracer/Handlers/RTView/UI/Charts.hs | 2 + .../Tracer/Handlers/RTView/UI/HTML/Body.hs | 19 +++++- .../Tracer/Handlers/RTView/UI/Types.hs | 2 + .../Handlers/RTView/Update/Transactions.hs | 10 +++ 8 files changed, 155 insertions(+), 15 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 712f185e832..68ccecf4f97 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -18,6 +18,8 @@ module Cardano.Node.Tracing.Tracers.Consensus , calculateBlockFetchClientMetrics , servedBlockLatest , ClientMetrics + , txsMempoolTimeoutSoftCounterName + , impliesMempoolTimeoutSoft ) where @@ -1241,6 +1243,17 @@ instance MetaTrace (TraceLocalTxSubmissionServerEvent blk) where -- Mempool Tracer -------------------------------------------------------------------------------- +txsMempoolTimeoutSoftCounterName :: Text.Text +txsMempoolTimeoutSoftCounterName = "txsMempoolTimeoutSoft" + +impliesMempoolTimeoutSoft :: + LedgerSupportsMempool blk => TraceEventMempool blk -> Bool +impliesMempoolTimeoutSoft = \case + TraceMempoolRejectedTx _tx txApplyErr _mpSz -> + -- TODO export a proper predicate from Consensus + "ApplyTxError (ConwayMempoolFailure" `List.isPrefixOf` show txApplyErr + _ -> False + instance ( LogFormatting (ApplyTxErr blk) , LogFormatting (GenTx blk) @@ -1311,10 +1324,14 @@ instance [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) , IntM "mempoolBytes" (fromIntegral . unByteSize32 . msNumBytes $ mpSz) ] - asMetrics (TraceMempoolRejectedTx _tx _txApplyErr _ mpSz) = + asMetrics ev@(TraceMempoolRejectedTx _tx _txApplyErr mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) , IntM "mempoolBytes" (fromIntegral . unByteSize32 . msNumBytes $ mpSz) ] + ++ + [ CounterM txsMempoolTimeoutSoftCounterName Nothing + | impliesMempoolTimeoutSoft ev + ] asMetrics (TraceMempoolRemoveTxs txs mpSz) = [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz) , IntM "mempoolBytes" (fromIntegral . unByteSize32 . msNumBytes $ mpSz) @@ -1370,6 +1387,7 @@ instance MetaTrace (TraceEventMempool blk) where metricsDocFor (Namespace _ ["RejectedTx"]) = [ ("txsInMempool","Transactions in mempool") , ("mempoolBytes", "Byte size of the mempool") + , (txsMempoolTimeoutSoftCounterName, "Transactions that soft timed out in mempool") ] metricsDocFor (Namespace _ ["RemoveTxs"]) = [ ("txsInMempool","Transactions in mempool") diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 18f9130998b..840076510db 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -3,20 +3,26 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Node.Tracing.Tracers.Diffusion - () where + ( txsMempoolTimeoutHardCounterName + , impliesMempoolTimeoutHard + ) where import Cardano.Logging import Cardano.Node.Configuration.TopologyP2P () +import Control.Exception (fromException) +import Ouroboros.Consensus.Mempool.API (ExnMempoolTimeout) import qualified Ouroboros.Network.Diffusion.Types as Diff import Ouroboros.Network.PeerSelection.LedgerPeers (NumberOfPeers (..), PoolStake (..), TraceLedgerPeers (..)) @@ -356,6 +362,16 @@ instance MetaTrace Mux.ChannelTrace where , Namespace [] ["ChannelSendEnd"] ] +txsMempoolTimeoutHardCounterName :: Text +txsMempoolTimeoutHardCounterName = "txsMempoolTimeoutHard" + +impliesMempoolTimeoutHard :: Mux.Trace -> Bool +impliesMempoolTimeoutHard = \case + Mux.TraceExceptionExit _mid _dir e + | Just _ <- fromException @ExnMempoolTimeout e + -> True + _ -> False + instance LogFormatting Mux.Trace where forMachine _dtal (Mux.TraceState new) = mconcat [ "kind" .= String "Mux.TraceState" @@ -435,6 +451,24 @@ instance LogFormatting Mux.Trace where forHuman Mux.TraceStopping = "Mux stopping" forHuman Mux.TraceStopped = "Mux stoppped" + asMetrics = \case + Mux.TraceState{} -> [] + Mux.TraceCleanExit{} -> [] + ev@Mux.TraceExceptionExit{} -> + -- Somewhat awkward to "catch" this Consensus exception here, but + -- Diffusion Layer is indeed the ultimate manager of the per-peer + -- threads. + [ CounterM txsMempoolTimeoutHardCounterName Nothing + | impliesMempoolTimeoutHard ev + ] + Mux.TraceStartEagerly{} -> [] + Mux.TraceStartOnDemand{} -> [] + Mux.TraceStartOnDemandAny{} -> [] + Mux.TraceStartedOnDemand{} -> [] + Mux.TraceTerminating{} -> [] + Mux.TraceStopping{} -> [] + Mux.TraceStopped{} -> [] + instance MetaTrace Mux.Trace where namespaceFor Mux.TraceState {} = Namespace [] ["State"] @@ -491,6 +525,20 @@ instance MetaTrace Mux.Trace where "Mux shutdown." documentFor _ = Nothing + metricsDocFor (Namespace _ ["State"]) = [] + metricsDocFor (Namespace _ ["CleanExit"]) = [] + metricsDocFor (Namespace _ ["ExceptionExit"]) = + [ (txsMempoolTimeoutHardCounterName, "Transactions that hard timed out in mempool") + ] + metricsDocFor (Namespace _ ["StartEagerly"]) = [] + metricsDocFor (Namespace _ ["StartOnDemand"]) = [] + metricsDocFor (Namespace _ ["StartedOnDemand"]) = [] + metricsDocFor (Namespace _ ["StartOnDemandAny"]) = [] + metricsDocFor (Namespace _ ["Terminating"]) = [] + metricsDocFor (Namespace _ ["Stopping"]) = [] + metricsDocFor (Namespace _ ["Stopped"]) = [] + metricsDocFor _ = [] + allNamespaces = [ Namespace [] ["State"] , Namespace [] ["CleanExit"] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 38a4134586e..93cb416b5e2 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -43,6 +43,8 @@ import Cardano.Node.Startup import qualified Cardano.Node.STM as STM import Cardano.Node.TraceConstraints import Cardano.Node.Tracing +import qualified Cardano.Node.Tracing.Tracers.Consensus as ConsensusTracers +import qualified Cardano.Node.Tracing.Tracers.Diffusion as DiffusionTracers import Cardano.Node.Tracing.Tracers.NodeVersion import Cardano.Network.Diffusion (CardanoPeerSelectionCounters) import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) @@ -80,6 +82,8 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import Ouroboros.Consensus.Util.Enclose +import qualified Network.Mux as Mux + import qualified Cardano.Network.Diffusion.Types as Cardano.Diffusion import qualified Cardano.Network.PeerSelection.Governor.Types as Cardano @@ -388,7 +392,7 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect = do diffusionTracers :: Cardano.Diffusion.CardanoTracers IO diffusionTracers = Cardano.Diffusion.Tracers - { Diffusion.dtMuxTracer = muxTracer + { Diffusion.dtMuxTracer = muxTracer ekgDirect trSel tr , Diffusion.dtChannelTracer = channelTracer , Diffusion.dtBearerTracer = bearerTracer , Diffusion.dtHandshakeTracer = handshakeTracer @@ -464,8 +468,6 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect = do } verb :: TracingVerbosity verb = traceVerbosity trSel - muxTracer = - tracerOnOff (traceMux trSel) verb "Mux" tr channelTracer = tracerOnOff (traceMux trSel) verb "MuxChannel" tr bearerTracer = @@ -537,6 +539,32 @@ mkTracers _ _ _ _ _ = , ledgerMetricsTracer = nullTracer } +-------------------------------------------------------------------------------- +-- Diffusion Layer Tracers +-------------------------------------------------------------------------------- + +notifyTxsMempoolTimeoutHard :: Maybe EKGDirect -> Tracer IO Mux.Trace +notifyTxsMempoolTimeoutHard mbEKGDirect = case mbEKGDirect of + Nothing -> nullTracer + Just ekgDirect -> Tracer $ \ev -> do + when (DiffusionTracers.impliesMempoolTimeoutHard ev) $ do + sendEKGDirectCounter ekgDirect DiffusionTracers.txsMempoolTimeoutHardCounterName + +muxTracer + :: Maybe EKGDirect + -> TraceSelection + -> Trace IO Text + -> Tracer IO (Mux.WithBearer (ConnectionId RemoteAddress) Mux.Trace) +muxTracer mbEKGDirect trSel tracer = Tracer $ \ev -> do + -- Update the EKG metric even when this tracer is turned off. + flip traceWith (Mux.wbEvent ev) $ + notifyTxsMempoolTimeoutHard mbEKGDirect + whenOn (traceMux trSel) $ do + flip traceWith ev $ + annotateSeverity $ + toLogObject' (traceVerbosity trSel) $ + appendName "Mux" tracer + -------------------------------------------------------------------------------- -- Chain DB Tracers -------------------------------------------------------------------------------- @@ -796,7 +824,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.txOutboundTracer = tracerOnOff (traceTxOutbound trSel) verb "TxOutbound" tr , Consensus.localTxSubmissionServerTracer = tracerOnOff (traceLocalTxSubmissionServer trSel) verb "LocalTxSubmissionServer" tr - , Consensus.mempoolTracer = tracerOnOff' (traceMempool trSel) $ mempoolTracer trSel tr fStats + , Consensus.mempoolTracer = mempoolTracer mbEKGDirect trSel tr fStats , Consensus.forgeTracer = tracerOnOff' (traceForge trSel) $ Tracer $ \tlcev@Consensus.TraceLabelCreds{} -> do traceWith (annotateSeverity @@ -1243,6 +1271,16 @@ notifyBlockForging fStats tr = Tracer $ \case -- Mempool Tracers -------------------------------------------------------------------------------- +notifyTxsMempoolTimeoutSoft :: + LedgerSupportsMempool blk + => Maybe EKGDirect + -> Tracer IO (TraceEventMempool blk) +notifyTxsMempoolTimeoutSoft mbEKGDirect = case mbEKGDirect of + Nothing -> nullTracer + Just ekgDirect -> Tracer $ \ev -> do + when (ConsensusTracers.impliesMempoolTimeoutSoft ev) $ do + sendEKGDirectCounter ekgDirect ConsensusTracers.txsMempoolTimeoutSoftCounterName + notifyTxsProcessed :: ForgingStats -> Trace IO Text -> Tracer IO (TraceEventMempool blk) notifyTxsProcessed fStats tr = Tracer $ \case TraceMempoolRemoveTxs [] _ -> return () @@ -1287,15 +1325,19 @@ mempoolTracer , LedgerSupportsMempool blk , ConvertRawHash blk ) - => TraceSelection + => Maybe EKGDirect + -> TraceSelection -> Trace IO Text -> ForgingStats -> Tracer IO (TraceEventMempool blk) -mempoolTracer tc tracer fStats = Tracer $ \ev -> do - traceWith (mempoolMetricsTraceTransformer tracer) ev - traceWith (notifyTxsProcessed fStats tracer) ev - let tr = appendName "Mempool" tracer - traceWith (mpTracer tc tr) ev +mempoolTracer mbEKGDirect tc tracer fStats = Tracer $ \ev -> do + -- Update the EKG metric even when this tracer is turned off. + traceWith (notifyTxsMempoolTimeoutSoft mbEKGDirect) ev + whenOn (traceMempool tc) $ do + traceWith (mempoolMetricsTraceTransformer tracer) ev + traceWith (notifyTxsProcessed fStats tracer) ev + let tr = appendName "Mempool" tracer + traceWith (mpTracer tc tr) ev mpTracer :: ( ToJSON (GenTxId blk) , ToObject (ApplyTxErr blk) @@ -1788,6 +1830,9 @@ tracerOnOff' tracerOnOff' (OnOff False) _ = nullTracer tracerOnOff' (OnOff True) tr = tr +whenOn :: Monad m => OnOff b -> m () -> m () +whenOn (OnOff b) = when b + instance Show a => Show (WithSeverity a) where show (WithSeverity _sev a) = show a diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs index a3e345cfd33..e122dcca4df 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs @@ -124,6 +124,8 @@ data DataName | TxsProcessedNumData | MempoolBytesData | TxsInMempoolData + | TxsMempoolTimeoutSoftData + | TxsMempoolTimeoutHardData deriving (Eq, Ord, Read, Show) type HistoricalData = Map DataName HistoricalPoints diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs index c426162a2b0..b7c8ee8aad3 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs @@ -320,6 +320,8 @@ dataNameToChartId dataName = TxsProcessedNumData -> TxsProcessedNumChart MempoolBytesData -> MempoolBytesChart TxsInMempoolData -> TxsInMempoolChart + TxsMempoolTimeoutSoftData -> TxsMempoolTimeoutSoftChart + TxsMempoolTimeoutHardData -> TxsMempoolTimeoutHardChart getSavedColorForNode :: TracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs index 1fac5b69679..caf8d202558 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs @@ -53,6 +53,11 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do mempoolBytesChart <- mkChart mempoolBytesTimer MempoolBytesData MempoolBytesChart "Mempool size" txsInMempoolChart <- mkChart txsInMempoolTimer TxsInMempoolData TxsInMempoolChart "Txs in mempool" + txsMempoolTimeoutSoftTimer <- mkChartTimer tracerEnv tHistory dsIxs TxsMempoolTimeoutSoftData TxsMempoolTimeoutSoftChart + txsMempoolTimeoutHardTimer <- mkChartTimer tracerEnv tHistory dsIxs TxsMempoolTimeoutHardData TxsMempoolTimeoutHardChart + txsMempoolTimeoutSoftChart <- mkChart txsMempoolTimeoutSoftTimer TxsMempoolTimeoutSoftData TxsMempoolTimeoutSoftChart "Txs that soft timed out in mempool" + txsMempoolTimeoutHardChart <- mkChart txsMempoolTimeoutHardTimer TxsMempoolTimeoutHardData TxsMempoolTimeoutHardChart "Txs that hard timed out in mempool" + -- Resources charts. cpuTimer <- mkChartTimer tracerEnv rHistory dsIxs CPUData CPUChart memoryTimer <- mkChartTimer tracerEnv rHistory dsIxs MemoryData MemoryChart @@ -298,6 +303,8 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do ] , UI.div #. "column" #+ [ element txsInMempoolChart + , element txsMempoolTimeoutSoftChart + , element txsMempoolTimeoutHardChart ] ] -- Resources charts. @@ -336,9 +343,11 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do Chart.prepareChartsJS - Chart.newTimeChartJS TxsProcessedNumChart "" - Chart.newTimeChartJS MempoolBytesChart "MB" - Chart.newTimeChartJS TxsInMempoolChart "" + Chart.newTimeChartJS TxsProcessedNumChart "" + Chart.newTimeChartJS MempoolBytesChart "MB" + Chart.newTimeChartJS TxsInMempoolChart "" + Chart.newTimeChartJS TxsMempoolTimeoutSoftChart "" + Chart.newTimeChartJS TxsMempoolTimeoutHardChart "" Chart.newTimeChartJS CPUChart "Percent" Chart.newTimeChartJS MemoryChart "MB" @@ -370,6 +379,8 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do UI.start txsProcessedNumTimer UI.start mempoolBytesTimer UI.start txsInMempoolTimer + UI.start txsMempoolTimeoutSoftTimer + UI.start txsMempoolTimeoutHardTimer UI.start cpuTimer UI.start memoryTimer @@ -400,6 +411,8 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do UI.stop txsProcessedNumTimer UI.stop mempoolBytesTimer UI.stop txsInMempoolTimer + UI.stop txsMempoolTimeoutSoftTimer + UI.stop txsMempoolTimeoutHardTimer UI.stop cpuTimer UI.stop memoryTimer diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs index 73f9f6d482a..bb037150f33 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs @@ -50,6 +50,8 @@ data ChartId | TxsProcessedNumChart | MempoolBytesChart | TxsInMempoolChart + | TxsMempoolTimeoutSoftChart + | TxsMempoolTimeoutHardChart deriving (Bounded, Enum, Generic, FromJSON, ToJSON, Show) data ChartSelectId diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs index 87466300188..3bfd9032af0 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs @@ -27,6 +27,10 @@ updateTransactionsHistory nodeId (TXHistory tHistory) metricName metricValue now | "txsProcessedNum" `isInfixOf` metricName -> updateTxsProcessedNum | "mempoolBytes" `isInfixOf` metricName -> updateMempoolBytes | "txsInMempool" `isInfixOf` metricName -> updateTxsInMempool + | "txsMempoolTimeoutSoft" `isInfixOf` metricName + -> updateTxsMempoolTimeoutSoft + | "txsMempoolTimeoutHard" `isInfixOf` metricName + -> updateTxsMempoolTimeoutHard | otherwise -> return () where updateTxsProcessedNum = @@ -41,3 +45,9 @@ updateTransactionsHistory nodeId (TXHistory tHistory) metricName metricValue now Right (mempoolBytes :: Int, _) -> do let !mempoolInMB = fromIntegral mempoolBytes / 1024 / 1024 :: Double addHistoricalData tHistory nodeId now MempoolBytesData $ ValueD mempoolInMB + + updateTxsMempoolTimeoutSoft = + readValueI metricValue $ addHistoricalData tHistory nodeId now TxsMempoolTimeoutSoftData + + updateTxsMempoolTimeoutHard = + readValueI metricValue $ addHistoricalData tHistory nodeId now TxsMempoolTimeoutHardData From 40a1e702b25430571b7f794585976b5fbd3cffee Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Tue, 27 Jan 2026 14:25:09 -0800 Subject: [PATCH 2/3] Add MempoolTimeoutSoftPredicate, ought to live in Consensus Layer --- .../src/Cardano/Node/TraceConstraints.hs | 3 + .../Cardano/Node/Tracing/Tracers/Consensus.hs | 56 ++++++++++++++++++- cardano-node/src/Cardano/Tracing/Tracers.hs | 4 +- 3 files changed, 59 insertions(+), 4 deletions(-) diff --git a/cardano-node/src/Cardano/Node/TraceConstraints.hs b/cardano-node/src/Cardano/Node/TraceConstraints.hs index 41ff18840f6..b837c757974 100644 --- a/cardano-node/src/Cardano/Node/TraceConstraints.hs +++ b/cardano-node/src/Cardano/Node/TraceConstraints.hs @@ -13,6 +13,7 @@ import Cardano.Ledger.Keys import Cardano.Logging (LogFormatting) import Cardano.Node.Queries (ConvertTxId, GetKESInfo (..), HasKESInfo (..), HasKESMetricsData (..), LedgerQueries) +import qualified Cardano.Node.Tracing.Tracers.Consensus as ConsensusTracers import Cardano.Protocol.Crypto (StandardCrypto) import Cardano.Tracing.HasIssuer (HasIssuer) import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateUpdateError, @@ -73,4 +74,6 @@ type TraceConstraints blk = , LogFormatting (ForgeStateUpdateError blk) , LogFormatting (Set (Credential 'Staking)) , LogFormatting (NonEmpty.NonEmpty (KeyHash 'Staking)) + + , ConsensusTracers.MempoolTimeoutSoftPredicate blk ) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 68ccecf4f97..293e99b7fe9 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -19,6 +20,8 @@ module Cardano.Node.Tracing.Tracers.Consensus , servedBlockLatest , ClientMetrics , txsMempoolTimeoutSoftCounterName + , MempoolTimeoutSoftPredicate (..) + , EraMempoolTimeoutSoftPredicate (..) , impliesMempoolTimeoutSoft ) where @@ -80,12 +83,23 @@ import Data.Int (Int64) import Data.IntPSQ (IntPSQ) import qualified Data.IntPSQ as Pq import qualified Data.List as List +import qualified Data.List.NonEmpty as NE import qualified Data.Text as Text import Data.Time (NominalDiffTime) import Data.Word (Word32, Word64) import Network.TypedProtocol.Core +-- all for MempoolTimeoutSoftPredicate +import qualified Cardano.Ledger.Conway.Rules as Conway +import qualified Cardano.Ledger.Core as SL (EraRule) +import qualified Cardano.Ledger.Shelley.API as SL (ApplyTxError (..)) +import qualified Data.SOP as SOP +import Ouroboros.Consensus.Byron.Ledger.Block as Consensus +import Ouroboros.Consensus.HardFork.Combinator as Consensus +import Ouroboros.Consensus.Shelley.Ledger.Block as Consensus +import Ouroboros.Consensus.TypeFamilyWrappers as Consensus + instance (LogFormatting adr, Show adr) => LogFormatting (ConnectionId adr) where forMachine _dtal (ConnectionId local' remote) = mconcat [ "connectionId" .= String (showT local' @@ -1247,19 +1261,55 @@ txsMempoolTimeoutSoftCounterName :: Text.Text txsMempoolTimeoutSoftCounterName = "txsMempoolTimeoutSoft" impliesMempoolTimeoutSoft :: - LedgerSupportsMempool blk => TraceEventMempool blk -> Bool + forall blk. MempoolTimeoutSoftPredicate blk => TraceEventMempool blk -> Bool impliesMempoolTimeoutSoft = \case TraceMempoolRejectedTx _tx txApplyErr _mpSz -> - -- TODO export a proper predicate from Consensus - "ApplyTxError (ConwayMempoolFailure" `List.isPrefixOf` show txApplyErr + errImpliesMempoolTimeoutSoft (Proxy @blk) txApplyErr _ -> False +class MempoolTimeoutSoftPredicate blk where + -- | Does the error indicate a mempool timeout + errImpliesMempoolTimeoutSoft :: proxy blk -> ApplyTxErr blk -> Bool + +instance SOP.All MempoolTimeoutSoftPredicate xs => MempoolTimeoutSoftPredicate (Consensus.HardForkBlock xs) where + errImpliesMempoolTimeoutSoft _prx = \case + Consensus.HardForkApplyTxErrWrongEra{} -> False + Consensus.HardForkApplyTxErrFromEra (Consensus.OneEraApplyTxErr ns) -> + SOP.hcollapse $ SOP.hcmap (Proxy @MempoolTimeoutSoftPredicate) f ns + where + f :: forall x. MempoolTimeoutSoftPredicate x => Consensus.WrapApplyTxErr x -> SOP.K Bool x + f (Consensus.WrapApplyTxErr err) = SOP.K $ errImpliesMempoolTimeoutSoft (Proxy @x) err + +instance MempoolTimeoutSoftPredicate Consensus.ByronBlock where + errImpliesMempoolTimeoutSoft = \_prx _err -> False + +instance EraMempoolTimeoutSoftPredicate era => MempoolTimeoutSoftPredicate (Consensus.ShelleyBlock proto era) where + errImpliesMempoolTimeoutSoft _prx = \case + SL.ApplyTxError (err NE.:| errs) -> + null errs && eraImpliesMempoolTimeoutSoft (Proxy @era) err + +class EraMempoolTimeoutSoftPredicate era where + -- | Does the error indicate a mempool timeout + eraImpliesMempoolTimeoutSoft :: proxy era -> Conway.PredicateFailure (SL.EraRule "LEDGER" era) -> Bool + +instance EraMempoolTimeoutSoftPredicate ShelleyEra where eraImpliesMempoolTimeoutSoft _prx _err = False +instance EraMempoolTimeoutSoftPredicate AllegraEra where eraImpliesMempoolTimeoutSoft _prx _err = False +instance EraMempoolTimeoutSoftPredicate MaryEra where eraImpliesMempoolTimeoutSoft _prx _err = False +instance EraMempoolTimeoutSoftPredicate AlonzoEra where eraImpliesMempoolTimeoutSoft _prx _err = False +instance EraMempoolTimeoutSoftPredicate BabbageEra where eraImpliesMempoolTimeoutSoft _prx _err = False +instance EraMempoolTimeoutSoftPredicate ConwayEra where + eraImpliesMempoolTimeoutSoft _prx = \case + Conway.ConwayMempoolFailure txt -> Text.pack "MempoolTxTooSlow" `Text.isPrefixOf` txt + _ -> False +instance EraMempoolTimeoutSoftPredicate DijkstraEra where eraImpliesMempoolTimeoutSoft _prx _err = False + instance ( LogFormatting (ApplyTxErr blk) , LogFormatting (GenTx blk) , ToJSON (GenTxId blk) , LedgerSupportsMempool blk , ConvertRawHash blk + , MempoolTimeoutSoftPredicate blk ) => LogFormatting (TraceEventMempool blk) where forMachine dtal (TraceMempoolAddedTx tx _mpSzBefore mpSzAfter) = mconcat diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 93cb416b5e2..2f183bff6e6 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -758,6 +758,7 @@ mkConsensusTracers , ToObject (ValidationErr (BlockProtocol blk)) , ToObject (ForgeStateUpdateError blk) , Consensus.RunNode blk + , ConsensusTracers.MempoolTimeoutSoftPredicate blk , HasKESMetricsData blk , HasKESInfo blk ) @@ -1272,7 +1273,7 @@ notifyBlockForging fStats tr = Tracer $ \case -------------------------------------------------------------------------------- notifyTxsMempoolTimeoutSoft :: - LedgerSupportsMempool blk + ConsensusTracers.MempoolTimeoutSoftPredicate blk => Maybe EKGDirect -> Tracer IO (TraceEventMempool blk) notifyTxsMempoolTimeoutSoft mbEKGDirect = case mbEKGDirect of @@ -1323,6 +1324,7 @@ mempoolTracer , ToObject (ApplyTxErr blk) , ToObject (GenTx blk) , LedgerSupportsMempool blk + , ConsensusTracers.MempoolTimeoutSoftPredicate blk , ConvertRawHash blk ) => Maybe EKGDirect From 30ecaad9e8f5a05ceff62366c49437386a2fd007 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Wed, 28 Jan 2026 08:19:53 -0800 Subject: [PATCH 3/3] Revert changes to cardano-tracer (since rtview is dead) --- .../Handlers/RTView/State/Historical.hs | 2 -- .../Tracer/Handlers/RTView/UI/Charts.hs | 2 -- .../Tracer/Handlers/RTView/UI/HTML/Body.hs | 19 +++---------------- .../Tracer/Handlers/RTView/UI/Types.hs | 2 -- .../Handlers/RTView/Update/Transactions.hs | 10 ---------- 5 files changed, 3 insertions(+), 32 deletions(-) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs index e122dcca4df..a3e345cfd33 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs @@ -124,8 +124,6 @@ data DataName | TxsProcessedNumData | MempoolBytesData | TxsInMempoolData - | TxsMempoolTimeoutSoftData - | TxsMempoolTimeoutHardData deriving (Eq, Ord, Read, Show) type HistoricalData = Map DataName HistoricalPoints diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs index b7c8ee8aad3..c426162a2b0 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs @@ -320,8 +320,6 @@ dataNameToChartId dataName = TxsProcessedNumData -> TxsProcessedNumChart MempoolBytesData -> MempoolBytesChart TxsInMempoolData -> TxsInMempoolChart - TxsMempoolTimeoutSoftData -> TxsMempoolTimeoutSoftChart - TxsMempoolTimeoutHardData -> TxsMempoolTimeoutHardChart getSavedColorForNode :: TracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs index caf8d202558..1fac5b69679 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs @@ -53,11 +53,6 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do mempoolBytesChart <- mkChart mempoolBytesTimer MempoolBytesData MempoolBytesChart "Mempool size" txsInMempoolChart <- mkChart txsInMempoolTimer TxsInMempoolData TxsInMempoolChart "Txs in mempool" - txsMempoolTimeoutSoftTimer <- mkChartTimer tracerEnv tHistory dsIxs TxsMempoolTimeoutSoftData TxsMempoolTimeoutSoftChart - txsMempoolTimeoutHardTimer <- mkChartTimer tracerEnv tHistory dsIxs TxsMempoolTimeoutHardData TxsMempoolTimeoutHardChart - txsMempoolTimeoutSoftChart <- mkChart txsMempoolTimeoutSoftTimer TxsMempoolTimeoutSoftData TxsMempoolTimeoutSoftChart "Txs that soft timed out in mempool" - txsMempoolTimeoutHardChart <- mkChart txsMempoolTimeoutHardTimer TxsMempoolTimeoutHardData TxsMempoolTimeoutHardChart "Txs that hard timed out in mempool" - -- Resources charts. cpuTimer <- mkChartTimer tracerEnv rHistory dsIxs CPUData CPUChart memoryTimer <- mkChartTimer tracerEnv rHistory dsIxs MemoryData MemoryChart @@ -303,8 +298,6 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do ] , UI.div #. "column" #+ [ element txsInMempoolChart - , element txsMempoolTimeoutSoftChart - , element txsMempoolTimeoutHardChart ] ] -- Resources charts. @@ -343,11 +336,9 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do Chart.prepareChartsJS - Chart.newTimeChartJS TxsProcessedNumChart "" - Chart.newTimeChartJS MempoolBytesChart "MB" - Chart.newTimeChartJS TxsInMempoolChart "" - Chart.newTimeChartJS TxsMempoolTimeoutSoftChart "" - Chart.newTimeChartJS TxsMempoolTimeoutHardChart "" + Chart.newTimeChartJS TxsProcessedNumChart "" + Chart.newTimeChartJS MempoolBytesChart "MB" + Chart.newTimeChartJS TxsInMempoolChart "" Chart.newTimeChartJS CPUChart "Percent" Chart.newTimeChartJS MemoryChart "MB" @@ -379,8 +370,6 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do UI.start txsProcessedNumTimer UI.start mempoolBytesTimer UI.start txsInMempoolTimer - UI.start txsMempoolTimeoutSoftTimer - UI.start txsMempoolTimeoutHardTimer UI.start cpuTimer UI.start memoryTimer @@ -411,8 +400,6 @@ mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do UI.stop txsProcessedNumTimer UI.stop mempoolBytesTimer UI.stop txsInMempoolTimer - UI.stop txsMempoolTimeoutSoftTimer - UI.stop txsMempoolTimeoutHardTimer UI.stop cpuTimer UI.stop memoryTimer diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs index bb037150f33..73f9f6d482a 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Types.hs @@ -50,8 +50,6 @@ data ChartId | TxsProcessedNumChart | MempoolBytesChart | TxsInMempoolChart - | TxsMempoolTimeoutSoftChart - | TxsMempoolTimeoutHardChart deriving (Bounded, Enum, Generic, FromJSON, ToJSON, Show) data ChartSelectId diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs index 3bfd9032af0..87466300188 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Transactions.hs @@ -27,10 +27,6 @@ updateTransactionsHistory nodeId (TXHistory tHistory) metricName metricValue now | "txsProcessedNum" `isInfixOf` metricName -> updateTxsProcessedNum | "mempoolBytes" `isInfixOf` metricName -> updateMempoolBytes | "txsInMempool" `isInfixOf` metricName -> updateTxsInMempool - | "txsMempoolTimeoutSoft" `isInfixOf` metricName - -> updateTxsMempoolTimeoutSoft - | "txsMempoolTimeoutHard" `isInfixOf` metricName - -> updateTxsMempoolTimeoutHard | otherwise -> return () where updateTxsProcessedNum = @@ -45,9 +41,3 @@ updateTransactionsHistory nodeId (TXHistory tHistory) metricName metricValue now Right (mempoolBytes :: Int, _) -> do let !mempoolInMB = fromIntegral mempoolBytes / 1024 / 1024 :: Double addHistoricalData tHistory nodeId now MempoolBytesData $ ValueD mempoolInMB - - updateTxsMempoolTimeoutSoft = - readValueI metricValue $ addHistoricalData tHistory nodeId now TxsMempoolTimeoutSoftData - - updateTxsMempoolTimeoutHard = - readValueI metricValue $ addHistoricalData tHistory nodeId now TxsMempoolTimeoutHardData