Add test to verify withdrawals from (un)delegated credentials

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

@@ -1,28 +1,39 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Ledger.Conway.Imp.LedgerSpec (spec) where
 
+import Cardano.Ledger.Address (RewardAccount (..))
+import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Rules (ConwayLedgerPredFailure (..), maxRefScriptSizePerTx)
-import Cardano.Ledger.Plutus (SLanguage (..))
+import Cardano.Ledger.DRep
+import Cardano.Ledger.Plutus (SLanguage (..), hashPlutusScript)
 import Cardano.Ledger.SafeHash (originalBytesSize)
+import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
 import qualified Data.Set as Set
 import Lens.Micro ((&), (.~))
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Imp.Common
-import Test.Cardano.Ledger.Plutus.Examples (alwaysFailsWithDatum)
+import Test.Cardano.Ledger.Plutus.Examples (
+  alwaysFailsWithDatum,
+  alwaysSucceedsNoDatum,
+ )
+
+import Cardano.Ledger.Credential (Credential (..))
 
 spec ::
   forall era.
   ( ConwayEraImp era
   , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era
   ) =>
   SpecWith (ImpTestState era)
-spec =
+spec = do
   it "TxRefScriptsSizeTooBig" $ do
     -- we use here the largest script we currently have as many times as necessary to
     -- trigger the predicate failure
@@ -38,3 +49,45 @@ spec =
       tx
       [ injectFailure $ ConwayTxRefScriptsSizeTooBig (size * n) maxRefScriptSizePerTx
       ]
+
+  it "Withdraw from delegated and non-delegated staking key" $ do
+    modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
+    cred <- KeyHashObj <$> freshKeyHash
+    ra <- registerStakeCredential cred
+    submitAndExpireProposalToMakeReward cred
+    reward <- lookupReward cred
+
+    let tx = mkBasicTx $ mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(ra, reward)]
+
+    pv <- getProtVer
+    if HF.bootstrapPhase pv
+      then submitTx_ tx
+      else
+        submitFailingTx
+          tx
+          [injectFailure $ ConwayWdrlNotDelegatedToDRep [raCredential ra]]
+    _ <- delegateToDRep cred (Coin 1_000_000) DRepAlwaysAbstain
+    submitTx_ $
+      mkBasicTx $
+        mkBasicTxBody
+          & withdrawalsTxBodyL
+            .~ Withdrawals
+              [ (ra, if HF.bootstrapPhase pv then mempty else reward)
+              ]
+
+  it "Withdraw from delegated and non-delegated staking script" $ do
+    modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
+    let scriptHash = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV3
+    let cred = ScriptHashObj scriptHash
+    ra <- registerStakeCredential cred
+    submitAndExpireProposalToMakeReward cred
+    reward <- lookupReward cred
+
+    submitTx_ $
+      mkBasicTx $
+        mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(ra, reward)]
+
+    _ <- delegateToDRep cred (Coin 1_000_000) DRepAlwaysAbstain
+    submitTx_ $
+      mkBasicTx $
+        mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(ra, mempty)]