From 3f141a7185b1b762bee2c2ef5155af547a7ea63c Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 25 Nov 2024 08:35:58 -0700 Subject: [PATCH 1/4] Add access to other parts of Ledger to the debug repl envirnment --- .../cardano-ledger-repl-environment.cabal | 5 +++++ libs/cardano-ledger-repl-environment/src/ReplEnvironment.hs | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/libs/cardano-ledger-repl-environment/cardano-ledger-repl-environment.cabal b/libs/cardano-ledger-repl-environment/cardano-ledger-repl-environment.cabal index e1fda4616de..b3c0108ba80 100644 --- a/libs/cardano-ledger-repl-environment/cardano-ledger-repl-environment.cabal +++ b/libs/cardano-ledger-repl-environment/cardano-ledger-repl-environment.cabal @@ -20,6 +20,11 @@ library cardano-ledger-binary, cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-ledger-conway:{cardano-ledger-conway, testlib}, + cardano-ledger-shelley, + cardano-ledger-allegra, + cardano-ledger-mary, + cardano-ledger-alonzo, + cardano-ledger-babbage, cardano-ledger-conformance, cardano-ledger-test, constrained-generators, diff --git a/libs/cardano-ledger-repl-environment/src/ReplEnvironment.hs b/libs/cardano-ledger-repl-environment/src/ReplEnvironment.hs index 9cc3310dae7..42ec72817cd 100644 --- a/libs/cardano-ledger-repl-environment/src/ReplEnvironment.hs +++ b/libs/cardano-ledger-repl-environment/src/ReplEnvironment.hs @@ -12,7 +12,10 @@ -- the REPL should load this module automatically. module ReplEnvironment where +import Cardano.Ledger.Allegra +import Cardano.Ledger.Alonzo import Cardano.Ledger.Api +import Cardano.Ledger.Babbage import Cardano.Ledger.Binary import Cardano.Ledger.CertState import Cardano.Ledger.Coin @@ -20,7 +23,10 @@ import Cardano.Ledger.Conway import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Crypto +import Cardano.Ledger.Mary import Cardano.Ledger.PoolDistr +import Cardano.Ledger.Shelley +import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Val import Test.Cardano.Ledger.Api.DebugTools From 273f3a8cd8cc5d355a9b38898c834134f2df38b9 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 25 Nov 2024 08:42:48 -0700 Subject: [PATCH 2/4] Add a test case that can reproduce a bug with DRep delegations --- .../impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index 347ea6cdaf3..c89bdb28344 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -456,6 +456,11 @@ spec = do expectDelegatedVote cred (DRepCredential drepCred2) + impAnn "Check that unregistration of previous delegation does not affect current delegation" $ do + unRegisterDRep drepCred + + expectDelegatedVote cred (DRepCredential drepCred2) + it "Delegate vote and unregister stake credentials" $ do expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL cred <- KeyHashObj <$> freshKeyHash From c3059b0b3954f1feca29ad7af9c6887b7db22831 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 25 Nov 2024 08:58:21 -0700 Subject: [PATCH 3/4] Fix a bug where DRep UnDelegation update is erased. Fixes #4772 This is how it was suppose to be implemented to begin with, however this fix no longer can be applied without a hradfork, so the follow up commit will take care of that. --- eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 93bf2943b47..877e863170b 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -278,7 +278,7 @@ processDelegationInternal stakeCred mCurDelegatee newDelegatee = processDRepUnDelegation stakeCred mCurDelegatee cState & certDStateL . dsUnifiedL %~ \umap -> UM.DRepUView umap UM.⨃ Map.singleton stakeCred dRep - dReps = vsDReps (certVState cState) + dReps = vsDReps (certVState cState') in case dRep of DRepCredential targetDRep | Just dRepState <- Map.lookup targetDRep dReps -> From 33a61fea977b960ac3d0a034881ab2da7a7eaa19 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 25 Nov 2024 10:42:21 -0700 Subject: [PATCH 4/4] Make sure that the fix for #4772 is done safely We can no longer fix this issue without a hardfork. The danger of fixing it without a hardfork would be that discrepencies in the ledger state could lead to different nodes having different DRep delegations when we out of the bootstrap, if such bug to be manifested on mainnet. This commit ensures that the fix is applied during the hardfork out of the bootstrap phase. --- .../src/Cardano/Ledger/Conway/Rules/Deleg.hs | 18 ++++++++++++------ .../Cardano/Ledger/Conway/Rules/HardFork.hs | 6 +++++- .../Cardano/Ledger/Conway/Imp/DelegSpec.hs | 4 ++-- 3 files changed, 19 insertions(+), 9 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 877e863170b..20fa3b5e4cc 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -23,7 +23,7 @@ module Cardano.Ledger.Conway.Rules.Deleg ( processDelegation, ) where -import Cardano.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..)) +import Cardano.Ledger.BaseTypes (ProtVer (..), ShelleyBase, StrictMaybe (..), natVersion) import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders ( Decode (From, Invalid, SumD, Summands), @@ -174,6 +174,7 @@ conwayDelegTransition = do judgmentContext let ppKeyDeposit = pp ^. ppKeyDepositL + pv = pp ^. ppProtocolVersionL checkDepositAgainstPParams deposit = deposit == ppKeyDeposit ?! IncorrectDepositDELEG deposit registerStakeCredential stakeCred = @@ -228,13 +229,14 @@ conwayDelegTransition = do ConwayDelegCert stakeCred delegatee -> do mCurDelegatee <- checkStakeKeyIsRegistered stakeCred checkStakeDelegateeRegistered delegatee - pure $ processDelegationInternal stakeCred mCurDelegatee delegatee certState + pure $ + processDelegationInternal (pvMajor pv < natVersion @10) stakeCred mCurDelegatee delegatee certState ConwayRegDelegCert stakeCred delegatee deposit -> do checkDepositAgainstPParams deposit checkStakeKeyNotRegistered stakeCred checkStakeDelegateeRegistered delegatee pure $ - processDelegationInternal stakeCred Nothing delegatee $ + processDelegationInternal (pvMajor pv < natVersion @10) stakeCred Nothing delegatee $ certState & certDStateL . dsUnifiedL .~ registerStakeCredential stakeCred -- | Apply new delegation, while properly cleaning up older delegations. This function @@ -248,13 +250,15 @@ processDelegation :: CertState era processDelegation stakeCred newDelegatee !certState = certState' where - !certState' = processDelegationInternal stakeCred mCurDelegatee newDelegatee certState + !certState' = processDelegationInternal False stakeCred mCurDelegatee newDelegatee certState mUMElem = Map.lookup stakeCred (UM.umElems (dsUnified (certDState certState))) mCurDelegatee = mUMElem >>= umElemToDelegatee -- | Same as `processDelegation`, except it expects the current delegation supplied as an -- argument, because in ledger rules we already have it readily available. processDelegationInternal :: + -- | Preserve the buggy behavior where DRep delegations are not updated correctly (See #4772) + Bool -> -- | Delegator Credential 'Staking (EraCrypto era) -> -- | Current delegatee for the above stake credential that needs to be cleaned up. @@ -263,7 +267,7 @@ processDelegationInternal :: Delegatee (EraCrypto era) -> CertState era -> CertState era -processDelegationInternal stakeCred mCurDelegatee newDelegatee = +processDelegationInternal preserveIncorrectDelegation stakeCred mCurDelegatee newDelegatee = case newDelegatee of DelegStake sPool -> delegStake sPool DelegVote dRep -> delegVote dRep @@ -278,7 +282,9 @@ processDelegationInternal stakeCred mCurDelegatee newDelegatee = processDRepUnDelegation stakeCred mCurDelegatee cState & certDStateL . dsUnifiedL %~ \umap -> UM.DRepUView umap UM.⨃ Map.singleton stakeCred dRep - dReps = vsDReps (certVState cState') + dReps + | preserveIncorrectDelegation = vsDReps (certVState cState) + | otherwise = vsDReps (certVState cState') in case dRep of DRepCredential targetDRep | Just dRepState <- Map.lookup targetDRep dReps -> diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs index 6b7aeecde26..94cf70a6f63 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs @@ -74,7 +74,11 @@ hardforkTransition = do epochState & esLStateL . lsCertStateL %~ \certState -> let umap = certState ^. certDStateL . dsUnifiedL - dReps = certState ^. certVStateL . vsDRepsL + dReps = + -- Reset all delegations in order to remove any inconsistencies + -- Delegations will be reset accordingly below. + Map.map (\dRepState -> dRepState {drepDelegs = Set.empty}) $ + certState ^. certVStateL . vsDRepsL (dRepsWithDelegations, elemsWithoutUnknownDRepDelegations) = Map.mapAccumWithKey adjustDelegations dReps (UM.umElems umap) adjustDelegations ds stakeCred umElem@(UM.UMElem rd ptr stakePool mDrep) = diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs index c89bdb28344..2ccc99ba8c3 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs @@ -458,8 +458,8 @@ spec = do impAnn "Check that unregistration of previous delegation does not affect current delegation" $ do unRegisterDRep drepCred - - expectDelegatedVote cred (DRepCredential drepCred2) + -- we need to preserve the buggy behavior until the boostrap phase is over. + ifBootstrap (expectNotDelegatedVote cred) (expectDelegatedVote cred (DRepCredential drepCred2)) it "Delegate vote and unregister stake credentials" $ do expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL