[wip] - DelegSpec updates

Author: teodanciu

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

@@ -467,7 +467,32 @@ spec = do
       impAnn "Check that unregistration of previous delegation does not affect current delegation" $ do
         unRegisterDRep drepCred
         -- we need to preserve the buggy behavior until the boostrap phase is over.
-        ifBootstrap (expectNotDelegatedVote cred) (expectDelegatedVote cred (DRepCredential drepCred2))
+        ifBootstrap
+          ( do
+              -- we cannot `expectNotDelegatedVote` because the the delegation is still in the DRepState of the other pool
+              accounts <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL
+              expectNothingExpr (lookupDRepDelegation cred accounts)
+          )
+          (expectDelegatedVote cred (DRepCredential drepCred2))
+
+    it "Redelegate vote to the same DRep" $ do
+      expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
+
+      cred <- KeyHashObj <$> freshKeyHash
+      drepCred <- KeyHashObj <$> registerDRep
+
+      submitTx_ $
+        mkBasicTx mkBasicTxBody
+          & bodyTxL . certsTxBodyL
+            .~ [RegDepositDelegTxCert cred (DelegVote (DRepCredential drepCred)) expectedDeposit]
+      expectDelegatedVote cred (DRepCredential drepCred)
+
+      submitTx_ $
+        mkBasicTx mkBasicTxBody
+          & bodyTxL . certsTxBodyL
+            .~ [DelegTxCert cred (DelegVote (DRepCredential drepCred))]
+
+      expectDelegatedVote cred (DRepCredential drepCred)
 
     it "Delegate vote and unregister stake credentials" $ do
       expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
@@ -658,6 +683,8 @@ spec = do
           & bodyTxL . certsTxBodyL
             .~ [UnRegDepositTxCert cred expectedDeposit]
       expectNotRegistered cred
+      expectNotDelegatedVote cred
+      expectNotDelegatedToPool cred
 
     it "Delegate to DRep and SPO and change delegation to a different SPO" $ do
       expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
@@ -695,10 +722,15 @@ spec = do
 
     expectNotDelegatedToPool :: Credential 'Staking -> ImpTestM era ()
     expectNotDelegatedToPool cred = do
-      accounts <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL
+      certState <- getsNES $ nesEsL . esLStateL . lsCertStateL
+      let accounts = certState ^. certDStateL . accountsL
+      let pools = certState ^. certPStateL . psStakePoolsL
       impAnn (show cred <> " expected to not have delegated to a stake pool") $ do
-        accountState <- expectJust $ lookupAccountState cred accounts
-        expectNothingExpr (accountState ^. stakePoolDelegationAccountStateL)
+        forM_ (lookupAccountState cred accounts) $ \accountState ->
+          expectNothingExpr (accountState ^. stakePoolDelegationAccountStateL)
+        assertBool
+          ("Expected no stake pool state delegation to contain the stake credential: " <> show cred)
+          (all (Set.notMember cred . spsDelegs) (Map.elems pools))
 
     expectDelegatedVote :: HasCallStack => Credential 'Staking -> DRep -> ImpTestM era ()
     expectDelegatedVote cred drep = do
@@ -723,8 +755,12 @@ spec = do
     expectNotDelegatedVote :: Credential 'Staking -> ImpTestM era ()
     expectNotDelegatedVote cred = do
       accounts <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL
-      impAnn (show cred <> " expected to not have their vote delegated") $
+      dreps <- getsNES $ nesEsL . epochStateRegDrepL
+      impAnn (show cred <> " expected to not have their vote delegated") $ do
         expectNothingExpr (lookupDRepDelegation cred accounts)
+        assertBool
+          ("Expected no drep state delegation to contain the stake credential: " <> show cred)
+          (all (Set.notMember cred . drepDelegs) (Map.elems dreps))
 
 conwayEraSpecificSpec :: SpecWith (ImpInit (LedgerSpec ConwayEra))
 conwayEraSpecificSpec = do
@@ -764,7 +800,17 @@ expectRegistered cred = do
 expectDelegatedToPool ::
   (HasCallStack, ConwayEraImp era) => Credential 'Staking -> KeyHash 'StakePool -> ImpTestM era ()
 expectDelegatedToPool cred poolKh = do
-  accounts <- getsNES $ nesEsL . esLStateL . lsCertStateL . certDStateL . accountsL
+  certState <- getsNES $ nesEsL . esLStateL . lsCertStateL
+  let accounts = certState ^. certDStateL . accountsL
+  let pools = certState ^. certPStateL . psStakePoolsL
   impAnn (show cred <> " expected to have delegated to " <> show poolKh) $ do
     accountState <- expectJust $ lookupAccountState cred accounts
     accountState ^. stakePoolDelegationAccountStateL `shouldBe` Just poolKh
+    case Map.lookup poolKh pools of
+      Nothing ->
+        assertFailure $
+          "Expected stake pool state for: " <> show poolKh
+      Just poolState ->
+        assertBool
+          ("Expected pool delegations to contain the stake credential: " <> show cred)
+          (cred `Set.member` (poolState ^. spsDelegsL))