Refactor some utility functions from ImpTest for better reusability

eras/conway/impl/CHANGELOG.md

@@ -13,6 +13,12 @@
   * `reCurrentEpochL`
   * `reCommitteeStateL`
 
+### `testlib`
+
+  * Removed `redelegateDRep` from `ImpTest`
+  * Changed signature of `delegateToDRep` to take a `Credential` parameter
+
+
 ## 1.16.1.0
 
 * Replace GOVCERT `updateDRepExpiry` with `computeDRepExpiry`

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

@@ -744,20 +744,22 @@ votingSpec =
       describe "Predefined DReps" $ do
         it "acceptedRatio with default DReps" $ do
           (drep1, _, committeeGovId) <- electBasicCommittee
-          (drep2, drep2Staking, _) <- setupSingleDRep 1_000_000
+          (_, drep2Staking, _) <- setupSingleDRep 1_000_000
 
           paramChangeGovId <- submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
           submitYesVote_ (DRepVoter drep1) paramChangeGovId
 
           passEpoch
           calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 2
 
-          _ <- delegateToDRep 1_000_000 DRepAlwaysNoConfidence
+          kh <- freshKeyHash
+          _ <- registerStakeCredential (KeyHashObj kh)
+          _ <- delegateToDRep (KeyHashObj kh) (Coin 1_000_000) DRepAlwaysNoConfidence
           passEpoch
           -- AlwaysNoConfidence vote acts like a 'No' vote for actions other than NoConfidence
           calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 3
 
-          redelegateDRep drep2 DRepAlwaysAbstain drep2Staking
+          _ <- delegateToDRep drep2Staking zero DRepAlwaysAbstain
           passEpoch
           -- AlwaysAbstain vote acts like 'Abstain' vote
           calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 2
@@ -796,14 +798,7 @@ votingSpec =
           passEpoch
           isDRepAccepted noConfidenceGovId `shouldReturn` False
 
-          submitTxAnn_ "Redelegate to AlwaysNoConfidence " $
-            mkBasicTx mkBasicTxBody
-              & bodyTxL . certsTxBodyL
-                .~ SSeq.fromList
-                  [ DelegTxCert @era
-                      drep2Staking
-                      (DelegVote DRepAlwaysNoConfidence)
-                  ]
+          _ <- delegateToDRep drep2Staking zero DRepAlwaysNoConfidence
           passEpoch
           isDRepAccepted noConfidenceGovId `shouldReturn` True
           passEpoch
@@ -829,7 +824,7 @@ votingSpec =
           passEpoch
           getTreasury `shouldReturn` initialTreasury
 
-          redelegateDRep drep2 DRepAlwaysAbstain drep2Staking
+          _ <- delegateToDRep drep2Staking zero DRepAlwaysAbstain
 
           passEpoch
           -- the delegation turns the No vote into an Abstain, enough to pass the action
@@ -844,7 +839,9 @@ votingSpec =
               & ppDRepVotingThresholdsL . dvtMotionNoConfidenceL .~ 1 %! 1
               & ppCoinsPerUTxOByteL .~ CoinPerByte (Coin 1)
           (drep, _, committeeId) <- electBasicCommittee
-          _ <- delegateToDRep 300 DRepAlwaysNoConfidence
+          kh <- freshKeyHash
+          _ <- registerStakeCredential (KeyHashObj kh)
+          _ <- delegateToDRep (KeyHashObj kh) (Coin 300) DRepAlwaysNoConfidence
           noConfidence <- submitGovAction (NoConfidence (SJust committeeId))
           submitYesVote_ (DRepVoter drep) noConfidence
           logAcceptedRatio noConfidence

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

@@ -43,7 +43,6 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   unRegisterDRep,
   updateDRep,
   delegateToDRep,
-  redelegateDRep,
   setupSingleDRep,
   setupDRepWithoutStake,
   setupPoolWithStake,
@@ -216,7 +215,7 @@ import Lens.Micro
 import Test.Cardano.Ledger.Babbage.ImpTest
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.TreeDiff ()
-import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr)
+import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkCred)
 import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus (testingCostModel)
@@ -449,7 +448,7 @@ setupDRepWithoutStake = do
           ]
   pure (drepKH, delegatorKH)
 
--- | Registers a new DRep and delegates the specified amount of ADA to it.
+-- | Registers a new DRep, registers its stake credentials and delegates the specified amount of ADA to it.
 setupSingleDRep ::
   ConwayEraImp era =>
   Integer ->
@@ -461,54 +460,47 @@ setupSingleDRep ::
     )
 setupSingleDRep stake = do
   drepKH <- registerDRep
-  (stakingCred, spendingKh) <- delegateToDRep stake (DRepCredential (KeyHashObj drepKH))
-  pure (KeyHashObj drepKH, stakingCred, spendingKh)
+  delegatorKH <- freshKeyHash
+  deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
+  let tx =
+        mkBasicTx mkBasicTxBody
+          & bodyTxL . certsTxBodyL
+            .~ SSeq.fromList
+              [ RegDepositTxCert
+                  (KeyHashObj delegatorKH)
+                  deposit
+              ]
+  submitTx_ tx
+  spendingKP <-
+    delegateToDRep (KeyHashObj delegatorKH) (Coin stake) (DRepCredential (KeyHashObj drepKH))
+  pure (KeyHashObj drepKH, KeyHashObj delegatorKH, spendingKP)
 
 delegateToDRep ::
   ConwayEraImp era =>
-  Integer ->
+  Credential 'Staking (EraCrypto era) ->
+  Coin ->
   DRep (EraCrypto era) ->
   ImpTestM
     era
-    ( Credential 'Staking (EraCrypto era)
-    , KeyPair 'Payment (EraCrypto era)
-    )
-delegateToDRep stake dRep = do
-  (delegatorKH, delegatorKP) <- freshKeyPair
+    (KeyPair 'Payment (EraCrypto era))
+delegateToDRep cred stake dRep = do
   (_, spendingKP) <- freshKeyPair
-  deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
+  let addr = Addr Testnet (mkCred spendingKP) (StakeRefBase cred)
   submitTxAnn_ "Delegate to DRep" $
     mkBasicTx mkBasicTxBody
       & bodyTxL . outputsTxBodyL
         .~ SSeq.singleton
           ( mkBasicTxOut
-              (mkAddr (spendingKP, delegatorKP))
-              (inject $ Coin stake)
+              addr
+              (inject stake)
           )
       & bodyTxL . certsTxBodyL
         .~ SSeq.fromList
-          [ RegDepositDelegTxCert
-              (KeyHashObj delegatorKH)
+          [ DelegTxCert
+              cred
               (DelegVote dRep)
-              deposit
-          ]
-  pure (KeyHashObj delegatorKH, spendingKP)
-
-redelegateDRep ::
-  ConwayEraImp era =>
-  Credential 'DRepRole (EraCrypto era) ->
-  DRep (EraCrypto era) ->
-  Credential 'Staking (EraCrypto era) ->
-  ImpTestM era ()
-redelegateDRep dRepCred newDRep stakingCred = do
-  drepState <- lookupDRepState dRepCred
-  submitTx_ $
-    mkBasicTx mkBasicTxBody
-      & bodyTxL . certsTxBodyL
-        .~ SSeq.fromList
-          [ UnRegDRepTxCert dRepCred (drepState ^. drepDepositL)
-          , DelegTxCert stakingCred (DelegVote newDRep)
           ]
+  pure spendingKP
 
 lookupDRepState ::
   HasCallStack =>
@@ -774,7 +766,7 @@ submitAndExpireProposalToMakeReward stakingC = do
       ProposalProcedure
         { pProcDeposit = deposit
         , pProcReturnAddr = rewardAccount
-        , pProcGovAction = TreasuryWithdrawals mempty def
+        , pProcGovAction = InfoAction
         , pProcAnchor = def
         }
   passNEpochs $ 2 + fromIntegral lifetime

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.14.0.0
 
+* Added `registerStakeCredential` and `delegateStake` to `ImpTest`
 * Remove protocol version argument from `mkShelleyGlobals` (`maxMajorPV` was removed from `Globals`)
 * Added `EncCBOR` instances for:
   * `UtxoEnv`

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -71,7 +71,9 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   impLogToExpr,
   runImpRule,
   tryRunImpRule,
+  delegateStake,
   registerRewardAccount,
+  registerStakeCredential,
   getRewardAccountFor,
   lookupReward,
   registerPool,
@@ -1587,29 +1589,42 @@ getRewardAccountFor stakingC = do
   networkId <- use (impGlobalsL . to networkId)
   pure $ RewardAccount networkId stakingC
 
-registerRewardAccount ::
+registerStakeCredential ::
   forall era.
   ( HasCallStack
   , ShelleyEraImp era
   ) =>
+  Credential 'Staking (EraCrypto era) ->
   ImpTestM era (RewardAccount (EraCrypto era))
-registerRewardAccount = do
-  khDelegator <- freshKeyHash
-  kpDelegator <- lookupKeyPair khDelegator
-  (_, kpSpending) <- freshKeyPair
-  let stakingCredential = KeyHashObj khDelegator
-  submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText stakingCredential)) $
+registerStakeCredential cred = do
+  submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $
     mkBasicTx mkBasicTxBody
-      & bodyTxL . outputsTxBodyL
-        .~ SSeq.fromList
-          [ mkBasicTxOut
-              (mkAddr (kpSpending, kpDelegator))
-              (inject $ Coin 10_000_000)
-          ]
       & bodyTxL . certsTxBodyL
-        .~ SSeq.fromList [RegTxCert @era stakingCredential]
+        .~ SSeq.fromList [RegTxCert @era cred]
   networkId <- use (impGlobalsL . to networkId)
-  pure $ RewardAccount networkId stakingCredential
+  pure $ RewardAccount networkId cred
+
+delegateStake ::
+  ShelleyEraImp era =>
+  Credential 'Staking (EraCrypto era) ->
+  KeyHash 'StakePool (EraCrypto era) ->
+  ImpTestM era ()
+delegateStake cred poolKH = do
+  submitTxAnn_ ("Delegate Staking Credential: " <> T.unpack (credToText cred)) $
+    mkBasicTx mkBasicTxBody
+      & bodyTxL . certsTxBodyL
+        .~ SSeq.fromList
+          [DelegStakeTxCert cred poolKH]
+
+registerRewardAccount ::
+  forall era.
+  ( HasCallStack
+  , ShelleyEraImp era
+  ) =>
+  ImpTestM era (RewardAccount (EraCrypto era))
+registerRewardAccount = do
+  khDelegator <- freshKeyHash
+  registerStakeCredential (KeyHashObj khDelegator)
 
 lookupReward :: HasCallStack => Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
 lookupReward stakingCredential = do