Skip to content

Commit 72c6c95

Browse files
aniketdlehins
authored andcommitted
Add randomised reg-unreg certs for Imptests.
* `genRegTxCert` to choose between `RegTxCert` and `RegDepositTxCert` * `genUnRegTxCert` to choose between `UnRegTxCert` and `UnRegDepositTxCert`
1 parent 95907f5 commit 72c6c95

File tree

3 files changed

+42
-6
lines changed

3 files changed

+42
-6
lines changed

eras/conway/impl/CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99

1010
### `testlib`
1111

12+
* Add `genRegTxCert` and `genUnRegTxCert`. #4830
1213
* Add `Arbitrary` instance for `ConwayBbodyPredFailure` and `ConwayMempoolPredFailure`
1314

1415
## 1.18.0.0

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -49,10 +49,12 @@ spec = do
4949
expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
5050

5151
freshKeyHash >>= \kh -> do
52+
let cred = KeyHashObj kh
53+
regTxCert <- genRegTxCert cred
5254
submitTx_ $
5355
mkBasicTx mkBasicTxBody
54-
& bodyTxL . certsTxBodyL .~ [RegTxCert (KeyHashObj kh)]
55-
expectRegistered (KeyHashObj kh)
56+
& bodyTxL . certsTxBodyL .~ [regTxCert]
57+
expectRegistered cred
5658

5759
freshKeyHash >>= \kh -> do
5860
submitTx_ $
@@ -207,13 +209,11 @@ spec = do
207209
expectRegisteredRewardAddress otherRewardAccount
208210
submitAndExpireProposalToMakeReward otherStakeCred
209211
lookupReward otherStakeCred `shouldReturn` govActionDeposit
212+
unRegTxCert <- genUnRegTxCert stakeCred
210213
submitTx_ . mkBasicTx $
211214
mkBasicTxBody
212215
& certsTxBodyL
213-
.~ SSeq.fromList
214-
-- https://github.com/IntersectMBO/formal-ledger-specifications/issues/636
215-
-- we use this inplace of UnRegTxCert to make conformance-spec happy
216-
[UnRegDepositTxCert stakeCred keyDeposit]
216+
.~ SSeq.fromList [unRegTxCert]
217217
& withdrawalsTxBodyL
218218
.~ Withdrawals
219219
( Map.fromList

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

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,8 @@ module Test.Cardano.Ledger.Conway.ImpTest (
4343
submitYesVote_,
4444
submitFailingVote,
4545
trySubmitVote,
46+
genRegTxCert,
47+
genUnRegTxCert,
4648
registerDRep,
4749
unRegisterDRep,
4850
updateDRep,
@@ -215,6 +217,7 @@ import Cardano.Ledger.Shelley.LedgerState (
215217
)
216218
import Cardano.Ledger.TxIn (TxId (..))
217219
import Cardano.Ledger.UMap (dRepMap)
220+
import qualified Cardano.Ledger.UMap as UMap
218221
import Cardano.Ledger.UTxO (EraUTxO, UTxO, balance, sumAllValue, txInsFilter)
219222
import Cardano.Ledger.Val (Val (..), (<->))
220223
import Control.Monad (forM)
@@ -390,6 +393,38 @@ unRegisterDRep drep = do
390393
& bodyTxL . certsTxBodyL
391394
.~ SSeq.singleton (UnRegDRepTxCert drep refund)
392395

396+
genUnRegTxCert ::
397+
forall era.
398+
( ShelleyEraImp era
399+
, ConwayEraTxCert era
400+
) =>
401+
Credential 'Staking ->
402+
ImpTestM era (TxCert era)
403+
genUnRegTxCert stakingCredential = do
404+
umap <- getsNES unifiedL
405+
let mumapDeposit = UMap.rdDepositCoin <$> UMap.lookup stakingCredential (UMap.RewDepUView umap)
406+
case mumapDeposit of
407+
Nothing -> pure $ UnRegTxCert stakingCredential
408+
Just umapDeposit ->
409+
elements
410+
[ UnRegTxCert stakingCredential
411+
, UnRegDepositTxCert stakingCredential umapDeposit
412+
]
413+
414+
genRegTxCert ::
415+
forall era.
416+
( ShelleyEraImp era
417+
, ConwayEraTxCert era
418+
) =>
419+
Credential 'Staking ->
420+
ImpTestM era (TxCert era)
421+
genRegTxCert stakingCredential =
422+
oneof
423+
[ pure $ RegTxCert stakingCredential
424+
, RegDepositTxCert stakingCredential
425+
<$> getsNES (nesEsL . curPParamsEpochStateL . ppKeyDepositL)
426+
]
427+
393428
-- | Submit a transaction that updates a given DRep
394429
updateDRep ::
395430
forall era.

0 commit comments

Comments
 (0)