Merge pull request #3729 from input-output-hk/aniketd/no-proposals-dr…

…ep-expiry-bump

DRep expiry update after a contiguous set of epochs with no proposals to vote on

eras/allegra/impl/cardano-ledger-allegra.cabal

@@ -52,7 +52,7 @@ library
         bytestring,
         cardano-crypto-class,
         cardano-ledger-binary >=1.0,
-        cardano-ledger-core >=1.6.1 && <1.7,
+        cardano-ledger-core >=1.6.1 && <1.8,
         cardano-ledger-shelley >=1.6.1 && <1.7,
         cardano-strict-containers,
         cardano-slotting,

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -67,7 +67,7 @@ library
         cardano-ledger-allegra >=1.1,
         cardano-crypto-class,
         cardano-ledger-binary >=1.0.1,
-        cardano-ledger-core >=1.6.1 && <1.7,
+        cardano-ledger-core >=1.6.1 && <1.8,
         cardano-ledger-mary >=1.1,
         cardano-ledger-shelley ^>=1.6.1,
         cardano-slotting,

eras/alonzo/test-suite/cardano-ledger-alonzo-test.cabal

@@ -51,7 +51,7 @@ library
         bytestring,
         cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >=1.4,
         cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.0,
-        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.5 && <1.7,
+        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.5 && <1.8,
         cardano-ledger-pretty,
         cardano-ledger-allegra ^>=1.2,
         cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.6 && <1.7,

eras/babbage/impl/cardano-ledger-babbage.cabal

@@ -62,7 +62,7 @@ library
         cardano-ledger-allegra >=1.1,
         cardano-ledger-alonzo ^>=1.4.2,
         cardano-ledger-binary >=1.0,
-        cardano-ledger-core >=1.6.1 && <1.7,
+        cardano-ledger-core >=1.6.1 && <1.8,
         cardano-ledger-mary >=1.1,
         cardano-ledger-shelley ^>=1.6,
         cardano-slotting,

eras/babbage/test-suite/cardano-ledger-babbage-test.cabal

@@ -41,7 +41,7 @@ library
         cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >=1.3 && <1.5,
         cardano-ledger-alonzo-test >=1.1,
         cardano-ledger-babbage:{cardano-ledger-babbage, testlib} ^>=1.4,
-        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.3 && <1.7,
+        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.3 && <1.8,
         cardano-ledger-shelley-ma-test >=1.1,
         cardano-ledger-mary ^>=1.3,
         cardano-ledger-shelley-test >=1.1,

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## 1.9.0.0
 
+* Prevent `DRep` expiry when there are no active governance proposals to vote on (in ConwayCERTS). #3729
+  * Add `updateNumDormantEpochs` function in `ConwayEPOCH` to update the dormant-epochs counter
+  * Refactor access to `ConwayGovState` by making its lens part of `ConwayEraGov`.
+  * Export `gasExpiresAfterL` for use in tests
 * Add `ExpirationEpochTooSmall` data constructor to `ConwayGovPredFailure`
 * Add `ConflictingCommitteeUpdate` data constructor to `ConwayGovPredFailure`
 * Rename `NewCommitte` to `UpdateCommittee`

eras/conway/impl/cardano-ledger-conway.cabal

@@ -73,7 +73,7 @@ library
         cardano-ledger-allegra >=1.1,
         cardano-ledger-alonzo ^>=1.4.2,
         cardano-ledger-babbage >=1.4.1,
-        cardano-ledger-core ^>=1.6.1,
+        cardano-ledger-core ^>=1.7,
         cardano-ledger-mary >=1.1,
         cardano-ledger-shelley ^>=1.6.1,
         cardano-slotting,

eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs

@@ -81,6 +81,7 @@ module Cardano.Ledger.Conway.Governance (
   prevCommitteeStateL,
   gasCommitteeVotesL,
   gasDRepVotesL,
+  gasExpiresAfterL,
   gasStakePoolVotesL,
 ) where
 
@@ -133,6 +134,7 @@ import Cardano.Ledger.Conway.Governance.Procedures (
   VotingProcedures (..),
   gasCommitteeVotesL,
   gasDRepVotesL,
+  gasExpiresAfterL,
   gasStakePoolVotesL,
   govActionIdToText,
   indexedGovProps,
@@ -552,9 +554,11 @@ instance EraPParams (ConwayEra c) => EraGov (ConwayEra c) where
 
 class EraGov era => ConwayEraGov era where
   constitutionGovStateL :: Lens' (GovState era) (Constitution era)
+  snapshotsGovStateL :: Lens' (GovState era) (GovSnapshots era)
 
 instance Crypto c => ConwayEraGov (ConwayEra c) where
   constitutionGovStateL = cgEnactStateL . ensConstitutionL
+  snapshotsGovStateL = cgGovSnapshotsL
 
 pparamsUpdateThreshold ::
   forall era.

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs

@@ -41,6 +41,7 @@ module Cardano.Ledger.Conway.Governance.Procedures (
   gasDRepVotesL,
   gasStakePoolVotesL,
   gasCommitteeVotesL,
+  gasExpiresAfterL,
 ) where
 
 import Cardano.Crypto.Hash (hashToTextAsHex)
@@ -193,6 +194,9 @@ gasDRepVotesL = lens gasDRepVotes (\x y -> x {gasDRepVotes = y})
 gasStakePoolVotesL :: Lens' (GovActionState era) (Map (KeyHash 'StakePool (EraCrypto era)) Vote)
 gasStakePoolVotesL = lens gasStakePoolVotes (\x y -> x {gasStakePoolVotes = y})
 
+gasExpiresAfterL :: Lens' (GovActionState era) EpochNo
+gasExpiresAfterL = lens gasExpiresAfter $ \x y -> x {gasExpiresAfter = y}
+
 instance EraPParams era => ToExpr (GovActionState era)
 
 instance EraPParams era => ToJSON (GovActionState era) where

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs

@@ -32,7 +32,7 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
-import Cardano.Ledger.CertState (certDStateL, certVStateL, vsDRepsL)
+import Cardano.Ledger.CertState (certDStateL, certVStateL, vsDRepsL, vsNumDormantEpochsL)
 import Cardano.Ledger.Conway.Core (
   Era (EraCrypto),
   EraRule,
@@ -72,6 +72,7 @@ import Control.State.Transition.Extended (
  )
 import qualified Data.Map.Strict as Map
 import Data.Sequence (Seq (..))
+import qualified Data.Sequence.Strict as SSeq
 import GHC.Generics (Generic)
 import Lens.Micro
 import NoThunks.Class (NoThunks (..))
@@ -176,22 +177,44 @@ conwayCertsTransition = do
 
   case certificates of
     Empty -> do
-      -- Update DRep expiry for all DReps that are voting in this transaction
+      -- If there is a new governance proposal to vote on in this transaction,
+      -- AND the number of dormant-epochs recorded is greater than zero, we bump
+      -- the expiry for all DReps by the number of dormant epochs, and reset the
+      -- counter to zero.
+      -- It does not matter that this rule (CERTS) is called _before_ the GOV rule
+      -- in LEDGER, even though we cannot validate any governance proposal here,
+      -- since the entire transaction will fail if the proposal is not accepted in
+      -- GOV, and so will this expiry bump done here. It will be discarded.
+      let certState' =
+            let hasProposals = not . SSeq.null $ tx ^. bodyTxL . proposalProceduresTxBodyL
+                numDormantEpochs = certState ^. certVStateL . vsNumDormantEpochsL
+                isNumDormantEpochsNonZero = numDormantEpochs /= 0
+             in if hasProposals && isNumDormantEpochsNonZero
+                  then
+                    certState
+                      & certVStateL . vsDRepsL %~ (<&> (drepExpiryL %~ (+ numDormantEpochs)))
+                      & certVStateL . vsNumDormantEpochsL .~ 0
+                  else certState
+
+      -- Update DRep expiry for all DReps that are voting in this transaction.
+      -- This will execute in mutual-exclusion to the previous updates to DRep expiry,
+      -- because if there are no proposals to vote on , there will be no votes either.
       let drepActivity = pp ^. ppDRepActivityL
           updatedVSDReps =
             Map.foldlWithKey'
               ( \dreps voter _ -> case voter of
                   DRepVoter cred -> Map.adjust (drepExpiryL .~ currentEpoch + drepActivity) cred dreps
                   _ -> dreps
               )
-              (certState ^. certVStateL . vsDRepsL)
+              (certState' ^. certVStateL . vsDRepsL)
               (unVotingProcedures $ tx ^. bodyTxL . votingProceduresTxBodyL)
-          certStateWithDRepExpiryUpdated = certState & certVStateL . vsDRepsL .~ updatedVSDReps
+          certStateWithDRepExpiryUpdated = certState' & certVStateL . vsDRepsL .~ updatedVSDReps
           dState = certStateWithDRepExpiryUpdated ^. certDStateL
           withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL
+
       -- Validate withdrawals and rewards and drain withdrawals
-      validateTrans WithdrawalsNotInRewardsCERTS $
-        validateZeroRewards dState withdrawals network
+      validateTrans WithdrawalsNotInRewardsCERTS $ validateZeroRewards dState withdrawals network
+
       pure $ certStateWithDRepExpiryUpdated & certDStateL .~ drainWithdrawals dState withdrawals
     gamma :|> c -> do
       certState' <-

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs

@@ -31,13 +31,15 @@ import Cardano.Ledger.CertState (
   dsUnifiedL,
   vsCommitteeStateL,
   vsDRepsL,
+  vsNumDormantEpochsL,
  )
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayRATIFY)
 import Cardano.Ledger.Conway.Governance (
   Committee,
+  ConwayEraGov,
   ConwayGovState (..),
   GovActionState (..),
   GovSnapshots (..),
@@ -46,7 +48,10 @@ import Cardano.Ledger.Conway.Governance (
   cgGovSnapshotsL,
   curGovSnapshotsL,
   ensCommitteeL,
+  prevGovSnapshotsL,
   snapshotActions,
+  snapshotIds,
+  snapshotsGovStateL,
  )
 import Cardano.Ledger.Conway.Governance.Procedures (Committee (..))
 import Cardano.Ledger.Conway.Governance.Snapshots (snapshotLookupId, snapshotRemoveIds)
@@ -112,15 +117,15 @@ import Data.Sequence.Strict (StrictSeq (..))
 import qualified Data.Sequence.Strict as Seq
 import qualified Data.Set as Set
 import Data.Void (Void, absurd)
-import Lens.Micro (Lens', (%~), (&), (.~), (<>~), (^.))
+import Lens.Micro (Lens', (%~), (&), (+~), (.~), (<>~), (^.))
 
 data ConwayEpochEvent era
   = PoolReapEvent (Event (EraRule "POOLREAP" era))
   | SnapEvent (Event (EraRule "SNAP" era))
 
 instance
   ( EraTxOut era
-  , EraGov era
+  , ConwayEraGov era
   , Embed (EraRule "SNAP" era) (ConwayEPOCH era)
   , Environment (EraRule "SNAP" era) ~ SnapEnv era
   , State (EraRule "SNAP" era) ~ SnapShots (EraCrypto era)
@@ -173,6 +178,15 @@ returnProposalDeposits removedProposals =
   where
     updateUMap = returnProposalDepositsUMap removedProposals
 
+-- | When there have been zero governance proposals to vote on in the previous epoch
+-- increase the dormant-epoch counter by one.
+updateNumDormantEpochs :: ConwayEraGov era => LedgerState era -> LedgerState era
+updateNumDormantEpochs ls =
+  let wasPrevEpochDormant = Seq.null . snapshotIds $ ls ^. lsUTxOStateL . utxosGovStateL . snapshotsGovStateL . prevGovSnapshotsL
+   in if wasPrevEpochDormant
+        then ls & lsCertStateL . certVStateL . vsNumDormantEpochsL +~ 1
+        else ls
+
 epochTransition ::
   forall era.
   ( Embed (EraRule "SNAP" era) (ConwayEPOCH era)
@@ -188,7 +202,7 @@ epochTransition ::
   , State (EraRule "RATIFY" era) ~ RatifyState era
   , GovState era ~ ConwayGovState era
   , Signal (EraRule "RATIFY" era) ~ RatifySignal era
-  , EraGov era
+  , ConwayEraGov era
   ) =>
   TransitionRule (ConwayEPOCH era)
 epochTransition = do
@@ -197,15 +211,16 @@ epochTransition = do
       , es@EpochState
           { esAccountState = acnt
           , esSnapshots = ss
-          , esLState = ls
+          , esLState = ledgerState
           , esNonMyopic = nm
           }
       , eNo
       ) <-
     judgmentContext
-  let pp = es ^. curPParamsEpochStateL
-  let utxoSt = lsUTxOState ls
-  let CertState vstate pstate dstate = lsCertState ls
+  let ls = updateNumDormantEpochs ledgerState
+      pp = es ^. curPParamsEpochStateL
+      utxoSt = lsUTxOState ls
+      CertState vstate pstate dstate = lsCertState ls
   ss' <-
     trans @(EraRule "SNAP" era) $ TRC (SnapEnv ls pp, ss, ())
 

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -249,6 +249,7 @@ govTransition ::
   TransitionRule (ConwayGOV era)
 govTransition = do
   TRC (GovEnv txid currentEpoch pp, st, gp) <- judgmentContext
+  expectedNetworkId <- liftSTS $ asks networkId
 
   let applyProps st' Empty = pure st'
       applyProps st' ((idx, ProposalProcedure {..}) :<| ps) = do
@@ -259,7 +260,6 @@ govTransition = do
 
         runTest $ actionWellFormed pProcGovAction
 
-        expectedNetworkId <- liftSTS $ asks networkId
         getRwdNetwork pProcReturnAddr
           == expectedNetworkId
             ?! ProposalProcedureNetworkIdMismatch pProcReturnAddr expectedNetworkId

eras/conway/test-suite/cardano-ledger-conway-test.cabal

@@ -43,7 +43,7 @@ library
         cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.0,
         cardano-strict-containers,
         cardano-ledger-conway:{cardano-ledger-conway, testlib} >=1.9 && <1.10,
-        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.3 && <1.7,
+        cardano-ledger-core:{cardano-ledger-core, testlib} >=1.3 && <1.8,
         cardano-ledger-allegra ^>=1.2,
         cardano-ledger-mary ^>=1.3,
         cardano-ledger-shelley-ma-test >=1.1,

eras/mary/impl/cardano-ledger-mary.cabal

@@ -59,7 +59,7 @@ library
         cardano-data,
         cardano-ledger-allegra >=1.1,
         cardano-ledger-binary >=1.0,
-        cardano-ledger-core >=1.6.1 && <1.7,
+        cardano-ledger-core >=1.6.1 && <1.8,
         cardano-ledger-shelley >=1.6.1 && <1.7,
         containers,
         deepseq,

eras/shelley/impl/cardano-ledger-shelley.cabal

@@ -105,7 +105,7 @@ library
         cardano-data >=1.0,
         cardano-ledger-binary >=1.0,
         cardano-ledger-byron,
-        cardano-ledger-core >=1.6.1 && <1.7,
+        cardano-ledger-core >=1.6.1 && <1.8,
         cardano-slotting,
         vector-map >=1.0,
         containers,

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs

@@ -1138,23 +1138,18 @@ tests =
           actualHex = B16.encode actual
           expectedHex =
             mconcat
-              [ "8700a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85"
-              , "006805b047b0825410aa1581ca646474b8f5431261506b6c2"
-              , "73d307c7569a4eb6c96b42dd4a29520a0384821927101903e"
-              , "8828383a081a0a084a0a0a0a08482a0a0a0a084a0a0000086"
-              , "a1825820ee155ace9c40292074cb6aff8c9ccdd273c81648f"
-              , "f1149ef36bcea6ebb8a3e250082583900cb9358529df4729c"
-              , "3246a2a033cb9821abbfd16de4888005904abc410d6a577e9"
-              , "441ad8ed9663931906e4d43ece8f82c712b1d0235affb060a"
-              , "1903e80184a0a092000000190800000000001864d81e82000"
-              , "1d81e820001d81e820001d81e820001810002000100920000"
-              , "00190800000000001864d81e820001d81e820001d81e82000"
-              , "1d81e82000181000200000082a0a0008483a0a0a083a0a0a0"
-              , "83a0a0a00082a000818300880082020082a000000000a0a08"
-              , "40185a0803903ba820200a0a082a0a0a1581ce0a714319812"
-              , "c3f773ba04ec5d6b3ffcd5aad85006805b047b08254182820"
-              , "1015820c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652"
-              , "ae3e1310c28e621dd87b4ca0"
+              [ "8700a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b0825410aa158"
+              , "1ca646474b8f5431261506b6c273d307c7569a4eb6c96b42dd4a29520a03848219271019"
+              , "03e8828384a081a0a00084a0a0a0a08482a0a0a0a084a0a0000086a1825820ee155ace9c"
+              , "40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e250082583900cb935852"
+              , "9df4729c3246a2a033cb9821abbfd16de4888005904abc410d6a577e9441ad8ed9663931"
+              , "906e4d43ece8f82c712b1d0235affb060a1903e80184a0a0920000001908000000000018"
+              , "64d81e820001d81e820001d81e820001d81e820001810002000100920000001908000000"
+              , "00001864d81e820001d81e820001d81e820001d81e82000181000200000082a0a0008483"
+              , "a0a0a083a0a0a083a0a0a00082a000818300880082020082a000000000a0a0840185a080"
+              , "3903ba820200a0a082a0a0a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad8500680"
+              , "5b047b082541828201015820c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652ae3e13"
+              , "10c28e621dd87b4ca0"
               ]
        in testCase "ledger state golden test" $
             unless (actual == expected) $

libs/cardano-ledger-api/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.6.0.0
 
+* Add the dormant-epochs counter to `DRep` expiry in `queryDRepState` #3729
+  * If it is not zero.
 * Rename:
   * `GovActionsState` to `GovSnapshots`
   * `cgGovActionsStateL` to `cgGovSnapshotsL`

libs/cardano-ledger-api/cardano-ledger-api.cabal

@@ -54,7 +54,7 @@ library
         cardano-ledger-babbage >=1.1,
         cardano-ledger-binary >=1.0,
         cardano-ledger-conway >=1.7,
-        cardano-ledger-core >=1.5 && <1.7,
+        cardano-ledger-core ^>=1.7,
         cardano-ledger-mary >=1.1,
         cardano-ledger-shelley ^>=1.6,
         cardano-slotting,

libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs

@@ -31,7 +31,7 @@ import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Compactible (fromCompact)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
-import Cardano.Ledger.DRepDistr (extractDRepDistr)
+import Cardano.Ledger.DRepDistr (drepExpiryL, extractDRepDistr)
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
 import Cardano.Ledger.SafeHash (SafeHash)
 import Cardano.Ledger.Shelley.Governance (EraGov (GovState, getConstitution))
@@ -93,9 +93,14 @@ queryDRepState ::
   Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
 queryDRepState nes creds
   | null creds = drepsState
-  | otherwise = drepsState `Map.restrictKeys` creds
+  | otherwise =
+      drepsState `Map.restrictKeys` creds
+        & if numDormantEpochs == 0
+          then id
+          else (<&> drepExpiryL %~ (+ numDormantEpochs))
   where
     drepsState = vsDReps $ certVState $ lsCertState $ esLState $ nesEs nes
+    numDormantEpochs = vsNumDormantEpochs $ certVState $ lsCertState $ esLState $ nesEs nes
 
 -- | Query DRep stake distribution. Note that this can be an expensive query because there
 -- is a chance that current distribution has not been fully computed yet.