From 1bf9cece7930ec1309590f1ef2bc1959ef3891d4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Wed, 12 Feb 2025 14:19:33 +0200
Subject: [PATCH] Added a test

---
 .../Cardano/Ledger/Conway/Imp/DelegSpec.hs    | 64 ++++++++++++++++++-
 .../Test/Cardano/Ledger/Shelley/ImpTest.hs    |  5 ++
 2 files changed, 68 insertions(+), 1 deletion(-)

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
index 4bcc0712cac..b29dcfe93dc 100644
--- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs
+++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/DelegSpec.hs
@@ -6,13 +6,14 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Ledger.Conway.Imp.DelegSpec (
   spec,
 ) where
 
 import Cardano.Ledger.Address (RewardAccount (..))
-import Cardano.Ledger.BaseTypes (EpochInterval (..), StrictMaybe (..), addEpochInterval)
+import Cardano.Ledger.BaseTypes (EpochInterval (..), StrictMaybe (..), addEpochInterval, ProtVer (..), mkVersion)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Governance
@@ -36,6 +37,7 @@ import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus.Examples (evenRedeemerNoDatum)
+import Data.Maybe (fromJust)
 
 spec ::
   forall era.
@@ -477,6 +479,66 @@ spec = do
             .~ [UnRegDepositTxCert cred expectedDeposit]
       expectNotRegistered cred
       expectNotDelegatedVote cred
+    disableImpInitExpectLedgerRuleConformance $
+      it "Delegate vote and unregister after hardfork" $ do
+        (_, ccCred, _) <- electBasicCommittee
+        let bootstrapVer = ProtVer (fromJust $ mkVersion @Int 9) 0
+        setProtVer bootstrapVer
+        (khSPO, _, _) <- setupPoolWithStake $ Coin 10_000_000
+        passNEpochs 3
+        expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
+        cred <- KeyHashObj <$> freshKeyHash
+        submitTx_ $
+          mkBasicTx mkBasicTxBody
+            & bodyTxL . certsTxBodyL
+              .~ [RegDepositDelegTxCert cred (DelegVote DRepAlwaysAbstain) expectedDeposit]
+        registerAndRetirePoolToMakeReward cred
+        expectRegistered cred
+        expectDelegatedVote cred DRepAlwaysAbstain
+        getProtVer `shouldReturn` bootstrapVer
+        let postBootstrapVer = ProtVer (fromJust $ mkVersion @Int 10) 0
+        hfGaid <- submitGovAction $ HardForkInitiation SNothing postBootstrapVer
+        submitVote_ VoteYes (StakePoolVoter khSPO) hfGaid
+        submitVote_ VoteYes (CommitteeVoter ccCred) hfGaid
+        passNEpochs 3
+        getProtVer `shouldReturn` postBootstrapVer
+        withdrawalAmount <- getsPParams ppPoolDepositL
+        rewardAccount <- getRewardAccountFor cred
+        submitTx_ $
+          mkBasicTx mkBasicTxBody
+            & bodyTxL . certsTxBodyL
+              .~ [UnRegTxCert cred]
+            & bodyTxL . withdrawalsTxBodyL
+              .~ Withdrawals (Map.singleton rewardAccount withdrawalAmount)
+        expectNotRegistered cred
+        expectNotDelegatedVote cred
+    it "Delegate vote and undelegate after delegating to some stake pools" $ do
+      (khSPO, _, _) <- setupPoolWithStake $ Coin 1_000_000
+      expectedDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
+      cred <- KeyHashObj <$> freshKeyHash
+      submitTx_ $
+        mkBasicTx mkBasicTxBody
+          & bodyTxL . certsTxBodyL
+            .~ [RegDepositDelegTxCert cred (DelegVote DRepAlwaysAbstain) expectedDeposit]
+      registerAndRetirePoolToMakeReward cred
+      expectRegistered cred
+      expectDelegatedVote cred DRepAlwaysAbstain
+      forM_ @[] [1..3 :: Int] $ \_ -> do
+        submitTx_ $
+          mkBasicTx mkBasicTxBody
+            & bodyTxL . certsTxBodyL
+              .~ [DelegTxCert cred (DelegStake khSPO)]
+      passNEpochs 3
+      withdrawalAmount <- getsPParams ppPoolDepositL
+      rewardAccount <- getRewardAccountFor cred
+      submitTx_ $
+        mkBasicTx mkBasicTxBody
+          & bodyTxL . certsTxBodyL
+            .~ [UnRegTxCert cred]
+          & bodyTxL . withdrawalsTxBodyL
+            .~ Withdrawals (Map.singleton rewardAccount withdrawalAmount)
+      expectNotRegistered cred
+      expectNotDelegatedVote cred
 
   describe "Delegate both stake and vote - separated out for conformance mismatch" $
     -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/640
diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
index f83e6b2c078..8b0be6575ce 100644
--- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
+++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
@@ -58,6 +58,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
   trySubmitTx,
   modifyNES,
   getProtVer,
+  setProtVer,
   getsNES,
   getUTxO,
   impAddNativeScript,
@@ -1442,6 +1443,10 @@ getUTxO = getsNES utxoL
 getProtVer :: EraGov era => ImpTestM era ProtVer
 getProtVer = getsNES $ nesEsL . curPParamsEpochStateL . ppProtocolVersionL
 
+setProtVer :: EraGov era => ProtVer -> ImpTestM era ()
+setProtVer pv = modifyNES $
+  nesEsL . curPParamsEpochStateL . ppProtocolVersionL .~ pv
+
 submitTxAnn ::
   (HasCallStack, ShelleyEraImp era) =>
   String ->