Merge pull request #4707 from IntersectMBO/lehins/add-imp-tests-for-d…

…rep-delegation

Add imp tests for drep delegation

eras/conway/impl/CHANGELOG.md

@@ -4,6 +4,10 @@
 
 * Add new event `GovRemovedVotes` for invalidated votes
 
+### `testlib`
+
+* Add `whenBootstrap`
+
 ## 1.17.0.0
 
 * Added `reDelegatees` and `rePoolParams` to `RatifyEnv` for updated SPO vote calculation #4645

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

@@ -92,7 +92,7 @@ library
         cardano-ledger-allegra ^>=1.6,
         cardano-ledger-alonzo ^>=1.12,
         cardano-ledger-babbage ^>=1.10,
-        cardano-ledger-core ^>=1.15,
+        cardano-ledger-core ^>=1.15.1,
         cardano-ledger-mary ^>=1.7,
         cardano-ledger-shelley ^>=1.15,
         cardano-slotting,

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

@@ -5,17 +5,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Test.Cardano.Ledger.Conway.Imp.DelegSpec (
   spec,
 ) where
 
 import Cardano.Ledger.Address (RewardAccount (..))
-import Cardano.Ledger.BaseTypes (EpochInterval (..), addEpochInterval)
+import Cardano.Ledger.BaseTypes (EpochInterval (..), StrictMaybe (..), addEpochInterval)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core
+import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Conway.Rules (ConwayDelegPredFailure (..))
 import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Credential (Credential (..))
@@ -28,8 +28,9 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.UMap as UMap
 import Cardano.Ledger.Val (Val (..))
 import Data.Functor ((<&>))
-import qualified Data.Map as Map
-import Lens.Micro ((&), (.~))
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Lens.Micro ((%~), (&), (.~))
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common
@@ -336,6 +337,24 @@ spec = do
 
       expectDelegatedVote cred (DRepCredential drepCred)
       expectNotDelegatedToPool cred
+      whenBootstrap $ do
+        impAnn "Ensure DRep delegation is populated after bootstrap" $ do
+          -- Clear out delegation, in order to check its repopulation from UMap.
+          let deleteDelegation =
+                Map.adjust (drepDelegsL %~ Set.delete cred) drepCred
+          --  Drep delegation for both version 9 and 10 are populating both umap and
+          --  `drepDelegs`, so manually modifying the umap in the state is the only way to
+          --  test the correct repopulation of `drepDelegs`
+          modifyNES $ nesEsL . epochStateRegDrepL %~ deleteDelegation
+          hotCreds <- registerInitialCommittee
+          (spo, _, _) <- setupPoolWithStake $ Coin 3_000_000_000
+          protVer <- getProtVer
+          gai <- submitGovAction $ HardForkInitiation SNothing (majorFollow protVer)
+          submitYesVoteCCs_ hotCreds gai
+          submitYesVote_ (StakePoolVoter spo) gai
+          passNEpochs 2
+          getLastEnactedHardForkInitiation `shouldReturn` SJust (GovPurposeId gai)
+          expectDelegatedVote cred (DRepCredential drepCred)
 
     it "Delegate vote of registered stake credentials to unregistered drep" $ do
       RewardAccount _ cred <- registerRewardAccount
@@ -347,6 +366,16 @@ spec = do
           inBootstrap = do
             submitTx_ tx
             expectDelegatedVote cred (DRepCredential drepCred)
+            impAnn "Ensure delegation is cleaned up on the transition out of bootstrap" $ do
+              hotCreds <- registerInitialCommittee
+              (spo, _, _) <- setupPoolWithStake $ Coin 3_000_000_000
+              protVer <- getProtVer
+              gai <- submitGovAction $ HardForkInitiation SNothing (majorFollow protVer)
+              submitYesVoteCCs_ hotCreds gai
+              submitYesVote_ (StakePoolVoter spo) gai
+              passNEpochs 2
+              getLastEnactedHardForkInitiation `shouldReturn` SJust (GovPurposeId gai)
+              expectNotDelegatedVote cred
 
           outOfBootstrap = do
             submitFailingTx tx [injectFailure $ DelegateeDRepNotRegisteredDELEG drepCred]
@@ -522,8 +551,19 @@ spec = do
 
     expectDelegatedVote cred drep = do
       umap <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . dsUnifiedL
-      impAnn (show cred <> " expected to have their vote delegated to " <> show drep) $
+      dreps <- getsNES $ nesEsL . epochStateRegDrepL
+      impAnn (show cred <> " expected to have their vote delegated to " <> show drep) $ do
         Map.lookup cred (dRepMap umap) `shouldBe` Just drep
+        case drep of
+          DRepCredential drepCred ->
+            case Map.lookup drepCred dreps of
+              Nothing ->
+                whenPostBootstrap $ assertFailure "Expected DRep to be registered"
+              Just drepState ->
+                assertBool
+                  "Expected DRep delegations to contain the stake credential"
+                  (cred `Set.member` drepDelegs drepState)
+          _ -> pure ()
 
     expectNotDelegatedVote cred = do
       umap <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . dsUnifiedL

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

@@ -93,7 +93,7 @@ initiateHardForkWithLessThanMinimalCommitteeSize =
     mHotCred <- resignCommitteeColdKey committeeMember anchor
     protVer <- getProtVer
     gai <- submitGovAction $ HardForkInitiation SNothing (majorFollow protVer)
-    submitYesVoteCCs_ (maybe NE.toList (\hotCred -> NE.filter (/= hotCred)) mHotCred $ hotCs) gai
+    submitYesVoteCCs_ (maybe NE.toList (\hotCred -> NE.filter (/= hotCred)) mHotCred hotCs) gai
     submitYesVote_ (StakePoolVoter spoK1) gai
     if bootstrapPhase protVer
       then do

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -113,6 +113,7 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   currentProposalsShouldContain,
   withImpStateWithProtVer,
   ifBootstrap,
+  whenBootstrap,
   whenPostBootstrap,
   submitYesVoteCCs_,
   donateToTreasury,
@@ -1645,6 +1646,11 @@ majorFollow pv@(ProtVer x _) = case succVersion x of
 cantFollow :: ProtVer -> ProtVer
 cantFollow (ProtVer x y) = ProtVer x (y + 3)
 
+whenBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
+whenBootstrap a = do
+  pv <- getProtVer
+  when (HardForks.bootstrapPhase pv) a
+
 whenPostBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
 whenPostBootstrap a = do
   pv <- getProtVer

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,7 +2,7 @@
 
 ## 1.15.1.0
 
-*
+* Add `drepDelegsL`
 
 ### `testlib`
 

libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs

@@ -13,6 +13,7 @@ module Cardano.Ledger.DRep (
   drepExpiryL,
   drepAnchorL,
   drepDepositL,
+  drepDelegsL,
 ) where
 
 import Cardano.Ledger.BaseTypes
@@ -181,3 +182,6 @@ drepAnchorL = lens drepAnchor (\x y -> x {drepAnchor = y})
 
 drepDepositL :: Lens' (DRepState c) Coin
 drepDepositL = lens drepDeposit (\x y -> x {drepDeposit = y})
+
+drepDelegsL :: Lens' (DRepState c) (Set (Credential 'Staking c))
+drepDelegsL = lens drepDelegs (\x y -> x {drepDelegs = y})