From f980bbd8700cc7d400749ad0d2af6ad40678d112 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Sun, 31 Aug 2025 12:36:54 +0200 Subject: [PATCH 01/12] Make `genRegTxCert` a method of `ShelleyEraImp` --- .../Test/Cardano/Ledger/Allegra/ImpTest.hs | 1 + .../Test/Cardano/Ledger/Alonzo/ImpTest.hs | 1 + .../Test/Cardano/Ledger/Babbage/ImpTest.hs | 1 + .../Cardano/Ledger/Conway/Imp/DelegSpec.hs | 41 +++++++++---------- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 6 +-- .../Test/Cardano/Ledger/Dijkstra/ImpTest.hs | 16 ++++++++ .../Test/Cardano/Ledger/Mary/ImpTest.hs | 1 + eras/shelley/impl/CHANGELOG.md | 2 + .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 11 +++++ 9 files changed, 56 insertions(+), 24 deletions(-) diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs index 5ed844b5557..890a7cbcff8 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs @@ -41,6 +41,7 @@ instance ShelleyEraImp AllegraEra where fixupTx = shelleyFixupTx expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer + genRegTxCert = shelleyGenRegTxCert impAllegraSatisfyNativeScript :: ( ShelleyEraImp era diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs index cbc3fb7de02..99f994dfca4 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs @@ -432,6 +432,7 @@ instance ShelleyEraImp AlonzoEra where fixupTx = alonzoFixupTx expectTxSuccess = impAlonzoExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer + genRegTxCert = shelleyGenRegTxCert instance MaryEraImp AlonzoEra diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs index 74f8715d5d7..7c59204047b 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs @@ -54,6 +54,7 @@ instance ShelleyEraImp BabbageEra where fixupTx = babbageFixupTx expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer + genRegTxCert = shelleyGenRegTxCert babbageFixupTx :: ( HasCallStack diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index 2bafef4e241..17379fb196f 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -729,37 +729,36 @@ conwayEraSpecificSpec :: conwayEraSpecificSpec = do describe "Register stake credential" $ do it "Without any deposit" $ do - freshKeyHash >>= \kh -> do - let cred = KeyHashObj kh - regTxCert <- genRegTxCert cred - submitTx_ $ - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL .~ [regTxCert] - expectRegistered cred + cred <- KeyHashObj <$> freshKeyHash + regTxCert <- genRegTxCert cred + submitTx_ $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL .~ [regTxCert] + expectRegistered cred describe "Delegate stake" $ do it "Register and delegate in the same transaction" $ do - expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL - - cred <- KeyHashObj <$> freshKeyHash + cred1 <- KeyHashObj <$> freshKeyHash + regTxCert1 <- genRegTxCert cred1 poolKh <- freshKeyHash registerPoolWithDeposit poolKh submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL - .~ [ RegDepositTxCert cred expectedDeposit - , DelegTxCert cred (DelegStake poolKh) + .~ [ regTxCert1 + , DelegTxCert cred1 (DelegStake poolKh) ] - expectDelegatedToPool cred poolKh + expectDelegatedToPool cred1 poolKh - freshKeyHash >>= \kh -> do - submitTx_ $ - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL - .~ [ RegDepositTxCert (KeyHashObj kh) expectedDeposit - , DelegStakeTxCert (KeyHashObj kh) poolKh -- using the pattern from Shelley - ] - expectDelegatedToPool (KeyHashObj kh) poolKh + cred2 <- KeyHashObj <$> freshKeyHash + regTxCert2 <- genRegTxCert cred2 + submitTx_ $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL + .~ [ regTxCert2 + , DelegStakeTxCert cred2 poolKh -- using the pattern from Shelley + ] + expectDelegatedToPool cred2 poolKh expectRegistered :: (HasCallStack, ConwayEraImp era) => Credential 'Staking -> ImpTestM era () expectRegistered cred = do diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 2fd3caaed23..7002316aa56 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -46,7 +46,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( submitYesVote_, submitFailingVote, trySubmitVote, - genRegTxCert, genUnRegTxCert, registerDRep, unRegisterDRep, @@ -307,6 +306,7 @@ instance ShelleyEraImp ConwayEra where fixupTx = babbageFixupTx expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = conwayModifyImpInitProtVer + genRegTxCert = conwayGenRegTxCert conwayModifyImpInitProtVer :: forall era. @@ -411,7 +411,7 @@ genUnRegTxCert stakingCredential = do , UnRegDepositTxCert stakingCredential (fromCompact (accountState ^. depositAccountStateL)) ] -genRegTxCert :: +conwayGenRegTxCert :: forall era. ( ShelleyEraImp era , ShelleyEraTxCert era @@ -419,7 +419,7 @@ genRegTxCert :: ) => Credential 'Staking -> ImpTestM era (TxCert era) -genRegTxCert stakingCredential = +conwayGenRegTxCert stakingCredential = oneof [ pure $ RegTxCert stakingCredential , RegDepositTxCert stakingCredential diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs index 7663dcee79b..da72dc927cb 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs @@ -2,6 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -13,6 +14,7 @@ module Test.Cardano.Ledger.Dijkstra.ImpTest ( exampleDijkstraGenesis, DijkstraEraImp, impDijkstraSatisfyNativeScript, + dijkstraGenRegTxCert, ) where import Cardano.Ledger.Allegra.Scripts ( @@ -32,6 +34,8 @@ import Cardano.Ledger.Conway.Rules ( ConwayDelegPredFailure (..), ConwayLedgerPredFailure (..), ) +import Cardano.Ledger.Conway.TxCert +import Cardano.Ledger.Credential import Cardano.Ledger.Dijkstra (DijkstraEra) import Cardano.Ledger.Dijkstra.Core import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis (..)) @@ -78,6 +82,7 @@ instance ShelleyEraImp DijkstraEra where fixupTx = babbageFixupTx expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = conwayModifyImpInitProtVer + genRegTxCert = dijkstraGenRegTxCert instance MaryEraImp DijkstraEra @@ -154,3 +159,14 @@ impDijkstraSatisfyNativeScript providedVKeyHashes txBody script = do | evalDijkstraNativeScript mempty vi guards ns -> pure $ Just mempty | otherwise -> pure Nothing _ -> error "Impossible: All NativeScripts should have been accounted for" + +dijkstraGenRegTxCert :: + forall era. + ( ShelleyEraImp era + , ConwayEraTxCert era + ) => + Credential 'Staking -> + ImpTestM era (TxCert era) +dijkstraGenRegTxCert stakingCredential = + RegDepositTxCert stakingCredential + <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL) diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs index 473713119ca..1db064ea5e1 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs @@ -27,6 +27,7 @@ instance ShelleyEraImp MaryEra where fixupTx = shelleyFixupTx expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer + genRegTxCert = shelleyGenRegTxCert class ( ShelleyEraImp era diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 32d9d7a08b8..e859e0dac55 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -96,6 +96,8 @@ ### `testlib` * Remove `shelleyAccountsToUMap` corresponding to the removal of `UMap` from core. +* Added `shelleyGenRegTxCert` +* Added `genRegTxCert` to `ShelleyEraImp` * Added `impSatisfySignature` and `impSatisfyMNativeScripts` * Added `EraSpecificSpec ShelleyEra` instance * Added `EraSpecificSpec` class diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 8e69af728fc..845b9b9bd5e 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -123,6 +123,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest ( withEachEraVersion, impSatisfyMNativeScripts, impSatisfySignature, + shelleyGenRegTxCert, -- * Logging Doc, @@ -507,6 +508,8 @@ class expectTxSuccess :: HasCallStack => Tx era -> ImpTestM era () + genRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era) + impSatisfySignature :: KeyHash 'Witness -> Set.Set (KeyHash 'Witness) -> @@ -800,6 +803,7 @@ instance fixupTx = shelleyFixupTx expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer + genRegTxCert = shelleyGenRegTxCert -- | Figure out all the Byron Addresses that need witnesses as well as all of the -- KeyHashes for Shelley Key witnesses that are required. @@ -1851,3 +1855,10 @@ simulateThenRestore sim = do result <- sim put snapshot pure result + +shelleyGenRegTxCert :: + forall era. + ShelleyEraTxCert era => + Credential 'Staking -> + ImpTestM era (TxCert era) +shelleyGenRegTxCert = pure . RegTxCert From 24d64acaf85db94c62f287d0350ff0ebd0a7afce Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Sun, 31 Aug 2025 23:09:47 +0200 Subject: [PATCH 02/12] Make `genUnRegTxCert` a method of `ShelleyEraImp` --- .../Test/Cardano/Ledger/Allegra/ImpTest.hs | 1 + .../Test/Cardano/Ledger/Alonzo/ImpTest.hs | 1 + .../Test/Cardano/Ledger/Babbage/ImpTest.hs | 1 + .../Cardano/Ledger/Conway/Imp/DelegSpec.hs | 2 +- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 6 ++--- .../Test/Cardano/Ledger/Dijkstra/ImpTest.hs | 24 ++++++++++++++----- .../Test/Cardano/Ledger/Mary/ImpTest.hs | 1 + eras/shelley/impl/CHANGELOG.md | 2 ++ .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 11 +++++++++ 9 files changed, 39 insertions(+), 10 deletions(-) diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs index 890a7cbcff8..a45d9d1fdf8 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs @@ -42,6 +42,7 @@ instance ShelleyEraImp AllegraEra where expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer genRegTxCert = shelleyGenRegTxCert + genUnRegTxCert = shelleyGenUnRegTxCert impAllegraSatisfyNativeScript :: ( ShelleyEraImp era diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs index 99f994dfca4..b681d6b69d2 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs @@ -433,6 +433,7 @@ instance ShelleyEraImp AlonzoEra where expectTxSuccess = impAlonzoExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer genRegTxCert = shelleyGenRegTxCert + genUnRegTxCert = shelleyGenUnRegTxCert instance MaryEraImp AlonzoEra diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs index 7c59204047b..9205f253601 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs @@ -55,6 +55,7 @@ instance ShelleyEraImp BabbageEra where expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer genRegTxCert = shelleyGenRegTxCert + genUnRegTxCert = shelleyGenUnRegTxCert babbageFixupTx :: ( HasCallStack diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index 17379fb196f..c18f8c48ff2 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -230,7 +230,7 @@ spec = do expectRegisteredRewardAddress otherRewardAccount submitAndExpireProposalToMakeReward otherStakeCred getBalance otherStakeCred `shouldReturn` govActionDeposit - let unRegTxCert = UnRegDepositTxCert stakeCred keyDeposit + unRegTxCert <- genUnRegTxCert stakeCred submitTx_ . mkBasicTx $ mkBasicTxBody & certsTxBodyL .~ SSeq.fromList [unRegTxCert] diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 7002316aa56..87b0ac1da84 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -46,7 +46,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( submitYesVote_, submitFailingVote, trySubmitVote, - genUnRegTxCert, registerDRep, unRegisterDRep, updateDRep, @@ -307,6 +306,7 @@ instance ShelleyEraImp ConwayEra where expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = conwayModifyImpInitProtVer genRegTxCert = conwayGenRegTxCert + genUnRegTxCert = conwayGenUnRegTxCert conwayModifyImpInitProtVer :: forall era. @@ -393,7 +393,7 @@ unRegisterDRep drep = do & bodyTxL . certsTxBodyL .~ SSeq.singleton (UnRegDRepTxCert drep refund) -genUnRegTxCert :: +conwayGenUnRegTxCert :: forall era. ( ShelleyEraImp era , ShelleyEraTxCert era @@ -401,7 +401,7 @@ genUnRegTxCert :: ) => Credential 'Staking -> ImpTestM era (TxCert era) -genUnRegTxCert stakingCredential = do +conwayGenUnRegTxCert stakingCredential = do accounts <- getsNES (nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL) case lookupAccountState stakingCredential accounts of Nothing -> pure $ UnRegTxCert stakingCredential diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs index da72dc927cb..7fc477ebbd4 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs @@ -21,12 +21,8 @@ import Cardano.Ledger.Allegra.Scripts ( pattern RequireTimeExpire, pattern RequireTimeStart, ) -import Cardano.Ledger.BaseTypes ( - BoundedRational (..), - EpochInterval (..), - addEpochInterval, - knownNonZeroBounded, - ) +import Cardano.Ledger.BaseTypes +import Cardano.Ledger.Compactible import Cardano.Ledger.Conway.Governance (ConwayEraGov (..), committeeMembersL) import Cardano.Ledger.Conway.Rules ( ConwayCertPredFailure (..), @@ -56,6 +52,7 @@ import Cardano.Ledger.Shelley.Scripts ( pattern RequireMOf, pattern RequireSignature, ) +import Cardano.Ledger.State import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import qualified Data.Set as Set @@ -83,6 +80,7 @@ instance ShelleyEraImp DijkstraEra where expectTxSuccess = impBabbageExpectTxSuccess modifyImpInitProtVer = conwayModifyImpInitProtVer genRegTxCert = dijkstraGenRegTxCert + genUnRegTxCert = dijkstraGenUnRegTxCert instance MaryEraImp DijkstraEra @@ -170,3 +168,17 @@ dijkstraGenRegTxCert :: dijkstraGenRegTxCert stakingCredential = RegDepositTxCert stakingCredential <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL) + +dijkstraGenUnRegTxCert :: + forall era. + ( ShelleyEraImp era + , ConwayEraTxCert era + ) => + Credential 'Staking -> + ImpTestM era (TxCert era) +dijkstraGenUnRegTxCert stakingCredential = do + accounts <- getsNES (nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL) + case lookupAccountState stakingCredential accounts of + Nothing -> error "TODO" + Just accountState -> + pure $ UnRegDepositTxCert stakingCredential (fromCompact (accountState ^. depositAccountStateL)) diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs index 1db064ea5e1..7b17187b6fa 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs @@ -28,6 +28,7 @@ instance ShelleyEraImp MaryEra where expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer genRegTxCert = shelleyGenRegTxCert + genUnRegTxCert = shelleyGenUnRegTxCert class ( ShelleyEraImp era diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index e859e0dac55..f47c38d9f7a 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -96,6 +96,8 @@ ### `testlib` * Remove `shelleyAccountsToUMap` corresponding to the removal of `UMap` from core. +* Added `shelleyGenUnRegTxCert` +* Added `genUnRegTxCert` to `ShelleyEraImp` * Added `shelleyGenRegTxCert` * Added `genRegTxCert` to `ShelleyEraImp` * Added `impSatisfySignature` and `impSatisfyMNativeScripts` diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 845b9b9bd5e..7bda025c468 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -124,6 +124,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest ( impSatisfyMNativeScripts, impSatisfySignature, shelleyGenRegTxCert, + shelleyGenUnRegTxCert, -- * Logging Doc, @@ -510,6 +511,8 @@ class genRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era) + genUnRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era) + impSatisfySignature :: KeyHash 'Witness -> Set.Set (KeyHash 'Witness) -> @@ -804,6 +807,7 @@ instance expectTxSuccess = impShelleyExpectTxSuccess modifyImpInitProtVer = shelleyModifyImpInitProtVer genRegTxCert = shelleyGenRegTxCert + genUnRegTxCert = shelleyGenUnRegTxCert -- | Figure out all the Byron Addresses that need witnesses as well as all of the -- KeyHashes for Shelley Key witnesses that are required. @@ -1862,3 +1866,10 @@ shelleyGenRegTxCert :: Credential 'Staking -> ImpTestM era (TxCert era) shelleyGenRegTxCert = pure . RegTxCert + +shelleyGenUnRegTxCert :: + forall era. + ShelleyEraTxCert era => + Credential 'Staking -> + ImpTestM era (TxCert era) +shelleyGenUnRegTxCert = pure . UnRegTxCert From 7a2c312be4a6042a1a22472fd381e54fd69c1a34 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Sat, 9 Aug 2025 15:05:35 +0200 Subject: [PATCH 03/12] Remove `registerStakeCredentialWithDeposit` --- eras/conway/impl/CHANGELOG.md | 1 + .../Cardano/Ledger/Conway/Imp/LedgerSpec.hs | 6 ++--- .../Cardano/Ledger/Conway/Imp/RatifySpec.hs | 2 +- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 23 +++---------------- .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 4 ++-- .../Cardano/Ledger/Api/State/Imp/QuerySpec.hs | 4 ++-- 6 files changed, 12 insertions(+), 28 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index a61bc322fd7..a54fbdc32fd 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -109,6 +109,7 @@ ### `testlib` +* Removed `registerStakeCredentialWithDeposit` * Added `EraSpecificSpec ConwayEra` instance * Added `registerRewardAccountWithDeposit` * Added `regDelegToDRep` diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index dfecce222b3..5b843b673db 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -81,7 +81,7 @@ spec = do modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 kh <- freshKeyHash let cred = KeyHashObj kh - ra <- registerStakeCredentialWithDeposit cred + ra <- registerStakeCredential cred submitAndExpireProposalToMakeReward cred balance <- getBalance cred @@ -108,7 +108,7 @@ spec = do modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 kh <- freshKeyHash let cred = KeyHashObj kh - ra <- registerStakeCredentialWithDeposit cred + ra <- registerStakeCredential cred submitAndExpireProposalToMakeReward cred balance <- getBalance cred @@ -155,7 +155,7 @@ spec = do & ppDRepActivityL .~ EpochInterval 1 kh <- freshKeyHash let cred = KeyHashObj kh - ra <- registerStakeCredentialWithDeposit cred + ra <- registerStakeCredential cred submitAndExpireProposalToMakeReward cred balance <- getBalance cred diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 23fc6f13cec..d3c3dc0ed42 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -814,7 +814,7 @@ votingSpec = calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 2 kh <- freshKeyHash - _ <- registerStakeCredentialWithDeposit (KeyHashObj kh) + _ <- registerStakeCredential (KeyHashObj kh) _ <- delegateToDRep (KeyHashObj kh) (Coin 1_000_000) DRepAlwaysNoConfidence passEpoch -- AlwaysNoConfidence vote acts like a 'No' vote for actions other than NoConfidence diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 87b0ac1da84..72eb4552621 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -133,7 +133,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( FailBoth (..), delegateSPORewardAddressToDRep_, getCommittee, - registerStakeCredentialWithDeposit, registerPoolWithDeposit, registerRewardAccountWithDeposit, ) where @@ -150,7 +149,6 @@ import Cardano.Ledger.BaseTypes ( addEpochInterval, binOpEpochNo, inject, - networkId, textToUrl, ) import Cardano.Ledger.Coin (Coin (..)) @@ -178,7 +176,7 @@ import Cardano.Ledger.Conway.Rules ( ) import Cardano.Ledger.Conway.State import Cardano.Ledger.Conway.TxCert (Delegatee (..)) -import Cardano.Ledger.Credential (Credential (..), credToText) +import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.DRep import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..), hashPlutusScript) import Cardano.Ledger.Shelley.LedgerState ( @@ -218,7 +216,6 @@ import qualified Data.Text as T import Data.Tree import qualified GHC.Exts as GHC (fromList) import Lens.Micro -import Lens.Micro.Mtl (use) import Prettyprinter (align, hsep, viaShow, vsep) import Test.Cardano.Ledger.Babbage.ImpTest import Test.Cardano.Ledger.Conway.Arbitrary () @@ -1842,26 +1839,12 @@ instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ConwayEra where getCommittee :: ConwayEraGov era => ImpTestM era (StrictMaybe (Committee era)) getCommittee = getsNES $ nesEsL . epochStateGovStateL . committeeGovStateL -registerStakeCredentialWithDeposit :: - forall era. - ConwayEraImp era => - Credential 'Staking -> - ImpTestM era RewardAccount -registerStakeCredentialWithDeposit cred = do - deposit <- getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL) - submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $ - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL - .~ SSeq.fromList [RegDepositTxCert cred deposit] - networkId <- use (impGlobalsL . to networkId) - pure $ RewardAccount networkId cred - registerPoolWithDeposit :: ConwayEraImp era => KeyHash 'StakePool -> ImpTestM era () registerPoolWithDeposit khPool = - (freshKeyHash >>= registerStakeCredentialWithDeposit . KeyHashObj) + (freshKeyHash >>= registerStakeCredential . KeyHashObj) >>= registerPoolWithRewardAccount khPool registerRewardAccountWithDeposit :: @@ -1869,4 +1852,4 @@ registerRewardAccountWithDeposit :: ConwayEraImp era => ImpTestM era RewardAccount registerRewardAccountWithDeposit = do - freshKeyHash >>= registerStakeCredentialWithDeposit . KeyHashObj + freshKeyHash >>= registerStakeCredential . KeyHashObj diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 7bda025c468..3c28328be96 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -1570,15 +1570,15 @@ registerStakeCredential :: forall era. ( HasCallStack , ShelleyEraImp era - , ShelleyEraTxCert era ) => Credential 'Staking -> ImpTestM era RewardAccount registerStakeCredential cred = do + regTxCert <- genRegTxCert cred submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL - .~ SSeq.fromList [RegTxCert cred] + .~ SSeq.fromList [regTxCert] networkId <- use (impGlobalsL . to networkId) pure $ RewardAccount networkId cred diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs index 80eb431ef2e..4d5f3eebdb2 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs @@ -204,12 +204,12 @@ spec = do kh <- freshKeyHash let cred = KeyHashObj kh - _ <- registerStakeCredentialWithDeposit cred + _ <- registerStakeCredential cred _ <- delegateToDRep cred (Coin 2_000_000) DRepAlwaysAbstain kh2 <- freshKeyHash let cred2 = KeyHashObj kh2 - _ <- registerStakeCredentialWithDeposit cred2 + _ <- registerStakeCredential cred2 _ <- delegateToDRep cred2 (Coin 3_000_000) DRepAlwaysNoConfidence let realDRepCred = DRepCredential credDrep From 2700d2da6c5a89edd27f2201a5fef58a42483ddc Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 2 Sep 2025 23:21:08 +0200 Subject: [PATCH 04/12] Remove `registerPoolWithDeposit` --- eras/conway/impl/CHANGELOG.md | 1 + .../Cardano/Ledger/Conway/Imp/DelegSpec.hs | 28 +++++++++---------- .../Test/Cardano/Ledger/Conway/Imp/GovSpec.hs | 2 +- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 13 ++------- .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 4 +-- 5 files changed, 19 insertions(+), 29 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index a54fbdc32fd..93735d6c785 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -109,6 +109,7 @@ ### `testlib` +* Removed `registerPoolWithDeposit` * Removed `registerStakeCredentialWithDeposit` * Added `EraSpecificSpec ConwayEra` instance * Added `registerRewardAccountWithDeposit` diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index c18f8c48ff2..e6e1f0c5660 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -218,7 +218,7 @@ spec = do otherStakeCred <- KeyHashObj <$> freshKeyHash otherRewardAccount <- getRewardAccountFor otherStakeCred khStakePool <- freshKeyHash - registerPoolWithDeposit khStakePool + registerPool khStakePool submitTx_ . mkBasicTx $ mkBasicTxBody & certsTxBodyL @@ -255,7 +255,7 @@ spec = do .~ [RegDepositTxCert cred expectedDeposit] poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh submitTx_ $ mkBasicTx mkBasicTxBody @@ -268,7 +268,7 @@ spec = do expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh freshKeyHash >>= \kh -> do submitTx_ $ mkBasicTx mkBasicTxBody @@ -279,7 +279,7 @@ spec = do it "Delegate unregistered stake credentials" $ do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh submitFailingTx ( mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL @@ -313,7 +313,7 @@ spec = do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL @@ -328,7 +328,7 @@ spec = do expectDelegatedToPool cred poolKh poolKh1 <- freshKeyHash - registerPoolWithDeposit poolKh1 + registerPool poolKh1 submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL @@ -336,9 +336,9 @@ spec = do expectDelegatedToPool cred poolKh1 poolKh2 <- freshKeyHash - registerPoolWithDeposit poolKh2 + registerPool poolKh2 poolKh3 <- freshKeyHash - registerPoolWithDeposit poolKh3 + registerPool poolKh3 submitTx_ $ mkBasicTx mkBasicTxBody @@ -354,7 +354,7 @@ spec = do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL @@ -565,7 +565,7 @@ spec = do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash rewardAccount <- registerRewardAccountWithDeposit - registerPoolWithDeposit poolKh + registerPool poolKh drepCred <- KeyHashObj <$> registerDRep submitTx_ $ @@ -633,7 +633,7 @@ spec = do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh drepCred <- KeyHashObj <$> registerDRep submitTx_ $ @@ -658,7 +658,7 @@ spec = do cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh drepCred <- KeyHashObj <$> registerDRep submitTx_ $ @@ -673,7 +673,7 @@ spec = do expectDelegatedVote cred (DRepCredential drepCred) poolKh' <- freshKeyHash - registerPoolWithDeposit poolKh' + registerPool poolKh' submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL @@ -741,7 +741,7 @@ conwayEraSpecificSpec = do cred1 <- KeyHashObj <$> freshKeyHash regTxCert1 <- genRegTxCert cred1 poolKh <- freshKeyHash - registerPoolWithDeposit poolKh + registerPool poolKh submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs index 97cf3ac8223..9723e3feba4 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs @@ -893,7 +893,7 @@ votingSpec = conAnchor `shouldNotBe` anchor it "can submit SPO votes" $ do spoHash <- freshKeyHash - registerPoolWithDeposit spoHash + registerPool spoHash passNEpochs 3 gaId <- submitParameterChange SNothing $ diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 72eb4552621..654dfaabc3a 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -133,7 +133,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( FailBoth (..), delegateSPORewardAddressToDRep_, getCommittee, - registerPoolWithDeposit, registerRewardAccountWithDeposit, ) where @@ -531,7 +530,7 @@ setupPoolWithStake :: ImpTestM era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking) setupPoolWithStake delegCoin = impAnn "Set up pool with stake" $ do khPool <- freshKeyHash - registerPoolWithDeposit khPool + registerPool khPool credDelegatorPayment <- KeyHashObj <$> freshKeyHash credDelegatorStaking <- KeyHashObj <$> freshKeyHash sendCoinTo_ (mkAddr credDelegatorPayment credDelegatorStaking) delegCoin @@ -552,7 +551,7 @@ setupPoolWithoutStake :: ImpTestM era (KeyHash 'StakePool, Credential 'Staking) setupPoolWithoutStake = do khPool <- freshKeyHash - registerPoolWithDeposit khPool + registerPool khPool credDelegatorStaking <- KeyHashObj <$> freshKeyHash deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL submitTxAnn_ "Delegate to stake pool" $ @@ -1839,14 +1838,6 @@ instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ConwayEra where getCommittee :: ConwayEraGov era => ImpTestM era (StrictMaybe (Committee era)) getCommittee = getsNES $ nesEsL . epochStateGovStateL . committeeGovStateL -registerPoolWithDeposit :: - ConwayEraImp era => - KeyHash 'StakePool -> - ImpTestM era () -registerPoolWithDeposit khPool = - (freshKeyHash >>= registerStakeCredential . KeyHashObj) - >>= registerPoolWithRewardAccount khPool - registerRewardAccountWithDeposit :: forall era. ConwayEraImp era => diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 3c28328be96..64306633ea5 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -1640,9 +1640,7 @@ freshPoolParams khPool rewardAccount = do } registerPool :: - ( ShelleyEraImp era - , ShelleyEraTxCert era - ) => + ShelleyEraImp era => KeyHash 'StakePool -> ImpTestM era () registerPool khPool = registerRewardAccount >>= registerPoolWithRewardAccount khPool From ca14ea0b243adc91608e920d40a3b877471806f3 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 2 Sep 2025 23:21:22 +0200 Subject: [PATCH 05/12] Remove `registerRewardAccountWithDeposit` --- eras/conway/impl/CHANGELOG.md | 1 + .../Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs | 4 ++-- .../Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs | 6 +++--- .../Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs | 12 ++++++------ .../Test/Cardano/Ledger/Conway/Imp/GovSpec.hs | 16 ++++++++-------- .../Cardano/Ledger/Conway/Imp/HardForkSpec.hs | 2 +- .../Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs | 2 +- .../Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs | 4 ++-- .../Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs | 10 +++++----- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 10 +--------- .../Test/Cardano/Ledger/Shelley/ImpTest.hs | 5 +---- 11 files changed, 31 insertions(+), 41 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 93735d6c785..b85dcb37688 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -109,6 +109,7 @@ ### `testlib` +* Removed `registerRewardAccountWithDeposit` * Removed `registerPoolWithDeposit` * Removed `registerStakeCredentialWithDeposit` * Added `EraSpecificSpec ConwayEra` instance diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index e6e1f0c5660..0fef9769730 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -401,7 +401,7 @@ spec = do expectDelegatedVote cred (DRepCredential drepCred) it "Delegate vote of registered stake credentials to unregistered drep" $ do - RewardAccount _ cred <- registerRewardAccountWithDeposit + RewardAccount _ cred <- registerRewardAccount drepCred <- KeyHashObj <$> freshKeyHash let tx = mkBasicTx mkBasicTxBody @@ -564,7 +564,7 @@ spec = do expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL cred <- KeyHashObj <$> freshKeyHash poolKh <- freshKeyHash - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount registerPool poolKh drepCred <- KeyHashObj <$> registerDRep diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs index dfc266c5dee..aeb242749f9 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs @@ -80,7 +80,7 @@ treasuryWithdrawalsSpec = describe "Treasury withdrawals" $ do -- Treasury withdrawals are disallowed in bootstrap, so we're running these tests only post-bootstrap it "Modify EnactState as expected" $ whenPostBootstrap $ do - rewardAcount1 <- registerRewardAccountWithDeposit + rewardAcount1 <- registerRewardAccount govActionId <- submitTreasuryWithdrawals [(rewardAcount1, Coin 666)] gas <- getGovActionState govActionId let govAction = gasAction gas @@ -97,7 +97,7 @@ treasuryWithdrawalsSpec = enactState' <- runImpRule @"ENACT" () enactState signal ensWithdrawals enactState' `shouldBe` [(raCredential rewardAcount1, Coin 666)] - rewardAcount2 <- registerRewardAccountWithDeposit + rewardAcount2 <- registerRewardAccount let withdrawals' = [ (rewardAcount1, Coin 111) , (rewardAcount2, Coin 222) @@ -194,7 +194,7 @@ treasuryWithdrawalsSpec = sumRewardAccounts withdrawals = mconcat <$> traverse (getAccountBalance . fst) withdrawals genWithdrawalsExceeding (Coin val) n = do vals <- genValuesExceeding val n - forM (Coin <$> vals) $ \coin -> (,coin) <$> registerRewardAccountWithDeposit + forM (Coin <$> vals) $ \coin -> (,coin) <$> registerRewardAccount checkNoWithdrawal initialTreasury withdrawals = do getsNES treasuryL `shouldReturn` initialTreasury sumRewardAccounts withdrawals `shouldReturn` zero diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs index 39649f4e7be..04eec928196 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs @@ -88,7 +88,7 @@ proposalsSpec = pp & ppGovActionLifetimeL .~ EpochInterval 1 & ppGovActionDepositL .~ deposit - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount initialValue <- getsNES (nesEsL . curPParamsEpochStateL . ppMinFeeAL) @@ -404,8 +404,8 @@ treasurySpec = it "TreasuryWithdrawalExtra" $ whenPostBootstrap $ do disableTreasuryExpansion - rewardAccount <- registerRewardAccountWithDeposit - rewardAccountOther <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount + rewardAccountOther <- registerRewardAccount govPolicy <- getGovPolicy treasuryWithdrawalExpectation [ TreasuryWithdrawals (Map.singleton rewardAccount (Coin 667)) govPolicy @@ -430,7 +430,7 @@ treasuryWithdrawalExpectation extraWithdrawals = do (dRepCred, _, _) <- setupSingleDRep 1_000_000 treasuryStart <- getsNES treasuryL treasuryStart `shouldBe` withdrawalAmount - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount govPolicy <- getGovPolicy (govActionId NE.:| _) <- submitGovActions $ @@ -459,7 +459,7 @@ depositMovesToTreasuryWhenStakingAddressUnregisters = do & ppGovActionLifetimeL .~ EpochInterval 8 & ppGovActionDepositL .~ Coin 100 & ppCommitteeMaxTermLengthL .~ EpochInterval 0 - returnAddr <- registerRewardAccountWithDeposit + returnAddr <- registerRewardAccount govActionDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL keyDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL govPolicy <- getGovPolicy @@ -516,7 +516,7 @@ eventsSpec = describe "Events" $ do (proposal, getsNES (nesEsL . curPParamsEpochStateL . ppCoinsPerUTxOByteL) `shouldReturn` newVal) (proposalA, checkProposedParameterA) <- proposeParameterChange (proposalB, _) <- proposeParameterChange - rewardAccount@(RewardAccount _ rewardCred) <- registerRewardAccountWithDeposit + rewardAccount@(RewardAccount _ rewardCred) <- registerRewardAccount passEpoch -- prevent proposalC expiry and force it's deletion due to conflit. proposalC <- impAnn "proposalC" $ do newVal <- CoinPerByte . Coin <$> choose (3000, 6500) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs index 9723e3feba4..7f8c7210713 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs @@ -119,7 +119,7 @@ predicateFailuresSpec = } it "ProposalDepositIncorrect" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount actionDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL anchor <- arbitrary submitFailingProposal @@ -711,7 +711,7 @@ proposalsSpec = do it "Proposals are stored in the expected order" $ whenPostBootstrap $ do modifyPParams $ ppMaxValSizeL .~ 1_000_000_000 ens <- getEnactState - returnAddr <- registerRewardAccountWithDeposit + returnAddr <- registerRewardAccount withdrawal <- (: []) . (returnAddr,) . Coin . getPositive <$> (arbitrary :: ImpTestM era (Positive Integer)) @@ -1013,7 +1013,7 @@ policySpec = mkProposal (ParameterChange SNothing pparamsUpdate (SJust scriptHash)) >>= submitProposal_ impAnn "TreasuryWithdrawals with correct policy succeeds" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let withdrawals = Map.fromList [(rewardAccount, Coin 1000)] mkProposal (TreasuryWithdrawals withdrawals (SJust scriptHash)) >>= submitProposal_ @@ -1025,7 +1025,7 @@ policySpec = [injectFailure $ InvalidPolicyHash (SJust wrongScriptHash) (SJust scriptHash)] impAnn "TreasuryWithdrawals with invalid policy fails" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let withdrawals = Map.fromList [(rewardAccount, Coin 1000)] mkProposal (TreasuryWithdrawals withdrawals (SJust wrongScriptHash)) >>= flip @@ -1079,7 +1079,7 @@ withdrawalsSpec = it "Fails predicate when treasury withdrawal has nonexistent return address" $ do policy <- getGovPolicy unregisteredRewardAccount <- freshKeyHash >>= getRewardAccountFor . KeyHashObj - registeredRewardAccount <- registerRewardAccountWithDeposit + registeredRewardAccount <- registerRewardAccount let genPositiveCoin = Coin . getPositive <$> arbitrary withdrawals <- sequence @@ -1124,10 +1124,10 @@ withdrawalsSpec = it "Fails for empty withdrawals" $ do mkTreasuryWithdrawalsGovAction [] >>= expectZeroTreasuryFailurePostBootstrap - rwdAccount1 <- registerRewardAccountWithDeposit + rwdAccount1 <- registerRewardAccount mkTreasuryWithdrawalsGovAction [(rwdAccount1, zero)] >>= expectZeroTreasuryFailurePostBootstrap - rwdAccount2 <- registerRewardAccountWithDeposit + rwdAccount2 <- registerRewardAccount let withdrawals = [(rwdAccount1, zero), (rwdAccount2, zero)] mkTreasuryWithdrawalsGovAction withdrawals >>= expectZeroTreasuryFailurePostBootstrap @@ -1299,7 +1299,7 @@ bootstrapPhaseSpec = submitYesVote_ (StakePoolVoter spo) gid submitYesVote_ (CommitteeVoter committee) gid it "Treasury withdrawal" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount action <- mkTreasuryWithdrawalsGovAction [(rewardAccount, Coin 1000)] proposal <- mkProposalWithRewardAccount action rewardAccount checkProposalFailure proposal diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/HardForkSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/HardForkSpec.hs index b71e9d0b3c3..3c8d7e021ba 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/HardForkSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/HardForkSpec.hs @@ -99,7 +99,7 @@ spec = do passNEpochs 2 getProtVer `shouldReturn` pv11 registerStakePoolTx kh vrf = do - pps <- registerRewardAccountWithDeposit >>= freshPoolParams kh + pps <- registerRewardAccount >>= freshPoolParams kh pure $ mkBasicTx mkBasicTxBody & bodyTxL . certsTxBodyL .~ [RegPoolTxCert $ pps & ppVrfL .~ vrf] diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index 5b843b673db..4d336b90c15 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -280,7 +280,7 @@ spec = do mkBasicTx (mkBasicTxBody & proposalProceduresTxBodyL .~ [proposal]) ccHot <- registerCommitteeHotKey ccCold govActionId <- do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount submitTreasuryWithdrawals [(rewardAccount, Coin 1)] let diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index d3c3dc0ed42..34e0d484da5 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -458,7 +458,7 @@ committeeMinSizeAffectsInFlightProposalsSpec = describe "CommitteeMinSize affects in-flight proposals" $ do let setCommitteeMinSize n = modifyPParams $ ppCommitteeMinSizeL .~ n submitTreasuryWithdrawal amount = do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount submitTreasuryWithdrawals [(rewardAccount, amount)] it "TreasuryWithdrawal fails to ratify due to an increase in CommitteeMinSize" $ whenPostBootstrap $ do disableTreasuryExpansion @@ -877,7 +877,7 @@ votingSpec = (drep2, drep2Staking, _) <- setupSingleDRep 1_000_000 - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount govId <- submitTreasuryWithdrawals [(rewardAccount, initialTreasury)] submitYesVote_ (CommitteeVoter comMember) govId diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs index 50486e1f265..3665fecb2c3 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs @@ -269,7 +269,7 @@ conwayFeaturesPlutusV1V2FailureSpec = do describe "ProposalProcedures" $ do it "V1" $ do deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let badField = OSet.singleton $ ProposalProcedure deposit rewardAccount InfoAction def testPlutusV1V2Failure (hashPlutusScript $ redeemerSameAsDatum SPlutusV1) @@ -279,7 +279,7 @@ conwayFeaturesPlutusV1V2FailureSpec = do $ ProposalProceduresFieldNotSupported badField it "V2" $ do deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let badField = OSet.singleton $ ProposalProcedure deposit rewardAccount InfoAction def testPlutusV1V2Failure (hashPlutusScript $ redeemerSameAsDatum SPlutusV2) @@ -479,7 +479,7 @@ govPolicySpec = do submitFailingTx tx [injectFailure $ ScriptWitnessNotValidatingUTXOW [scriptHash]] impAnn "TreasuryWithdrawals" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let withdrawals = Map.fromList [(rewardAccount, Coin 1000)] let govAction = TreasuryWithdrawals withdrawals (SJust scriptHash) proposal <- mkProposal govAction @@ -500,7 +500,7 @@ govPolicySpec = do (Constitution anchor (SJust alwaysSucceedsSh)) dRep committeeMembers' - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount impAnn "ParameterChange" $ do let pparamsUpdate = def & ppuCommitteeMinSizeL .~ SJust 1 @@ -527,7 +527,7 @@ govPolicySpec = do submitPhase2Invalid_ tx impAnn "TreasuryWithdrawals" $ do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount let withdrawals = Map.fromList [(rewardAccount, Coin 1000)] let govAction = TreasuryWithdrawals withdrawals (SJust alwaysFailsSh) proposal <- mkProposal govAction diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 654dfaabc3a..03de9dd1d2e 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -133,7 +133,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( FailBoth (..), delegateSPORewardAddressToDRep_, getCommittee, - registerRewardAccountWithDeposit, ) where import Cardano.Ledger.Address (RewardAccount (..)) @@ -780,7 +779,7 @@ mkProposal :: GovAction era -> ImpTestM era (ProposalProcedure era) mkProposal ga = do - rewardAccount <- registerRewardAccountWithDeposit + rewardAccount <- registerRewardAccount mkProposalWithRewardAccount ga rewardAccount submitGovAction :: @@ -1837,10 +1836,3 @@ instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ConwayEra where getCommittee :: ConwayEraGov era => ImpTestM era (StrictMaybe (Committee era)) getCommittee = getsNES $ nesEsL . epochStateGovStateL . committeeGovStateL - -registerRewardAccountWithDeposit :: - forall era. - ConwayEraImp era => - ImpTestM era RewardAccount -registerRewardAccountWithDeposit = do - freshKeyHash >>= registerStakeCredential . KeyHashObj diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 64306633ea5..68608b39651 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -1600,12 +1600,9 @@ registerRewardAccount :: forall era. ( HasCallStack , ShelleyEraImp era - , ShelleyEraTxCert era ) => ImpTestM era RewardAccount -registerRewardAccount = do - khDelegator <- freshKeyHash - registerStakeCredential (KeyHashObj khDelegator) +registerRewardAccount = freshKeyHash >>= registerStakeCredential . KeyHashObj lookupReward :: EraCertState era => Credential 'Staking -> ImpTestM era (Maybe Coin) lookupReward = lookupBalance From 3d607b1afabc683b1b9c74ce5d4291a781115251 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 9 Sep 2025 18:47:31 +0200 Subject: [PATCH 06/12] Use certs w/out deposits in some script validation tests For some reason, these tests fail if we use certificates with deposits, so as a temporary measure we will avoid using deposits in these cases. Related: https://github.com/IntersectMBO/cardano-ledger/issues/4571 --- .../Ledger/Alonzo/Imp/UtxowSpec/Valid.hs | 25 +++++++++++++++---- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs index 326938e661f..e30de1fe364 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs @@ -10,6 +10,7 @@ module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec, alonzoEraSpecificSpec) where +import Cardano.Ledger.Address import Cardano.Ledger.Allegra.Scripts ( pattern RequireTimeExpire, ) @@ -19,9 +20,9 @@ import Cardano.Ledger.Alonzo.Rules ( ) import Cardano.Ledger.Alonzo.Scripts (eraLanguages) import Cardano.Ledger.Alonzo.TxWits (unTxDatsL) -import Cardano.Ledger.BaseTypes (StrictMaybe (..), inject, natVersion) +import Cardano.Ledger.BaseTypes (Globals (networkId), StrictMaybe (..), inject, natVersion) import Cardano.Ledger.Coin (Coin (..)) -import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) +import Cardano.Ledger.Credential (Credential (..), StakeReference (..), credToText) import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.Plutus ( Data (..), @@ -35,8 +36,10 @@ import Cardano.Ledger.Shelley.Scripts ( pattern RequireSignature, ) import qualified Data.Map.Strict as Map +import qualified Data.Sequence.Strict as SSeq +import qualified Data.Text as T import GHC.Exts (fromList) -import Lens.Micro ((%~), (&), (.~)) +import Lens.Micro (to, (%~), (&), (.~)) import Lens.Micro.Mtl (use) import qualified PlutusLedgerApi.Common as P import Test.Cardano.Ledger.Alonzo.ImpTest @@ -157,7 +160,7 @@ alonzoEraSpecificSpec = do mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)] it "Not validating WITHDRAWAL script" $ do - account <- registerStakeCredential $ ScriptHashObj alwaysFailsNoDatumHash + account <- registerStakeCredentialNoDeposit $ ScriptHashObj alwaysFailsNoDatumHash submitPhase2Invalid_ $ mkBasicTx $ mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)] @@ -183,7 +186,7 @@ alonzoEraSpecificSpec = do rewardScriptHashes = [alwaysSucceedsNoDatumHash, timelockScriptHash2] txIns <- traverse produceScript inputScriptHashes multiAsset <- MultiAsset . fromList <$> traverse scriptAsset assetScriptHashes - rewardAccounts <- traverse (registerStakeCredential . ScriptHashObj) rewardScriptHashes + rewardAccounts <- traverse (registerStakeCredentialNoDeposit . ScriptHashObj) rewardScriptHashes outputAddr <- freshKeyHash @'Payment let txOut = @@ -215,3 +218,15 @@ alonzoEraSpecificSpec = do else -- Conway fixed the bug that was causing DELEG to fail submitTx_ tx + where + -- NOTE: certain tests somehow require certificates without deposits + -- otherwise, they will yield a Plutus failure + -- TODO: figure out what's the problem, this might be of interest: + -- https://github.com/IntersectMBO/cardano-ledger/issues/4571 + registerStakeCredentialNoDeposit cred = do + submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL + .~ SSeq.fromList [RegTxCert cred] + nId <- use (impGlobalsL . to networkId) + pure $ RewardAccount nId cred From 9dd213b735c2aab672a11240d7ea37f643ad9dbb Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 9 Sep 2025 21:04:55 +0200 Subject: [PATCH 07/12] Remove `shelleyEraSpecificSpec` No longer necessary since the introduction of `genRegTxCert`, `genUnRegTxCert` `ShelleyEraImp` typeclass methods. --- .../Test/Cardano/Ledger/Allegra/Imp.hs | 3 +- .../testlib/Test/Cardano/Ledger/Alonzo/Imp.hs | 3 +- .../Test/Cardano/Ledger/Babbage/Imp.hs | 4 +- .../testlib/Test/Cardano/Ledger/Conway/Imp.hs | 4 +- .../testlib/Test/Cardano/Ledger/Mary/Imp.hs | 4 +- .../Test/Cardano/Ledger/Shelley/Imp.hs | 17 +---- .../Cardano/Ledger/Shelley/Imp/PoolSpec.hs | 69 +++++++------------ 7 files changed, 33 insertions(+), 71 deletions(-) diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs index 487baf07490..239f88f060c 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs @@ -34,5 +34,4 @@ spec = do describe "AllegraImpSpec" . withEachEraVersion @era $ UtxowSpec.spec -instance EraSpecificSpec AllegraEra where - eraSpecificSpec = ShelleyImp.shelleyEraSpecificSpec +instance EraSpecificSpec AllegraEra diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs index f46b96f655a..4b6f0d3e930 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs @@ -27,7 +27,6 @@ import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as Utxow import Test.Cardano.Ledger.Alonzo.ImpTest import Test.Cardano.Ledger.Imp.Common import qualified Test.Cardano.Ledger.Mary.Imp as MaryImp -import qualified Test.Cardano.Ledger.Shelley.Imp.PoolSpec as ShelleyImp spec :: forall era. @@ -64,4 +63,4 @@ alonzoEraSpecificSpec = do Utxow.alonzoEraSpecificSpec instance EraSpecificSpec AlonzoEra where - eraSpecificSpec = ShelleyImp.shelleyEraSpecificSpec >> alonzoEraSpecificSpec + eraSpecificSpec = alonzoEraSpecificSpec diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs index 51d51233e78..9a2acd4e13e 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs @@ -30,7 +30,6 @@ import qualified Test.Cardano.Ledger.Babbage.Imp.UtxoSpec as Utxo import qualified Test.Cardano.Ledger.Babbage.Imp.UtxosSpec as Utxos import qualified Test.Cardano.Ledger.Babbage.Imp.UtxowSpec as Utxow import Test.Cardano.Ledger.Imp.Common -import qualified Test.Cardano.Ledger.Shelley.Imp.PoolSpec as ShelleyImp spec :: forall era. @@ -70,6 +69,5 @@ babbageEraSpecificSpec = do instance EraSpecificSpec BabbageEra where eraSpecificSpec = - ShelleyImp.shelleyEraSpecificSpec - >> AlonzoImp.alonzoEraSpecificSpec + AlonzoImp.alonzoEraSpecificSpec >> babbageEraSpecificSpec diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index 3cfd0aa063e..fbcded477b4 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -59,7 +59,6 @@ import qualified Test.Cardano.Ledger.Conway.Imp.UtxosSpec as Utxos import qualified Test.Cardano.Ledger.Conway.Imp.UtxowSpec as Utxow import Test.Cardano.Ledger.Conway.ImpTest import Test.Cardano.Ledger.Imp.Common -import qualified Test.Cardano.Ledger.Shelley.Imp as ShelleyImp spec :: forall era. @@ -157,7 +156,6 @@ conwayEraSpecificSpec = do instance EraSpecificSpec ConwayEra where eraSpecificSpec = - ShelleyImp.shelleyEraSpecificSpec - >> AlonzoImp.alonzoEraSpecificSpec + AlonzoImp.alonzoEraSpecificSpec >> BabbageImp.babbageEraSpecificSpec >> conwayEraSpecificSpec diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs index ca1e0a4aa84..fb361c01d14 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs @@ -19,7 +19,6 @@ import qualified Test.Cardano.Ledger.Allegra.Imp as AllegraImp import Test.Cardano.Ledger.Imp.Common import qualified Test.Cardano.Ledger.Mary.Imp.UtxoSpec as Utxo import Test.Cardano.Ledger.Mary.ImpTest -import qualified Test.Cardano.Ledger.Shelley.Imp as ShelleyImp spec :: forall era. @@ -36,5 +35,4 @@ spec = do withEachEraVersion @era $ Utxo.spec -instance EraSpecificSpec MaryEra where - eraSpecificSpec = ShelleyImp.shelleyEraSpecificSpec +instance EraSpecificSpec MaryEra diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs index db0361cc03f..11cdbfbd589 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs @@ -5,7 +5,7 @@ {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Cardano.Ledger.Shelley.Imp (spec, shelleyEraSpecificSpec) where +module Test.Cardano.Ledger.Shelley.Imp (spec) where import Cardano.Ledger.Core import Cardano.Ledger.Shelley (ShelleyEra) @@ -14,7 +14,6 @@ import Cardano.Ledger.Shelley.Rules ( ShelleyUtxoPredFailure, ShelleyUtxowPredFailure, ) -import Cardano.Ledger.Shelley.TxCert (ShelleyEraTxCert) import Test.Cardano.Ledger.Imp.Common import qualified Test.Cardano.Ledger.Shelley.Imp.EpochSpec as Epoch import qualified Test.Cardano.Ledger.Shelley.Imp.LedgerSpec as Ledger @@ -44,16 +43,4 @@ spec = do describe "ShelleyPureTests" $ do Instant.spec @era -shelleyEraSpecificSpec :: - ( ShelleyEraImp era - , ShelleyEraTxCert era - , InjectRuleFailure "LEDGER" ShelleyPoolPredFailure era - ) => - SpecWith (ImpInit (LedgerSpec era)) -shelleyEraSpecificSpec = do - describe "Shelley era specific Imp spec" $ - describe "Certificates without deposits" $ do - describe "POOL" Pool.shelleyEraSpecificSpec - -instance EraSpecificSpec ShelleyEra where - eraSpecificSpec = shelleyEraSpecificSpec +instance EraSpecificSpec ShelleyEra diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs index 6420baf48fd..e2891882f42 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs @@ -5,7 +5,7 @@ {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -module Test.Cardano.Ledger.Shelley.Imp.PoolSpec (spec, shelleyEraSpecificSpec) where +module Test.Cardano.Ledger.Shelley.Imp.PoolSpec (spec) where import Cardano.Crypto.Hash.Class (sizeHash) import Cardano.Ledger.Address (RewardAccount (..)) @@ -15,8 +15,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Shelley.Rules (ShelleyPoolPredFailure (..)) -import Cardano.Ledger.Shelley.TxCert (ShelleyEraTxCert) -import Cardano.Ledger.State (PoolMetadata (..), PoolParams, ppCostL, ppMetadataL, ppVrfL, spsVrf) +import Cardano.Ledger.State (PoolMetadata (..), ppCostL, ppMetadataL, ppVrfL, spsVrf) import qualified Data.Map.Strict as Map import Data.Proxy import Lens.Micro @@ -32,6 +31,16 @@ spec :: SpecWith (ImpInit (LedgerSpec era)) spec = describe "POOL" $ do describe "Register and re-register pools" $ do + it "register a pool with too low cost" $ do + (kh, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF + minPoolCost <- getsPParams ppMinPoolCostL + tooLowCost <- Coin <$> choose (0, unCoin minPoolCost) + let pps = (\p -> p & ppCostL .~ tooLowCost) <$> poolParams kh vrf + registerPoolTx <$> pps >>= \tx -> + submitFailingTx + tx + [injectFailure $ StakePoolCostTooLowPOOL $ Mismatch tooLowCost minPoolCost] + it "register a pool with a reward account having the wrong network id" $ do pv <- getsPParams ppProtocolVersionL rewardCredential <- KeyHashObj <$> freshKeyHash @@ -48,32 +57,6 @@ spec = describe "POOL" $ do submitTx_ tx else submitFailingTx tx [injectFailure $ WrongNetworkPOOL (Mismatch Mainnet Testnet) kh] - - describe "Retiring pools" $ do - it "retire an unregistered pool" $ do - khNew <- freshKeyHash - retirePoolTx khNew (EpochInterval 10) >>= \tx -> - submitFailingTx tx [injectFailure $ StakePoolNotRegisteredOnKeyPOOL khNew] - -shelleyEraSpecificSpec :: - forall era. - ( ShelleyEraImp era - , ShelleyEraTxCert era - , InjectRuleFailure "LEDGER" ShelleyPoolPredFailure era - ) => - SpecWith (ImpInit (LedgerSpec era)) -shelleyEraSpecificSpec = describe "POOL" $ do - describe "Register and re-register pools" $ do - it "register a pool with too low cost" $ do - (kh, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF - minPoolCost <- getsPParams ppMinPoolCostL - tooLowCost <- Coin <$> choose (0, unCoin minPoolCost) - let pps = (\p -> p & ppCostL .~ tooLowCost) <$> poolParams kh vrf - registerPoolTx <$> pps >>= \tx -> - submitFailingTx - tx - [injectFailure $ StakePoolCostTooLowPOOL $ Mismatch tooLowCost minPoolCost] - it "register a pool with too big metadata" $ do pv <- getsPParams ppProtocolVersionL let maxMetadataSize = sizeHash (Proxy :: Proxy HASH) @@ -213,6 +196,11 @@ shelleyEraSpecificSpec = describe "POOL" $ do submitFailingTx tx [injectFailure $ VRFKeyHashAlreadyRegistered khNew vrf] describe "Retiring pools" $ do + it "retire an unregistered pool" $ do + khNew <- freshKeyHash + retirePoolTx khNew (EpochInterval 10) >>= \tx -> + submitFailingTx tx [injectFailure $ StakePoolNotRegisteredOnKeyPOOL khNew] + it "retire a pool with too high a retirement epoch" $ do (kh, _) <- registerNewPool maxRetireInterval <- getsPParams ppEMaxL @@ -333,6 +321,15 @@ shelleyEraSpecificSpec = describe "POOL" $ do registerPoolTx <$> poolParams kh vrf >>= submitTx_ expectPool kh (Just vrf) pure (kh, vrf) + registerPoolTx pps = + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL .~ [RegPoolTxCert pps] + retirePoolTx kh retirementInterval = do + curEpochNo <- getsNES nesELL + let retirement = addEpochInterval curEpochNo retirementInterval + pure $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL .~ [RetirePoolTxCert kh retirement] expectPool poolKh mbVrf = do pps <- psStakePools <$> getPState spsVrf <$> Map.lookup poolKh pps `shouldBe` mbVrf @@ -351,17 +348,3 @@ shelleyEraSpecificSpec = describe "POOL" $ do pps <- registerRewardAccount >>= freshPoolParams kh pure $ pps & ppVrfL .~ vrf getPState = getsNES @era $ nesEsL . esLStateL . lsCertStateL . certPStateL - -registerPoolTx :: ShelleyEraImp era => PoolParams -> Tx era -registerPoolTx pps = - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL .~ [RegPoolTxCert pps] - -retirePoolTx :: - ShelleyEraImp era => KeyHash 'StakePool -> EpochInterval -> ImpM (LedgerSpec era) (Tx era) -retirePoolTx kh retirementInterval = do - curEpochNo <- getsNES nesELL - let retirement = addEpochInterval curEpochNo retirementInterval - pure $ - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL .~ [RetirePoolTxCert kh retirement] From d517778952a168e9fb29e41c184ffc59595866c6 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Thu, 11 Sep 2025 20:01:49 +0200 Subject: [PATCH 08/12] Remove `regDelegToDRep` helper This reverts commit 9a06817f7fe18d13b3903c564cffa07f29c724dc and related changes. --- eras/conway/impl/CHANGELOG.md | 1 + .../Cardano/Ledger/Conway/Imp/CertsSpec.hs | 15 +++++----- .../Cardano/Ledger/Conway/Imp/LedgerSpec.hs | 3 +- .../Cardano/Ledger/Conway/Imp/RatifySpec.hs | 5 ++-- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 28 ++++--------------- .../Test/Cardano/Ledger/Dijkstra/ImpTest.hs | 2 +- 6 files changed, 19 insertions(+), 35 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index b85dcb37688..77afe8e027c 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -109,6 +109,7 @@ ### `testlib` +* Removed `regDelegToDRep` * Removed `registerRewardAccountWithDeposit` * Removed `registerPoolWithDeposit` * Removed `registerStakeCredentialWithDeposit` diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs index 1616475a527..e89e8c4e84b 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs @@ -63,8 +63,8 @@ spec = do ] } ) - (registeredRwdAccount, reward, _stakeKey2) <- - setupRewardAccount (Coin 1_000_000) DRepAlwaysNoConfidence + (registeredRwdAccount, reward, stakeKey2) <- setupRewardAccount + void $ delegateToDRep (KeyHashObj stakeKey2) (Coin 1_000_000) DRepAlwaysNoConfidence let tx = mkBasicTx $ @@ -95,8 +95,10 @@ spec = do modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 pv <- getsPParams @era ppProtocolVersionL - (rwdAccount1, reward1, _stakeKey1) <- setupRewardAccount (Coin 1_000_000) DRepAlwaysAbstain - (rwdAccount2, reward2, _stakeKey2) <- setupRewardAccount (Coin 1_000_000) DRepAlwaysAbstain + (rwdAccount1, reward1, stakeKey1) <- setupRewardAccount + (rwdAccount2, reward2, stakeKey2) <- setupRewardAccount + void $ delegateToDRep (KeyHashObj stakeKey1) (Coin 1_000_000) DRepAlwaysAbstain + void $ delegateToDRep (KeyHashObj stakeKey2) (Coin 1_000_000) DRepAlwaysAbstain submitFailingTx ( mkBasicTx $ mkBasicTxBody @@ -127,11 +129,10 @@ spec = do $ Withdrawals [(rwdAccount1, zero)] ] where - setupRewardAccount stake dRep = do + setupRewardAccount = do kh <- freshKeyHash let cred = KeyHashObj kh - void $ regDelegToDRep cred stake dRep - ra <- getRewardAccountFor cred + ra <- registerStakeCredential cred submitAndExpireProposalToMakeReward cred b <- getBalance cred pure (ra, b, kh) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index 4d336b90c15..7ef313cca90 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -204,8 +204,7 @@ spec = do modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2 let scriptHash = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV3 let cred = ScriptHashObj scriptHash - void $ regDelegToDRep cred (Coin 1_000_000) DRepAlwaysAbstain - ra <- getRewardAccountFor cred + ra <- registerStakeCredential cred submitAndExpireProposalToMakeReward cred balance <- getBalance cred diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 34e0d484da5..4a8e364a2dd 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -904,8 +904,9 @@ votingSpec = & ppDRepVotingThresholdsL . dvtMotionNoConfidenceL .~ 1 %! 1 & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 1) (drep, _, committeeId) <- electBasicCommittee - cred <- KeyHashObj <$> freshKeyHash - void $ regDelegToDRep cred (Coin 300) DRepAlwaysNoConfidence + kh <- freshKeyHash + _ <- registerStakeCredential (KeyHashObj kh) + _ <- delegateToDRep (KeyHashObj kh) (Coin 300) DRepAlwaysNoConfidence noConfidence <- submitGovAction (NoConfidence (SJust committeeId)) submitYesVote_ (DRepVoter drep) noConfidence logAcceptedRatio noConfidence diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index 03de9dd1d2e..5aa4481d2b0 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -51,7 +51,6 @@ module Test.Cardano.Ledger.Conway.ImpTest ( updateDRep, delegateToDRep, setupSingleDRep, - regDelegToDRep, setupDRepWithoutStake, setupPoolWithStake, setupPoolWithoutStake, @@ -463,33 +462,16 @@ setupSingleDRep :: ImpTestM era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment) setupSingleDRep stake = impAnn "Set up a single DRep" $ do drepKH <- registerDRep - kh <- freshKeyHash - (delegatorKH, spendingKP) <- - regDelegToDRep (KeyHashObj kh) (Coin stake) (DRepCredential (KeyHashObj drepKH)) - pure (KeyHashObj drepKH, delegatorKH, spendingKP) - -regDelegToDRep :: - ConwayEraImp era => - Credential 'Staking -> - Coin -> - DRep -> - ImpTestM era (Credential 'Staking, KeyPair 'Payment) -regDelegToDRep cred stake dRep = do + delegatorKH <- freshKeyHash deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL - (_, spendingKP) <- freshKeyPair let tx = mkBasicTx mkBasicTxBody - & bodyTxL . outputsTxBodyL - .~ SSeq.singleton (mkBasicTxOut (mkAddr spendingKP cred) (inject stake)) & bodyTxL . certsTxBodyL - .~ SSeq.fromList - [ RegDepositDelegTxCert - cred - (DelegVote dRep) - deposit - ] + .~ SSeq.fromList [RegDepositTxCert (KeyHashObj delegatorKH) deposit] submitTx_ tx - pure (cred, spendingKP) + spendingKP <- + delegateToDRep (KeyHashObj delegatorKH) (Coin stake) (DRepCredential (KeyHashObj drepKH)) + pure (KeyHashObj drepKH, KeyHashObj delegatorKH, spendingKP) delegateToDRep :: ConwayEraImp era => diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs index 7fc477ebbd4..cc4053f898c 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs @@ -43,7 +43,7 @@ import Cardano.Ledger.Dijkstra.Scripts ( ) import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..)) import Cardano.Ledger.Plutus (SLanguage (..)) -import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesEsL) +import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure) import qualified Cardano.Ledger.Shelley.Rules as Shelley import Cardano.Ledger.Shelley.Scripts ( From edf5afc041747f00c46079fdf1a88e3e12cb0da4 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Wed, 17 Sep 2025 00:43:53 +0200 Subject: [PATCH 09/12] Move some `alonzoEraSpecificSpec` tests --- .../Ledger/Alonzo/Imp/UtxowSpec/Valid.hs | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs index e30de1fe364..654eb4f4831 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs @@ -90,6 +90,21 @@ spec = describe "Valid transactions" $ do mkBasicTx $ mkBasicTxBody & inputsTxBodyL .~ [txIn] + it "Validating CERT script" $ do + txIn <- produceScript alwaysSucceedsWithDatumHash + txCert <- genRegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash + submitTx_ $ + mkBasicTx $ + mkBasicTxBody + & inputsTxBodyL .~ [txIn] + & certsTxBodyL .~ [txCert] + + it "Validating WITHDRAWAL script" $ do + account <- registerStakeCredential $ ScriptHashObj alwaysSucceedsNoDatumHash + submitTx_ $ + mkBasicTx $ + mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)] + it "Validating MINT script" $ do submitTx_ =<< mkTokenMintingTx alwaysSucceedsNoDatumHash @@ -135,15 +150,6 @@ alonzoEraSpecificSpec = do alwaysFailsWithDatumHash = hashPlutusScript $ alwaysFailsWithDatum slang :: ScriptHash alwaysFailsNoDatumHash = hashPlutusScript $ alwaysFailsNoDatum slang :: ScriptHash - it "Validating CERT script" $ do - txIn <- produceScript alwaysSucceedsWithDatumHash - let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash - submitTx_ $ - mkBasicTx $ - mkBasicTxBody - & inputsTxBodyL .~ [txIn] - & certsTxBodyL .~ [txCert] - it "Not validating CERT script" $ do txIn <- produceScript alwaysFailsWithDatumHash let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash @@ -153,12 +159,6 @@ alonzoEraSpecificSpec = do & inputsTxBodyL .~ [txIn] & certsTxBodyL .~ [txCert] - it "Validating WITHDRAWAL script" $ do - account <- registerStakeCredential $ ScriptHashObj alwaysSucceedsNoDatumHash - submitTx_ $ - mkBasicTx $ - mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)] - it "Not validating WITHDRAWAL script" $ do account <- registerStakeCredentialNoDeposit $ ScriptHashObj alwaysFailsNoDatumHash submitPhase2Invalid_ $ From e3118582c6ee977a7ada0ee9a6e8374a35144029 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Wed, 17 Sep 2025 00:44:13 +0200 Subject: [PATCH 10/12] Remove `babbageEraSpecificSpec` No longer necessary since the introduction of `genRegTxCert`, `genUnRegTxCert` `ShelleyEraImp` typeclass methods. --- .../testlib/Test/Cardano/Ledger/Babbage/Imp.hs | 17 ++--------------- .../Cardano/Ledger/Babbage/Imp/UtxowSpec.hs | 15 ++------------- .../Ledger/Babbage/Imp/UtxowSpec/Valid.hs | 16 +++------------- .../testlib/Test/Cardano/Ledger/Conway/Imp.hs | 1 - 4 files changed, 7 insertions(+), 42 deletions(-) diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs index 9a2acd4e13e..5bcdf3d13bb 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs @@ -6,7 +6,7 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Cardano.Ledger.Babbage.Imp (spec, babbageEraSpecificSpec) where +module Test.Cardano.Ledger.Babbage.Imp (spec) where import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) import Cardano.Ledger.Alonzo.Rules ( @@ -15,7 +15,7 @@ import Cardano.Ledger.Alonzo.Rules ( AlonzoUtxowPredFailure, ) import Cardano.Ledger.Babbage (BabbageEra) -import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, InjectRuleFailure, ShelleyEraTxCert) +import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, InjectRuleFailure) import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure) import Cardano.Ledger.Babbage.TxInfo (BabbageContextError) import Cardano.Ledger.BaseTypes (Inject) @@ -55,19 +55,6 @@ spec = do Utxow.spec Utxos.spec @era -babbageEraSpecificSpec :: - forall era. - ( AlonzoEraImp era - , ShelleyEraTxCert era - , BabbageEraTxBody era - ) => - SpecWith (ImpInit (LedgerSpec era)) -babbageEraSpecificSpec = do - describe "Babbage era specific Imp spec" $ - describe "Certificates without deposits" $ - describe "UTXOW" Utxow.babbageEraSpecificSpec - instance EraSpecificSpec BabbageEra where eraSpecificSpec = AlonzoImp.alonzoEraSpecificSpec - >> babbageEraSpecificSpec diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec.hs index f1c429fe272..cb9a481c89b 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec.hs @@ -4,11 +4,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Test.Cardano.Ledger.Babbage.Imp.UtxowSpec (spec, babbageEraSpecificSpec) where +module Test.Cardano.Ledger.Babbage.Imp.UtxowSpec (spec) where import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure, AlonzoUtxowPredFailure) -import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, InjectRuleFailure, ShelleyEraTxCert) +import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, InjectRuleFailure) import Cardano.Ledger.Babbage.Rules (BabbageUtxowPredFailure) import Cardano.Ledger.Babbage.TxInfo (BabbageContextError) import Cardano.Ledger.BaseTypes (Inject) @@ -33,14 +33,3 @@ spec = do describe "UTXOW" $ do Valid.spec Invalid.spec - -babbageEraSpecificSpec :: - forall era. - ( AlonzoEraImp era - , BabbageEraTxBody era - , ShelleyEraTxCert era - ) => - SpecWith (ImpInit (LedgerSpec era)) -babbageEraSpecificSpec = do - describe "UTXOW - certificates without deposits" $ do - Valid.babbageEraSpecificSpec diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec/Valid.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec/Valid.hs index e28c7dbfceb..38e10273808 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec/Valid.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp/UtxowSpec/Valid.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module Test.Cardano.Ledger.Babbage.Imp.UtxowSpec.Valid (spec, babbageEraSpecificSpec) where +module Test.Cardano.Ledger.Babbage.Imp.UtxowSpec.Valid (spec) where import Cardano.Ledger.Alonzo.TxWits (unTxDatsL) import Cardano.Ledger.Babbage.Core @@ -171,17 +171,6 @@ spec = describe "Valid" $ do & bodyTxL . inputsTxBodyL .~ [txInAt 0 txInitial] & bodyTxL . referenceInputsTxBodyL .~ [txInAt 1 txInitial] -babbageEraSpecificSpec :: - forall era. - ( AlonzoEraImp era - , BabbageEraTxBody era - , ShelleyEraTxCert era - ) => - SpecWith (ImpInit (LedgerSpec era)) -babbageEraSpecificSpec = describe "Valid" $ do - forM_ @[] [PlutusV2 .. eraMaxLanguage @era] $ \slang -> do - describe (show slang) $ do - withSLanguage slang $ \lang -> do it "Use a reference script to authorize a delegation certificate" $ do addr <- freshKeyAddr_ plutus <- mkPlutusScript $ alwaysSucceedsNoDatum lang @@ -196,9 +185,10 @@ babbageEraSpecificSpec = describe "Valid" $ do submitTx $ mkBasicTx mkBasicTxBody & bodyTxL . outputsTxBodyL .~ [txOut, txOutRef] + cert <- genRegTxCert $ ScriptHashObj $ hashScript script submitTx_ $ mkBasicTx mkBasicTxBody & bodyTxL . inputsTxBodyL .~ [txInAt 0 txInitial] & bodyTxL . referenceInputsTxBodyL .~ [txInAt 1 txInitial] & bodyTxL . certsTxBodyL - .~ [RegTxCert . ScriptHashObj $ hashScript script] + .~ [cert] diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index fbcded477b4..896bbb3dc8b 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -157,5 +157,4 @@ conwayEraSpecificSpec = do instance EraSpecificSpec ConwayEra where eraSpecificSpec = AlonzoImp.alonzoEraSpecificSpec - >> BabbageImp.babbageEraSpecificSpec >> conwayEraSpecificSpec From bdcc2c0dfb1e45e3e6ecc29fe012964ec1eca5de Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Wed, 17 Sep 2025 00:44:19 +0200 Subject: [PATCH 11/12] Move a `conwayEraSpecificSpec` testcase --- .../Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index 0fef9769730..a4555c8cd43 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -57,6 +57,14 @@ spec = do it "With correct deposit or without any deposit" $ do expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL + cred <- KeyHashObj <$> freshKeyHash + -- NOTE: This will always generate certs with deposits post-Conway + regTxCert <- genRegTxCert cred + submitTx_ $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL .~ [regTxCert] + expectRegistered cred + freshKeyHash >>= \kh -> do submitTx_ $ mkBasicTx mkBasicTxBody @@ -727,15 +735,6 @@ conwayEraSpecificSpec :: ) => SpecWith (ImpInit (LedgerSpec era)) conwayEraSpecificSpec = do - describe "Register stake credential" $ do - it "Without any deposit" $ do - cred <- KeyHashObj <$> freshKeyHash - regTxCert <- genRegTxCert cred - submitTx_ $ - mkBasicTx mkBasicTxBody - & bodyTxL . certsTxBodyL .~ [regTxCert] - expectRegistered cred - describe "Delegate stake" $ do it "Register and delegate in the same transaction" $ do cred1 <- KeyHashObj <$> freshKeyHash From e2ea84f996ac9e1f41b37bb95f2c2bb11eccea88 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Fri, 26 Sep 2025 01:27:23 +0200 Subject: [PATCH 12/12] Apply suggestions from code review Co-authored-by: teodanciu --- eras/babbage/impl/CHANGELOG.md | 6 +++++- eras/babbage/impl/cardano-ledger-babbage.cabal | 2 +- eras/conway/impl/CHANGELOG.md | 8 ++++---- .../Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs | 1 + .../Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs | 6 +++--- .../Test/Cardano/Ledger/Dijkstra/ImpTest.hs | 11 +++++------ eras/shelley/impl/CHANGELOG.md | 14 +++++++++----- eras/shelley/impl/cardano-ledger-shelley.cabal | 2 +- .../testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs | 4 ++-- 9 files changed, 31 insertions(+), 23 deletions(-) diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 4fa079161af..69bc52a37e4 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -1,9 +1,13 @@ # Version history for `cardano-ledger-babbage` -## 1.12.0.1 +## 1.12.1.0 * +### `testlib` + +* Removed `babbageEraSpecificSpec` + ## 1.12.0.0 * Hide `Cardano.Ledger.Babbage.Translation` module diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal index 57ce88c412d..7f58fce9368 100644 --- a/eras/babbage/impl/cardano-ledger-babbage.cabal +++ b/eras/babbage/impl/cardano-ledger-babbage.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-babbage -version: 1.12.0.1 +version: 1.12.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 77afe8e027c..f1d5a2029ee 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -9,6 +9,10 @@ ### `testlib` +* Removed `regDelegToDRep` +* Removed `registerRewardAccountWithDeposit` +* Removed `registerPoolWithDeposit` +* Removed `registerStakeCredentialWithDeposit` * Remove `conwayAccountsToUMap` corresponding to the removal of `UMap` from core. ## 1.20.0.0 @@ -109,10 +113,6 @@ ### `testlib` -* Removed `regDelegToDRep` -* Removed `registerRewardAccountWithDeposit` -* Removed `registerPoolWithDeposit` -* Removed `registerStakeCredentialWithDeposit` * Added `EraSpecificSpec ConwayEra` instance * Added `registerRewardAccountWithDeposit` * Added `regDelegToDRep` diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index 7ef313cca90..887bb5a41fa 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -205,6 +205,7 @@ spec = do let scriptHash = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV3 let cred = ScriptHashObj scriptHash ra <- registerStakeCredential cred + void $ delegateToDRep cred (Coin 1_000_000) DRepAlwaysAbstain submitAndExpireProposalToMakeReward cred balance <- getBalance cred diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 4a8e364a2dd..a0bee280f90 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -904,9 +904,9 @@ votingSpec = & ppDRepVotingThresholdsL . dvtMotionNoConfidenceL .~ 1 %! 1 & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 1) (drep, _, committeeId) <- electBasicCommittee - kh <- freshKeyHash - _ <- registerStakeCredential (KeyHashObj kh) - _ <- delegateToDRep (KeyHashObj kh) (Coin 300) DRepAlwaysNoConfidence + cred <- KeyHashObj <$> freshKeyHash + _ <- registerStakeCredential cred + _ <- delegateToDRep cred (Coin 300) DRepAlwaysNoConfidence noConfidence <- submitGovAction (NoConfidence (SJust committeeId)) submitYesVote_ (DRepVoter drep) noConfidence logAcceptedRatio noConfidence diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs index cc4053f898c..b5c803f0139 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs +++ b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs @@ -14,7 +14,6 @@ module Test.Cardano.Ledger.Dijkstra.ImpTest ( exampleDijkstraGenesis, DijkstraEraImp, impDijkstraSatisfyNativeScript, - dijkstraGenRegTxCert, ) where import Cardano.Ledger.Allegra.Scripts ( @@ -177,8 +176,8 @@ dijkstraGenUnRegTxCert :: Credential 'Staking -> ImpTestM era (TxCert era) dijkstraGenUnRegTxCert stakingCredential = do - accounts <- getsNES (nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL) - case lookupAccountState stakingCredential accounts of - Nothing -> error "TODO" - Just accountState -> - pure $ UnRegDepositTxCert stakingCredential (fromCompact (accountState ^. depositAccountStateL)) + accounts <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL + deposit <- case lookupAccountState stakingCredential accounts of + Nothing -> getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL + Just accountState -> pure (fromCompact (accountState ^. depositAccountStateL)) + pure $ UnRegDepositTxCert stakingCredential deposit diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index f47c38d9f7a..5580fe0de1b 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -1,9 +1,17 @@ # Version history for `cardano-ledger-shelley` -## 1.17.0.1 +## 1.17.1.0 * +### `testlib` + +* Removed `shelleyEraSpecificSpec` +* Added `shelleyGenUnRegTxCert` +* Added `genUnRegTxCert` to `ShelleyEraImp` +* Added `shelleyGenRegTxCert` +* Added `genRegTxCert` to `ShelleyEraImp` + ## 1.17.0.0 * Changed `MaxTxSizeUTxO` and `sizeShelleyTxF` to use `Word32` @@ -96,10 +104,6 @@ ### `testlib` * Remove `shelleyAccountsToUMap` corresponding to the removal of `UMap` from core. -* Added `shelleyGenUnRegTxCert` -* Added `genUnRegTxCert` to `ShelleyEraImp` -* Added `shelleyGenRegTxCert` -* Added `genRegTxCert` to `ShelleyEraImp` * Added `impSatisfySignature` and `impSatisfyMNativeScripts` * Added `EraSpecificSpec ShelleyEra` instance * Added `EraSpecificSpec` class diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index b6fcbd15a90..470083d90a7 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-shelley -version: 1.17.0.0 +version: 1.17.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 68608b39651..100afd148c1 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -509,9 +509,9 @@ class expectTxSuccess :: HasCallStack => Tx era -> ImpTestM era () - genRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era) + genRegTxCert :: Credential 'Staking -> ImpTestM era (TxCert era) - genUnRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era) + genUnRegTxCert :: Credential 'Staking -> ImpTestM era (TxCert era) impSatisfySignature :: KeyHash 'Witness ->