Make genRegTxCert a method of ShelleyEraImp

Author: Lucsanszky

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

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

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

@@ -429,6 +429,7 @@ instance ShelleyEraImp AlonzoEra where
   fixupTx = alonzoFixupTx
   expectTxSuccess = impAlonzoExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
+  genRegTxCert = shelleyGenRegTxCert
 
 instance MaryEraImp AlonzoEra
 

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

@@ -54,6 +54,7 @@ instance ShelleyEraImp BabbageEra where
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
+  genRegTxCert = shelleyGenRegTxCert
 
 babbageFixupTx ::
   ( HasCallStack

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

@@ -728,37 +728,33 @@ 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
+      (regTxCert, cred) <- genRegTxCert
+      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
+      (regTxCert1, cred1) <- genRegTxCert
       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
+      (regTxCert2, cred2) <- genRegTxCert
+      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

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

@@ -45,7 +45,7 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   submitYesVote_,
   submitFailingVote,
   trySubmitVote,
-  genRegTxCert,
+  conwayGenRegTxCert,
   genUnRegTxCert,
   registerDRep,
   unRegisterDRep,
@@ -302,6 +302,7 @@ instance ShelleyEraImp ConwayEra where
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
   registerStakeCredential = conwayRegisterStakeCredential
+  genRegTxCert = conwayGenRegTxCert
 
 instance MaryEraImp ConwayEra
 
@@ -408,20 +409,22 @@ genUnRegTxCert stakingCredential = do
         , UnRegDepositTxCert stakingCredential (fromCompact (accountState ^. depositAccountStateL))
         ]
 
-genRegTxCert ::
+conwayGenRegTxCert ::
   forall era.
   ( ShelleyEraImp era
   , ShelleyEraTxCert era
   , ConwayEraTxCert era
   ) =>
-  Credential 'Staking ->
-  ImpTestM era (TxCert era)
-genRegTxCert stakingCredential =
-  oneof
-    [ pure $ RegTxCert stakingCredential
-    , RegDepositTxCert stakingCredential
-        <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
-    ]
+  ImpTestM era (TxCert era, Credential 'Staking)
+conwayGenRegTxCert = do
+  stakingCredential <- KeyHashObj <$> freshKeyHash
+  cert <-
+    oneof
+      [ pure $ RegTxCert stakingCredential
+      , RegDepositTxCert stakingCredential
+          <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
+      ]
+  pure (cert, stakingCredential)
 
 -- | Submit a transaction that updates a given DRep
 updateDRep ::

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
@@ -10,6 +11,7 @@ module Test.Cardano.Ledger.Dijkstra.ImpTest (
   module Test.Cardano.Ledger.Conway.ImpTest,
   exampleDijkstraGenesis,
   DijkstraEraImp,
+  dijkstraGenRegTxCert,
 ) where
 
 import Cardano.Ledger.BaseTypes
@@ -21,6 +23,7 @@ import Cardano.Ledger.Conway.Rules (
   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 (..))
@@ -54,6 +57,7 @@ instance ShelleyEraImp DijkstraEra where
   fixupTx = babbageFixupTx
   expectTxSuccess = impBabbageExpectTxSuccess
   registerStakeCredential = conwayRegisterStakeCredential
+  genRegTxCert = dijkstraGenRegTxCert
 
 instance MaryEraImp DijkstraEra
 
@@ -117,3 +121,16 @@ exampleDijkstraGenesis =
           , udppRefScriptCostMultiplier = fromJust $ boundRational 1.2
           }
     }
+
+dijkstraGenRegTxCert ::
+  forall era.
+  ( ShelleyEraImp era
+  , ConwayEraTxCert era
+  ) =>
+  ImpTestM era (TxCert era, Credential 'Staking)
+dijkstraGenRegTxCert = do
+  stakingCredential <- KeyHashObj <$> freshKeyHash
+  cert <-
+    RegDepositTxCert stakingCredential
+      <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
+  pure (cert, stakingCredential)

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

@@ -28,6 +28,7 @@ instance ShelleyEraImp MaryEra where
   fixupTx = shelleyFixupTx
   expectTxSuccess = impShelleyExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
+  genRegTxCert = shelleyGenRegTxCert
 
 class
   ( ShelleyEraImp era

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

@@ -117,6 +117,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   unlessMajorVersion,
   getsPParams,
   withEachEraVersion,
+  shelleyGenRegTxCert,
 
   -- * Logging
   Doc,
@@ -496,6 +497,8 @@ class
 
   registerStakeCredential :: HasCallStack => Credential 'Staking -> ImpTestM era RewardAccount
 
+  genRegTxCert :: HasCallStack => ImpTestM era (TxCert era, Credential 'Staking)
+
 defaultInitNewEpochState ::
   forall era g s m.
   ( MonadState s m
@@ -740,6 +743,7 @@ instance
   fixupTx = shelleyFixupTx
   expectTxSuccess = impShelleyExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
+  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.
@@ -1781,3 +1785,11 @@ simulateThenRestore sim = do
   result <- sim
   put snapshot
   pure result
+
+shelleyGenRegTxCert ::
+  forall era.
+  ShelleyEraTxCert era =>
+  ImpTestM era (TxCert era, Credential 'Staking)
+shelleyGenRegTxCert = do
+  stakingCredential <- KeyHashObj <$> freshKeyHash
+  pure (RegTxCert stakingCredential, stakingCredential)