diff --git a/ouroboros-consensus-cardano/changelog.d/20240710_104628_nick.frisby_remove_cap_override_forge.md b/ouroboros-consensus-cardano/changelog.d/20240710_104628_nick.frisby_remove_cap_override_forge.md new file mode 100644 index 0000000000..ac9b61ab73 --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20240710_104628_nick.frisby_remove_cap_override_forge.md @@ -0,0 +1,22 @@ + + + + + +### Breaking + +- Remove the capacity override from forging functions. diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index bb50f7582b..a487ec0a41 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal @@ -350,6 +350,7 @@ test-suite shelley-test constraints, containers, filepath, + measures, microlens, ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib}, ouroboros-consensus-cardano, diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Forge.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Forge.hs index fa7ce7421a..02ea93dbf3 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Forge.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Forge.hs @@ -40,14 +40,11 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool (LedgerSupportsMempool (..), txForgetValidated) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Protocol.PBFT forgeByronBlock :: HasCallStack => TopLevelConfig ByronBlock - -> Mempool.TxOverrides ByronBlock -- ^ How to override max tx capacity - -- defined by ledger -> BlockNo -- ^ Current block number -> SlotNo -- ^ Current slot number -> TickedLedgerState ByronBlock -- ^ Current ledger @@ -123,15 +120,13 @@ initBlockPayloads = BlockPayloads forgeRegularBlock :: HasCallStack => BlockConfig ByronBlock - -> Mempool.TxOverrides ByronBlock -- ^ How to override max tx capacity - -- defined by ledger -> BlockNo -- ^ Current block number -> SlotNo -- ^ Current slot number -> TickedLedgerState ByronBlock -- ^ Current ledger -> [Validated (GenTx ByronBlock)] -- ^ Txs to consider adding in the block -> PBftIsLeader PBftByronCrypto -- ^ Leader proof ('IsLeader') -> ByronBlock -forgeRegularBlock cfg maxTxCapacityOverrides bno sno st txs isLeader = +forgeRegularBlock cfg bno sno st txs isLeader = forge $ forgePBftFields (mkByronContextDSIGN cfg) @@ -146,7 +141,7 @@ forgeRegularBlock cfg maxTxCapacityOverrides bno sno st txs isLeader = foldr extendBlockPayloads initBlockPayloads - (takeLargestPrefixThatFits maxTxCapacityOverrides st txs) + (takeLargestPrefixThatFits st txs) txPayload :: CC.UTxO.TxPayload txPayload = CC.UTxO.mkTxPayload (bpTxs blockPayloads) diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs index 4c81d14eb1..0811eaea18 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs @@ -49,7 +49,6 @@ import Ouroboros.Consensus.Config.SupportsNode import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.InitStorage import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run @@ -128,10 +127,9 @@ type instance ForgeStateUpdateError ByronBlock = Void byronBlockForging :: Monad m - => Mempool.TxOverrides ByronBlock - -> ByronLeaderCredentials + => ByronLeaderCredentials -> BlockForging m ByronBlock -byronBlockForging maxTxCapacityOverrides creds = BlockForging { +byronBlockForging creds = BlockForging { forgeLabel = blcLabel creds , canBeLeader , updateForgeState = \_ _ _ -> return $ ForgeStateUpdated () @@ -141,7 +139,7 @@ byronBlockForging maxTxCapacityOverrides creds = BlockForging { canBeLeader slot tickedPBftState - , forgeBlock = \cfg -> return ....: forgeByronBlock cfg maxTxCapacityOverrides + , forgeBlock = \cfg -> return ....: forgeByronBlock cfg } where canBeLeader = mkPBftCanBeLeader creds @@ -156,10 +154,9 @@ mkPBftCanBeLeader (ByronLeaderCredentials sk cert nid _) = PBftCanBeLeader { blockForgingByron :: Monad m => ProtocolParams ByronBlock -> [BlockForging m ByronBlock] -blockForgingByron ProtocolParamsByron { byronLeaderCredentials = mLeaderCreds - , byronMaxTxCapacityOverrides = maxTxCapacityOverrides +blockForgingByron ProtocolParamsByron { byronLeaderCredentials = mLeaderCreds } = - byronBlockForging maxTxCapacityOverrides + byronBlockForging <$> maybeToList mLeaderCreds {------------------------------------------------------------------------------- @@ -178,7 +175,6 @@ data instance ProtocolParams ByronBlock = ProtocolParamsByron { , byronProtocolVersion :: Update.ProtocolVersion , byronSoftwareVersion :: Update.SoftwareVersion , byronLeaderCredentials :: Maybe ByronLeaderCredentials - , byronMaxTxCapacityOverrides :: Mempool.TxOverrides ByronBlock } protocolInfoByron :: ProtocolParams ByronBlock diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs index d72e1930df..058a947345 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs @@ -100,7 +100,6 @@ import Ouroboros.Consensus.HardFork.Combinator.Serialisation import qualified Ouroboros.Consensus.HardFork.History as History import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Extended -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run @@ -631,37 +630,30 @@ protocolInfoCardano paramsCardano genesisShelley = ledgerTransitionConfig ^. L.tcShelleyGenesisL ProtocolParamsByron { - byronGenesis = genesisByron - , byronLeaderCredentials = mCredsByron - , byronMaxTxCapacityOverrides = maxTxCapacityOverridesByron + byronGenesis = genesisByron + , byronLeaderCredentials = mCredsByron } = paramsByron ProtocolParamsShelleyBased { shelleyBasedInitialNonce = initialNonceShelley , shelleyBasedLeaderCredentials = credssShelleyBased } = paramsShelleyBased ProtocolParamsShelley { - shelleyProtVer = protVerShelley - , shelleyMaxTxCapacityOverrides = maxTxCapacityOverridesShelley + shelleyProtVer = protVerShelley } = paramsShelley ProtocolParamsAllegra { - allegraProtVer = protVerAllegra - , allegraMaxTxCapacityOverrides = maxTxCapacityOverridesAllegra + allegraProtVer = protVerAllegra } = paramsAllegra ProtocolParamsMary { - maryProtVer = protVerMary - , maryMaxTxCapacityOverrides = maxTxCapacityOverridesMary + maryProtVer = protVerMary } = paramsMary ProtocolParamsAlonzo { - alonzoProtVer = protVerAlonzo - , alonzoMaxTxCapacityOverrides = maxTxCapacityOverridesAlonzo + alonzoProtVer = protVerAlonzo } = paramsAlonzo ProtocolParamsBabbage { - babbageProtVer = protVerBabbage - , babbageMaxTxCapacityOverrides = maxTxCapacityOverridesBabbage + babbageProtVer = protVerBabbage } = paramsBabbage ProtocolParamsConway { - conwayProtVer = protVerConway - , conwayMaxTxCapacityOverrides = maxTxCapacityOverridesConway + conwayProtVer = protVerConway } = paramsConway transitionConfigShelley = transitionConfigAllegra ^. L.tcPreviousEraConfigL @@ -1033,7 +1025,7 @@ protocolInfoCardano paramsCardano mBlockForgingByron :: Maybe (NonEmptyOptNP (BlockForging m) (CardanoEras c)) mBlockForgingByron = do creds <- mCredsByron - return $ byronBlockForging maxTxCapacityOverridesByron creds `OptNP.at` IZ + return $ byronBlockForging creds `OptNP.at` IZ blockForgingShelleyBased :: ShelleyLeaderCredentials c @@ -1058,28 +1050,26 @@ protocolInfoCardano paramsCardano Absolute.KESPeriod $ fromIntegral $ slot `div` praosSlotsPerKESPeriod let tpraos :: forall era. - ShelleyEraWithCrypto c (TPraos c) era - => Mempool.TxOverrides (ShelleyBlock (TPraos c) era) - -> BlockForging m (ShelleyBlock (TPraos c) era) - tpraos maxTxCapacityOverrides = - TPraos.shelleySharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides + ShelleyEraWithCrypto c (TPraos c) era + => BlockForging m (ShelleyBlock (TPraos c) era) + tpraos = + TPraos.shelleySharedBlockForging hotKey slotToPeriod credentials let praos :: forall era. - ShelleyEraWithCrypto c (Praos c) era - => Mempool.TxOverrides (ShelleyBlock (Praos c) era) - -> BlockForging m (ShelleyBlock (Praos c) era) - praos maxTxCapacityOverrides = - Praos.praosSharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides + ShelleyEraWithCrypto c (Praos c) era + => BlockForging m (ShelleyBlock (Praos c) era) + praos = + Praos.praosSharedBlockForging hotKey slotToPeriod credentials pure $ OptSkip -- Byron $ OptNP.fromNonEmptyNP $ - tpraos maxTxCapacityOverridesShelley :* - tpraos maxTxCapacityOverridesAllegra :* - tpraos maxTxCapacityOverridesMary :* - tpraos maxTxCapacityOverridesAlonzo :* - praos maxTxCapacityOverridesBabbage :* - praos maxTxCapacityOverridesConway :* + tpraos :* + tpraos :* + tpraos :* + tpraos :* + praos :* + praos :* Nil protocolClientInfoCardano :: diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs index 9f8cdd55e8..77c62751f9 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs @@ -21,7 +21,6 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Mempool (TxLimits) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Protocol.Abstract (CanBeLeader, IsLeader) import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey) import Ouroboros.Consensus.Shelley.Eras (EraCrypto) @@ -45,8 +44,6 @@ forgeShelleyBlock :: => HotKey (EraCrypto era) m -> CanBeLeader proto -> TopLevelConfig (ShelleyBlock proto era) - -> Mempool.TxOverrides (ShelleyBlock proto era) -- ^ How to override max tx - -- capacity defined by ledger -> BlockNo -- ^ Current block number -> SlotNo -- ^ Current slot number -> TickedLedgerState (ShelleyBlock proto era) -- ^ Current ledger @@ -57,7 +54,6 @@ forgeShelleyBlock hotKey cbl cfg - maxTxCapacityOverrides curNo curSlot tickedLedger @@ -76,7 +72,7 @@ forgeShelleyBlock SL.toTxSeq @era . Seq.fromList . fmap extractTx - $ takeLargestPrefixThatFits maxTxCapacityOverrides tickedLedger txs + $ takeLargestPrefixThatFits tickedLedger txs extractTx :: Validated (GenTx (ShelleyBlock proto era)) -> Core.Tx era extractTx (ShelleyValidatedTx _txid vtx) = SL.extractTx vtx diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs index 356a19867d..dac56748d3 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs @@ -56,12 +56,11 @@ praosBlockForging :: , IOLike m ) => PraosParams - -> Mempool.TxOverrides (ShelleyBlock (Praos c) era) -> ShelleyLeaderCredentials (EraCrypto era) -> m (BlockForging m (ShelleyBlock (Praos c) era)) -praosBlockForging praosParams maxTxCapacityOverrides credentials = do +praosBlockForging praosParams credentials = do hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod praosMaxKESEvo - pure $ praosSharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides + pure $ praosSharedBlockForging hotKey slotToPeriod credentials where PraosParams {praosMaxKESEvo, praosSlotsPerKESPeriod} = praosParams @@ -89,16 +88,14 @@ praosSharedBlockForging :: => HotKey.HotKey c m -> (SlotNo -> Absolute.KESPeriod) -> ShelleyLeaderCredentials c - -> Mempool.TxOverrides (ShelleyBlock (Praos c) era) - -> BlockForging m (ShelleyBlock (Praos c) era) + -> BlockForging m (ShelleyBlock (Praos c) era) praosSharedBlockForging hotKey slotToPeriod ShelleyLeaderCredentials { shelleyLeaderCredentialsCanBeLeader = canBeLeader , shelleyLeaderCredentialsLabel = label - } - maxTxCapacityOverrides = do + } = do BlockForging { forgeLabel = label <> "_" <> T.pack (L.eraName @era), canBeLeader = canBeLeader, @@ -114,7 +111,6 @@ praosSharedBlockForging hotKey canBeLeader cfg - maxTxCapacityOverrides } {------------------------------------------------------------------------------- @@ -122,13 +118,11 @@ praosSharedBlockForging -------------------------------------------------------------------------------} data instance ProtocolParams (ShelleyBlock (Praos c) (BabbageEra c)) = ProtocolParamsBabbage { - babbageProtVer :: SL.ProtVer + babbageProtVer :: SL.ProtVer -- ^ see 'Ouroboros.Consensus.Shelley.Node.TPraos.shelleyProtVer', mutatis mutandi - , babbageMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock (Praos c) (BabbageEra c)) } data instance ProtocolParams (ShelleyBlock (Praos c) (ConwayEra c)) = ProtocolParamsConway { - conwayProtVer :: SL.ProtVer + conwayProtVer :: SL.ProtVer -- ^ see 'Ouroboros.Consensus.Shelley.Node.TPraos.shelleyProtVer', mutatis mutandi - , conwayMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock (Praos c) (ConwayEra c)) } diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs index 50a85f99e0..da55810792 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs @@ -54,7 +54,6 @@ import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Mempool (TxLimits) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey) @@ -90,12 +89,11 @@ shelleyBlockForging :: , IOLike m ) => TPraosParams - -> Mempool.TxOverrides (ShelleyBlock (TPraos c) era) -> ShelleyLeaderCredentials (EraCrypto era) -> m (BlockForging m (ShelleyBlock (TPraos c) era)) -shelleyBlockForging tpraosParams maxTxCapacityOverrides credentials = do +shelleyBlockForging tpraosParams credentials = do hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod tpraosMaxKESEvo - pure $ shelleySharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides + pure $ shelleySharedBlockForging hotKey slotToPeriod credentials where TPraosParams {tpraosMaxKESEvo, tpraosSlotsPerKESPeriod} = tpraosParams @@ -124,9 +122,8 @@ shelleySharedBlockForging :: => HotKey c m -> (SlotNo -> Absolute.KESPeriod) -> ShelleyLeaderCredentials c - -> Mempool.TxOverrides (ShelleyBlock (TPraos c) era) -> BlockForging m (ShelleyBlock (TPraos c) era) -shelleySharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides = +shelleySharedBlockForging hotKey slotToPeriod credentials = BlockForging { forgeLabel = label <> "_" <> T.pack (L.eraName @era) , canBeLeader = canBeLeader @@ -143,7 +140,6 @@ shelleySharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides hotKey canBeLeader cfg - maxTxCapacityOverrides } where ShelleyLeaderCredentials { @@ -206,29 +202,25 @@ data instance ProtocolParams (ShelleyBlock (TPraos c) (ShelleyEra c)) = Protocol -- version increments past 'shelleyProtVer', this isn't an important -- discrepancy. The key aspects of the comment before this TODO are only -- important for the last era prot ver limit, anyway. - shelleyProtVer :: SL.ProtVer - , shelleyMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock(TPraos c) (ShelleyEra c) ) + shelleyProtVer :: SL.ProtVer } -- | Parameters needed to run Allegra data instance ProtocolParams (ShelleyBlock (TPraos c) (AllegraEra c)) = ProtocolParamsAllegra { - allegraProtVer :: SL.ProtVer + allegraProtVer :: SL.ProtVer -- ^ see 'shelleyProtVer', mutatis mutandi - , allegraMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock (TPraos c) (AllegraEra c) ) } -- | Parameters needed to run Mary data instance ProtocolParams (ShelleyBlock (TPraos c) (MaryEra c)) = ProtocolParamsMary { - maryProtVer :: SL.ProtVer + maryProtVer :: SL.ProtVer -- ^ see 'shelleyProtVer', mutatis mutandi - , maryMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock (TPraos c) (MaryEra c) ) } -- | Parameters needed to run Alonzo data instance ProtocolParams (ShelleyBlock (TPraos c) (AlonzoEra c)) = ProtocolParamsAlonzo { - alonzoProtVer :: SL.ProtVer + alonzoProtVer :: SL.ProtVer -- ^ see 'shelleyProtVer', mutatis mutandi - , alonzoMaxTxCapacityOverrides :: Mempool.TxOverrides (ShelleyBlock (TPraos c) (AlonzoEra c) ) } protocolInfoShelley :: @@ -247,14 +239,12 @@ protocolInfoShelley :: protocolInfoShelley shelleyGenesis protocolParamsShelleyBased ProtocolParamsShelley { - shelleyProtVer = protVer - , shelleyMaxTxCapacityOverrides = maxTxCapacityOverrides + shelleyProtVer = protVer } = protocolInfoTPraosShelleyBased protocolParamsShelleyBased (L.mkShelleyTransitionConfig shelleyGenesis) protVer - maxTxCapacityOverrides protocolInfoTPraosShelleyBased :: forall m era c. @@ -268,7 +258,6 @@ protocolInfoTPraosShelleyBased :: -> L.TransitionConfig era -> SL.ProtVer -- ^ see 'shelleyProtVer', mutatis mutandi - -> Mempool.TxOverrides (ShelleyBlock (TPraos c) era) -> ( ProtocolInfo (ShelleyBlock (TPraos c) era) , m [BlockForging m (ShelleyBlock (TPraos c) era)] ) @@ -277,15 +266,14 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased { , shelleyBasedLeaderCredentials = credentialss } transitionCfg - protVer - maxTxCapacityOverrides = + protVer = assertWithMsg (validateGenesis genesis) $ ( ProtocolInfo { pInfoConfig = topLevelConfig , pInfoInitLedger = initExtLedgerState } , traverse - (shelleyBlockForging tpraosParams maxTxCapacityOverrides) + (shelleyBlockForging tpraosParams) credentialss ) where diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Ledger.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Ledger.hs index 3c9bb80b3b..948e656481 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Ledger.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Ledger.hs @@ -43,7 +43,6 @@ import Ouroboros.Consensus.ByronSpec.Ledger import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Dual -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Protocol.PBFT import qualified Test.Cardano.Chain.Elaboration.Block as Spec.Test import qualified Test.Cardano.Chain.Elaboration.Keys as Spec.Test @@ -223,7 +222,6 @@ forgeDualByronBlock cfg curBlockNo curSlotNo tickedLedger vtxs isLeader = main :: ByronBlock main = forgeByronBlock (dualTopLevelConfigMain cfg) - (Mempool.mkOverrides Mempool.noOverridesMeasure) curBlockNo curSlotNo (tickedDualLedgerStateMain tickedLedger) diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node.hs index d3fb3bdd3c..b3a9d1f127 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node.hs @@ -37,7 +37,6 @@ import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Dual import Ouroboros.Consensus.Ledger.Extended -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.InitStorage import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run @@ -69,10 +68,7 @@ dualByronBlockForging creds = BlockForging { , forgeBlock = return .....: forgeDualByronBlock } where - BlockForging {..} = - byronBlockForging - (Mempool.mkOverrides Mempool.noOverridesMeasure) - creds + BlockForging {..} = byronBlockForging creds {------------------------------------------------------------------------------- ProtocolInfo diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs index 10bd553623..2ad8101852 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs @@ -38,7 +38,6 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Protocol.PBFT @@ -121,7 +120,6 @@ exampleBlock :: ByronBlock exampleBlock = forgeRegularBlock cfg - (Mempool.mkOverrides Mempool.noOverridesMeasure) (BlockNo 1) (SlotNo 1) (applyChainTick ledgerConfig (SlotNo 1) ledgerStateAfterEBB) diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/ProtocolInfo.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/ProtocolInfo.hs index a892b8d49e..8628828395 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/ProtocolInfo.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/ProtocolInfo.hs @@ -24,7 +24,6 @@ import Ouroboros.Consensus.Byron.Crypto.DSIGN (ByronDSIGN, SignKeyDSIGN (..)) import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import Ouroboros.Consensus.Byron.Node -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo (..)) import Ouroboros.Consensus.NodeId (CoreNodeId (..)) import Ouroboros.Consensus.Protocol.PBFT @@ -66,7 +65,6 @@ mkProtocolByron params coreNodeId genesisConfig genesisSecrets = , byronProtocolVersion = theProposedProtocolVersion , byronSoftwareVersion = theProposedSoftwareVersion , byronLeaderCredentials = Just leaderCredentials - , byronMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure } mkLeaderCredentials :: diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs index d3da203a3f..04996e4978 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs @@ -35,8 +35,7 @@ import Ouroboros.Consensus.Block.Forging (BlockForging) import Ouroboros.Consensus.BlockchainTime (SlotLength) import Ouroboros.Consensus.Byron.Node (ByronLeaderCredentials, ProtocolParams (..), byronGenesis, - byronMaxTxCapacityOverrides, byronPbftSignatureThreshold, - byronSoftwareVersion) + byronPbftSignatureThreshold, byronSoftwareVersion) import Ouroboros.Consensus.Cardano.Block (CardanoBlock) import Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints, CardanoHardForkTriggers (..), ProtocolParams (..), @@ -44,7 +43,6 @@ import Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints, protocolInfoCardano) import Ouroboros.Consensus.Config (emptyCheckpointsMap) import Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..)) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..), ProtocolInfo) import Ouroboros.Consensus.NodeId (CoreNodeId (..)) @@ -279,35 +277,28 @@ mkTestProtocolInfo , byronProtocolVersion = aByronProtocolVersion , byronSoftwareVersion = softVerByron , byronLeaderCredentials = Just leaderCredentialsByron - , byronMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure } ProtocolParamsShelleyBased { shelleyBasedInitialNonce = initialNonce , shelleyBasedLeaderCredentials = [leaderCredentialsShelley] } ProtocolParamsShelley { - shelleyProtVer = hfSpecProtVer Shelley hardForkSpec - , shelleyMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = hfSpecProtVer Shelley hardForkSpec } ProtocolParamsAllegra { - allegraProtVer = hfSpecProtVer Allegra hardForkSpec - , allegraMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + allegraProtVer = hfSpecProtVer Allegra hardForkSpec } ProtocolParamsMary { - maryProtVer = hfSpecProtVer Mary hardForkSpec - , maryMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + maryProtVer = hfSpecProtVer Mary hardForkSpec } ProtocolParamsAlonzo { - alonzoProtVer = hfSpecProtVer Alonzo hardForkSpec - , alonzoMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + alonzoProtVer = hfSpecProtVer Alonzo hardForkSpec } ProtocolParamsBabbage { - babbageProtVer = hfSpecProtVer Babbage hardForkSpec - , babbageMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + babbageProtVer = hfSpecProtVer Babbage hardForkSpec } ProtocolParamsConway { - conwayProtVer = hfSpecProtVer Conway hardForkSpec - , conwayMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + conwayProtVer = hfSpecProtVer Conway hardForkSpec } CardanoHardForkTriggers' { triggerHardForkShelley = hfSpecTransitionTrigger Shelley hardForkSpec diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs index 47d4eb79c1..02a8586cf8 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs @@ -50,7 +50,6 @@ import Ouroboros.Consensus.Ledger.Basics (LedgerConfig) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import Ouroboros.Consensus.Mempool (TxLimits) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Protocol.TPraos @@ -267,7 +266,6 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased protocolParamsShelleyBased (transCfg2 ^. L.tcPreviousEraConfigL) protVer1 - (Mempool.mkOverrides Mempool.noOverridesMeasure) eraParams1 :: History.EraParams eraParams1 = shelleyEraParams genesis @@ -292,7 +290,6 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased } transCfg2 protVer2 - (Mempool.mkOverrides Mempool.noOverridesMeasure) eraParams2 :: History.EraParams eraParams2 = shelleyEraParams genesis diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Byron.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Byron.hs index c9b7ea0ad9..edd7320e82 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Byron.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Byron.hs @@ -33,7 +33,6 @@ import qualified Data.ByteString.Lazy as LB import Data.Text as Text (unpack) import Ouroboros.Consensus.Cardano import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Mempool as Mempool import Prelude hiding (show, (.)) @@ -83,10 +82,7 @@ mkSomeConsensusProtocolByron NodeByronProtocolConfiguration { Update.SoftwareVersion npcByronApplicationName npcByronApplicationVersion, - byronLeaderCredentials = - optionalLeaderCredentials, - byronMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + byronLeaderCredentials = optionalLeaderCredentials } readGenesis :: GenesisFile diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs index ecc94a67cd..a23e1bd99d 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs @@ -37,7 +37,6 @@ import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Cardano.Node (CardanoProtocolParams) import Ouroboros.Consensus.Config (emptyCheckpointsMap) import Ouroboros.Consensus.HardFork.Combinator.Condense () -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Shelley.Crypto (StandardCrypto) @@ -180,10 +179,7 @@ mkConsensusProtocolCardano NodeByronProtocolConfiguration { Byron.SoftwareVersion npcByronApplicationName npcByronApplicationVersion, - byronLeaderCredentials = - byronLeaderCredentials, - byronMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + byronLeaderCredentials = byronLeaderCredentials } Consensus.ProtocolParamsShelleyBased { shelleyBasedInitialNonce = Shelley.genesisHashToPraosNonce @@ -195,54 +191,40 @@ mkConsensusProtocolCardano NodeByronProtocolConfiguration { -- version that this node will declare that it understands, when it -- is in the Shelley era. That is, it is the version of protocol -- /after/ Shelley, i.e. Allegra. - shelleyProtVer = - ProtVer (natVersion @3) 0, - shelleyMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = ProtVer (natVersion @3) 0 } Consensus.ProtocolParamsAllegra { -- This is /not/ the Allegra protocol version. It is the protocol -- version that this node will declare that it understands, when it -- is in the Allegra era. That is, it is the version of protocol -- /after/ Allegra, i.e. Mary. - allegraProtVer = - ProtVer (natVersion @4) 0, - allegraMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + allegraProtVer = ProtVer (natVersion @4) 0 } Consensus.ProtocolParamsMary { -- This is /not/ the Mary protocol version. It is the protocol -- version that this node will declare that it understands, when it -- is in the Mary era. That is, it is the version of protocol -- /after/ Mary, i.e. Alonzo. - maryProtVer = ProtVer (natVersion @5) 0, - maryMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + maryProtVer = ProtVer (natVersion @5) 0 } Consensus.ProtocolParamsAlonzo { -- This is /not/ the Alonzo protocol version. It is the protocol -- version that this node will declare that it understands, when it -- is in the Alonzo era. That is, it is the version of protocol -- /after/ Alonzo, i.e. Babbage. - alonzoProtVer = ProtVer (natVersion @7) 0, - alonzoMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + alonzoProtVer = ProtVer (natVersion @7) 0 } Consensus.ProtocolParamsBabbage { -- This is /not/ the Babbage protocol version. It is the protocol -- version that this node will declare that it understands, when it -- is in the Babbage era. - Consensus.babbageProtVer = ProtVer (natVersion @9) 0, - Consensus.babbageMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + Consensus.babbageProtVer = ProtVer (natVersion @9) 0 } Consensus.ProtocolParamsConway { -- This is /not/ the Conway protocol version. It is the protocol -- version that this node will declare that it understands, when it -- is in the Conway era. - Consensus.conwayProtVer = ProtVer (natVersion @9) 0, - Consensus.conwayMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + Consensus.conwayProtVer = ProtVer (natVersion @9) 0 } -- The 'CardanoHardForkTriggers' specify the parameters needed to -- transition between two eras. The comments below also apply for all diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs index 505c941123..10d5e506ac 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs @@ -44,7 +44,6 @@ import qualified Data.Aeson as Aeson (FromJSON (..), eitherDecodeStrict') import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..)) import Ouroboros.Consensus.Shelley.Node (Nonce (..), @@ -87,10 +86,7 @@ mkSomeConsensusProtocolShelley NodeShelleyProtocolConfiguration { leaderCredentials } Consensus.ProtocolParamsShelley { - shelleyProtVer = - ProtVer (natVersion @2) 0, - shelleyMaxTxCapacityOverrides = - Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = ProtVer (natVersion @2) 0 } genesisHashToPraosNonce :: GenesisHash -> Nonce diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Byron.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Byron.hs index 3aa4f38794..08248df351 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Byron.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Byron.hs @@ -26,7 +26,6 @@ import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import qualified Ouroboros.Consensus.Byron.Ledger as Byron import Ouroboros.Consensus.Byron.Node (PBftSignatureThreshold (..), ProtocolParams (..), protocolInfoByron) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Text.Builder (decimal) @@ -114,5 +113,4 @@ mkByronProtocolInfo genesisConfig signatureThreshold = , byronProtocolVersion = Update.ProtocolVersion 1 0 0 , byronSoftwareVersion = Update.SoftwareVersion (Update.ApplicationName "db-analyser") 2 , byronLeaderCredentials = Nothing - , byronMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure } diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs index 486ff914a7..4000591d49 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs @@ -70,7 +70,6 @@ import Ouroboros.Consensus.HardFork.Combinator (HardForkBlock (..), import Ouroboros.Consensus.HardFork.Combinator.State (currentState) import Ouroboros.Consensus.HeaderValidation (HasAnnTip) import Ouroboros.Consensus.Ledger.Abstract -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Shelley.HFEras () import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley.Ledger @@ -376,7 +375,6 @@ mkCardanoProtocolInfo genesisByron signatureThreshold transitionConfig initialNo , byronProtocolVersion = Byron.Update.ProtocolVersion 1 2 0 , byronSoftwareVersion = Byron.Update.SoftwareVersion (Byron.Update.ApplicationName "db-analyser") 2 , byronLeaderCredentials = Nothing - , byronMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure } ProtocolParamsShelleyBased { shelleyBasedInitialNonce = initialNonce @@ -386,28 +384,22 @@ mkCardanoProtocolInfo genesisByron signatureThreshold transitionConfig initialNo -- Note that this is /not/ the Shelley protocol version, see -- https://github.com/IntersectMBO/cardano-node/blob/daeae61a005776ee7b7514ce47de3933074234a8/cardano-node/src/Cardano/Node/Protocol/Cardano.hs#L167-L170 -- and the succeeding comments. - shelleyProtVer = ProtVer (SL.natVersion @3) 0 - , shelleyMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = ProtVer (SL.natVersion @3) 0 } ProtocolParamsAllegra { - allegraProtVer = ProtVer (SL.natVersion @4) 0 - , allegraMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + allegraProtVer = ProtVer (SL.natVersion @4) 0 } ProtocolParamsMary { - maryProtVer = ProtVer (SL.natVersion @5) 0 - , maryMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + maryProtVer = ProtVer (SL.natVersion @5) 0 } ProtocolParamsAlonzo { - alonzoProtVer = ProtVer (SL.natVersion @7) 0 - , alonzoMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + alonzoProtVer = ProtVer (SL.natVersion @7) 0 } ProtocolParamsBabbage { - babbageProtVer = ProtVer (SL.natVersion @9) 0 - , babbageMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + babbageProtVer = ProtVer (SL.natVersion @9) 0 } ProtocolParamsConway { - conwayProtVer = ProtVer (SL.natVersion @9) 0 - , conwayMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + conwayProtVer = ProtVer (SL.natVersion @9) 0 } triggers transitionConfig diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs index f04a3a7e88..a916a1517a 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs @@ -37,7 +37,6 @@ import Data.Sequence.Strict (StrictSeq) import Data.Word (Word64) import Lens.Micro ((^.)) import Lens.Micro.Extras (view) -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Eras (StandardCrypto, @@ -156,6 +155,5 @@ mkShelleyProtocolInfo genesis initialNonce = , shelleyBasedLeaderCredentials = [] } ProtocolParamsShelley { - shelleyProtVer = SL.ProtVer (CL.natVersion @2) 0 - , shelleyMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = SL.ProtVer (CL.natVersion @2) 0 } diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs index 2b4642b814..23f4e83b9d 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs @@ -75,7 +75,6 @@ import Lens.Micro import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Config.SecurityParam -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (PraosCanBeLeader), @@ -422,8 +421,7 @@ mkProtocolShelley genesis initialNonce protVer coreNode = , shelleyBasedLeaderCredentials = [mkLeaderCredentials coreNode] } ProtocolParamsShelley { - shelleyProtVer = protVer - , shelleyMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure + shelleyProtVer = protVer } {------------------------------------------------------------------------------- diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs index b8fa9f1412..7eea0aa650 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs @@ -20,7 +20,6 @@ import Ouroboros.Consensus.Byron.Ledger hiding (byronProtocolVersion, byronSoftwareVersion) import Ouroboros.Consensus.Byron.Node import Ouroboros.Consensus.Config -import qualified Ouroboros.Consensus.Mempool as Mempool import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Serialisation () import Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..)) @@ -98,7 +97,6 @@ testCfg = pInfoConfig protocolInfo , byronProtocolVersion = CC.Update.ProtocolVersion 1 0 0 , byronSoftwareVersion = CC.Update.SoftwareVersion (CC.Update.ApplicationName "Cardano Test") 2 , byronLeaderCredentials = Nothing - , byronMaxTxCapacityOverrides = Mempool.mkOverrides Mempool.noOverridesMeasure } -- | Matches the values used for the generators. diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs index 5e7cedcf8a..7eba72667d 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs @@ -47,7 +47,6 @@ import Ouroboros.Consensus.Byron.Ledger.Conversions import Ouroboros.Consensus.Byron.Node import Ouroboros.Consensus.Byron.Protocol import Ouroboros.Consensus.Config -import qualified Ouroboros.Consensus.Mempool as TxLimits import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId @@ -1295,10 +1294,7 @@ mkRekeyUpd genesisConfig genesisSecrets cid pInfo blockForging eno newSK = do (_:_) -> let genSK = genesisSecretFor genesisConfig genesisSecrets cid creds' = updSignKey genSK bcfg cid (coerce eno) newSK - blockForging' = - byronBlockForging - (TxLimits.mkOverrides TxLimits.noOverridesMeasure) - creds' + blockForging' = byronBlockForging creds' in Just TestNodeInitialization { tniCrucialTxs = [dlgTx (blcDlgCert creds')] diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Coherence.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Coherence.hs index 4f60aa9b39..31e2d0b571 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Coherence.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Coherence.hs @@ -1,6 +1,7 @@ module Test.Consensus.Shelley.Coherence (tests) where import Cardano.Ledger.Alonzo.Scripts (ExUnits, pointWiseExUnits) +import qualified Data.Measure as Measure import Data.Word (Word32) import qualified Ouroboros.Consensus.Mempool.Capacity as MempoolCapacity import Ouroboros.Consensus.Shelley.Ledger.Mempool (AlonzoMeasure (..), @@ -11,15 +12,15 @@ import Test.Tasty.QuickCheck tests :: TestTree tests = testGroup "Shelley coherences" [ - testProperty "MempoolCapacity.<= uses pointWiseExUnits (<=)" leqCoherence + testProperty "Measure.<= uses pointWiseExUnits (<=)" leqCoherence ] --- | 'MempoolCapacity.<=' and @'pointWiseExUnits' (<=)@ must agree +-- | 'Measure.<=' and @'pointWiseExUnits' (<=)@ must agree leqCoherence :: Word32 -> ExUnits -> ExUnits -> Property leqCoherence w eu1 eu2 = actual === expected where inj eu = AlonzoMeasure (MempoolCapacity.ByteSize w) (fromExUnits eu) - actual = inj eu1 MempoolCapacity.<= inj eu2 + actual = inj eu1 Measure.<= inj eu2 expected = pointWiseExUnits (<=) eu1 eu2 diff --git a/ouroboros-consensus/changelog.d/20240710_104545_nick.frisby_remove_cap_override_forge.md b/ouroboros-consensus/changelog.d/20240710_104545_nick.frisby_remove_cap_override_forge.md new file mode 100644 index 0000000000..ac9b61ab73 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20240710_104545_nick.frisby_remove_cap_override_forge.md @@ -0,0 +1,22 @@ + + + + + +### Breaking + +- Remove the capacity override from forging functions. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs index d6400ee676..2019f51d24 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs @@ -154,23 +154,16 @@ data BlockForging m blk = BlockForging { -- -- Filters out all transactions that do not fit the maximum size of total -- transactions in a single block, which is determined by querying the ledger --- state for the current limit and the given override. The result is the --- pointwise minimum of the ledger-specific capacity and the result of the --- override. In other words, the override can only reduce (parts of) the --- 'MempoolCapacity.TxMeasure'. +-- state for the current limit. takeLargestPrefixThatFits :: TxLimits blk - => MempoolCapacity.TxOverrides blk - -> TickedLedgerState blk + => TickedLedgerState blk -> [Validated (GenTx blk)] -> [Validated (GenTx blk)] -takeLargestPrefixThatFits overrides ledger txs = +takeLargestPrefixThatFits ledger txs = Measure.take (MempoolCapacity.txMeasure ledger) capacity txs where - capacity = - MempoolCapacity.applyOverrides - overrides - (MempoolCapacity.txsBlockCapacity ledger) + capacity = MempoolCapacity.txsBlockCapacity ledger data ShouldForge blk = -- | Before check whether we are a leader in this slot, we tried to update diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool.hs index 8851ce82b2..849e38cce4 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool.hs @@ -27,12 +27,6 @@ module Ouroboros.Consensus.Mempool ( -- ** Transaction size , ByteSize (..) , TxLimits (..) - -- ** Restricting more strongly than the ledger's limits - , TxOverrides - , applyOverrides - , getOverrides - , mkOverrides - , noOverridesMeasure -- * Mempool initialization , openMempool , openMempoolWithoutSyncThread @@ -51,8 +45,7 @@ import Ouroboros.Consensus.Mempool.API (ForgeLedgerState (..), import Ouroboros.Consensus.Mempool.Capacity (ByteSize (..), MempoolCapacityBytes (..), MempoolCapacityBytesOverride (..), MempoolSize (..), - TxLimits (..), TxOverrides (..), applyOverrides, - computeMempoolCapacity, mkOverrides, noOverridesMeasure) + TxLimits (..), computeMempoolCapacity) import Ouroboros.Consensus.Mempool.Impl.Common (LedgerInterface (..), TraceEventMempool (..), chainDBLedgerInterface) import Ouroboros.Consensus.Mempool.Init (openMempool, diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Capacity.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Capacity.hs index 6bf11d433c..d9d314bbe3 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Capacity.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Capacity.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | Mempool capacity, size and transaction size datatypes. @@ -22,24 +21,14 @@ module Ouroboros.Consensus.Mempool.Capacity ( -- * Transaction size , ByteSize (..) , TxLimits (..) - , (<=) - -- * Restricting more strongly than the ledger's limits - , TxOverrides - , applyOverrides - , getOverrides - , mkOverrides - , noOverridesMeasure ) where -import Data.Coerce (coerce) import Data.Measure (BoundedMeasure, Measure) -import qualified Data.Measure as Measure import Data.Word (Word32) import NoThunks.Class import Ouroboros.Consensus.Ledger.Basics import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Ticked (Ticked (..)) -import Prelude hiding ((<=)) {------------------------------------------------------------------------------- Mempool capacity in bytes @@ -128,11 +117,6 @@ class BoundedMeasure (TxMeasure blk) => TxLimits blk where -- | What is the allowed capacity for txs in an individual block? txsBlockCapacity :: Ticked (LedgerState blk) -> TxMeasure blk --- | Is every component of the first value less-than-or-equal-to the --- corresponding component of the second value? -(<=) :: Measure a => a -> a -> Bool -(<=) = (Measure.<=) - {------------------------------------------------------------------------------- ByteSize -------------------------------------------------------------------------------} @@ -141,49 +125,3 @@ newtype ByteSize = ByteSize { unByteSize :: Word32 } deriving stock (Show) deriving newtype (Eq, Ord) deriving newtype (BoundedMeasure, Measure) - -{------------------------------------------------------------------------------- - Overrides --------------------------------------------------------------------------------} - --- | An override that lowers a capacity limit --- --- Specifically, we use this override to let the node operator limit the total --- 'TxMeasure' of transactions in blocks even more severely than would the --- ledger state's 'txsBlockCapacity'. The forge logic will use the 'Measure.min' --- (ie the lattice's @meet@ operator) to combine this override with the capacity --- given by the ledger state. More concretely, that will typically be a --- componentwise minimum operation, along each of the components\/dimensions of --- @'TxMeasure' blk@. --- --- This newtype wrapper distinguishes the intention of this particular --- 'TxMeasure' as such an override. We use 'TxMeasure' in different ways in this --- code base. The newtype also allows us to distinguish the one most appropriate --- monoid among many offered by the 'TxLimits' superclass constraints: it is the --- monoid induced by the bounded meet-semilattice (see 'BoundedMeasure') that is --- relevant to the notion of /overriding/ the ledger's block capacity. -newtype TxOverrides blk = - -- This constructor is not exported. - TxOverrides { getOverrides :: TxMeasure blk } - -instance TxLimits blk => Monoid (TxOverrides blk) where - mempty = TxOverrides noOverridesMeasure - -instance TxLimits blk => Semigroup (TxOverrides blk) where - (<>) = coerce $ Measure.min @(TxMeasure blk) - --- | @'applyOverrides' 'noOverrides' m = m@ -noOverridesMeasure :: BoundedMeasure a => a -noOverridesMeasure = Measure.maxBound - --- | Smart constructor for 'Overrides'. -mkOverrides :: TxMeasure blk -> TxOverrides blk -mkOverrides = TxOverrides - --- | Apply the override -applyOverrides :: - TxLimits blk - => TxOverrides blk - -> TxMeasure blk - -> TxMeasure blk -applyOverrides (TxOverrides m') m = Measure.min m' m