diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs index 88e0ea5a814..992b27aaa92 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -22,6 +22,7 @@ module Cardano.Ledger.Alonzo.Rules.Utxo ( utxoPredFailShelleyToAlonzo, validateCollateralContainsNonADA, validateExUnitsTooBigUTxO, + validateOutputTooBigUTxO, validateInsufficientCollateral, validateOutsideForecast, validateScriptsNotPaidUTxO, @@ -88,7 +89,7 @@ import Cardano.Ledger.Shelley.LedgerState ( import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, UtxoEnv (..)) import qualified Cardano.Ledger.Shelley.Rules as Shelley import Cardano.Ledger.Shelley.Tx (TxIn) -import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), areAllAdaOnly, coinBalance, sumAllValue, txouts) +import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), areAllAdaOnly, coinBalance, sumAllValue) import qualified Cardano.Ledger.Val as Val import Cardano.Slotting.EpochInfo.API (EpochInfo, epochInfoSlotToUTCTime) import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo) @@ -362,11 +363,11 @@ validateOutsideForecast ei slotNo sysSt tx = -- -- > ∀ txout ∈ txouts txb, getValue txout ≥ inject (utxoEntrySize txout ∗ coinsPerUTxOWord pp) validateOutputTooSmallUTxO :: - AlonzoEraTxOut era => + (AlonzoEraTxOut era, Foldable f) => PParams era -> - UTxO era -> + f (TxOut era) -> Test (AlonzoUtxoPredFailure era) -validateOutputTooSmallUTxO pp (UTxO outputs) = +validateOutputTooSmallUTxO pp outputs = failureUnless (null outputsTooSmall) $ OutputTooSmallUTxO outputsTooSmall where outputsTooSmall = @@ -376,7 +377,7 @@ validateOutputTooSmallUTxO pp (UTxO outputs) = in -- pointwise is used because non-ada amounts must be >= 0 too not $ Val.pointwise (>=) v (Val.inject $ getMinCoinTxOut pp txOut) ) - (Map.elems outputs) + (toList outputs) -- | Ensure that there are no `TxOut`s that have `Value` of size larger -- than @MaxValSize@. We use serialized length of `Value` because this Value @@ -386,16 +387,17 @@ validateOutputTooSmallUTxO pp (UTxO outputs) = validateOutputTooBigUTxO :: ( EraTxOut era , AlonzoEraPParams era + , Foldable f ) => PParams era -> - UTxO era -> + f (TxOut era) -> Test (AlonzoUtxoPredFailure era) -validateOutputTooBigUTxO pp (UTxO outputs) = +validateOutputTooBigUTxO pp outputs = failureUnless (null outputsTooBig) $ OutputTooBigUTxO outputsTooBig where maxValSize = pp ^. ppMaxValSizeL protVer = pp ^. ppProtocolVersionL - outputsTooBig = foldl' accum [] $ Map.elems outputs + outputsTooBig = foldl' accum [] outputs accum ans txOut = let v = txOut ^. valueTxOutL serSize = fromIntegral $ BSL.length $ serialize (pvMajor protVer) v @@ -503,7 +505,7 @@ utxoTransition = do {- adaPolicy ∉ supp mint tx above check not needed because mint field of type MultiAsset cannot contain ada -} - let outputs = txouts txBody + let outputs = txBody ^. outputsTxBodyL {- ∀ txout ∈ txouts txb, getValuetxout ≥ inject (uxoEntrySizetxout ∗ coinsPerUTxOWord p) -} runTest $ validateOutputTooSmallUTxO pp outputs @@ -511,12 +513,12 @@ utxoTransition = do runTest $ validateOutputTooBigUTxO pp outputs {- ∀ ( _ ↦ (a,_)) ∈ txoutstxb, a ∈ Addrbootstrap → bootstrapAttrsSize a ≤ 64 -} - runTestOnSignal $ Shelley.validateOutputBootAddrAttrsTooBig (Map.elems (unUTxO outputs)) + runTestOnSignal $ Shelley.validateOutputBootAddrAttrsTooBig outputs netId <- liftSTS $ asks networkId {- ∀(_ → (a, _)) ∈ txouts txb, netId a = NetworkId -} - runTestOnSignal $ Shelley.validateWrongNetwork netId . toList $ txBody ^. outputsTxBodyL + runTestOnSignal $ Shelley.validateWrongNetwork netId outputs {- ∀(a → ) ∈ txwdrls txb, netId a = NetworkId -} runTestOnSignal $ Shelley.validateWrongNetworkWithdrawal netId txBody diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 78a206dddc4..d7f1a7d8104 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -4,6 +4,8 @@ * Add `ToJSON` instance for `BabbageTxOut`. * Add `ToJSON` instance for `BabbagePParams Identity` and `BabbagePParams StrictMaybe` +* Removed validation function `validateOutputTooBigUTxO`, in favor of the same function + from `cardano-ledger-alonzo`. ###`testlib` diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs index 270ac661762..e17f60a3ed7 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs @@ -19,7 +19,6 @@ module Cardano.Ledger.Babbage.Rules.Utxo ( validateTotalCollateral, validateCollateralEqBalance, validateOutputTooSmallUTxO, - validateOutputTooBigUTxO, ) where import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure) @@ -32,8 +31,11 @@ import Cardano.Ledger.Alonzo.Rules ( AlonzoUtxosPredFailure (..), utxoPredFailMaToAlonzo, utxoPredFailShelleyToAlonzo, + ) +import qualified Cardano.Ledger.Alonzo.Rules as Alonzo ( validateExUnitsTooBigUTxO, validateInsufficientCollateral, + validateOutputTooBigUTxO, validateOutsideForecast, validateScriptsNotPaidUTxO, validateTooManyCollateralInputs, @@ -49,13 +51,12 @@ import Cardano.Ledger.Babbage.Core import Cardano.Ledger.Babbage.Era (BabbageUTXO) import Cardano.Ledger.Babbage.Rules.Utxos (BabbageUTXOS) import Cardano.Ledger.BaseTypes ( - ProtVer (..), ShelleyBase, epochInfo, networkId, systemStart, ) -import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), Sized (..), serialize) +import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), Sized (..)) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Rules.ValidationMode ( @@ -85,9 +86,8 @@ import Control.State.Transition.Extended ( trans, ) import Data.Bifunctor (first) -import qualified Data.ByteString.Lazy as BSL import Data.Coerce (coerce) -import Data.Foldable (Foldable (foldl'), sequenceA_, toList) +import Data.Foldable (sequenceA_, toList) import Data.List.NonEmpty (NonEmpty) import qualified Data.Map.Strict as Map import Data.Maybe.Strict (StrictMaybe (..)) @@ -204,12 +204,12 @@ validateTotalCollateral :: validateTotalCollateral pp txBody utxoCollateral = sequenceA_ [ -- Part 3: (∀(a,_,_) ∈ range (collateral txb ◁ utxo), a ∈ Addrvkey) - fromAlonzoValidation $ validateScriptsNotPaidUTxO utxoCollateral + fromAlonzoValidation $ Alonzo.validateScriptsNotPaidUTxO utxoCollateral , -- Part 4: isAdaOnly balance fromAlonzoValidation $ validateCollateralContainsNonADA txBody utxoCollateral , -- Part 5: balance ≥ ⌈txfee txb ∗ (collateralPercent pp) / 100⌉ - fromAlonzoValidation $ validateInsufficientCollateral pp txBody bal + fromAlonzoValidation $ Alonzo.validateInsufficientCollateral pp txBody bal , -- Part 6: (txcoll tx ≠ ◇) ⇒ balance = txcoll tx validateCollateralEqBalance bal (txBody ^. totalCollateralTxBodyL) , -- Part 7: collInputs tx ≠ ∅ @@ -261,14 +261,14 @@ validateCollateralEqBalance bal txcoll = -- > getValue txout ≥ inject ( serSize txout ∗ coinsPerUTxOByte pp ) validateOutputTooSmallUTxO :: - EraTxOut era => + (EraTxOut era, Foldable f) => PParams era -> - [Sized (TxOut era)] -> + f (Sized (TxOut era)) -> Test (BabbageUtxoPredFailure era) validateOutputTooSmallUTxO pp outs = failureUnless (null outputsTooSmall) $ BabbageOutputTooSmallUTxO outputsTooSmall where - outs' = map (\out -> (sizedValue out, getMinCoinSizedTxOut pp out)) outs + outs' = map (\out -> (sizedValue out, getMinCoinSizedTxOut pp out)) (toList outs) outputsTooSmall = filter ( \(out, minSize) -> @@ -282,27 +282,6 @@ validateOutputTooSmallUTxO pp outs = ) outs' --- > serSize (getValue txout) ≤ maxValSize pp -validateOutputTooBigUTxO :: - ( EraTxOut era - , AlonzoEraPParams era - ) => - PParams era -> - [TxOut era] -> - Test (AlonzoUtxoPredFailure era) -validateOutputTooBigUTxO pp outs = - failureUnless (null outputsTooBig) $ OutputTooBigUTxO outputsTooBig - where - maxValSize = pp ^. ppMaxValSizeL - protVer = pp ^. ppProtocolVersionL - outputsTooBig = foldl' accum [] outs - accum ans txOut = - let v = txOut ^. valueTxOutL - serSize = fromIntegral $ BSL.length $ serialize (pvMajor protVer) v - in if serSize > maxValSize - then (fromIntegral serSize, fromIntegral maxValSize, txOut) : ans - else ans - -- | The UTxO transition rule for the Babbage eras. utxoTransition :: forall era. @@ -335,7 +314,7 @@ utxoTransition = do ei <- liftSTS $ asks epochInfo {- epochInfoSlotToUTCTime epochInfo systemTime i_f ≠ ◇ -} - runTest $ validateOutsideForecast ei slot sysSt tx + runTest $ Alonzo.validateOutsideForecast ei slot sysSt tx {- txins txb ≠ ∅ -} runTestOnSignal $ Shelley.validateInputSetEmptyUTxO txBody @@ -354,12 +333,12 @@ utxoTransition = do cannot contain ada -} {- ∀ txout ∈ allOuts txb, getValue txout ≥ inject (serSize txout ∗ coinsPerUTxOByte pp) -} - let allSizedOutputs = toList (txBody ^. allSizedOutputsTxBodyF) + let allSizedOutputs = txBody ^. allSizedOutputsTxBodyF runTest $ validateOutputTooSmallUTxO pp allSizedOutputs let allOutputs = fmap sizedValue allSizedOutputs {- ∀ txout ∈ allOuts txb, serSize (getValue txout) ≤ maxValSize pp -} - runTest $ validateOutputTooBigUTxO pp allOutputs + runTest $ Alonzo.validateOutputTooBigUTxO pp allOutputs {- ∀ ( _ ↦ (a,_)) ∈ allOuts txb, a ∈ Addrbootstrap → bootstrapAttrsSize a ≤ 64 -} runTestOnSignal $ Shelley.validateOutputBootAddrAttrsTooBig allOutputs @@ -373,16 +352,16 @@ utxoTransition = do runTestOnSignal $ Shelley.validateWrongNetworkWithdrawal netId txBody {- (txnetworkid txb = NetworkId) ∨ (txnetworkid txb = ◇) -} - runTestOnSignal $ validateWrongNetworkInTxBody netId txBody + runTestOnSignal $ Alonzo.validateWrongNetworkInTxBody netId txBody {- txsize tx ≤ maxTxSize pp -} runTestOnSignal $ Shelley.validateMaxTxSizeUTxO pp tx {- totExunits tx ≤ maxTxExUnits pp -} - runTest $ validateExUnitsTooBigUTxO pp tx + runTest $ Alonzo.validateExUnitsTooBigUTxO pp tx {- ‖collateral tx‖ ≤ maxCollInputs pp -} - runTest $ validateTooManyCollateralInputs pp txBody + runTest $ Alonzo.validateTooManyCollateralInputs pp txBody trans @(EraRule "UTXOS" era) =<< coerce <$> judgmentContext diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs index b3ee7626506..a5b5a52b559 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs @@ -381,49 +381,49 @@ utxoInductive :: utxoInductive = do TRC (UtxoEnv slot pp dpstate genDelegs, u, tx) <- judgmentContext let UTxOState utxo _ _ ppup _ = u - let txb = tx ^. bodyTxL + txBody = tx ^. bodyTxL + outputs = txBody ^. outputsTxBodyL {- txttl txb ≥ slot -} - runTest $ validateTimeToLive txb slot + runTest $ validateTimeToLive txBody slot {- txins txb ≠ ∅ -} - runTest $ validateInputSetEmptyUTxO txb + runTest $ validateInputSetEmptyUTxO txBody {- minfee pp tx ≤ txfee txb -} runTest $ validateFeeTooSmallUTxO pp tx {- txins txb ⊆ dom utxo -} - runTest $ validateBadInputsUTxO utxo $ txb ^. inputsTxBodyL + runTest $ validateBadInputsUTxO utxo $ txBody ^. inputsTxBodyL netId <- liftSTS $ asks networkId {- ∀(_ → (a, _)) ∈ txouts txb, netId a = NetworkId -} - runTest . validateWrongNetwork netId . toList $ txb ^. outputsTxBodyL + runTest $ validateWrongNetwork netId outputs {- ∀(a → ) ∈ txwdrls txb, netId a = NetworkId -} - runTest $ validateWrongNetworkWithdrawal netId txb + runTest $ validateWrongNetworkWithdrawal netId txBody {- consumed pp utxo txb = produced pp poolParams txb -} - runTest $ validateValueNotConservedUTxO pp utxo dpstate txb + runTest $ validateValueNotConservedUTxO pp utxo dpstate txBody -- process Protocol Parameter Update Proposals ppup' <- trans @(EraRule "PPUP" era) $ TRC (PPUPEnv slot pp genDelegs, ppup, txup tx) - let outputs = txouts txb {- ∀(_ → (_, c)) ∈ txouts txb, c ≥ (minUTxOValue pp) -} runTest $ validateOutputTooSmallUTxO pp outputs {- ∀ ( _ ↦ (a,_)) ∈ txoutstxb, a ∈ Addrbootstrap → bootstrapAttrsSize a ≤ 64 -} - runTest $ validateOutputBootAddrAttrsTooBig (Map.elems (unUTxO outputs)) + runTest $ validateOutputBootAddrAttrsTooBig outputs {- txsize tx ≤ maxTxSize pp -} runTest $ validateMaxTxSizeUTxO pp tx - let refunded = keyTxRefunds pp dpstate txb - let totalDeposits' = totalTxDeposits pp dpstate txb + let refunded = keyTxRefunds pp dpstate txBody + let totalDeposits' = totalTxDeposits pp dpstate txBody let depositChange = totalDeposits' Val.<-> refunded - tellEvent $ TotalDeposits (hashAnnotated txb) depositChange - pure $! updateUTxOState pp u txb depositChange ppup' + tellEvent $ TotalDeposits (hashAnnotated txBody) depositChange + pure $! updateUTxOState pp u txBody depositChange ppup' -- | The ttl field marks the top of an open interval, so it must be strictly -- less than the slot, so fail if it is (>=). @@ -482,17 +482,17 @@ validateBadInputsUTxO utxo txins = -- -- > ∀(_ → (a, _)) ∈ txouts txb, netId a = NetworkId validateWrongNetwork :: - EraTxOut era => + (EraTxOut era, Foldable f) => Network -> - [TxOut era] -> + f (TxOut era) -> Test (ShelleyUtxoPredFailure era) -validateWrongNetwork netId outs = +validateWrongNetwork netId outputs = failureUnless (null addrsWrongNetwork) $ WrongNetwork netId (Set.fromList addrsWrongNetwork) where addrsWrongNetwork = filter (\a -> getNetwork a /= netId) - (view addrTxOutL <$> outs) + (view addrTxOutL <$> toList outputs) -- | Make sure all addresses match the supplied NetworkId -- @@ -534,11 +534,11 @@ validateValueNotConservedUTxO pp utxo dpstate txb = -- -- > ∀(_ → (_, c)) ∈ txouts txb, c ≥ (minUTxOValue pp) validateOutputTooSmallUTxO :: - EraTxOut era => + (EraTxOut era, Foldable f) => PParams era -> - UTxO era -> + f (TxOut era) -> Test (ShelleyUtxoPredFailure era) -validateOutputTooSmallUTxO pp (UTxO outputs) = +validateOutputTooSmallUTxO pp outputs = failureUnless (null outputsTooSmall) $ OutputTooSmallUTxO outputsTooSmall where -- minUTxOValue deposit comparison done as Coin because this rule is correct @@ -547,15 +547,15 @@ validateOutputTooSmallUTxO pp (UTxO outputs) = outputsTooSmall = filter (\txOut -> txOut ^. coinTxOutL < getMinCoinTxOut pp txOut) - (Map.elems outputs) + (toList outputs) -- | Bootstrap (i.e. Byron) addresses have variable sized attributes in them. -- It is important to limit their overall size. -- -- > ∀ ( _ ↦ (a,_)) ∈ txoutstxb, a ∈ Addrbootstrap → bootstrapAttrsSize a ≤ 64 validateOutputBootAddrAttrsTooBig :: - EraTxOut era => - [TxOut era] -> + (EraTxOut era, Foldable f) => + f (TxOut era) -> Test (ShelleyUtxoPredFailure era) validateOutputBootAddrAttrsTooBig outputs = failureUnless (null outputsAttrsTooBig) $ OutputBootAddrAttrsTooBig outputsAttrsTooBig @@ -567,7 +567,7 @@ validateOutputBootAddrAttrsTooBig outputs = Just addr -> bootstrapAddressAttrsSize addr > 64 _ -> False ) - outputs + (toList outputs) -- | Ensure that the size of the transaction does not exceed the @maxTxSize@ protocol parameter --