Merge #3261

3261: Move override support for max tx capacities into the ProtocolInfo constructors r=nfrisby a=nfrisby

Fixes #3235 (again).

See the individual commit messages, some of which are extensive.

Co-authored-by: Nicolas Frisby <nick.frisby@iohk.io>

cabal.project

@@ -195,21 +195,24 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: eb58eebc16ee898980c83bc325ab37a2c77b2414
-  --sha256: 1v5algrsa3g6lphl1nfih54xkc2xa5q1yfa3kgclcp6sxj1yjnnl
+  tag: 8c732560b201b5da8e3bdf175c6eda73a32d64bc
+  --sha256: 0nwy03wyd2ks4qxg47py7lm18karjz6vs7p8knmn3zy72i3n9rfi
   subdir:
+    base-deriving-via
     binary
     binary/test
     cardano-crypto-class
     cardano-crypto-praos
+    measures
+    orphans-deriving-via
     slotting
     strict-containers
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 136967cd3700f34c57cd70be7aceca8a5efca485
-  --sha256: 020sm2wsmc9qhkpmjz0qi8wl6w95lq5g0m1gvlivb0kc78w3lmhd
+  tag: 51561fcb13170e3849873eef82e634c1041ee1d6
+  --sha256: 1699hbz1i92hbjjzv9ym43qzji5xiz7gqbd0y8m2ylc353c0sxzn
   subdir:
     alonzo/impl
     alonzo/test

ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Ledger.hs

@@ -25,7 +25,6 @@ module Ouroboros.Consensus.ByronDual.Ledger (
   ) where
 
 import           Codec.Serialise
-import           Control.Exception (assert)
 import           Data.ByteString (ByteString)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -47,6 +46,7 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Dual
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Protocol.PBFT
 
 import           Ouroboros.Consensus.Byron.Crypto.DSIGN
@@ -211,14 +211,10 @@ forgeDualByronBlock
   -> BlockNo                              -- ^ Current block number
   -> SlotNo                               -- ^ Current slot number
   -> TickedLedgerState DualByronBlock     -- ^ Ledger
-  -> MaxTxCapacityOverride DualByronBlock -- ^ Do we override max tx capacity defined
-                                          --   by ledger (see MaxTxCapacityOverride)
   -> [Validated (GenTx DualByronBlock)]   -- ^ Txs to add in the block
   -> PBftIsLeader PBftByronCrypto         -- ^ Leader proof ('IsLeader')
   -> DualByronBlock
-forgeDualByronBlock cfg curBlockNo curSlotNo tickedLedger maxTxCapacityOverride vtxs isLeader =
-    -- for simplicity we assume that MaxTxCapacityOverride is not modified by tests
-    assert isNoMaxTxCapacityOverride $
+forgeDualByronBlock cfg curBlockNo curSlotNo tickedLedger vtxs isLeader =
     -- NOTE: We do not /elaborate/ the real Byron block from the spec one, but
     -- instead we /forge/ it. This is important, because we want to test that
     -- codepath. This does mean that we do not get any kind of "bridge" between
@@ -231,17 +227,13 @@ forgeDualByronBlock cfg curBlockNo curSlotNo tickedLedger maxTxCapacityOverride
       , dualBlockBridge = mconcat $ map vDualGenTxBridge vtxs
       }
   where
-    isNoMaxTxCapacityOverride = case maxTxCapacityOverride of
-      NoMaxTxCapacityOverride -> True
-      MaxTxCapacityOverride _ -> False
-
     main :: ByronBlock
     main = forgeByronBlock
              (dualTopLevelConfigMain cfg)
+             (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
              curBlockNo
              curSlotNo
              (tickedDualLedgerStateMain tickedLedger)
-             NoMaxTxCapacityOverride
              (map vDualGenTxMain vtxs)
              isLeader
 

ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Node.hs

@@ -38,14 +38,15 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Dual
 import           Ouroboros.Consensus.Ledger.Extended
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Node.InitStorage
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.Protocol.PBFT
 import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
 import           Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB (..))
-import           Ouroboros.Consensus.Util ((......:), (.:))
+import           Ouroboros.Consensus.Util ((.....:), (.:))
 
 import           Ouroboros.Consensus.Byron.Ledger
 import           Ouroboros.Consensus.Byron.Node
@@ -71,10 +72,13 @@ dualByronBlockForging creds = BlockForging {
     , updateForgeState = \cfg ->
         fmap castForgeStateUpdateInfo .: updateForgeState (dualTopLevelConfigMain cfg)
     , checkCanForge    = checkCanForge . dualTopLevelConfigMain
-    , forgeBlock       = return ......: forgeDualByronBlock
+    , forgeBlock       = return .....: forgeDualByronBlock
     }
   where
-    BlockForging {..} = byronBlockForging creds
+    BlockForging {..} =
+      byronBlockForging
+        (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
+        creds
 
 {-------------------------------------------------------------------------------
   ProtocolInfo

ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Examples.hs

@@ -37,6 +37,7 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.PBFT
@@ -123,10 +124,10 @@ exampleBlock :: ByronBlock
 exampleBlock =
     forgeRegularBlock
       cfg
+      (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
       (BlockNo 1)
       (SlotNo 1)
       (applyChainTick ledgerConfig (SlotNo 1) ledgerStateAfterEBB)
-      NoMaxTxCapacityOverride
       [ValidatedByronTx exampleGenTx]
       (fakeMkIsLeader leaderCredentials)
   where

ouroboros-consensus-byron-test/src/Test/ThreadNet/Infra/Byron/ProtocolInfo.hs

@@ -21,6 +21,7 @@ import qualified Cardano.Chain.Genesis as Genesis
 import qualified Cardano.Chain.Update as Update
 import qualified Cardano.Crypto as Crypto
 
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo (..))
 import           Ouroboros.Consensus.NodeId (CoreNodeId (..))
 import           Ouroboros.Consensus.Protocol.PBFT
@@ -62,6 +63,7 @@ mkProtocolByron params coreNodeId genesisConfig genesisSecrets =
           , byronProtocolVersion        = theProposedProtocolVersion
           , byronSoftwareVersion        = theProposedSoftwareVersion
           , byronLeaderCredentials      = Just leaderCredentials
+          , byronMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure
           }
 
 mkLeaderCredentials

ouroboros-consensus-byron-test/test/Test/Consensus/Byron/Serialisation.hs

@@ -22,6 +22,7 @@ import qualified Cardano.Chain.Block as CC.Block
 import qualified Cardano.Chain.Update as CC.Update
 
 import           Ouroboros.Consensus.Config
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Serialisation ()
 import           Ouroboros.Consensus.Util (Dict (..))
@@ -108,6 +109,7 @@ testCfg = pInfoConfig protocolInfo
         , byronProtocolVersion        = CC.Update.ProtocolVersion 1 0 0
         , byronSoftwareVersion        = CC.Update.SoftwareVersion (CC.Update.ApplicationName "Cardano Test") 2
         , byronLeaderCredentials      = Nothing
+        , byronMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure
         }
 
 -- | Matches the values used for the generators.

ouroboros-consensus-byron-test/test/Test/ThreadNet/Byron.hs

@@ -39,6 +39,7 @@ import qualified Ouroboros.Network.MockChain.Chain as Chain
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.NodeId
@@ -1300,7 +1301,10 @@ mkRekeyUpd genesisConfig genesisSecrets cid pInfo eno newSK =
         Just _  ->
           let genSK = genesisSecretFor genesisConfig genesisSecrets cid
               creds' = updSignKey genSK bcfg cid (coerce eno) newSK
-              blockForging' = byronBlockForging creds'
+              blockForging' =
+                byronBlockForging
+                  (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
+                  creds'
               pInfo' = pInfo { pInfoBlockForging = return [blockForging'] }
 
           in Just TestNodeInitialization

ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Forge.hs

@@ -38,6 +38,7 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsMempool
                      (LedgerSupportsMempool (..), txForgetValidated)
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Protocol.PBFT
 
 import           Ouroboros.Consensus.Byron.Crypto.DSIGN
@@ -50,11 +51,11 @@ import           Ouroboros.Consensus.Byron.Protocol
 forgeByronBlock
   :: HasCallStack
   => TopLevelConfig ByronBlock
+  -> TxLimits.Overrides ByronBlock    -- ^ How to override max tx capacity
+                                      --   defined by ledger
   -> BlockNo                          -- ^ Current block number
   -> SlotNo                           -- ^ Current slot number
   -> TickedLedgerState ByronBlock     -- ^ Current ledger
-  -> MaxTxCapacityOverride ByronBlock -- ^ Do we override max tx capacity defined
-                                      --   by ledger (see MaxTxCapacityOverride)
   -> [Validated (GenTx ByronBlock)]   -- ^ Txs to consider adding in the block
   -> PBftIsLeader PBftByronCrypto     -- ^ Leader proof ('IsLeader')
   -> ByronBlock
@@ -127,15 +128,15 @@ initBlockPayloads = BlockPayloads
 forgeRegularBlock
   :: HasCallStack
   => BlockConfig ByronBlock
+  -> TxLimits.Overrides ByronBlock     -- ^ How to override max tx capacity
+                                       --   defined by ledger
   -> BlockNo                           -- ^ Current block number
   -> SlotNo                            -- ^ Current slot number
   -> TickedLedgerState ByronBlock      -- ^ Current ledger
-  -> MaxTxCapacityOverride ByronBlock  -- ^ Do we override max tx capacity defined
-                                       --   by ledger (see MaxTxCapacityOverride)
   -> [Validated (GenTx ByronBlock)]    -- ^ Txs to consider adding in the block
   -> PBftIsLeader PBftByronCrypto      -- ^ Leader proof ('IsLeader')
   -> ByronBlock
-forgeRegularBlock cfg bno sno st maxTxCapacityOverride txs isLeader =
+forgeRegularBlock cfg maxTxCapacityOverrides bno sno st txs isLeader =
     forge $
       forgePBftFields
         (mkByronContextDSIGN cfg)
@@ -145,14 +146,12 @@ forgeRegularBlock cfg bno sno st maxTxCapacityOverride txs isLeader =
     epochSlots :: CC.Slot.EpochSlots
     epochSlots = byronEpochSlots cfg
 
-    computedMaxTxCapacity = computeMaxTxCapacity st maxTxCapacityOverride
-
     blockPayloads :: BlockPayloads
     blockPayloads =
         foldr
           extendBlockPayloads
           initBlockPayloads
-          (takeLargestPrefixThatFits computedMaxTxCapacity txs)
+          (takeLargestPrefixThatFits maxTxCapacityOverrides st txs)
 
     txPayload :: CC.UTxO.TxPayload
     txPayload = CC.UTxO.mkTxPayload (bpTxs blockPayloads)

ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Mempool.hs

@@ -85,13 +85,9 @@ import           Ouroboros.Consensus.Mempool.TxLimits
 -------------------------------------------------------------------------------}
 
 instance TxLimits ByronBlock where
-  type Measure ByronBlock = ByteSize
-  lessEq       = (<=)
-  txMeasure    = ByteSize . txInBlockSize . txForgetValidated
-  maxCapacity  = ByteSize . maxTxCapacity
-  pointwiseMin = min
-
-type instance Overrides ByronBlock = ByteSize -> ByteSize
+  type TxMeasure ByronBlock = ByteSize
+  txMeasure        = ByteSize . txInBlockSize . txForgetValidated
+  txsBlockCapacity = ByteSize . txsMaxBytes
 
 {-------------------------------------------------------------------------------
   Transactions
@@ -141,7 +137,7 @@ instance LedgerSupportsMempool ByronBlock where
     where
       validationMode = CC.ValidationMode CC.NoBlockValidation Utxo.TxValidationNoCrypto
 
-  maxTxCapacity st =
+  txsMaxBytes st =
     CC.getMaxBlockSize (tickedByronLedgerState st) - byronBlockEncodingOverhead
 
   txInBlockSize =

ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs

@@ -43,6 +43,7 @@ import           Ouroboros.Consensus.Config.SupportsNode
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Node.InitStorage
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
@@ -52,7 +53,7 @@ import           Ouroboros.Consensus.Protocol.PBFT
 import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
 import           Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB (..))
 import           Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
-import           Ouroboros.Consensus.Util ((......:))
+import           Ouroboros.Consensus.Util ((....:))
 
 import           Ouroboros.Consensus.Byron.Crypto.DSIGN
 import           Ouroboros.Consensus.Byron.Ledger
@@ -127,9 +128,10 @@ type instance ForgeStateUpdateError ByronBlock = Void
 
 byronBlockForging
   :: Monad m
-  => ByronLeaderCredentials
+  => TxLimits.Overrides ByronBlock
+  -> ByronLeaderCredentials
   -> BlockForging m ByronBlock
-byronBlockForging creds = BlockForging {
+byronBlockForging maxTxCapacityOverrides creds = BlockForging {
       forgeLabel       = blcLabel creds
     , canBeLeader
     , updateForgeState = \_ _ _ -> return $ ForgeStateUpdated ()
@@ -139,7 +141,7 @@ byronBlockForging creds = BlockForging {
                                canBeLeader
                                slot
                                tickedPBftState
-    , forgeBlock       = return ......: forgeByronBlock
+    , forgeBlock       = \cfg -> return ....: forgeByronBlock cfg maxTxCapacityOverrides
     }
   where
     canBeLeader = mkPBftCanBeLeader creds
@@ -167,6 +169,7 @@ data ProtocolParamsByron = ProtocolParamsByron {
     , byronProtocolVersion        :: Update.ProtocolVersion
     , byronSoftwareVersion        :: Update.SoftwareVersion
     , byronLeaderCredentials      :: Maybe ByronLeaderCredentials
+    , byronMaxTxCapacityOverrides :: TxLimits.Overrides ByronBlock
     }
 
 protocolInfoByron ::
@@ -179,6 +182,7 @@ protocolInfoByron ProtocolParamsByron {
                     , byronProtocolVersion        = pVer
                     , byronSoftwareVersion        = sVer
                     , byronLeaderCredentials      = mLeaderCreds
+                    , byronMaxTxCapacityOverrides = maxTxCapacityOverrides
                     } =
     ProtocolInfo {
         pInfoConfig = TopLevelConfig {
@@ -198,7 +202,9 @@ protocolInfoByron ProtocolParamsByron {
           , headerState = genesisHeaderState S.empty
           }
       , pInfoBlockForging =
-          return $ byronBlockForging <$> maybeToList mLeaderCreds
+            return
+          $ fmap (byronBlockForging maxTxCapacityOverrides)
+          $ maybeToList mLeaderCreds
       }
   where
     compactedGenesisConfig = compactGenesisConfig genesisConfig

ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs

@@ -55,7 +55,7 @@ instance LedgerSupportsMempool ByronSpecBlock where
       $ applyTx cfg DoNotIntervene slot (forgetValidatedByronSpecGenTx vtx) st
 
   -- Dummy values, as these are not used in practice.
-  maxTxCapacity = const maxBound
+  txsMaxBytes   = const maxBound
   txInBlockSize = const 0
 
   txForgetValidated = forgetValidatedByronSpecGenTx

ouroboros-consensus-cardano-test/src/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs

@@ -46,7 +46,8 @@ import qualified Ouroboros.Consensus.HardFork.History as History
 import qualified Cardano.Ledger.Era as SL
 import qualified Shelley.Spec.Ledger.API as SL
 
-import           Ouroboros.Consensus.Mempool.TxLimits
+import           Ouroboros.Consensus.Mempool.TxLimits (TxLimits)
+import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Node
@@ -256,6 +257,7 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased
           protocolParamsShelleyBased
           ()  -- trivial translation context
           protVer1
+          (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
 
     eraParams1 :: History.EraParams
     eraParams1 = shelleyEraParams genesis1
@@ -288,6 +290,7 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased
             }
           transCtxt2
           protVer2
+          (TxLimits.mkOverrides TxLimits.noOverridesMeasure)
 
     eraParams2 :: History.EraParams
     eraParams2 = shelleyEraParams genesis2