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.
IntersectMBO · Nov 25, 2024 · 3a56835 · 3a56835
1 parent c3059b0
commit 3a56835
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 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
@@ -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 True 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
@@ -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
@@ -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