Skip to content

Commit 2b6cbff

Browse files
committed
Enable Imp conformance for DELEG.
- Replace the use of `UnRegTxCert` with `UnRegDepositTxCert` to make conformance pass. - Override conformance-check for a test that requires missing pool retirement implementation in the spec.
1 parent 221eaa8 commit 2b6cbff

File tree

2 files changed

+75
-70
lines changed
  • eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp
  • libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance

2 files changed

+75
-70
lines changed

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

Lines changed: 74 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -211,7 +211,9 @@ spec = do
211211
mkBasicTxBody
212212
& certsTxBodyL
213213
.~ SSeq.fromList
214-
[UnRegTxCert stakeCred]
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]
215217
& withdrawalsTxBodyL
216218
.~ Withdrawals
217219
( Map.fromList
@@ -476,6 +478,77 @@ spec = do
476478
expectNotRegistered cred
477479
expectNotDelegatedVote cred
478480

481+
describe "Delegate both stake and vote - separated out for conformance mismatch" $
482+
-- https://github.com/IntersectMBO/formal-ledger-specifications/issues/640
483+
-- TODO: Re-enable after issue is resolved, by removing this override
484+
modifyImpInitExpectLedgerRuleConformance (\_ _ _ _ _ -> pure ()) $ do
485+
it "Delegate, retire and re-register pool" $ do
486+
expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
487+
cred <- KeyHashObj <$> freshKeyHash
488+
poolKh <- freshKeyHash
489+
rewardAccount <- registerRewardAccount
490+
registerPool poolKh
491+
drepCred <- KeyHashObj <$> registerDRep
492+
493+
submitTx_ $
494+
mkBasicTx mkBasicTxBody
495+
& bodyTxL . certsTxBodyL
496+
.~ [ RegDepositDelegTxCert
497+
cred
498+
(DelegStakeVote poolKh (DRepCredential drepCred))
499+
expectedDeposit
500+
]
501+
expectDelegatedToPool cred poolKh
502+
expectDelegatedVote cred (DRepCredential drepCred)
503+
504+
let poolLifetime = 2
505+
let poolExpiry = getsNES nesELL <&> \n -> addEpochInterval n $ EpochInterval poolLifetime
506+
507+
poolExpiry >>= \pe ->
508+
submitTx_ $
509+
mkBasicTx mkBasicTxBody
510+
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe]
511+
512+
-- when pool is re-registered after its expiration, all delegations are cleared
513+
passNEpochs $ fromIntegral poolLifetime
514+
expectNotDelegatedToPool cred
515+
registerPoolWithRewardAccount poolKh rewardAccount
516+
expectNotDelegatedToPool cred
517+
-- the vote delegation is kept
518+
expectDelegatedVote cred (DRepCredential drepCred)
519+
520+
-- re-delegate
521+
submitTx_ $
522+
mkBasicTx mkBasicTxBody
523+
& bodyTxL . certsTxBodyL
524+
.~ [ DelegTxCert
525+
cred
526+
(DelegStake poolKh)
527+
]
528+
expectDelegatedToPool cred poolKh
529+
530+
-- when pool is re-registered before its expiration, delegations are kept
531+
poolExpiry >>= \pe ->
532+
submitTx_ $
533+
mkBasicTx mkBasicTxBody
534+
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe]
535+
-- re-register the pool before the expiration time
536+
passNEpochs $ fromIntegral poolLifetime - 1
537+
registerPoolWithRewardAccount poolKh rewardAccount
538+
expectDelegatedToPool cred poolKh
539+
passNEpochs 2
540+
expectDelegatedToPool cred poolKh
541+
542+
-- when pool is retired and re-registered in the same transaction, delegations are kept
543+
pps <- poolParams poolKh rewardAccount
544+
poolExpiry >>= \pe ->
545+
submitTx_ $
546+
mkBasicTx mkBasicTxBody
547+
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe, RegPoolTxCert pps]
548+
549+
expectDelegatedToPool cred poolKh
550+
passNEpochs $ fromIntegral poolLifetime
551+
expectDelegatedToPool cred poolKh
479552
describe "Delegate both stake and vote" $ do
480553
it "Delegate and unregister credentials" $ do
481554
expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
@@ -531,74 +604,6 @@ spec = do
531604
.~ [DelegTxCert cred (DelegStake poolKh')]
532605
expectDelegatedToPool cred poolKh'
533606
expectDelegatedVote cred (DRepCredential drepCred)
534-
535-
it "Delegate, retire and re-register pool" $ do
536-
expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
537-
cred <- KeyHashObj <$> freshKeyHash
538-
poolKh <- freshKeyHash
539-
rewardAccount <- registerRewardAccount
540-
registerPool poolKh
541-
drepCred <- KeyHashObj <$> registerDRep
542-
543-
submitTx_ $
544-
mkBasicTx mkBasicTxBody
545-
& bodyTxL . certsTxBodyL
546-
.~ [ RegDepositDelegTxCert
547-
cred
548-
(DelegStakeVote poolKh (DRepCredential drepCred))
549-
expectedDeposit
550-
]
551-
expectDelegatedToPool cred poolKh
552-
expectDelegatedVote cred (DRepCredential drepCred)
553-
554-
let poolLifetime = 2
555-
let poolExpiry = getsNES nesELL <&> \n -> addEpochInterval n $ EpochInterval poolLifetime
556-
557-
poolExpiry >>= \pe ->
558-
submitTx_ $
559-
mkBasicTx mkBasicTxBody
560-
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe]
561-
562-
-- when pool is re-registered after its expiration, all delegations are cleared
563-
passNEpochs $ fromIntegral poolLifetime
564-
expectNotDelegatedToPool cred
565-
registerPoolWithRewardAccount poolKh rewardAccount
566-
expectNotDelegatedToPool cred
567-
-- the vote delegation is kept
568-
expectDelegatedVote cred (DRepCredential drepCred)
569-
570-
-- re-delegate
571-
submitTx_ $
572-
mkBasicTx mkBasicTxBody
573-
& bodyTxL . certsTxBodyL
574-
.~ [ DelegTxCert
575-
cred
576-
(DelegStake poolKh)
577-
]
578-
expectDelegatedToPool cred poolKh
579-
580-
-- when pool is re-registered before its expiration, delegations are kept
581-
poolExpiry >>= \pe ->
582-
submitTx_ $
583-
mkBasicTx mkBasicTxBody
584-
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe]
585-
-- re-register the pool before the expiration time
586-
passNEpochs $ fromIntegral poolLifetime - 1
587-
registerPoolWithRewardAccount poolKh rewardAccount
588-
expectDelegatedToPool cred poolKh
589-
passNEpochs 2
590-
expectDelegatedToPool cred poolKh
591-
592-
-- when pool is retired and re-registered in the same transaction, delegations are kept
593-
pps <- poolParams poolKh rewardAccount
594-
poolExpiry >>= \pe ->
595-
submitTx_ $
596-
mkBasicTx mkBasicTxBody
597-
& bodyTxL . certsTxBodyL .~ [RetirePoolTxCert poolKh pe, RegPoolTxCert pps]
598-
599-
expectDelegatedToPool cred poolKh
600-
passNEpochs $ fromIntegral poolLifetime
601-
expectDelegatedToPool cred poolKh
602607
where
603608
expectRegistered cred = do
604609
umap <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . dsUnifiedL

libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance/Imp.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,7 @@ spec =
153153
describe "Conway Imp conformance" $ do
154154
describe "BBODY" Bbody.spec
155155
describe "CERTS" Certs.spec
156-
xdescribe "DELEG" Deleg.spec
156+
describe "DELEG" Deleg.spec
157157
xdescribe "ENACT" Enact.spec
158158
xdescribe "EPOCH" Epoch.spec
159159
xdescribe "GOV" Gov.spec

0 commit comments

Comments
 (0)