{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Test.Cardano.Ledger.Conway.Imp.CertsSpec (spec) where import Cardano.Ledger.BaseTypes (EpochInterval (..)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway (hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Rules (ConwayCertsPredFailure (..), ConwayLedgerPredFailure (..)) import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.DRep (DRep (..)) import Cardano.Ledger.Val (Val (..)) import Lens.Micro ((&), (.~)) import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Conway.ImpTest import Test.Cardano.Ledger.Imp.Common spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era)) spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era)) spec = do String -> SpecWith (ImpInit (LedgerSpec era)) -> SpecWith (ImpInit (LedgerSpec era)) forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Withdrawals" (SpecWith (ImpInit (LedgerSpec era)) -> SpecWith (ImpInit (LedgerSpec era))) -> SpecWith (ImpInit (LedgerSpec era)) -> SpecWith (ImpInit (LedgerSpec era)) forall a b. (a -> b) -> a -> b $ do String -> ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ())) forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Withdrawing from an unregistered reward account" (ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ()))) -> ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ())) forall a b. (a -> b) -> a -> b $ do (PParams era -> PParams era) -> ImpM (LedgerSpec era) () forall era. ShelleyEraImp era => (PParams era -> PParams era) -> ImpTestM era () modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ()) -> (PParams era -> PParams era) -> ImpM (LedgerSpec era) () forall a b. (a -> b) -> a -> b $ (EpochInterval -> Identity EpochInterval) -> PParams era -> Identity (PParams era) forall era. ConwayEraPParams era => Lens' (PParams era) EpochInterval Lens' (PParams era) EpochInterval ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval) -> PParams era -> Identity (PParams era)) -> EpochInterval -> PParams era -> PParams era forall s t a b. ASetter s t a b -> b -> s -> t .~ Word32 -> EpochInterval EpochInterval Word32 2 ProtVer pv <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a getsPParams @era (ProtVer -> f ProtVer) -> PParams era -> f (PParams era) forall era. EraPParams era => Lens' (PParams era) ProtVer Lens' (PParams era) ProtVer ppProtocolVersionL KeyHash 'Staking stakeKey <- ImpM (LedgerSpec era) (KeyHash 'Staking) forall (r :: KeyRole) s g (m :: * -> *). (HasKeyPairs s, MonadState s m, HasStatefulGen g m) => m (KeyHash r) freshKeyHash RewardAccount rwdAccount <- Credential 'Staking -> ImpTestM era RewardAccount forall era. Credential 'Staking -> ImpTestM era RewardAccount getRewardAccountFor (Credential 'Staking -> ImpTestM era RewardAccount) -> Credential 'Staking -> ImpTestM era RewardAccount forall a b. (a -> b) -> a -> b $ KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj KeyHash 'Staking stakeKey let tx :: Tx era tx = TxBody era -> Tx era forall era. EraTx era => TxBody era -> Tx era mkBasicTx (TxBody era -> Tx era) -> TxBody era -> Tx era forall a b. (a -> b) -> a -> b $ TxBody era forall era. EraTxBody era => TxBody era mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era forall a b. a -> (a -> b) -> b & (Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era) forall era. EraTxBody era => Lens' (TxBody era) Withdrawals Lens' (TxBody era) Withdrawals withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era)) -> Withdrawals -> TxBody era -> TxBody era forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount, Integer -> Coin Coin Integer 20)] notInRewardsFailure :: EraRuleFailure "LEDGER" era notInRewardsFailure = ( if ProtVer -> Bool hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule ProtVer pv then ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era) -> (Withdrawals -> ConwayLedgerPredFailure era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayLedgerPredFailure era ConwayWithdrawalsMissingAccounts @era else ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era) -> (Withdrawals -> ConwayCertsPredFailure era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayCertsPredFailure era WithdrawalsNotInRewardsCERTS @era ) (Withdrawals -> EraRuleFailure "LEDGER" era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall a b. (a -> b) -> a -> b $ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount, Integer -> Coin Coin Integer 20)] in ImpM (LedgerSpec era) () -> (NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) ()) -> SubmitFailureExpectation era -> ImpM (LedgerSpec era) () forall era a. EraGov era => ImpTestM era a -> (NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era a) -> SubmitFailureExpectation era -> ImpTestM era a submitBootstrapAware (Tx era -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era () submitTx_ Tx era tx) (Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era () submitFailingTx Tx era tx) ( FailBoth era -> SubmitFailureExpectation era forall era. FailBoth era -> SubmitFailureExpectation era FailBootstrapAndPostBootstrap (FailBoth era -> SubmitFailureExpectation era) -> FailBoth era -> SubmitFailureExpectation era forall a b. (a -> b) -> a -> b $ FailBoth { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era)) bootstrapFailures = [Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) EraRuleFailure "LEDGER" era notInRewardsFailure] , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era)) postBootstrapFailures = [ Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) EraRuleFailure "LEDGER" era notInRewardsFailure , ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era forall era. NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era ConwayWdrlNotDelegatedToDRep [Item (NonEmpty (KeyHash 'Staking)) KeyHash 'Staking stakeKey]) ] } ) (RewardAccount registeredRwdAccount, Coin reward, KeyHash 'Staking stakeKey2) <- ImpM (LedgerSpec era) (RewardAccount, Coin, KeyHash 'Staking) setupRewardAccount ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall (f :: * -> *) a. Functor f => f a -> f () void (ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall a b. (a -> b) -> a -> b $ Credential 'Staking -> Coin -> DRep -> ImpM (LedgerSpec era) (KeyPair 'Payment) forall era. ConwayEraImp era => Credential 'Staking -> Coin -> DRep -> ImpTestM era (KeyPair 'Payment) delegateToDRep (KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj KeyHash 'Staking stakeKey2) (Integer -> Coin Coin Integer 1_000_000) DRep DRepAlwaysNoConfidence let tx :: Tx era tx = TxBody era -> Tx era forall era. EraTx era => TxBody era -> Tx era mkBasicTx (TxBody era -> Tx era) -> TxBody era -> Tx era forall a b. (a -> b) -> a -> b $ TxBody era forall era. EraTxBody era => TxBody era mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era forall a b. a -> (a -> b) -> b & (Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era) forall era. EraTxBody era => Lens' (TxBody era) Withdrawals Lens' (TxBody era) Withdrawals withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era)) -> Withdrawals -> TxBody era -> TxBody era forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount, Coin forall t. Val t => t zero), (RewardAccount registeredRwdAccount, Coin reward)] notInRewardsFailure :: EraRuleFailure "LEDGER" era notInRewardsFailure = ( if ProtVer -> Bool hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule ProtVer pv then ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era) -> (Withdrawals -> ConwayLedgerPredFailure era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayLedgerPredFailure era ConwayWithdrawalsMissingAccounts @era else ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era) -> (Withdrawals -> ConwayCertsPredFailure era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayCertsPredFailure era WithdrawalsNotInRewardsCERTS @era ) (Withdrawals -> EraRuleFailure "LEDGER" era) -> Withdrawals -> EraRuleFailure "LEDGER" era forall a b. (a -> b) -> a -> b $ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount, Coin forall t. Val t => t zero)] in ImpM (LedgerSpec era) () -> (NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) ()) -> SubmitFailureExpectation era -> ImpM (LedgerSpec era) () forall era a. EraGov era => ImpTestM era a -> (NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era a) -> SubmitFailureExpectation era -> ImpTestM era a submitBootstrapAware (Tx era -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era () submitTx_ Tx era tx) (Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era () submitFailingTx Tx era tx) ( FailBoth era -> SubmitFailureExpectation era forall era. FailBoth era -> SubmitFailureExpectation era FailBootstrapAndPostBootstrap (FailBoth era -> SubmitFailureExpectation era) -> FailBoth era -> SubmitFailureExpectation era forall a b. (a -> b) -> a -> b $ FailBoth { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era)) bootstrapFailures = [Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) EraRuleFailure "LEDGER" era notInRewardsFailure] , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era)) postBootstrapFailures = [ Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) EraRuleFailure "LEDGER" era notInRewardsFailure , ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era forall era. NonEmpty (KeyHash 'Staking) -> ConwayLedgerPredFailure era ConwayWdrlNotDelegatedToDRep [Item (NonEmpty (KeyHash 'Staking)) KeyHash 'Staking stakeKey]) ] } ) String -> ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ())) forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Withdrawing the wrong amount" (ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ()))) -> ImpM (LedgerSpec era) () -> SpecWith (Arg (ImpM (LedgerSpec era) ())) forall a b. (a -> b) -> a -> b $ do (PParams era -> PParams era) -> ImpM (LedgerSpec era) () forall era. ShelleyEraImp era => (PParams era -> PParams era) -> ImpTestM era () modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ()) -> (PParams era -> PParams era) -> ImpM (LedgerSpec era) () forall a b. (a -> b) -> a -> b $ (EpochInterval -> Identity EpochInterval) -> PParams era -> Identity (PParams era) forall era. ConwayEraPParams era => Lens' (PParams era) EpochInterval Lens' (PParams era) EpochInterval ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval) -> PParams era -> Identity (PParams era)) -> EpochInterval -> PParams era -> PParams era forall s t a b. ASetter s t a b -> b -> s -> t .~ Word32 -> EpochInterval EpochInterval Word32 2 ProtVer pv <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a getsPParams @era (ProtVer -> f ProtVer) -> PParams era -> f (PParams era) forall era. EraPParams era => Lens' (PParams era) ProtVer Lens' (PParams era) ProtVer ppProtocolVersionL (RewardAccount rwdAccount1, Coin reward1, KeyHash 'Staking stakeKey1) <- ImpM (LedgerSpec era) (RewardAccount, Coin, KeyHash 'Staking) setupRewardAccount (RewardAccount rwdAccount2, Coin reward2, KeyHash 'Staking stakeKey2) <- ImpM (LedgerSpec era) (RewardAccount, Coin, KeyHash 'Staking) setupRewardAccount ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall (f :: * -> *) a. Functor f => f a -> f () void (ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall a b. (a -> b) -> a -> b $ Credential 'Staking -> Coin -> DRep -> ImpM (LedgerSpec era) (KeyPair 'Payment) forall era. ConwayEraImp era => Credential 'Staking -> Coin -> DRep -> ImpTestM era (KeyPair 'Payment) delegateToDRep (KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj KeyHash 'Staking stakeKey1) (Integer -> Coin Coin Integer 1_000_000) DRep DRepAlwaysAbstain ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall (f :: * -> *) a. Functor f => f a -> f () void (ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpM (LedgerSpec era) () forall a b. (a -> b) -> a -> b $ Credential 'Staking -> Coin -> DRep -> ImpM (LedgerSpec era) (KeyPair 'Payment) forall era. ConwayEraImp era => Credential 'Staking -> Coin -> DRep -> ImpTestM era (KeyPair 'Payment) delegateToDRep (KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj KeyHash 'Staking stakeKey2) (Integer -> Coin Coin Integer 1_000_000) DRep DRepAlwaysAbstain Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era () submitFailingTx ( TxBody era -> Tx era forall era. EraTx era => TxBody era -> Tx era mkBasicTx (TxBody era -> Tx era) -> TxBody era -> Tx era forall a b. (a -> b) -> a -> b $ TxBody era forall era. EraTxBody era => TxBody era mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era forall a b. a -> (a -> b) -> b & (Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era) forall era. EraTxBody era => Lens' (TxBody era) Withdrawals Lens' (TxBody era) Withdrawals withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era)) -> Withdrawals -> TxBody era -> TxBody era forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [ (RewardAccount rwdAccount1, Coin reward1 Coin -> Coin -> Coin forall t. Val t => t -> t -> t <+> Integer -> Coin Coin Integer 1) , (RewardAccount rwdAccount2, Coin reward2) ] ) [ ( if ProtVer -> Bool hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule ProtVer pv then ConwayLedgerPredFailure era -> PredicateFailure (EraRule "LEDGER" era) ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayLedgerPredFailure era -> PredicateFailure (EraRule "LEDGER" era)) -> (Withdrawals -> ConwayLedgerPredFailure era) -> Withdrawals -> PredicateFailure (EraRule "LEDGER" era) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayLedgerPredFailure era ConwayIncompleteWithdrawals @era else ConwayCertsPredFailure era -> PredicateFailure (EraRule "LEDGER" era) ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayCertsPredFailure era -> PredicateFailure (EraRule "LEDGER" era)) -> (Withdrawals -> ConwayCertsPredFailure era) -> Withdrawals -> PredicateFailure (EraRule "LEDGER" era) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayCertsPredFailure era WithdrawalsNotInRewardsCERTS @era ) (Withdrawals -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))) -> Withdrawals -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) forall a b. (a -> b) -> a -> b $ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount1, Coin reward1 Coin -> Coin -> Coin forall t. Val t => t -> t -> t <+> Integer -> Coin Coin Integer 1)] ] Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpM (LedgerSpec era) () forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era () submitFailingTx ( TxBody era -> Tx era forall era. EraTx era => TxBody era -> Tx era mkBasicTx (TxBody era -> Tx era) -> TxBody era -> Tx era forall a b. (a -> b) -> a -> b $ TxBody era forall era. EraTxBody era => TxBody era mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era forall a b. a -> (a -> b) -> b & (Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era) forall era. EraTxBody era => Lens' (TxBody era) Withdrawals Lens' (TxBody era) Withdrawals withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals) -> TxBody era -> Identity (TxBody era)) -> Withdrawals -> TxBody era -> TxBody era forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount1, Coin forall t. Val t => t zero)] ) [ ( if ProtVer -> Bool hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule ProtVer pv then ConwayLedgerPredFailure era -> PredicateFailure (EraRule "LEDGER" era) ConwayLedgerPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayLedgerPredFailure era -> PredicateFailure (EraRule "LEDGER" era)) -> (Withdrawals -> ConwayLedgerPredFailure era) -> Withdrawals -> PredicateFailure (EraRule "LEDGER" era) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayLedgerPredFailure era ConwayIncompleteWithdrawals @era else ConwayCertsPredFailure era -> PredicateFailure (EraRule "LEDGER" era) ConwayCertsPredFailure era -> EraRuleFailure "LEDGER" era forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure (ConwayCertsPredFailure era -> PredicateFailure (EraRule "LEDGER" era)) -> (Withdrawals -> ConwayCertsPredFailure era) -> Withdrawals -> PredicateFailure (EraRule "LEDGER" era) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall era. Withdrawals -> ConwayCertsPredFailure era WithdrawalsNotInRewardsCERTS @era ) (Withdrawals -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))) -> Withdrawals -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) forall a b. (a -> b) -> a -> b $ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount rwdAccount1, Coin forall t. Val t => t zero)] ] where setupRewardAccount :: ImpM (LedgerSpec era) (RewardAccount, Coin, KeyHash 'Staking) setupRewardAccount = do KeyHash 'Staking kh <- ImpM (LedgerSpec era) (KeyHash 'Staking) forall (r :: KeyRole) s g (m :: * -> *). (HasKeyPairs s, MonadState s m, HasStatefulGen g m) => m (KeyHash r) freshKeyHash let cred :: Credential 'Staking cred = KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj KeyHash 'Staking kh RewardAccount ra <- Credential 'Staking -> ImpTestM era RewardAccount forall era. (HasCallStack, ShelleyEraImp era) => Credential 'Staking -> ImpTestM era RewardAccount registerStakeCredential Credential 'Staking cred Credential 'Staking -> ImpM (LedgerSpec era) () forall era. ConwayEraImp era => Credential 'Staking -> ImpTestM era () submitAndExpireProposalToMakeReward Credential 'Staking cred Coin b <- Credential 'Staking -> ImpTestM era Coin forall era. (HasCallStack, EraCertState era) => Credential 'Staking -> ImpTestM era Coin getBalance Credential 'Staking cred (RewardAccount, Coin, KeyHash 'Staking) -> ImpM (LedgerSpec era) (RewardAccount, Coin, KeyHash 'Staking) forall a. a -> ImpM (LedgerSpec era) a forall (f :: * -> *) a. Applicative f => a -> f a pure (RewardAccount ra, Coin b, KeyHash 'Staking kh)