Remove duplication. Reuse the same function in Babbage from Alonzo.

Also improve consistency a little by relying on Foldable.

Avoid allocation of intermediate lists by writing in a more fusion
friendly manner

Avoid redundant usage of `txouts` function

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,20 +505,20 @@ 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
 
   {-   ∀ txout ∈ txouts txb, serSize (getValue txout) ≤ maxValSize pp   -}
   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

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`
 

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
 

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
 --