Skip to content

Commit

Permalink
Merge pull request #4857 from IntersectMBO/jj/lazy-predfailures
Browse files Browse the repository at this point in the history
Made predicate failure and environment fields lazy
lehins authored Jan 28, 2025
2 parents 85543d6 + 014420f commit 95907f5
Showing 40 changed files with 263 additions and 257 deletions.
1 change: 1 addition & 0 deletions eras/allegra/impl/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -2,6 +2,7 @@

## 1.7.0.0

* Made the fields of predicate failures and environments lazy
* Add `Era era` constraint to `NoThunks` instance for `TimeLock`
* Remove `Era era` constraint from:
* `getRequireSignatureTimelock`
26 changes: 13 additions & 13 deletions eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs
Original file line number Diff line number Diff line change
@@ -70,29 +70,29 @@ import Validation
-- ==========================================================

data AllegraUtxoPredFailure era
= BadInputsUTxO !(Set TxIn) -- The bad transaction inputs
= BadInputsUTxO (Set TxIn) -- The bad transaction inputs
| OutsideValidityIntervalUTxO
!ValidityInterval -- transaction's validity interval
!SlotNo -- current slot
| MaxTxSizeUTxO !(Mismatch 'RelLTEQ Integer)
ValidityInterval -- transaction's validity interval
SlotNo -- current slot
| MaxTxSizeUTxO (Mismatch 'RelLTEQ Integer)
| InputSetEmptyUTxO
| FeeTooSmallUTxO !(Mismatch 'RelGTEQ Coin)
| ValueNotConservedUTxO !(Mismatch 'RelEQ (Value era)) -- Consumed, then produced
| FeeTooSmallUTxO (Mismatch 'RelGTEQ Coin)
| ValueNotConservedUTxO (Mismatch 'RelEQ (Value era)) -- Consumed, then produced
| WrongNetwork
!Network -- the expected network id
!(Set Addr) -- the set of addresses with incorrect network IDs
Network -- the expected network id
(Set Addr) -- the set of addresses with incorrect network IDs
| WrongNetworkWithdrawal
!Network -- the expected network id
!(Set RewardAccount) -- the set of reward addresses with incorrect network IDs
Network -- the expected network id
(Set RewardAccount) -- the set of reward addresses with incorrect network IDs
| OutputTooSmallUTxO
![TxOut era] -- list of supplied transaction outputs that are too small
[TxOut era] -- list of supplied transaction outputs that are too small
| UpdateFailure (EraRuleFailure "PPUP" era) -- Subtransition Failures
| OutputBootAddrAttrsTooBig
![TxOut era] -- list of supplied bad transaction outputs
[TxOut era] -- list of supplied bad transaction outputs
| -- Kept for backwards compatibility: no longer used because the `MultiAsset` type of mint doesn't allow for this possibility
TriesToForgeADA -- TODO: remove
| OutputTooBigUTxO
![TxOut era] -- list of supplied bad transaction outputs
[TxOut era] -- list of supplied bad transaction outputs
deriving (Generic)

type instance EraRuleFailure "UTXO" AllegraEra = AllegraUtxoPredFailure AllegraEra
1 change: 1 addition & 0 deletions eras/alonzo/impl/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -2,6 +2,7 @@

## 1.13.0.0

* Made the fields of predicate failures and environments lazy
* Add `MemPack` instance for `Addr28Extra`, `DataHash32`, `AlonzoTxOut` and `PlutusScript AlonzoEra`
* Deprecate `hashAlonzoTxAuxData`
* Stop re-exporting deprecated `AuxiliaryDataHash` from `Cardano.Ledger.Alonzo.TxAuxData`
2 changes: 1 addition & 1 deletion eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs
Original file line number Diff line number Diff line change
@@ -81,7 +81,7 @@ import NoThunks.Class (NoThunks (..))

data AlonzoBbodyPredFailure era
= ShelleyInAlonzoBbodyPredFailure (ShelleyBbodyPredFailure era)
| TooManyExUnits !(Mismatch 'RelLTEQ ExUnits)
| TooManyExUnits (Mismatch 'RelLTEQ ExUnits)
deriving (Generic)

newtype AlonzoBbodyEvent era
42 changes: 21 additions & 21 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
Original file line number Diff line number Diff line change
@@ -119,58 +119,58 @@ import Validation
data AlonzoUtxoPredFailure era
= -- | The bad transaction inputs
BadInputsUTxO
!(Set TxIn)
(Set TxIn)
| OutsideValidityIntervalUTxO
-- | transaction's validity interval
!ValidityInterval
ValidityInterval
-- | current slot
!SlotNo
| MaxTxSizeUTxO !(Mismatch 'RelLTEQ Integer)
SlotNo
| MaxTxSizeUTxO (Mismatch 'RelLTEQ Integer)
| InputSetEmptyUTxO
| FeeTooSmallUTxO !(Mismatch 'RelGTEQ Coin)
| ValueNotConservedUTxO !(Mismatch 'RelEQ (Value era))
| FeeTooSmallUTxO (Mismatch 'RelGTEQ Coin)
| ValueNotConservedUTxO (Mismatch 'RelEQ (Value era))
| -- | the set of addresses with incorrect network IDs
WrongNetwork
-- | the expected network id
!Network
Network
-- | the set of addresses with incorrect network IDs
!(Set Addr)
(Set Addr)
| WrongNetworkWithdrawal
-- | the expected network id
!Network
Network
-- | the set of reward addresses with incorrect network IDs
!(Set RewardAccount)
(Set RewardAccount)
| -- | list of supplied transaction outputs that are too small
OutputTooSmallUTxO
![TxOut era]
[TxOut era]
| -- | Subtransition Failures
UtxosFailure (PredicateFailure (EraRule "UTXOS" era))
| -- | list of supplied bad transaction outputs
OutputBootAddrAttrsTooBig
![TxOut era]
[TxOut era]
| -- Kept for backwards compatibility: no longer used because the `MultiAsset` type of mint doesn't allow for this possibility
TriesToForgeADA
| -- | list of supplied bad transaction output triples (actualSize,PParameterMaxValue,TxOut)
OutputTooBigUTxO
![(Integer, Integer, TxOut era)]
[(Integer, Integer, TxOut era)]
| InsufficientCollateral
-- | balance computed
!DeltaCoin
DeltaCoin
-- | the required collateral for the given fee
!Coin
Coin
| -- | The UTxO entries which have the wrong kind of script
ScriptsNotPaidUTxO
!(UTxO era)
| ExUnitsTooBigUTxO !(Mismatch 'RelLTEQ ExUnits)
(UTxO era)
| ExUnitsTooBigUTxO (Mismatch 'RelLTEQ ExUnits)
| -- | The inputs marked for use as fees contain non-ADA tokens
CollateralContainsNonADA !(Value era)
CollateralContainsNonADA (Value era)
| -- | Wrong Network ID in body
WrongNetworkInTxBody !(Mismatch 'RelEQ Network)
WrongNetworkInTxBody (Mismatch 'RelEQ Network)
| -- | slot number outside consensus forecast range
OutsideForecast
!SlotNo
SlotNo
| -- | There are too many collateral inputs
TooManyCollateralInputs !(Mismatch 'RelLTEQ Natural)
TooManyCollateralInputs (Mismatch 'RelLTEQ Natural)
| NoCollateralInputs
deriving (Generic)

16 changes: 8 additions & 8 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs
Original file line number Diff line number Diff line change
@@ -92,26 +92,26 @@ import Validation
-- | The Predicate failure type in the Alonzo Era. It embeds the Predicate
-- failure type of the Shelley Era, as they share some failure modes.
data AlonzoUtxowPredFailure era
= ShelleyInAlonzoUtxowPredFailure !(ShelleyUtxowPredFailure era)
= ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure era)
| -- | List of scripts for which no redeemers were supplied
MissingRedeemers
![(PlutusPurpose AsItem era, ScriptHash)]
[(PlutusPurpose AsItem era, ScriptHash)]
| MissingRequiredDatums
-- TODO: Make this NonEmpty #4066

-- | Set of missing data hashes
!(Set DataHash)
(Set DataHash)
-- | Set of received data hashes
!(Set DataHash)
(Set DataHash)
| NotAllowedSupplementalDatums
-- TODO: Make this NonEmpty #4066

-- | Set of unallowed data hashes
!(Set DataHash)
(Set DataHash)
-- | Set of acceptable supplemental data hashes
!(Set DataHash)
(Set DataHash)
| PPViewHashesDontMatch
!(Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash))
(Mismatch 'RelEQ (StrictMaybe ScriptIntegrityHash))
| -- | Set of witnesses which were needed and not supplied
MissingRequiredSigners -- TODO: remove once in Conway. It is now redundant. See #3972
(Set (KeyHash 'Witness))
@@ -121,7 +121,7 @@ data AlonzoUtxowPredFailure era
(Set TxIn)
| -- | List of redeemers not needed
ExtraRedeemers
![PlutusPurpose AsIx era]
[PlutusPurpose AsIx era]
deriving (Generic)

type instance EraRuleFailure "UTXOW" AlonzoEra = AlonzoUtxowPredFailure AlonzoEra
1 change: 1 addition & 0 deletions eras/babbage/impl/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -2,6 +2,7 @@

## 1.11.0.0

* Made the fields of predicate failures and environments lazy
* Add `MemPack` instance for `BabbageTxOut` and `PlutusScript BabbageEra`
* Deprecate `Babbage` type synonym
* Remove crypto parametrization from `BabbageEra`
10 changes: 5 additions & 5 deletions eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs
Original file line number Diff line number Diff line change
@@ -108,20 +108,20 @@ import Validation (Validation, failureIf, failureUnless)

-- | Predicate failure for the Babbage Era
data BabbageUtxoPredFailure era
= AlonzoInBabbageUtxoPredFailure !(AlonzoUtxoPredFailure era) -- Inherited from Alonzo
= AlonzoInBabbageUtxoPredFailure (AlonzoUtxoPredFailure era) -- Inherited from Alonzo
| -- | The collateral is not equivalent to the total collateral asserted by the transaction
IncorrectTotalCollateralField
-- | collateral provided
!DeltaCoin
DeltaCoin
-- | collateral amount declared in transaction body
!Coin
Coin
| -- | list of supplied transaction outputs that are too small,
-- together with the minimum value for the given output.
BabbageOutputTooSmallUTxO
![(TxOut era, Coin)]
[(TxOut era, Coin)]
| -- | TxIns that appear in both inputs and reference inputs
BabbageNonDisjointRefInputs
!(NonEmpty TxIn)
(NonEmpty TxIn)
deriving (Generic)

type instance EraRuleFailure "UTXO" BabbageEra = BabbageUtxoPredFailure BabbageEra
8 changes: 4 additions & 4 deletions eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs
Original file line number Diff line number Diff line change
@@ -92,15 +92,15 @@ import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))
import Validation (failureUnless)

data BabbageUtxowPredFailure era
= AlonzoInBabbageUtxowPredFailure !(AlonzoUtxowPredFailure era) -- TODO: embed and translate
= AlonzoInBabbageUtxowPredFailure (AlonzoUtxowPredFailure era) -- TODO: embed and translate
| -- | Embed UTXO rule failures
UtxoFailure !(PredicateFailure (EraRule "UTXO" era))
UtxoFailure (PredicateFailure (EraRule "UTXO" era))
| -- | the set of malformed script witnesses
MalformedScriptWitnesses
!(Set ScriptHash)
(Set ScriptHash)
| -- | the set of malformed script witnesses
MalformedReferenceScripts
!(Set ScriptHash)
(Set ScriptHash)
deriving (Generic)

type instance EraRuleFailure "UTXOW" BabbageEra = BabbageUtxowPredFailure BabbageEra
1 change: 1 addition & 0 deletions eras/conway/impl/CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -2,6 +2,7 @@

## 1.19.0.0

* Made the fields of predicate failures and environments lazy
* Add `MemPack` instance for `PlutusScript ConwayEra`
* Deprecate `Conway` type synonym
* Remove crypto parametrization from `ConwayEra`
Original file line number Diff line number Diff line change
@@ -561,14 +561,14 @@ ratifySignalL = lens unRatifySignal (\x y -> x {unRatifySignal = y})
instance EraPParams era => NFData (RatifySignal era)

data RatifyEnv era = RatifyEnv
{ reStakeDistr :: !(Map (Credential 'Staking) (CompactForm Coin))
, reStakePoolDistr :: !PoolDistr
, reDRepDistr :: !(Map DRep (CompactForm Coin))
, reDRepState :: !(Map (Credential 'DRepRole) DRepState)
, reCurrentEpoch :: !EpochNo
, reCommitteeState :: !(CommitteeState era)
, reDelegatees :: !(Map (Credential 'Staking) DRep)
, rePoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
{ reStakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
, reStakePoolDistr :: PoolDistr
, reDRepDistr :: Map DRep (CompactForm Coin)
, reDRepState :: Map (Credential 'DRepRole) DRepState
, reCurrentEpoch :: EpochNo
, reCommitteeState :: CommitteeState era
, reDelegatees :: Map (Credential 'Staking) DRep
, rePoolParams :: Map (KeyHash 'StakePool) PoolParams
}
deriving (Generic)

10 changes: 5 additions & 5 deletions eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs
Original file line number Diff line number Diff line change
@@ -91,12 +91,12 @@ maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock = 1024 * 1024 -- 1MiB

data ConwayBbodyPredFailure era
= WrongBlockBodySizeBBODY !(Mismatch 'RelEQ Int)
| InvalidBodyHashBBODY !(Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody))
= WrongBlockBodySizeBBODY (Mismatch 'RelEQ Int)
| InvalidBodyHashBBODY (Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody))
| -- | LEDGERS rule subtransition Failures
LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
| TooManyExUnits !(Mismatch 'RelLTEQ ExUnits)
| BodyRefScriptsSizeTooBig !(Mismatch 'RelLTEQ Int)
LedgersFailure (PredicateFailure (EraRule "LEDGERS" era))
| TooManyExUnits (Mismatch 'RelLTEQ ExUnits)
| BodyRefScriptsSizeTooBig (Mismatch 'RelLTEQ Int)
deriving (Generic)

deriving instance
2 changes: 1 addition & 1 deletion eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs
Original file line number Diff line number Diff line change
@@ -76,7 +76,7 @@ import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)

data CertEnv era = CertEnv
{ cePParams :: !(PParams era)
{ cePParams :: PParams era
, ceCurrentEpoch :: EpochNo
-- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
, ceCurrentCommittee :: StrictMaybe (Committee era)
8 changes: 4 additions & 4 deletions eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs
Original file line number Diff line number Diff line change
@@ -86,8 +86,8 @@ import Lens.Micro
import NoThunks.Class (NoThunks (..))

data CertsEnv era = CertsEnv
{ certsTx :: !(Tx era)
, certsPParams :: !(PParams era)
{ certsTx :: Tx era
, certsPParams :: PParams era
, certsCurrentEpoch :: EpochNo
-- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
, certsCurrentCommittee :: StrictMaybe (Committee era)
@@ -113,9 +113,9 @@ instance (EraPParams era, NFData (Tx era)) => NFData (CertsEnv era)
data ConwayCertsPredFailure era
= -- | Withdrawals that are missing or do not withdrawal the entire amount
WithdrawalsNotInRewardsCERTS
!(Map.Map RewardAccount Coin)
(Map.Map RewardAccount Coin)
| -- | CERT rule subtransition Failures
CertFailure !(PredicateFailure (EraRule "CERT" era))
CertFailure (PredicateFailure (EraRule "CERT" era))
deriving (Generic)

type instance EraRuleFailure "CERTS" ConwayEra = ConwayCertsPredFailure ConwayEra
16 changes: 8 additions & 8 deletions eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs
Original file line number Diff line number Diff line change
@@ -137,11 +137,11 @@ import NoThunks.Class (NoThunks (..))
import Validation (failureUnless)

data GovEnv era = GovEnv
{ geTxId :: !TxId
, geEpoch :: !EpochNo
, gePParams :: !(PParams era)
, gePPolicy :: !(StrictMaybe ScriptHash)
, geCertState :: !(CertState era)
{ geTxId :: TxId
, geEpoch :: EpochNo
, gePParams :: PParams era
, gePPolicy :: StrictMaybe ScriptHash
, geCertState :: CertState era
}
deriving (Generic)

@@ -165,11 +165,11 @@ data ConwayGovPredFailure era
| MalformedProposal (GovAction era)
| ProposalProcedureNetworkIdMismatch RewardAccount Network
| TreasuryWithdrawalsNetworkIdMismatch (Set.Set RewardAccount) Network
| ProposalDepositIncorrect !(Mismatch 'RelEQ Coin)
| ProposalDepositIncorrect (Mismatch 'RelEQ Coin)
| -- | Some governance actions are not allowed to be voted on by certain types of
-- Voters. This failure lists all governance action ids with their respective voters
-- that are not allowed to vote on those governance actions.
DisallowedVoters !(NonEmpty (Voter, GovActionId))
DisallowedVoters (NonEmpty (Voter, GovActionId))
| ConflictingCommitteeUpdate
-- | Credentials that are mentioned as members to be both removed and added
(Set.Set (Credential 'ColdCommitteeRole))
@@ -182,7 +182,7 @@ data ConwayGovPredFailure era
-- | The PrevGovActionId of the HardForkInitiation that fails
(StrictMaybe (GovPurposeId 'HardForkPurpose era))
-- | Its protocol version and the protocal version of the previous gov-action pointed to by the proposal
!(Mismatch 'RelGT ProtVer)
(Mismatch 'RelGT ProtVer)
| InvalidPolicyHash
-- | The policy script hash in the proposal
(StrictMaybe ScriptHash)
14 changes: 7 additions & 7 deletions eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs
Original file line number Diff line number Diff line change
@@ -88,7 +88,7 @@ import Lens.Micro ((&), (.~), (^.))
import NoThunks.Class (NoThunks (..))

data ConwayGovCertEnv era = ConwayGovCertEnv
{ cgcePParams :: !(PParams era)
{ cgcePParams :: PParams era
, cgceCurrentEpoch :: EpochNo
-- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
, cgceCurrentCommittee :: StrictMaybe (Committee era)
@@ -114,15 +114,15 @@ deriving instance EraPParams era => Show (ConwayGovCertEnv era)
deriving instance EraPParams era => Eq (ConwayGovCertEnv era)

data ConwayGovCertPredFailure era
= ConwayDRepAlreadyRegistered !(Credential 'DRepRole)
| ConwayDRepNotRegistered !(Credential 'DRepRole)
| ConwayDRepIncorrectDeposit !(Mismatch 'RelEQ Coin)
| ConwayCommitteeHasPreviouslyResigned !(Credential 'ColdCommitteeRole)
| ConwayDRepIncorrectRefund !(Mismatch 'RelEQ Coin)
= ConwayDRepAlreadyRegistered (Credential 'DRepRole)
| ConwayDRepNotRegistered (Credential 'DRepRole)
| ConwayDRepIncorrectDeposit (Mismatch 'RelEQ Coin)
| ConwayCommitteeHasPreviouslyResigned (Credential 'ColdCommitteeRole)
| ConwayDRepIncorrectRefund (Mismatch 'RelEQ Coin)
| -- | Predicate failure whenever an update to an unknown committee member is
-- attempted. Current Constitutional Committee and all available proposals will be
-- searched before reporting this predicate failure.
ConwayCommitteeIsUnknown !(Credential 'ColdCommitteeRole)
ConwayCommitteeIsUnknown (Credential 'ColdCommitteeRole)
deriving (Show, Eq, Generic)

type instance EraRuleFailure "GOVCERT" ConwayEra = ConwayGovCertPredFailure ConwayEra
Loading

0 comments on commit 95907f5

Please sign in to comment.