Release Consensus packages for Node 8.12.1 (#1166)

This PR technically violates the ReleaseProcess.md rules. But it's
trivially so: the last commit of this PR is supposed to be isolated in a
separate PR.

Author: amesgen

README.md

@@ -1,9 +1,9 @@
 # Ouroboros Consensus
 
-[![consensus](https://img.shields.io/badge/ouroboros--consensus-0.19.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-0.19.0.0/)
-[![diffusion](https://img.shields.io/badge/ouroboros--consensus--diffusion-0.17.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-diffusion-0.17.0.0/)
+[![consensus](https://img.shields.io/badge/ouroboros--consensus-0.19.1.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-0.19.1.0/)
+[![diffusion](https://img.shields.io/badge/ouroboros--consensus--diffusion-0.17.0.1-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-diffusion-0.17.0.1/)
 [![protocol](https://img.shields.io/badge/ouroboros--consensus--protocol-0.9.0.1-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-protocol-0.9.0.1/)
-[![cardano](https://img.shields.io/badge/ouroboros--consensus--cardano-0.17.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-cardano-0.17.0.0/)
+[![cardano](https://img.shields.io/badge/ouroboros--consensus--cardano-0.17.1.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-cardano-0.17.1.0/)
 [![sop-extras](https://img.shields.io/badge/sop--extras-0.2.0.0-blue)](https://chap.intersectmbo.org/package/sop-extras-0.2.0.0/)
 [![strict-sop-core](https://img.shields.io/badge/strict--sop--core-0.1.1.0-blue)](https://chap.intersectmbo.org/package/strict-sop-core-0.1.1.0/)
 

cabal.project

@@ -16,7 +16,7 @@ index-state:
   -- Bump this if you need newer packages from Hackage
   , hackage.haskell.org 2024-06-23T23:01:13Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-06-18T14:00:00Z
+  , cardano-haskell-packages 2024-06-26T21:39:58Z
 
 packages:
   ouroboros-consensus

flake.lock

@@ -2,6 +2,13 @@
 
 # Changelog entries
 
+<a id='changelog-0.17.1.0'></a>
+## 0.17.1.0 — 2024-06-26
+
+### Non-Breaking
+
+- Enforce Conway minfees for ref scripts in the mempool, even in Babbage
+
 <a id='changelog-0.17.0.0'></a>
 ## 0.17.0.0 — 2024-06-19
 

ouroboros-consensus-cardano/CHANGELOG.md

@@ -1,6 +1,6 @@
 cabal-version: 3.0
 name: ouroboros-consensus-cardano
-version: 0.17.0.0
+version: 0.17.1.0
 synopsis:
   The instantation of the Ouroboros consensus layer used by Cardano
 
@@ -140,7 +140,7 @@ library
     cardano-ledger-babbage ^>=1.8.1,
     cardano-ledger-binary ^>=1.3.3,
     cardano-ledger-byron ^>=1.0.1,
-    cardano-ledger-conway ^>=1.15,
+    cardano-ledger-conway ^>=1.15.1,
     cardano-ledger-core ^>=1.13,
     cardano-ledger-mary ^>=1.6.1,
     cardano-ledger-shelley ^>=1.12,

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -143,6 +143,8 @@ instance LedgerSupportsMempool ByronBlock where
 
   txForgetValidated = forgetValidatedByronTx
 
+  txRefScriptSize _ _ _ = 0
+
 data instance TxId (GenTx ByronBlock)
   = ByronTxId             !Utxo.TxId
   | ByronDlgId            !Delegation.CertificateId

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE GADTs                   #-}
 {-# LANGUAGE LambdaCase              #-}
 {-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE NumericUnderscores      #-}
 {-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE TypeApplications        #-}
 {-# LANGUAGE TypeFamilies            #-}
@@ -28,6 +29,7 @@ module Ouroboros.Consensus.Shelley.Eras (
   , StandardMary
   , StandardShelley
     -- * Shelley-based era
+  , BabbageTxDict (..)
   , ConwayEraGovDict (..)
   , ShelleyBasedEra (..)
   , WrapTx (..)
@@ -45,6 +47,7 @@ import           Cardano.Ledger.Alonzo (AlonzoEra)
 import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
 import qualified Cardano.Ledger.Alonzo.Translation as Alonzo
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
+import qualified Cardano.Ledger.Api as SL
 import qualified Cardano.Ledger.Api.Era as L
 import           Cardano.Ledger.Babbage (BabbageEra)
 import qualified Cardano.Ledger.Babbage.Rules as Babbage
@@ -57,6 +60,8 @@ import qualified Cardano.Ledger.Conway.Rules as Conway
 import qualified Cardano.Ledger.Conway.Rules as SL
                      (ConwayLedgerPredFailure (..))
 import qualified Cardano.Ledger.Conway.Translation as Conway
+import qualified Cardano.Ledger.Conway.Tx as SL
+import qualified Cardano.Ledger.Conway.UTxO as SL
 import           Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (StandardCrypto)
 import           Cardano.Ledger.Keys (DSignable, Hash)
@@ -68,11 +73,13 @@ import           Cardano.Ledger.Shelley.Core as Core
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
 import qualified Cardano.Ledger.Shelley.Rules as SL
 import qualified Cardano.Ledger.Shelley.Transition as SL
+import qualified Cardano.Ledger.Val as SL
 import qualified Cardano.Protocol.TPraos.API as SL
 import           Control.Monad.Except
 import           Control.State.Transition (PredicateFailure)
 import           Data.Data (Proxy (Proxy))
 import           Data.List.NonEmpty (NonEmpty ((:|)))
+import           Lens.Micro ((^.))
 import           NoThunks.Class (NoThunks)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
                      (WhetherToIntervene (..))
@@ -162,6 +169,16 @@ class ( Core.EraSegWits era
   -- | Whether the era has an instance of 'CG.ConwayEraGov'
   getConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
 
+  getBabbageTxDict :: proxy era -> Maybe (BabbageTxDict era)
+
+data BabbageTxDict era where
+    BabbageTxDict ::
+         SL.BabbageEraTxBody era
+      => (Integer -> Integer -> SL.ApplyTxError era)
+         -- ^ Construct an arbitrary ledger error with two integers as its
+         -- payload.
+      -> BabbageTxDict era
+
 data ConwayEraGovDict era where
     ConwayEraGovDict :: CG.ConwayEraGov era => ConwayEraGovDict era
 
@@ -172,7 +189,7 @@ isBeforeConway _ =
 -- | The default implementation of 'applyShelleyBasedTx', a thin wrapper around
 -- 'SL.applyTx'
 defaultApplyShelleyBasedTx ::
-     ShelleyBasedEra era
+     forall era. ShelleyBasedEra era
   => SL.Globals
   -> SL.LedgerEnv era
   -> SL.LedgerState era
@@ -183,12 +200,51 @@ defaultApplyShelleyBasedTx ::
        ( SL.LedgerState era
        , SL.Validated (Core.Tx era)
        )
-defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx =
+defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx = do
+    refScriptPredicate
     SL.applyTx
       globals
       ledgerEnv
       mempoolState
       tx
+  where
+    refScriptPredicate = case getBabbageTxDict (Proxy @era) of
+      Nothing -> pure ()
+      Just (BabbageTxDict mkError)
+        -- Reject it if it has more than 100 kibibytes of ref script.
+        | refScriptsSize > totalRefScriptsSizeLimit
+        -> throwError $ mkError
+            -- As we are reusing an existing error message, we add a large
+            -- number to make users running into this are productively irritated
+            -- and post this error message somewhere where they can receive
+            -- help/context.
+            (toInteger refScriptsSize           + 1_000_000_000)
+            (toInteger totalRefScriptsSizeLimit + 1_000_000_000)
+        -- Reject it if it has more than 50 kibibytes of ref script and does not
+        -- satisfy an additional fee as calculated in the table below.
+        | refScriptsSize > freeOfChargeRefScriptsBytes
+        , actualFee < expectedFee
+        -> throwError $ mkError
+            -- See above for why we add a large constant.
+            (SL.unCoin actualFee   + 100_000_000)
+            (SL.unCoin expectedFee + 100_000_000)
+        | otherwise -> pure ()
+        where
+          totalRefScriptsSizeLimit :: Int
+          totalRefScriptsSizeLimit = 100 * 1024
+
+          freeOfChargeRefScriptsBytes :: Int
+          freeOfChargeRefScriptsBytes = 50 * 1024
+
+          actualFee = tx ^. SL.bodyTxL . SL.feeTxBodyL
+          expectedFee = minFee SL.<+> refScriptsFee
+            where
+              minFee = SL.getMinFeeTx (SL.ledgerPp ledgerEnv) tx 0
+              refScriptsFee = SL.tierRefScriptFee 1.2 25600 15 refScriptsSize
+
+          refScriptsSize = SL.txNonDistinctRefScriptsSize utxo tx
+
+          utxo = SL.utxosUtxo . SL.lsUTxOState $ mempoolState
 
 defaultGetConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
 defaultGetConwayEraGovDict _ = Nothing
@@ -199,34 +255,52 @@ instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
 
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
+  getBabbageTxDict _ = Nothing
+
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (AllegraEra c) where
   applyShelleyBasedTx = defaultApplyShelleyBasedTx
 
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
+  getBabbageTxDict _ = Nothing
+
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (MaryEra c) where
   applyShelleyBasedTx = defaultApplyShelleyBasedTx
 
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
+  getBabbageTxDict _ = Nothing
+
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (AlonzoEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
 
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
+  getBabbageTxDict _ = Nothing
+
 instance (Praos.PraosCrypto c) => ShelleyBasedEra (BabbageEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
 
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
+  getBabbageTxDict _ = Just $ BabbageTxDict $ \a b ->
+      SL.ApplyTxError
+    $ pure
+    $ SL.UtxowFailure
+    $ Babbage.UtxoFailure
+    $ Babbage.AlonzoInBabbageUtxoPredFailure
+    $ Alonzo.MaxTxSizeUTxO a b
+
 instance (Praos.PraosCrypto c) => ShelleyBasedEra (ConwayEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
 
   getConwayEraGovDict _ = Just ConwayEraGovDict
 
+  getBabbageTxDict _ = Nothing
+
 applyAlonzoBasedTx :: forall era.
   ( ShelleyBasedEra era,
     SupportsTwoPhaseValidation era,

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs

@@ -42,6 +42,7 @@ import           Cardano.Ledger.Alonzo.Tx (totExUnits)
 import           Cardano.Ledger.Binary (Annotator (..), DecCBOR (..),
                      EncCBOR (..), FromCBOR (..), FullByteString (..),
                      ToCBOR (..), toPlainDecoder)
+import qualified Cardano.Ledger.Conway.UTxO as SL
 import qualified Cardano.Ledger.Core as SL (txIdTxBody)
 import           Cardano.Ledger.Crypto (Crypto)
 import qualified Cardano.Ledger.SafeHash as SL
@@ -147,6 +148,12 @@ instance ShelleyCompatible proto era
 
   txForgetValidated (ShelleyValidatedTx txid vtx) = ShelleyTx txid (SL.extractTx vtx)
 
+  txRefScriptSize _cfg st (ShelleyTx _ tx) = case getBabbageTxDict (Proxy @era) of
+      Nothing              -> 0
+      Just BabbageTxDict{} -> SL.txNonDistinctRefScriptsSize utxo tx
+    where
+      utxo = SL.getUTxO . tickedShelleyLedgerState $ st
+
 mkShelleyTx :: forall era proto. ShelleyBasedEra era => Tx era -> GenTx (ShelleyBlock proto era)
 mkShelleyTx tx = ShelleyTx (SL.txIdTxBody @era (tx ^. bodyTxL)) tx
 

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs

@@ -56,3 +56,5 @@ instance LedgerSupportsMempool ByronSpecBlock where
   txInBlockSize = const 0
 
   txForgetValidated = forgetValidatedByronSpecGenTx
+
+  txRefScriptSize _cfg _tlst _tx = 0

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

@@ -2,6 +2,13 @@
 
 # Changelog entries
 
+<a id='changelog-0.17.0.1'></a>
+## 0.17.0.1 — 2024-06-26
+
+### Patch
+
+- Add trivial `txRefScriptSize` definitions
+
 <a id='changelog-0.17.0.0'></a>
 ## 0.17.0.0 — 2024-06-19