diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs index 6ab7a71cc98..fbc46c17993 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/LedgerSpec.hs @@ -1,20 +1,31 @@ {-# 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. @@ -22,7 +33,7 @@ spec :: , 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)]