Skip to content

Commit

Permalink
the alonzo UTxO rule to use alonzo minfee function
Browse files Browse the repository at this point in the history
Additionally, a new golden test for the alonzo fee calculation has been
added, using the block from:
IntersectMBO/cardano-node#4228 (comment)
  • Loading branch information
Jared Corduan committed Jul 28, 2022
1 parent ebcf1a8 commit 7bec14d
Show file tree
Hide file tree
Showing 5 changed files with 57 additions and 7 deletions.
11 changes: 7 additions & 4 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -50,7 +50,6 @@ import Cardano.Ledger.Rules.ValidationMode
( Inject (..),
InjectMaybe (..),
Test,
mapMaybeValidation,
runTest,
runTestOnSignal,
)
Expand Down Expand Up @@ -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 ->
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down

Large diffs are not rendered by default.

50 changes: 47 additions & 3 deletions eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions eras/alonzo/test-suite/test/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,7 @@ mainTests =
CDDL.tests 5,
Golden.goldenUTxOEntryMinAda,
Golden.goldenSerialization,
Golden.goldenMinFee,
Golden.goldenScriptIntegrity,
plutusScriptExamples,
txInfoTests
Expand Down

0 comments on commit 7bec14d

Please sign in to comment.