Defensive mempool

bench/plutus-scripts-bench/plutus-scripts-bench.cabal

@@ -82,10 +82,10 @@ library
   -- IOG dependencies
   --------------------------
   build-depends:
-    , cardano-api             ^>=10.19
-    , plutus-ledger-api       ^>=1.53
-    , plutus-tx               ^>=1.53
-    , plutus-tx-plugin        ^>=1.53
+    , cardano-api             ^>=10.23
+    , plutus-ledger-api       ^>=1.57
+    , plutus-tx               ^>=1.57
+    , plutus-tx-plugin        ^>=1.57
 
   ------------------------
   -- Non-IOG dependencies

bench/tx-generator/app/calibrate-script.hs

@@ -33,9 +33,9 @@ import           Data.Char
 import           Data.Function (on, (&))
 import           Data.List (nub, sort, transpose)
 import           Data.List.Extra (split)
+
 import           Data.Map.Strict as Map (Map, empty, fromList, union)
 import           Data.Maybe
-import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import           Numeric

bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs

@@ -24,7 +24,6 @@ import           Data.DList (DList)
 import qualified Data.DList as DL
 import           Data.Functor ((<&>))
 import           Data.Maybe
-import           Data.Text (Text)
 import qualified Data.Text as Text
 
 data CompileError where

bench/tx-generator/src/Cardano/Benchmarking/LogTypes.hs

@@ -48,7 +48,6 @@ import           Prelude
 import qualified Codec.CBOR.Term as CBOR
 import qualified Control.Concurrent.Async as Async (Async)
 import qualified Control.Concurrent.STM as STM (TVar)
-import           Data.Text
 import           Data.Time.Clock (DiffTime, NominalDiffTime)
 import           GHC.Generics
 import qualified Network.Mux as Mux

bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

@@ -24,7 +24,6 @@ import qualified Data.Attoparsec.ByteString as Atto
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS (lines)
 import qualified Data.ByteString.Lazy as BSL
-import           Data.Text (Text)
 import qualified Data.Yaml as Yaml (encode)
 import           GHC.Generics (Generic)
 import           System.Exit

bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs

@@ -51,7 +51,6 @@ import           Prelude
 
 import           Data.Function (on)
 import           Data.List.NonEmpty
-import           Data.Text (Text)
 import           GHC.Generics
 
 

bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs

@@ -46,7 +46,6 @@ import           Data.Kind
 import           Data.List (find)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe)
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Time.Clock
 import           GHC.Generics

bench/tx-generator/src/Cardano/TxGenerator/Utils.hs

@@ -18,7 +18,6 @@ import qualified Cardano.Ledger.Coin as L
 import           Cardano.TxGenerator.Types
 
 import           Data.Maybe (fromJust)
-import           Data.Text (Text)
 import           GHC.Stack
 
 

bench/tx-generator/tx-generator.cabal

@@ -111,9 +111,9 @@ library
                       , attoparsec-aeson
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 10.19
+                      , cardano-api ^>= 10.23
                       , cardano-binary
-                      , cardano-cli ^>= 10.13
+                      , cardano-cli ^>= 10.15
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-data

cabal.project

@@ -13,8 +13,19 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2025-10-17T00:26:22Z
-  , cardano-haskell-packages 2025-11-20T19:55:27Z
+  , hackage.haskell.org 2026-01-23T16:01:56Z
+  , cardano-haskell-packages 2026-01-30T03:40:53Z
+
+-- BEGIN SRP STANZAS MANAGED BY STANZAMAN --
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-cli.git
+  tag: fffc9cdff81296e9cd2409421f9ff52582f6ae6c
+  subdir: cardano-cli
+  --sha256: 0jhs47cqmmp9wryd7na473qsqan90d29mf01yjapkqlmrx3wyk6b
+
+-- END SRP STANZAS MANAGED BY STANZAMAN --
 
 packages:
   cardano-node

cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs

@@ -26,7 +26,6 @@ import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Control.Monad.Class.MonadTime.SI (DiffTime)
 import           Control.Tracer (Tracer (..), stdoutTracer)
 import           Data.Monoid (Last (..))
-import           Data.Text (Text)
 import qualified Data.Time.Clock as DTC
 import           Options.Applicative
 import qualified Options.Applicative as Opt

cardano-node-chairman/cardano-node-chairman.cabal

@@ -88,5 +88,5 @@ test-suite chairman-tests
   ghc-options:          -threaded -rtsopts "-with-rtsopts=-N -T"
 
   build-tool-depends:   cardano-node:cardano-node
-                      , cardano-cli:cardano-cli ^>= 10.13
+                      , cardano-cli:cardano-cli ^>= 10.15
                       , cardano-node-chairman:cardano-node-chairman

cardano-node/cardano-node.cabal

@@ -138,7 +138,7 @@ library
                       , async
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 10.19
+                      , cardano-api ^>= 10.23
                       , cardano-crypto-class ^>=2.2.3.2
                       , cardano-crypto-wrapper
                       , cardano-git-rev ^>=0.2.2
@@ -185,9 +185,9 @@ library
                       , network-mux >= 0.8
                       , nothunks
                       , optparse-applicative
-                      , ouroboros-consensus ^>= 0.28
+                      , ouroboros-consensus ^>= 0.30
                       , ouroboros-consensus-cardano ^>= 0.26
-                      , ouroboros-consensus-diffusion ^>= 0.24
+                      , ouroboros-consensus-diffusion ^>= 0.25
                       , ouroboros-consensus-protocol
                       , ouroboros-network-api ^>= 0.16
                       , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22.4

cardano-node/src/Cardano/Node/Configuration/NodeAddress.hs

@@ -37,7 +37,6 @@ import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo
 import           Data.Aeson (Value (..), object, withObject, (.:), (.=))
 import           Data.IP (IP (..), IPv4, IPv6)
 import qualified Data.IP as IP
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Network.DNS as DNS (Domain)

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -140,6 +140,28 @@ data NodeConfiguration
          -- 'Ouroboros.Network.Protocol.ChainSync.Codec.ChainSyncTimeout'
        , ncChainSyncIdleTimeout :: TimeoutOverride
 
+         -- Mempool timeout configurations:
+         -- These configuration control a lightweight "defensive programming"
+         -- feature in the Mempool.
+         -- See documentation in @Ouroboros.Consensus.Mempool.API@ for more info
+
+         -- | If the mempool takes longer than this to validate a tx, then it
+         -- discards the tx instead of adding it.
+       , ncMempoolTimeoutSoft :: DiffTime
+
+         -- | If the mempool takes longer than this to validate a tx, then it
+         -- disconnects from the peer.
+         --
+         -- WARNING: if this is less than 'mempoolTimeoutSoft', then
+         -- 'mempoolTimeoutSoft' is irrelevant. If it's equal or just barely larger,
+         -- then the soft/hard distinction will likely be unreliable.
+       , ncMempoolTimeoutHard :: DiffTime
+
+          -- | If the mempool takes longer than this cumulatively to
+          -- validate when each entered the mempool, then the mempool is at
+          -- capacity, ie it's full, ie no tx can be added.
+       , ncMempoolTimeoutCapacity :: DiffTime
+
          -- | Node AcceptedConnectionsLimit
        , ncAcceptedConnectionsLimit :: !AcceptedConnectionsLimit
 
@@ -237,6 +259,11 @@ data PartialNodeConfiguration
 
        , pncChainSyncIdleTimeout      :: !(Last DiffTime)
 
+       -- Mempool timeout configurations:
+       , pncMempoolTimeoutSoft :: !(Last DiffTime)
+       , pncMempoolTimeoutHard :: !(Last DiffTime)
+       , pncMempoolTimeoutCapacity :: !(Last DiffTime)
+
          -- AcceptedConnectionsLimit
        , pncAcceptedConnectionsLimit :: !(Last AcceptedConnectionsLimit)
 
@@ -370,6 +397,10 @@ instance FromJSON PartialNodeConfiguration where
 
       pncChainSyncIdleTimeout      <- Last <$> v .:? "ChainSyncIdleTimeout"
 
+      pncMempoolTimeoutSoft <- Last <$> v .:? "MempoolTimeoutSoft"
+      pncMempoolTimeoutHard <- Last <$> v .:? "MempoolTimeoutHard"
+      pncMempoolTimeoutCapacity <- Last <$> v .:? "MempoolTimeoutCapacity"
+
       -- Peer Sharing
       pncPeerSharing <- Last <$> v .:? "PeerSharing"
 
@@ -404,6 +435,9 @@ instance FromJSON PartialNodeConfiguration where
            , pncProtocolIdleTimeout
            , pncTimeWaitTimeout
            , pncChainSyncIdleTimeout
+           , pncMempoolTimeoutSoft
+           , pncMempoolTimeoutHard
+           , pncMempoolTimeoutCapacity
            , pncEgressPollInterval
            , pncAcceptedConnectionsLimit
            , pncDeadlineTargetOfRootPeers
@@ -658,6 +692,9 @@ defaultPartialNodeConfiguration =
     , pncAcceptedConnectionsLimit = Last (Just Ouroboros.defaultAcceptedConnectionsLimit)
       -- https://ouroboros-network.cardano.intersectmbo.org/ouroboros-network/Ouroboros-Network-Diffusion-Configuration.html#v:defaultAcceptedConnectionsLimit
     , pncChainSyncIdleTimeout     = mempty
+    , pncMempoolTimeoutSoft       = mempty
+    , pncMempoolTimeoutHard       = mempty
+    , pncMempoolTimeoutCapacity   = mempty
 
     -- these targets are set properly in makeNodeConfiguration below
     , pncDeadlineTargetOfRootPeers                 = mempty
@@ -780,6 +817,16 @@ makeNodeConfiguration pnc = do
     $ getLast
     $ pncChainSyncIdleTimeout pnc
 
+  let mempoolTimeouts = ( getLast (pncMempoolTimeoutSoft pnc)
+                        , getLast (pncMempoolTimeoutHard pnc)
+                        , getLast (pncMempoolTimeoutCapacity pnc)
+                        )
+  (ncMempoolTimeoutSoft, ncMempoolTimeoutHard, ncMempoolTimeoutCapacity) <- 
+    case mempoolTimeouts of
+      (Just s, Just h, Just c) -> pure (s, h, c)
+      (Nothing, Nothing, Nothing) -> pure (1, 1.5, 5)
+      _ -> Left "Mempool timeouts must be either all set or all unset"
+
   let ncPeerSharing =
         case pncPeerSharing pnc of
           Last Nothing ->
@@ -851,6 +898,9 @@ makeNodeConfiguration pnc = do
              , ncProtocolIdleTimeout
              , ncTimeWaitTimeout
              , ncChainSyncIdleTimeout
+             , ncMempoolTimeoutSoft
+             , ncMempoolTimeoutHard
+             , ncMempoolTimeoutCapacity
              , ncEgressPollInterval
              , ncAcceptedConnectionsLimit
              , ncDeadlineTargetOfRootPeers

cardano-node/src/Cardano/Node/Parsers.hs

@@ -121,6 +121,9 @@ nodeRunParser = do
            , pncTimeWaitTimeout = mempty
            , pncEgressPollInterval = mempty
            , pncChainSyncIdleTimeout = mempty
+           , pncMempoolTimeoutSoft = mempty
+           , pncMempoolTimeoutHard = mempty
+           , pncMempoolTimeoutCapacity = mempty
            , pncAcceptedConnectionsLimit = mempty
            , pncDeadlineTargetOfRootPeers = mempty
            , pncDeadlineTargetOfKnownPeers = mempty

cardano-node/src/Cardano/Node/Protocol/Byron.hs

@@ -39,7 +39,6 @@ import qualified Ouroboros.Consensus.Cardano as Consensus
 import           Control.Exception
 import qualified Data.ByteString.Lazy as LB
 import           Data.Maybe (fromMaybe)
-import           Data.Text (Text)
 
 
 ------------------------------------------------------------------------------

cardano-node/src/Cardano/Node/Run.hs

@@ -166,6 +166,7 @@ import           System.Win32.File
 import           Paths_cardano_node (version)
 
 import           Paths_cardano_node (version)
+import Ouroboros.Consensus.Mempool (MempoolTimeoutConfig(..))
 
 {- HLINT ignore "Fuse concatMap/map" -}
 {- HLINT ignore "Redundant <$>" -}
@@ -466,6 +467,11 @@ handleSimpleNode blockType runP tracers nc onKernel = do
           , rnTraceNTN       = nodeToNodeTracers tracers
           , rnTraceNTC       = nodeToClientTracers tracers
           , rnProtocolInfo   = pInfo
+          , rnMempoolTimeoutConfig = Just $ MempoolTimeoutConfig
+              { mempoolTimeoutSoft     = ncMempoolTimeoutSoft nc
+              , mempoolTimeoutHard     = ncMempoolTimeoutHard nc
+              , mempoolTimeoutCapacity = ncMempoolTimeoutCapacity nc
+              }
           , rnNodeKernelHook = \registry nodeKernel -> do
               -- set the initial block forging
               blockForging <- snd (Api.protocolInfo runP) (Consensus.kesAgentTracer $ consensusTracers tracers)

cardano-node/src/Cardano/Node/TraceConstraints.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MonoLocalBinds #-}
 
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 

cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs

@@ -1254,7 +1254,7 @@ instance
       , "tx" .= forMachine dtal (txForgetValidated tx)
       , "mempoolSize" .= forMachine dtal mpSzAfter
       ]
-  forMachine dtal (TraceMempoolRejectedTx tx txApplyErr mpSz) =
+  forMachine dtal (TraceMempoolRejectedTx tx txApplyErr _ mpSz) =
     mconcat $
       [ "kind" .= String "TraceMempoolRejectedTx"
       , "tx" .= forMachine dtal tx
@@ -1311,7 +1311,7 @@ instance
     [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz)
     , IntM "mempoolBytes" (fromIntegral . unByteSize32 . msNumBytes $ mpSz)
     ]
-  asMetrics (TraceMempoolRejectedTx _tx _txApplyErr mpSz) =
+  asMetrics (TraceMempoolRejectedTx _tx _txApplyErr _ mpSz) =
     [ IntM "txsInMempool" (fromIntegral $ msNumTxs mpSz)
     , IntM "mempoolBytes" (fromIntegral . unByteSize32 . msNumBytes $ mpSz)
     ]
@@ -1520,7 +1520,7 @@ instance ( tx ~ GenTx blk
       , "mempoolHash" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) mpHash)
       , "mempoolSlot" .= toJSON (unSlotNo mpSlot)
       ]
-  forMachine _dtal (TraceForgedBlock slotNo _ blk _) =
+  forMachine _dtal (TraceForgedBlock slotNo _ blk _ _) =
     mconcat
       [ "kind" .= String "TraceForgedBlock"
       , "slot" .= toJSON (unSlotNo slotNo)
@@ -1632,7 +1632,7 @@ instance ( tx ~ GenTx blk
         <> renderChainHash @blk (renderHeaderHash (Proxy @blk)) mpHash
         <> " ticked to slot "
         <> showT (unSlotNo mpSlot)
-  forHuman (TraceForgedBlock slotNo _ _ _) =
+  forHuman (TraceForgedBlock slotNo _ _ _ _) =
       "Forged block in slot " <> showT (unSlotNo slotNo)
   forHuman (TraceDidntAdoptBlock slotNo _) =
       "Didn't adopt forged block in slot " <> showT (unSlotNo slotNo)
@@ -1690,7 +1690,7 @@ instance ( tx ~ GenTx blk
     [CounterM "Forge.node-is-leader" Nothing]
   asMetrics TraceForgeTickedLedgerState {} = []
   asMetrics TraceForgingMempoolSnapshot {} = []
-  asMetrics (TraceForgedBlock slot _ _ _) =
+  asMetrics (TraceForgedBlock slot _ _ _ _) =
     [IntM "forgedSlotLast" (fromIntegral $ unSlotNo slot),
      CounterM "Forge.forged" Nothing]
   asMetrics (TraceDidntAdoptBlock _slot _) =

cardano-node/src/Cardano/Node/Types.hs

@@ -55,7 +55,6 @@ import           Data.ByteString (ByteString)
 import           Data.Maybe (isJust)
 import           Data.Monoid (Last (..))
 import           Data.String (IsString)
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Typeable
 import           Data.Word (Word16, Word8)

cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs

@@ -479,7 +479,7 @@ instance ( tx ~ GenTx blk
         <> renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) mpHash
         <> " ticked to slot "
         <> showT (unSlotNo mpSlot)
-    TraceForgedBlock slotNo _ _ _ -> const $
+    TraceForgedBlock slotNo _ _ _ _ -> const $
       "Forged block in slot " <> showT (unSlotNo slotNo)
     TraceDidntAdoptBlock slotNo _ -> const $
       "Didn't adopt forged block in slot " <> showT (unSlotNo slotNo)
@@ -1543,7 +1543,7 @@ instance ( ToObject (ApplyTxErr blk), ToObject (GenTx blk),
       , "tx" .= toObject verb (txForgetValidated tx)
       , "mempoolSize" .= toObject verb mpSzAfter
       ]
-  toObject verb (TraceMempoolRejectedTx tx txApplyErr mpSz) =
+  toObject verb (TraceMempoolRejectedTx tx txApplyErr _ mpSz) =
     mconcat $
       [ "kind" .= String "TraceMempoolRejectedTx"
       , "tx" .= toObject verb tx
@@ -1698,7 +1698,7 @@ instance ( RunNode blk
       , "mempoolHash" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) mpHash)
       , "mempoolSlot" .= toJSON (unSlotNo mpSlot)
       ]
-  toObject _verb (TraceForgedBlock slotNo _ blk _) =
+  toObject _verb (TraceForgedBlock slotNo _ blk _ _) =
     mconcat
       [ "kind"      .= String "TraceForgedBlock"
       , "slot"      .= toJSON (unSlotNo slotNo)

cardano-node/src/Cardano/Tracing/Tracers.hs

@@ -1140,7 +1140,7 @@ teeForge' tr =
           LogValue "forgeTickedLedgerState" $ PureI $ fromIntegral $ unSlotNo slot
         Consensus.TraceForgingMempoolSnapshot slot _prevPt _mpHash _mpSlotNo ->
           LogValue "forgingMempoolSnapshot" $ PureI $ fromIntegral $ unSlotNo slot
-        Consensus.TraceForgedBlock slot _ _ _ ->
+        Consensus.TraceForgedBlock slot _ _ _ _ ->
           LogValue "forgedSlotLast" $ PureI $ fromIntegral $ unSlotNo slot
         Consensus.TraceDidntAdoptBlock slot _ ->
           LogValue "notAdoptedSlotLast" $ PureI $ fromIntegral $ unSlotNo slot
@@ -1264,7 +1264,7 @@ mempoolMetricsTraceTransformer tr = Tracer $ \mempoolEvent -> do
   let tr' = appendName "metrics" tr
       (_n, tot_m) = case mempoolEvent of
                     TraceMempoolAddedTx     _tx0 _ tot0 -> (1, Just tot0)
-                    TraceMempoolRejectedTx  _tx0 _ tot0 -> (1, Just tot0)
+                    TraceMempoolRejectedTx  _tx0 _ _ tot0 -> (1, Just tot0)
                     TraceMempoolRemoveTxs   txs0   tot0 -> (length txs0, Just tot0)
                     TraceMempoolManuallyRemovedTxs txs0 txs1 tot0 -> ( length txs0 + length txs1, Just tot0)
                     TraceMempoolSynced _ -> (0, Nothing)