Merge pull request #4547 from IntersectMBO/td/drep-registration-expir…

…ation-fix Drep registration expiration fix
IntersectMBO · Aug 20, 2024 · 068c7a6 · 068c7a6
2 parents 87b58ea + f668f36
commit 068c7a6
Show file tree

Hide file tree

Showing 5 changed files with 77 additions and 20 deletions.
diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md
@@ -1,7 +1,8 @@
 # Version history for `cardano-ledger-conway`
 
-## 1.16.1.0
+## 1.17.0.0
 
+* Replace GOVCERT `updateDRepExpiry` with `computeDRepExpiry`
 * Added `Eq`, `Show`, `NFData` and `Generic` instances for `CertsEnv`
 * Add `delegateToDRep` and `redelegateDRep`
 

diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs
@@ -54,7 +54,7 @@ import Cardano.Ledger.Conway.Governance (
  )
 import Cardano.Ledger.Conway.Rules.Cert (CertEnv (CertEnv), ConwayCertEvent, ConwayCertPredFailure)
 import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure)
-import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure, updateDRepExpiry)
+import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure, computeDRepExpiry)
 import Cardano.Ledger.DRep (drepExpiryL)
 import Cardano.Ledger.Shelley.API (
   CertState (..),
@@ -236,7 +236,10 @@ conwayCertsTransition = do
             Map.foldlWithKey'
               ( \dreps voter _ -> case voter of
                   DRepVoter cred ->
-                    Map.adjust (updateDRepExpiry drepActivity currentEpoch numDormantEpochs) cred dreps
+                    Map.adjust
+                      (drepExpiryL .~ computeDRepExpiry drepActivity currentEpoch numDormantEpochs)
+                      cred
+                      dreps
                   _ -> dreps
               )
               vsDReps

diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs
@@ -18,7 +18,7 @@ module Cardano.Ledger.Conway.Rules.GovCert (
   ConwayGOVCERT,
   ConwayGovCertPredFailure (..),
   ConwayGovCertEnv (..),
-  updateDRepExpiry,
+  computeDRepExpiry,
 )
 where
 
@@ -53,6 +53,7 @@ import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.DRep (DRepState (..), drepAnchorL, drepDepositL, drepExpiryL)
 import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole, DRepRole))
+import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
 import Cardano.Slotting.Slot (EpochInterval, binOpEpochNo)
 import Control.DeepSeq (NFData)
 import Control.State.Transition.Extended (
@@ -235,7 +236,15 @@ conwayGovCertTransition = do
           { vsDReps =
               Map.insert
                 cred
-                (DRepState (addEpochInterval cgceCurrentEpoch ppDRepActivity) mAnchor ppDRepDeposit)
+                ( DRepState
+                    ( computeDRepExpiryVersioned
+                        cgcePParams
+                        cgceCurrentEpoch
+                        (vState ^. vsNumDormantEpochsL)
+                    )
+                    mAnchor
+                    ppDRepDeposit
+                )
                 vsDReps
           }
     ConwayUnRegDRep cred refund -> do
@@ -253,11 +262,13 @@ conwayGovCertTransition = do
           { vsDReps =
               Map.adjust
                 ( \drepState ->
-                    updateDRepExpiry
-                      ppDRepActivity
-                      cgceCurrentEpoch
-                      (vState ^. vsNumDormantEpochsL)
-                      $ drepState & drepAnchorL .~ mAnchor
+                    drepState
+                      & drepExpiryL
+                        .~ computeDRepExpiry
+                          ppDRepActivity
+                          cgceCurrentEpoch
+                          (vState ^. vsNumDormantEpochsL)
+                      & drepAnchorL .~ mAnchor
                 )
                 cred
                 vsDReps
@@ -272,18 +283,32 @@ conwayGovCertTransition = do
         UpdateCommittee _ _ newMembers _ -> Map.member coldCred newMembers
         _ -> False
 
-updateDRepExpiry ::
+computeDRepExpiryVersioned ::
+  ConwayEraPParams era =>
+  PParams era ->
+  -- | Current epoch
+  EpochNo ->
+  -- | The count of the dormant epochs
+  EpochNo ->
+  EpochNo
+computeDRepExpiryVersioned pp currentEpoch numDormantEpochs
+  -- Starting with version 10, we correctly take into account the number of dormant epochs
+  -- when registering a drep
+  | HF.bootstrapPhase (pp ^. ppProtocolVersionL) =
+      addEpochInterval currentEpoch (pp ^. ppDRepActivityL)
+  | otherwise =
+      computeDRepExpiry (pp ^. ppDRepActivityL) currentEpoch numDormantEpochs
+
+computeDRepExpiry ::
   -- | DRepActivity PParam
   EpochInterval ->
   -- | Current epoch
   EpochNo ->
   -- | The count of the dormant epochs
   EpochNo ->
-  DRepState c ->
-  DRepState c
-updateDRepExpiry ppDRepActivity currentEpoch numDormantEpochs =
-  drepExpiryL
-    .~ binOpEpochNo
-      (-)
-      (addEpochInterval currentEpoch ppDRepActivity)
-      numDormantEpochs
+  -- | Computed expiry
+  EpochNo
+computeDRepExpiry ppDRepActivity currentEpoch =
+  binOpEpochNo
+    (-)
+    (addEpochInterval currentEpoch ppDRepActivity)
diff --git a/libs/cardano-ledger-api/cardano-ledger-api.cabal b/libs/cardano-ledger-api/cardano-ledger-api.cabal
@@ -58,7 +58,7 @@ library
         cardano-ledger-alonzo >=1.9 && <1.11,
         cardano-ledger-babbage ^>=1.9,
         cardano-ledger-binary ^>=1.3,
-        cardano-ledger-conway >=1.13 && <1.17,
+        cardano-ledger-conway >=1.13 && <1.18,
         cardano-ledger-core ^>=1.14,
         cardano-ledger-mary ^>=1.7,
         cardano-ledger-shelley ^>=1.13,

diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs
@@ -28,6 +28,7 @@ import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (KeyHashObj))
 import Cardano.Ledger.DRep
 import Cardano.Ledger.Keys (KeyRole (..))
+import qualified Cardano.Ledger.Shelley.HardForks as HF
 import Cardano.Ledger.Shelley.LedgerState
 import Data.Default (def)
 import Data.Foldable (Foldable (..))
@@ -70,6 +71,33 @@ spec = do
         expectActualDRepExpiry drep $
           addEpochInterval curEpochNo $
             EpochInterval (drepActivity + fromIntegral n)
+
+      it "dRep registered when there are dormant epochs" $ do
+        let drepActivity = 3
+        modifyPParams $ ppDRepActivityL .~ EpochInterval drepActivity
+        let n = 2
+        passNEpochs n
+        expectNumDormantEpochs $ EpochNo (fromIntegral n)
+        (drep, _, _) <- setupSingleDRep 1_000_000
+
+        let expectedExpiry = do
+              epochNo <- getsNES nesELL
+              let tot = addEpochInterval epochNo (EpochInterval drepActivity)
+              pv <- getProtVer
+              pure $
+                if HF.bootstrapPhase pv
+                  then binOpEpochNo (+) tot (fromIntegral n)
+                  else tot
+
+        expectedExpiry >>= expectActualDRepExpiry drep
+
+        nes <- getsNES id
+        void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
+
+        expectedExpiry >>= expectDRepExpiry drep
+        drepState <- drepStateFromQuery drep nes
+        expectedExpiry >>= shouldBe (drepState ^. drepExpiryL)
+
       it "proposals are made and numDormantEpochs are added" $ do
         curEpochNo <- getsNES nesELL
         let drepActivity = 3