Make genUnRegTxCert a method of ShelleyEraImp

Author: Lucsanszky

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

@@ -44,6 +44,7 @@ instance ShelleyEraImp AllegraEra where
   expectTxSuccess = impShelleyExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
   genRegTxCert = shelleyGenRegTxCert
+  genUnRegTxCert = shelleyGenUnRegTxCert
 
 impAllegraSatisfyNativeScript ::
   ( AllegraEraScript era

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

@@ -430,6 +430,7 @@ instance ShelleyEraImp AlonzoEra where
   expectTxSuccess = impAlonzoExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
   genRegTxCert = shelleyGenRegTxCert
+  genUnRegTxCert = shelleyGenUnRegTxCert
 
 instance MaryEraImp AlonzoEra
 

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

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

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]

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

@@ -45,7 +45,6 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   submitYesVote_,
   submitFailingVote,
   trySubmitVote,
-  genUnRegTxCert,
   registerDRep,
   unRegisterDRep,
   updateDRep,
@@ -302,6 +301,7 @@ instance ShelleyEraImp ConwayEra where
   expectTxSuccess = impBabbageExpectTxSuccess
   registerStakeCredential = conwayRegisterStakeCredential
   genRegTxCert = conwayGenRegTxCert
+  genUnRegTxCert = conwayGenUnRegTxCert
 
 instance MaryEraImp ConwayEra
 
@@ -390,15 +390,15 @@ unRegisterDRep drep = do
       & bodyTxL . certsTxBodyL
         .~ SSeq.singleton (UnRegDRepTxCert drep refund)
 
-genUnRegTxCert ::
+conwayGenUnRegTxCert ::
   forall era.
   ( ShelleyEraImp era
   , ShelleyEraTxCert era
   , ConwayEraTxCert era
   ) =>
   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

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

@@ -15,6 +15,7 @@ module Test.Cardano.Ledger.Dijkstra.ImpTest (
 ) where
 
 import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Compactible
 import Cardano.Ledger.Conway.Governance (ConwayEraGov (..), committeeMembersL)
 import Cardano.Ledger.Conway.Rules (
   ConwayCertPredFailure (..),
@@ -32,6 +33,7 @@ import Cardano.Ledger.Plutus (SLanguage (..))
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure)
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
+import Cardano.Ledger.State
 import Data.Maybe (fromJust)
 import qualified Data.Sequence.Strict as SSeq
 import Lens.Micro
@@ -58,6 +60,7 @@ instance ShelleyEraImp DijkstraEra where
   expectTxSuccess = impBabbageExpectTxSuccess
   registerStakeCredential = conwayRegisterStakeCredential
   genRegTxCert = dijkstraGenRegTxCert
+  genUnRegTxCert = dijkstraGenUnRegTxCert
 
 instance MaryEraImp DijkstraEra
 
@@ -134,3 +137,17 @@ dijkstraGenRegTxCert = do
     RegDepositTxCert stakingCredential
       <$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
   pure (cert, stakingCredential)
+
+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))

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

@@ -29,6 +29,7 @@ instance ShelleyEraImp MaryEra where
   expectTxSuccess = impShelleyExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
   genRegTxCert = shelleyGenRegTxCert
+  genUnRegTxCert = shelleyGenUnRegTxCert
 
 class
   ( ShelleyEraImp era

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

@@ -118,6 +118,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   getsPParams,
   withEachEraVersion,
   shelleyGenRegTxCert,
+  shelleyGenUnRegTxCert,
 
   -- * Logging
   Doc,
@@ -499,6 +500,8 @@ class
 
   genRegTxCert :: HasCallStack => ImpTestM era (TxCert era, Credential 'Staking)
 
+  genUnRegTxCert :: HasCallStack => Credential 'Staking -> ImpTestM era (TxCert era)
+
 defaultInitNewEpochState ::
   forall era g s m.
   ( MonadState s m
@@ -744,6 +747,7 @@ instance
   expectTxSuccess = impShelleyExpectTxSuccess
   registerStakeCredential = shelleyRegisterStakeCredential
   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.
@@ -1793,3 +1797,10 @@ shelleyGenRegTxCert ::
 shelleyGenRegTxCert = do
   stakingCredential <- KeyHashObj <$> freshKeyHash
   pure (RegTxCert stakingCredential, stakingCredential)
+
+shelleyGenUnRegTxCert ::
+  forall era.
+  ShelleyEraTxCert era =>
+  Credential 'Staking ->
+  ImpTestM era (TxCert era)
+shelleyGenUnRegTxCert = pure . UnRegTxCert