Merge pull request #2938 from input-output-hk/jc/fix-alonzo-minfee-on…

…-release-1-0-0

the alonzo UTxO rule to use alonzo minfee function

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

@@ -21,8 +21,8 @@ import Cardano.Ledger.Address (Addr (..), RewardAcnt)
 import Cardano.Ledger.Alonzo.Data (DataHash, dataHashSize)
 import Cardano.Ledger.Alonzo.PParams (PParams' (..))
 import Cardano.Ledger.Alonzo.Rules.Utxos (ConcreteAlonzo, UTXOS, UtxosPredicateFailure)
-import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits)
-import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), totExUnits)
+import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Prices, pointWiseExUnits)
+import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), minfee, totExUnits)
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo (ValidatedTx)
 import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq)
 import Cardano.Ledger.Alonzo.TxWitness (Redeemers, TxWitness (txrdmrs'), nullRedeemers)
@@ -50,7 +50,6 @@ import Cardano.Ledger.Rules.ValidationMode
   ( Inject (..),
     InjectMaybe (..),
     Test,
-    mapMaybeValidation,
     runTest,
     runTestOnSignal,
   )
@@ -272,8 +271,10 @@ feesOK ::
     Core.Tx era ~ Alonzo.ValidatedTx era,
     -- "collateral" to get inputs to pay the fees
     HasField "collateral" (Core.TxBody era) (Set (TxIn (Crypto era))),
+    HasField "txrdmrs" (Core.Witnesses era) (Redeemers era),
     HasField "_minfeeA" (Core.PParams era) Natural,
     HasField "_minfeeB" (Core.PParams era) Natural,
+    HasField "_prices" (Core.PParams era) Prices,
     HasField "_collateralPercentage" (Core.PParams era) Natural
   ) =>
   Core.PParams era ->
@@ -286,9 +287,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 = getField @"txfee" txb
+      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 txb utxoCollateral bal

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

@@ -104,6 +104,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,14 +24,23 @@ import Cardano.Ledger.Alonzo.PParams
     getLanguageView,
   )
 import Cardano.Ledger.Alonzo.Rules.Utxo (utxoEntrySize)
-import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), mkCostModel)
+import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), Prices (..), mkCostModel)
+import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), minfee)
 import Cardano.Ledger.Alonzo.TxBody (TxOut (..))
-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 (SupportsSegWit (..))
 import Cardano.Ledger.Mary.Value (Value (..), 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 qualified Data.ByteString.Lazy as BSL
+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 <- BSL.readFile "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