WIP - registerStakeCredential improvement

Author: Lucsanszky

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs

@@ -42,6 +42,7 @@ instance ShelleyEraImp AllegraEra where
 
   fixupTx = shelleyFixupTx
   expectTxSuccess = impShelleyExpectTxSuccess
+  registerStakeCredential = shelleyRegisterStakeCredential
 
 impAllegraSatisfyNativeScript ::
   ( AllegraEraScript era

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs

@@ -428,6 +428,7 @@ instance ShelleyEraImp AlonzoEra where
   impSatisfyNativeScript = impAllegraSatisfyNativeScript
   fixupTx = alonzoFixupTx
   expectTxSuccess = impAlonzoExpectTxSuccess
+  registerStakeCredential = shelleyRegisterStakeCredential
 
 instance MaryEraImp AlonzoEra
 

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs

@@ -53,6 +53,7 @@ instance ShelleyEraImp BabbageEra where
   impSatisfyNativeScript = impAllegraSatisfyNativeScript
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
+  registerStakeCredential = shelleyRegisterStakeCredential
 
 babbageFixupTx ::
   ( HasCallStack

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
 
@@ -106,7 +106,7 @@ spec = do
     modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
     kh <- freshKeyHash
     let cred = KeyHashObj kh
-    ra <- registerStakeCredentialWithDeposit cred
+    ra <- registerStakeCredential cred
     submitAndExpireProposalToMakeReward cred
     balance <- getBalance cred
 
@@ -151,7 +151,7 @@ spec = do
         & ppDRepActivityL .~ EpochInterval 1
     kh <- freshKeyHash
     let cred = KeyHashObj kh
-    ra <- registerStakeCredentialWithDeposit cred
+    ra <- registerStakeCredential cred
     submitAndExpireProposalToMakeReward cred
     balance <- getBalance cred
 

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

@@ -812,7 +812,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

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

@@ -132,7 +132,7 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   FailBoth (..),
   delegateSPORewardAddressToDRep_,
   getCommittee,
-  registerStakeCredentialWithDeposit,
+  conwayRegisterStakeCredential,
   registerPoolWithDeposit,
   registerRewardAccountWithDeposit,
 ) where
@@ -301,6 +301,7 @@ instance ShelleyEraImp ConwayEra where
 
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
+  registerStakeCredential = conwayRegisterStakeCredential
 
 instance MaryEraImp ConwayEra
 
@@ -1794,12 +1795,14 @@ instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ConwayEra where
 getCommittee :: ConwayEraGov era => ImpTestM era (StrictMaybe (Committee era))
 getCommittee = getsNES $ nesEsL . epochStateGovStateL . committeeGovStateL
 
-registerStakeCredentialWithDeposit ::
+conwayRegisterStakeCredential ::
   forall era.
-  ConwayEraImp era =>
+  ( HasCallStack
+  , ConwayEraImp era
+  ) =>
   Credential 'Staking ->
   ImpTestM era RewardAccount
-registerStakeCredentialWithDeposit cred = do
+conwayRegisterStakeCredential cred = do
   deposit <- getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
   submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $
     mkBasicTx mkBasicTxBody
@@ -1813,12 +1816,12 @@ registerPoolWithDeposit ::
   KeyHash 'StakePool ->
   ImpTestM era ()
 registerPoolWithDeposit khPool =
-  (freshKeyHash >>= registerStakeCredentialWithDeposit . KeyHashObj)
+  (freshKeyHash >>= registerStakeCredential . KeyHashObj)
     >>= registerPoolWithRewardAccount khPool
 
 registerRewardAccountWithDeposit ::
   forall era.
   ConwayEraImp era =>
   ImpTestM era RewardAccount
 registerRewardAccountWithDeposit = do
-  freshKeyHash >>= registerStakeCredentialWithDeposit . KeyHashObj
+  freshKeyHash >>= registerStakeCredential . KeyHashObj

eras/dijkstra/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs

@@ -53,6 +53,7 @@ instance ShelleyEraImp DijkstraEra where
 
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
+  registerStakeCredential = conwayRegisterStakeCredential
 
 instance MaryEraImp DijkstraEra
 

eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs

@@ -27,6 +27,7 @@ instance ShelleyEraImp MaryEra where
   impSatisfyNativeScript = impAllegraSatisfyNativeScript
   fixupTx = shelleyFixupTx
   expectTxSuccess = impShelleyExpectTxSuccess
+  registerStakeCredential = shelleyRegisterStakeCredential
 
 class
   ( ShelleyEraImp era

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

@@ -69,7 +69,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   tryRunImpRuleNoAssertions,
   delegateStake,
   registerRewardAccount,
-  registerStakeCredential,
+  shelleyRegisterStakeCredential,
   getRewardAccountFor,
   getReward,
   lookupReward,
@@ -494,6 +494,8 @@ class
 
   expectTxSuccess :: HasCallStack => Tx era -> ImpTestM era ()
 
+  registerStakeCredential :: HasCallStack => Credential 'Staking -> ImpTestM era RewardAccount
+
 defaultInitNewEpochState ::
   forall era g s m.
   ( MonadState s m
@@ -737,6 +739,7 @@ instance
 
   fixupTx = shelleyFixupTx
   expectTxSuccess = impShelleyExpectTxSuccess
+  registerStakeCredential = shelleyRegisterStakeCredential
 
 -- | Figure out all the Byron Addresses that need witnesses as well as all of the
 -- KeyHashes for Shelley Key witnesses that are required.
@@ -1482,15 +1485,15 @@ getRewardAccountFor stakingC = do
   networkId <- use (impGlobalsL . to networkId)
   pure $ RewardAccount networkId stakingC
 
-registerStakeCredential ::
+shelleyRegisterStakeCredential ::
   forall era.
   ( HasCallStack
   , ShelleyEraImp era
   , ShelleyEraTxCert era
   ) =>
   Credential 'Staking ->
   ImpTestM era RewardAccount
-registerStakeCredential cred = do
+shelleyRegisterStakeCredential cred = do
   submitTxAnn_ ("Register Reward Account: " <> T.unpack (credToText cred)) $
     mkBasicTx mkBasicTxBody
       & bodyTxL . certsTxBodyL

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