Add test showing the problem of retiring stake pool with duplicate vrfs

Author: teodanciu

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

@@ -112,6 +112,7 @@ conwaySpec ::
   , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era
   , InjectRuleFailure "LEDGER" ConwayUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ConwayUtxowPredFailure era
+  , InjectRuleFailure "LEDGER" ShelleyPoolPredFailure era
   , InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
   , InjectRuleEvent "TICK" ConwayEpochEvent era
   , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era

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

@@ -14,6 +14,7 @@ import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Conway.PParams
 import Cardano.Ledger.Conway.State
 import Cardano.Ledger.Shelley.LedgerState
+import Cardano.Ledger.Shelley.Rules (ShelleyPoolPredFailure (..))
 import qualified Data.Set as Set
 import Lens.Micro
 import Test.Cardano.Ledger.Conway.ImpTest
@@ -22,7 +23,10 @@ import Test.Cardano.Ledger.Imp.Common
 
 spec ::
   forall era.
-  ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
+  ( ConwayEraImp era
+  , InjectRuleFailure "LEDGER" ShelleyPoolPredFailure era
+  ) =>
+  SpecWith (ImpInit (LedgerSpec era))
 spec = do
   it "VRF Keyhashes get populated at v11 HardFork" $ do
     -- Since we're testing the HardFork to 11, the test only makes sense for protocol version 10
@@ -49,6 +53,29 @@ spec = do
       expectVRFs [] -- VRF keyhashes in PState is not yet populated
       enactHardForkV11
       expectVRFs [vrf2, vrf3, vrf5]
+
+  it "Retiring a stake pool with a duplicate VRF Keyhash after v11 HardFork" $ do
+    whenMajorVersion @10 $ do
+      -- register two pools with the same vrf keyhash before the hard fork
+      (kh1, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF
+      registerStakePool kh1 vrf
+      kh2 <- freshKeyHash
+      registerStakePool kh2 vrf
+
+      enactHardForkV11
+      expectVRFs [vrf]
+      -- retire one of the pools after the hard fork
+      retireStakePool kh1 (EpochInterval 1)
+      passEpoch
+      -- the vrf keyhash should still be present, since another pool is registered with it
+      expectVRFs [vrf]
+
+      -- registration of the same vrf should be disallowed
+      kh3 <- freshKeyHash
+      registerStakePoolTx kh3 vrf >>= \tx ->
+        submitFailingTx
+          tx
+          [injectFailure $ VRFKeyHashAlreadyRegistered kh3 vrf]
   where
     enactHardForkV11 = do
       modifyPParams $ \pp ->
@@ -61,11 +88,13 @@ spec = do
       submitYesVoteCCs_ committee govActionId
       passNEpochs 2
       getProtVer `shouldReturn` pv11
-    registerStakePool kh vrf = do
+    registerStakePoolTx kh vrf = do
       pps <- registerRewardAccount >>= freshPoolParams kh
-      submitTx_ $
+      pure $
         mkBasicTx mkBasicTxBody
           & bodyTxL . certsTxBodyL .~ [RegPoolTxCert $ pps & ppVrfL .~ vrf]
+    registerStakePool kh vrf =
+      registerStakePoolTx kh vrf >>= submitTx_
     retireStakePool kh retirementInterval = do
       curEpochNo <- getsNES nesELL
       let retirement = addEpochInterval curEpochNo retirementInterval