Merge pull request #4713 from IntersectMBO/td/better-bootstrap-aware-…

…imptests

Better bootstrap-aware Imp tests

eras/conway/impl/CHANGELOG.md

@@ -6,6 +6,11 @@
 
 ### `testlib`
 
+* Add `mkUpdateCommitteeProposal`
+* Add `SubmitFailureExpectation`, `FailBoth`, `submitBootstrapAwareFailingVote`, `submitBootstrapAwareFailingProposal`, `submitBootstrapAwareFailingProposal_`
+* Add `mkConstitutionProposal`
+* Remove `submitConstitutionGovAction` and change signature of `submitConstitution`
+* Add `mkProposal` and `mkProposalWithRewardAccount`
 * Add `whenBootstrap`
 
 ## 1.17.2.0

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs

@@ -16,7 +16,8 @@ import Cardano.Ledger.Alonzo.Rules (
  )
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
 import Cardano.Ledger.Babbage.TxInfo (BabbageContextError)
-import Cardano.Ledger.BaseTypes (Inject, ShelleyBase, natVersion)
+import Cardano.Ledger.BaseTypes (Inject, ShelleyBase)
+import Cardano.Ledger.Conway (Conway)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Rules (
   ConwayBbodyPredFailure,
@@ -55,7 +56,7 @@ import qualified Test.Cardano.Ledger.Conway.Imp.LedgerSpec as Ledger
 import qualified Test.Cardano.Ledger.Conway.Imp.RatifySpec as Ratify
 import qualified Test.Cardano.Ledger.Conway.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Conway.Imp.UtxosSpec as Utxos
-import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp, withImpState, withImpStateWithProtVer)
+import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp, withImpStateWithProtVer)
 
 spec ::
   forall era.
@@ -97,28 +98,20 @@ spec ::
   Spec
 spec = do
   BabbageImp.spec @era
-  describe "ConwayImpSpec - post bootstrap (protocol version 10)" $
-    withImpStateWithProtVer @era (natVersion @10) $ do
-      describe "BBODY" $ Bbody.spec @era
-      describe "DELEG" $ Deleg.spec @era
-      describe "ENACT" $ Enact.spec @era
-      describe "EPOCH" $ Epoch.spec @era
-      describe "GOV" $ Gov.spec @era
-      describe "GOVCERT" $ GovCert.spec @era
-      describe "UTXO" $ Utxo.spec @era
-      describe "UTXOS" $ Utxos.spec @era
-      describe "RATIFY" $ Ratify.spec @era
-      describe "LEDGER" $ Ledger.spec @era
-  describe "ConwayImpSpec - bootstrap phase (protocol version 9)" $
-    withImpState @era $ do
-      describe "BBODY" $ Bbody.spec @era
-      describe "CERTS" $ Certs.spec @era
-      describe "DELEG" $ Deleg.spec @era
-      describe "ENACT" $ Enact.relevantDuringBootstrapSpec @era
-      describe "EPOCH" $ Epoch.relevantDuringBootstrapSpec @era
-      describe "GOV" $ Gov.relevantDuringBootstrapSpec @era
-      describe "GOVCERT" $ GovCert.relevantDuringBootstrapSpec @era
-      describe "UTXO" $ Utxo.spec @era
-      describe "UTXOS" $ Utxos.relevantDuringBootstrapSpec @era
-      describe "RATIFY" $ Ratify.relevantDuringBootstrapSpec @era
-      describe "LEDGER" $ Ledger.spec @era
+  let
+    conwayImpSpec protVer =
+      describe ("ConwayImpSpec - " <> show protVer) $
+        withImpStateWithProtVer @era protVer $ do
+          describe "BBODY" $ Bbody.spec @era
+          describe "CERTS" $ Certs.spec @era
+          describe "DELEG" $ Deleg.spec @era
+          describe "ENACT" $ Enact.spec @era
+          describe "EPOCH" $ Epoch.spec @era
+          describe "GOV" $ Gov.spec @era
+          describe "GOVCERT" $ GovCert.spec @era
+          describe "LEDGER" $ Ledger.spec @era
+          describe "RATIFY" $ Ratify.spec @era
+          describe "UTXO" $ Utxo.spec @era
+          describe "UTXOS" $ Utxos.spec @era
+   in
+    forM_ [eraProtVerLow @Conway .. eraProtVerHigh @Conway] conwayImpSpec

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/CertsSpec.hs

@@ -13,8 +13,9 @@ module Test.Cardano.Ledger.Conway.Imp.CertsSpec (spec) where
 import Cardano.Ledger.BaseTypes (EpochInterval (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core
-import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..))
+import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..), ConwayLedgerPredFailure (..))
 import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.DRep (DRep (..))
 import Cardano.Ledger.Val (Val (..))
 import Lens.Micro ((&), (.~))
 import Test.Cardano.Ledger.Conway.Arbitrary ()
@@ -25,38 +26,66 @@ spec ::
   forall era.
   ( ConwayEraImp era
   , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era
+  , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era
   ) =>
   SpecWith (ImpTestState era)
 spec = do
   describe "Withdrawals" $ do
     it "Withdrawing from an unregistered reward account" $ do
       modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
 
-      rwdAccount <- KeyHashObj <$> freshKeyHash >>= getRewardAccountFor
-      submitFailingTx
-        ( mkBasicTx $
+      stakeKey <- freshKeyHash
+      rwdAccount <- getRewardAccountFor $ KeyHashObj stakeKey
+      let
+        tx =
+          mkBasicTx $
             mkBasicTxBody
               & withdrawalsTxBodyL
-                .~ Withdrawals
-                  [(rwdAccount, Coin 20)]
-        )
-        [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, Coin 20)]]
-
-      (registeredRwdAccount, reward) <- setupRewardAccount
-      submitFailingTx
-        ( mkBasicTx $
+                .~ Withdrawals [(rwdAccount, Coin 20)]
+        notInRewardsFailure = injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, Coin 20)]
+       in
+        submitBootstrapAware
+          (submitTx_ tx)
+          (submitFailingTx tx)
+          ( FailBootstrapAndPostBootstrap $
+              FailBoth
+                { bootstrapFailures = [notInRewardsFailure]
+                , postBootstrapFailures =
+                    [ notInRewardsFailure
+                    , injectFailure (ConwayWdrlNotDelegatedToDRep [stakeKey])
+                    ]
+                }
+          )
+      (registeredRwdAccount, reward, stakeKey2) <- setupRewardAccount
+      void $ delegateToDRep (KeyHashObj stakeKey2) (Coin 1_000_000) DRepAlwaysNoConfidence
+      let
+        tx =
+          mkBasicTx $
             mkBasicTxBody
               & withdrawalsTxBodyL
-                .~ Withdrawals
-                  [(rwdAccount, zero), (registeredRwdAccount, reward)]
-        )
-        [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, zero)]]
+                .~ Withdrawals [(rwdAccount, zero), (registeredRwdAccount, reward)]
+        notInRewardsFailure = injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount, zero)]
+       in
+        submitBootstrapAware
+          (submitTx_ tx)
+          (submitFailingTx tx)
+          ( FailBootstrapAndPostBootstrap $
+              FailBoth
+                { bootstrapFailures = [notInRewardsFailure]
+                , postBootstrapFailures =
+                    [ notInRewardsFailure
+                    , injectFailure (ConwayWdrlNotDelegatedToDRep [stakeKey])
+                    ]
+                }
+          )
 
     it "Withdrawing the wrong amount" $ do
       modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
 
-      (rwdAccount1, reward1) <- setupRewardAccount
-      (rwdAccount2, reward2) <- setupRewardAccount
+      (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
@@ -78,8 +107,9 @@ spec = do
         [injectFailure $ WithdrawalsNotInRewardsCERTS [(rwdAccount1, zero)]]
   where
     setupRewardAccount = do
-      cred <- KeyHashObj <$> freshKeyHash
+      kh <- freshKeyHash
+      let cred = KeyHashObj kh
       ra <- registerStakeCredential cred
       submitAndExpireProposalToMakeReward cred
       rw <- lookupReward cred
-      pure (ra, rw)
+      pure (ra, rw, kh)