Merge pull request #2936 from input-output-hk/jc/fix-alonzo-minfee

the alonzo UTxO rule to use alonzo minfee function

CHANGELOG.md

@@ -132,6 +132,9 @@ BabbageEraTxBody --> AlonzoEraTxBody --> ....
   #2897
 - The error message for failed Plutus V2 scripts was being obscured by a bug which has now been fixed.
   #2888
+- The Alonzo UTxO rule was previously using the incorrect minfee function (from Shelley).
+  It now uses the Alonze minfee function.
+  #2936
 
 ## Release branch 1.0.0
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -36,8 +36,8 @@ import Cardano.Ledger.Address (Addr (..), RewardAcnt)
 import Cardano.Ledger.Alonzo.Data (dataHashSize)
 import Cardano.Ledger.Alonzo.Era (AlonzoUTXO)
 import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUTXOS, UtxosPredicateFailure)
-import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits)
-import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), totExUnits)
+import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Prices, pointWiseExUnits)
+import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), minfee, totExUnits)
 import Cardano.Ledger.Alonzo.TxBody
   ( AlonzoEraTxBody (..),
     AlonzoEraTxOut (..),
@@ -71,7 +71,6 @@ import Cardano.Ledger.Rules.ValidationMode
   ( Inject (..),
     InjectMaybe (..),
     Test,
-    mapMaybeValidation,
     runTest,
     runTestOnSignal,
   )
@@ -280,9 +279,9 @@ feesOK ::
   forall era.
   ( AlonzoEraTx era,
     Tx era ~ AlonzoTx era,
-    -- "collateral" to get inputs to pay the fees
     HasField "_minfeeA" (PParams era) Natural,
     HasField "_minfeeB" (PParams era) Natural,
+    HasField "_prices" (PParams era) Prices,
     HasField "_collateralPercentage" (PParams era) Natural
   ) =>
   PParams era ->
@@ -295,9 +294,11 @@ feesOK pp tx (UTxO utxo) =
       -- restrict Utxo to those inputs we use to pay fees.
       utxoCollateral = eval (collateral ◁ utxo)
       bal = balance @era (UTxO utxoCollateral)
+      theFee = txBody ^. feeTxBodyL
+      minimumFee = minfee @era pp tx
    in sequenceA_
         [ -- Part 1: minfee pp tx ≤ txfee txb
-          mapMaybeValidation fromShelleyFailure $ Shelley.validateFeeTooSmallUTxO pp tx,
+          failureUnless (minimumFee <= theFee) (inject (FeeTooSmallUTxO @era minimumFee theFee)),
           -- Part 2: (txrdmrs tx ≠ ∅ ⇒ validateCollateral)
           unless (nullRedeemers . txrdmrs' . wits $ tx) $
             validateCollateral pp txBody utxoCollateral bal
@@ -507,6 +508,7 @@ utxoTransition ::
     HasField "_coinsPerUTxOWord" (PParams era) Coin,
     HasField "_maxCollateralInputs" (PParams era) Natural,
     HasField "_collateralPercentage" (PParams era) Natural,
+    HasField "_prices" (PParams era) Prices,
     Inject (PredicateFailure (EraRule "PPUP" era)) (PredicateFailure (EraRule "UTXOS" era))
   ) =>
   TransitionRule (AlonzoUTXO era)
@@ -609,6 +611,7 @@ instance
     HasField "_protocolVersion" (PParams era) ProtVer,
     HasField "_maxCollateralInputs" (PParams era) Natural,
     HasField "_collateralPercentage" (PParams era) Natural,
+    HasField "_prices" (PParams era) Prices,
     Inject (PredicateFailure (EraRule "PPUP" era)) (PredicateFailure (EraRule "UTXOS" era))
   ) =>
   STS (AlonzoUTXO era)

eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal

@@ -106,6 +106,7 @@ test-suite cardano-ledger-alonzo-test
     cardano-ledger-shelley-ma-test,
     cardano-protocol-tpraos,
     cardano-slotting,
+    cborg,
     containers,
     data-default-class,
     plutus-core,

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs

@@ -7,11 +7,12 @@
 module Test.Cardano.Ledger.Alonzo.Golden
   ( goldenUTxOEntryMinAda,
     goldenSerialization,
+    goldenMinFee,
     goldenScriptIntegrity,
   )
 where
 
-import Cardano.Binary (serialize)
+import Cardano.Binary (Annotator (..), FullByteString (Full), fromCBOR, serialize)
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Data (Data (..), hashData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
@@ -23,13 +24,22 @@ import Cardano.Ledger.Alonzo.PParams
     getLanguageView,
   )
 import Cardano.Ledger.Alonzo.Rules (utxoEntrySize)
-import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), mkCostModel)
+import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), Prices (..), mkCostModel)
+import Cardano.Ledger.Alonzo.Tx (minfee)
 import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
-import Cardano.Ledger.BaseTypes (StrictMaybe (..))
+import Cardano.Ledger.BaseTypes (StrictMaybe (..), boundRational)
+import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Era (EraSegWits (..))
 import Cardano.Ledger.Mary.Value (MaryValue (..), valueFromList)
+import Cardano.Protocol.TPraos.BHeader (BHeader)
+import Codec.CBOR.Read (deserialiseFromBytes)
 import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Base16.Lazy as B16L
+import Data.Either (fromRight)
+import Data.Foldable (toList)
 import qualified Data.Map.Strict as Map
+import Data.Maybe (fromJust)
 import GHC.Stack (HasCallStack)
 import Plutus.V1.Ledger.Api (Data (..))
 import qualified Plutus.V1.Ledger.Api as PV1 (costModelParamNames)
@@ -180,6 +190,40 @@ goldenSerialization =
         serialize (SLE.sleTx ledgerExamplesAlonzo) @?= expected
     ]
 
+goldenMinFee :: TestTree
+goldenMinFee =
+  testGroup
+    "golden tests - minimum fee calculation"
+    [ testCase "Alonzo Block" $ do
+        -- This golden test uses the block from:
+        -- https://github.com/input-output-hk/cardano-node/issues/4228#issuecomment-1195707491
+        --
+        -- The first transaction in this block is invalide due to:
+        --   FeeTooSmallUTxO (Coin 1006053) (Coin 1001829)
+        --
+        -- The correct behavior is for the minimum fee for this transaction
+        -- to be 1006053 lovelace, as indicated by the failure above.
+        -- Nodes that had the bug determined the minimum fee to be 1001829.
+        hex <- readDataFile "golden/hex-block-node-issue-4228.cbor"
+        let cborBlock = fromRight mempty (B16L.decode hex)
+            (_leftover, Annotator f) =
+              fromRight (error "bad golden block 4228") $
+                deserialiseFromBytes fromCBOR cborBlock
+            _block :: Block (BHeader StandardCrypto) (AlonzoEra StandardCrypto)
+            _block@(Block _header txs) = f (Full cborBlock)
+            txs' = fromTxSeq @(AlonzoEra StandardCrypto) txs
+            firstTx = head $ toList txs'
+
+            -- Below are the relevant protocol parameters that were active
+            -- at the time this block was rejected.
+            priceMem = fromJust $ boundRational 0.0577
+            priceSteps = fromJust $ boundRational 0.0000721
+            prices = Prices priceMem priceSteps
+            pp = emptyPParams {_minfeeA = 44, _minfeeB = 155381, _prices = prices}
+
+        Coin 1006053 @?= minfee pp firstTx
+    ]
+
 fromRightError :: (HasCallStack, Show a) => String -> Either a b -> b
 fromRightError errorMsg =
   either (\e -> error $ errorMsg ++ ": " ++ show e) id

eras/alonzo/test-suite/test/Tests.hs

@@ -37,6 +37,7 @@ mainTests =
       CDDL.tests 5,
       Golden.goldenUTxOEntryMinAda,
       Golden.goldenSerialization,
+      Golden.goldenMinFee,
       Golden.goldenScriptIntegrity,
       plutusScriptExamples,
       txInfoTests