{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Conway.Imp.GovSpec (spec) where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin (Coin (Coin))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.Rules (ConwayGovPredFailure (..))
import Cardano.Ledger.Credential (Credential (KeyHashObj))
import Cardano.Ledger.Plutus.CostModels (updateCostModels)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Val (zero, (<->))
import Data.Default (Default (..))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import qualified Data.OMap.Strict as OMap
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Tree
import Lens.Micro
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
import Test.Cardano.Ledger.Imp.Common hiding (Success)

spec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
constitutionSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
proposalsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
votingSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
policySpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
predicateFailuresSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
withdrawalsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
pparamUpdateSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
networkIdSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
bootstrapPhaseSpec

unknownCostModelsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unknown CostModels" (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
"Are accepted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      CostModels
costModels <- Lens' (PParams era) CostModels -> ImpTestM era CostModels
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (CostModels -> f CostModels) -> PParams era -> f (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL
      CostModels
newCostModels <- ImpTestM era CostModels
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
gai <-
        StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
          PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
ppuCostModelsL ((StrictMaybe CostModels -> Identity (StrictMaybe CostModels))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe CostModels -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
SJust CostModels
newCostModels
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gai
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gai
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
      Lens' (PParams era) CostModels -> ImpTestM era CostModels
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (CostModels -> f CostModels) -> PParams era -> f (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL ImpTestM era CostModels -> CostModels -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` CostModels -> CostModels -> CostModels
updateCostModels CostModels
costModels CostModels
newCostModels

predicateFailuresSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
predicateFailuresSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
predicateFailuresSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Predicate failures" (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
"ProposalReturnAccountDoesNotExist" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
      RewardAccount
unregisteredRewardAccount <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) RewardAccount)
-> ImpM (LedgerSpec era) RewardAccount
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Credential 'Staking -> ImpM (LedgerSpec era) RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor (Credential 'Staking -> ImpM (LedgerSpec era) RewardAccount)
-> (KeyHash 'Staking -> Credential 'Staking)
-> KeyHash 'Staking
-> ImpM (LedgerSpec era) RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj

      ProposalProcedure era
proposal <- GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
forall era. GovAction era
InfoAction RewardAccount
unregisteredRewardAccount
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailPostBootstrap
          [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ RewardAccount -> ConwayGovPredFailure era
forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist RewardAccount
unregisteredRewardAccount]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ExpirationEpochTooSmall" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
committeeC <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let expiration :: EpochNo
expiration = Word64 -> EpochNo
EpochNo Word64
1
          action :: GovAction era
action =
            StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
              StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
              Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
              (Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
committeeC EpochNo
expiration)
              (Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      let expectedFailure :: EraRuleFailure "LEDGER" era
expectedFailure =
            ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall (Map (Credential 'ColdCommitteeRole) EpochNo
 -> ConwayGovPredFailure era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
committeeC EpochNo
expiration
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
action
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        FailBoth era -> SubmitFailureExpectation era
forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap
          FailBoth
            { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures = [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal, Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
expectedFailure]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
expectedFailure]
            }

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ProposalDepositIncorrect" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      RewardAccount
rewardAccount <- ImpM (LedgerSpec era) RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      Coin
actionDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL
      Anchor
anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
        ( ProposalProcedure
            { pProcReturnAddr :: RewardAccount
pProcReturnAddr = RewardAccount
rewardAccount
            , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
forall era. GovAction era
InfoAction
            , pProcDeposit :: Coin
pProcDeposit = Coin
actionDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
            , pProcAnchor :: Anchor
pProcAnchor = Anchor
anchor
            }
        )
        [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
            Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect (Mismatch 'RelEQ Coin -> ConwayGovPredFailure era)
-> Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$
              Mismatch
                { mismatchSupplied :: Coin
mismatchSupplied = Coin
actionDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
                , mismatchExpected :: Coin
mismatchExpected = Coin
actionDeposit
                }
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ConflictingCommitteeUpdate" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
committeeC <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      let action :: GovAction era
action =
            StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
              StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
              (Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
committeeC)
              (Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
committeeC (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
1)))
              (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      let expectedFailure :: EraRuleFailure "LEDGER" era
expectedFailure = ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole) -> ConwayGovPredFailure era
forall era.
Set (Credential 'ColdCommitteeRole) -> ConwayGovPredFailure era
ConflictingCommitteeUpdate (Set (Credential 'ColdCommitteeRole) -> ConwayGovPredFailure era)
-> Set (Credential 'ColdCommitteeRole) -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
committeeC
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
action
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        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 = [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal, Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
expectedFailure]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
expectedFailure]
            }
  where
    disallowedProposalFailure :: ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure = ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> (ProposalProcedure era -> ConwayGovPredFailure era)
-> ProposalProcedure era
-> EraRuleFailure "LEDGER" era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap

hardForkSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
hardForkSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"HardFork" (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
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the first one (doesn't have a GovPurposeId) " (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 -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
minorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
majorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
firstHardForkCantFollow
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the second one (has a GovPurposeId)" (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 -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
minorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
majorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
secondHardForkCantFollow

pparamUpdateSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
pparamUpdateSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
pparamUpdateSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PParamUpdate" (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
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PPU needs to be wellformed" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      let testMalformedProposal :: String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
testMalformedProposal String
lbl ASetter (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
lenz a
val = String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
lbl (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
            let ppu :: PParamsUpdate era
ppu =
                  PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                    PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& ASetter (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
lenz ASetter (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> StrictMaybe a -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
val
            GovAction era
ga <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
ppu
            GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga
              ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProposalProcedure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ProposalProcedure era
-> ImpM (LedgerSpec era) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
                ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
                [ConwayGovPredFailure era -> EraRuleFailure rule era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure rule era)
-> ConwayGovPredFailure era -> EraRuleFailure rule era
forall a b. (a -> b) -> a -> b
$ GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal GovAction era
ga]
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Word32)
     (StrictMaybe Word32)
-> Word32
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxBBSizeL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL
        Word32
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Word32)
     (StrictMaybe Word32)
-> Word32
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxTxSizeL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL
        Word32
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Word16)
     (StrictMaybe Word16)
-> Word16
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxBHSizeL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Word16)
  (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL
        Word16
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Natural)
     (StrictMaybe Natural)
-> Natural
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxValSizeL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxValSizeL
        Natural
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Natural)
     (StrictMaybe Natural)
-> Natural
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuCollateralPercentageL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCollateralPercentageL
        Natural
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe EpochInterval)
     (StrictMaybe EpochInterval)
-> EpochInterval
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuCommitteeMaxTermLengthL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuCommitteeMaxTermLengthL
        (EpochInterval -> SpecWith (ImpInit (LedgerSpec era)))
-> EpochInterval -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe EpochInterval)
     (StrictMaybe EpochInterval)
-> EpochInterval
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuGovActionLifetimeL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuGovActionLifetimeL
        (EpochInterval -> SpecWith (ImpInit (LedgerSpec era)))
-> EpochInterval -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
0
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Coin)
     (StrictMaybe Coin)
-> Coin
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuPoolDepositL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL
        Coin
forall t. Val t => t
zero
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Coin)
     (StrictMaybe Coin)
-> Coin
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuGovActionDepositL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL
        Coin
forall t. Val t => t
zero
      String
-> ASetter
     (PParamsUpdate era)
     (PParamsUpdate era)
     (StrictMaybe Coin)
     (StrictMaybe Coin)
-> Coin
-> SpecWith (ImpInit (LedgerSpec era))
forall {era} {era} {rule :: Symbol} {a} {a}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era, DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 NFData (PredicateFailure (EraRule rule era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era))) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuDRepDepositL cannot be 0"
        ASetter
  (PParamsUpdate era)
  (PParamsUpdate era)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL
        Coin
forall t. Val t => t
zero
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"PPU cannot be empty" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        GovAction era
ga <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
        GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga
          ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProposalProcedure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ProposalProcedure era
-> ImpM (LedgerSpec era) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal GovAction era
ga]

proposalsSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
proposalsSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
proposalsSpec = do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposals" (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
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Consistency" (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
"Proposals submitted without proper parent fail" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        let mkCorruptGovActionId :: GovActionId -> GovActionId
            mkCorruptGovActionId :: GovActionId -> GovActionId
mkCorruptGovActionId (GovActionId TxId
txi (GovActionIx Word16
gaix)) =
              TxId -> GovActionIx -> GovActionId
GovActionId TxId
txi (GovActionIx -> GovActionId) -> GovActionIx -> GovActionId
forall a b. (a -> b) -> a -> b
$ Word16 -> GovActionIx
GovActionIx (Word16 -> GovActionIx) -> Word16 -> GovActionIx
forall a b. (a -> b) -> a -> b
$ Word16
gaix Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
999
        Node GovActionId
p1 [Node GovActionId
_p11 []] <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            (Tree () -> ImpTestM era (Tree GovActionId))
-> Tree () -> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        GovAction era
parameterChangeAction <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> GovActionId -> StrictMaybe GovActionId
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovActionId
mkCorruptGovActionId GovActionId
p1)
        ProposalProcedure era
parameterChangeProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
parameterChangeAction
        ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
          ProposalProcedure era
parameterChangeProposal
          [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
parameterChangeProposal
          ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire" (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
4
        GovActionId
p1 <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        Tree GovActionId
a <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1)
            (Tree () -> ImpTestM era (Tree GovActionId))
-> Tree () -> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
              , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        Tree GovActionId
b <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            (Tree () -> ImpTestM era (Tree GovActionId))
-> Tree () -> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1) [GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
a]
                             , GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
b
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing [GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
b]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire over multiple rounds" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        let ppupdate :: PParamsUpdate era
ppupdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000)
        let submitInitialProposal :: ImpM (LedgerSpec era) GovActionId
submitInitialProposal = StrictMaybe GovActionId
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
ppupdate
        let submitChildProposal :: GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
parent = StrictMaybe GovActionId
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
parent) PParamsUpdate era
ppupdate
        (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
4
        GovActionId
p1 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]

        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId
p2 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        GovActionId
p11 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p1
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]

        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId
p3 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        GovActionId
p21 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p2
        [Tree GovActionId]
a <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitParameterChangeForest
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11)
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                 (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1)
                                 [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                     (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11)
                                     ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
a)
                                 ]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]

        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId
p4 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        GovActionId
p31 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p3
        GovActionId
p211 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p21
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                 (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1)
                                 [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                     (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11)
                                     ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
a)
                                 ]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []]]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p31) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []]]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p31) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        GovActionId
p5 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        GovActionId
p41 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p4
        GovActionId
p311 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p31
        GovActionId
p212 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p21
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                 (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2)
                                 [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                     (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21)
                                     [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []
                                     , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p212) []
                                     ]
                                 ]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p31) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p311) []]]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p41) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p5) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId
p6 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        GovActionId
p51 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p5
        GovActionId
p411 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p41
        GovActionId
p312 <- GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
p31
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                 (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3)
                                 [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                                     (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p31)
                                     [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p311) []
                                     , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p312) []
                                     ]
                                 ]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p41) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p411) []]]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p5) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p51) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p6) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p41) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p411) []]]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p5) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p51) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p6) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p5) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p51) []]
                             , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p6) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                             StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
                             [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p6) []
                             ]
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when competing proposals are enacted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole
dRep, Credential 'HotCommitteeRole
committeeMember, GovPurposeId GovActionId
committeeGovActionId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        a :: [Tree GovActionId]
a@[ Item [Tree GovActionId]
_
            , b :: Item [Tree GovActionId]
b@(Node GovActionId
p2 [Tree GovActionId]
_)
            ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                    ()
                    [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    ]
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                ]
            ]

        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
committeeGovActionId) []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
a)
                         ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p2
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committeeMember) GovActionId
p2
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpTestM era (Forest (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing []
                         , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
committeeGovActionId) []
                         , GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
Item [Tree GovActionId]
b
                         ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when competing proposals are enacted over multiple rounds" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        a :: [Tree GovActionId]
a@[ Item [Tree GovActionId]
c
            , Node
                GovActionId
p2
                [ Node GovActionId
p21 []
                  , Node GovActionId
p22 []
                  ]
            , Node GovActionId
p3 []
            ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                    ()
                    [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    ]
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
p2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p2
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
p21
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p21
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
p3
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p3 -- Two competing proposals break the tie based on proposal order
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
a)
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId
p4 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        GovActionId
p31 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
p3)
        GovActionId
p211 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
p21)
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            [ GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
Item [Tree GovActionId]
c
            , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2)
                [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []]
                , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p22) []
                ]
            , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p3) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p31) []]
            , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p4) []
            ]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2)
            [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []]
            , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p22) []
            ]
        [ Node GovActionId
p212 []
          , Node GovActionId
p213 []
          , Node GovActionId
p214 []
          ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21)
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        GovActionId
p2131 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
p213)
        GovActionId
p2141 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
p214)
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
p212
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p212
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2)
            [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node
                (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p21)
                [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p211) []
                , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p212) []
                , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p213) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2131) []]
                , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p214) [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p2141) []]
                ]
            , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p22) []
            ]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p212) []
        Proposals era
props <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
        Proposals era -> Int
forall era. Proposals era -> Int
proposalsSize Proposals era
props Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Int
0
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned for both enactment and expiry over multiple rounds" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (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
4
        [ a :: Item [Tree GovActionId]
a@( Node
                GovActionId
p1
                [ b :: Item [Tree GovActionId]
b@( Node
                        GovActionId
p11
                        [ Node GovActionId
_p111 []
                          , Node GovActionId
_p112 []
                          ]
                      )
                  ]
              )
          , Node
              GovActionId
_p2
              [ Node GovActionId
_p21 []
                , Node GovActionId
_p22 []
                ]
          , Node GovActionId
p3 []
          ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                    ()
                    [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                    ]
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p1
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p11
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p11
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p3
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p3 -- Two competing proposals break the tie based on proposal order
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust
          (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
Item [Tree GovActionId]
a
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- ConstitutionPurpose is a delayed action
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust
          (GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
Item [Tree GovActionId]
b
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11) []
        c :: [Tree GovActionId]
c@[ Node GovActionId
_p113 []
            , Node GovActionId
_p114 []
            ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11)
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11) ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
c)
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
4
        d :: [Tree GovActionId]
d@[ Node GovActionId
_p115 []
            , Node GovActionId
p116 []
            ] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11)
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11) ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Tree GovActionId]
c [Tree GovActionId] -> [Tree GovActionId] -> [Tree GovActionId]
forall a. Semigroup a => a -> a -> a
<> [Tree GovActionId]
d))
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p11) ((GovActionId -> StrictMaybe GovActionId)
-> Tree GovActionId -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust (Tree GovActionId -> Tree (StrictMaybe GovActionId))
-> [Tree GovActionId] -> Forest (StrictMaybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
d)
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p116
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p116
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p116) []
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Votes from subsequent epochs are considered for ratification" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> 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
4

        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        [Node GovActionId
p1 []] <-
          StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            [() -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []]
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing [StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1) []]
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p1
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> ImpTestM era (Forest (StrictMaybe GovActionId))
-> ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Forest (StrictMaybe GovActionId)
-> Int -> Tree (StrictMaybe GovActionId)
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) ImpTestM era (Forest (StrictMaybe GovActionId))
forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          ImpM (LedgerSpec era) (Tree (StrictMaybe GovActionId))
-> Tree (StrictMaybe GovActionId) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
p1) []
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals are stored in the expected order" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> 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
$ (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppMaxValSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1_000_000_000
        EnactState era
ens <- ImpTestM era (EnactState era)
forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
        RewardAccount
returnAddr <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
        [(RewardAccount, Coin)]
withdrawal <-
          ((RewardAccount, Coin)
-> [(RewardAccount, Coin)] -> [(RewardAccount, Coin)]
forall a. a -> [a] -> [a]
: []) ((RewardAccount, Coin) -> [(RewardAccount, Coin)])
-> (Positive Integer -> (RewardAccount, Coin))
-> Positive Integer
-> [(RewardAccount, Coin)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RewardAccount
returnAddr,) (Coin -> (RewardAccount, Coin))
-> (Positive Integer -> Coin)
-> Positive Integer
-> (RewardAccount, Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Coin)
-> (Positive Integer -> Integer) -> Positive Integer -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive
            (Positive Integer -> [(RewardAccount, Coin)])
-> ImpM (LedgerSpec era) (Positive Integer)
-> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImpM (LedgerSpec era) (Positive Integer)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary :: ImpTestM era (Positive Integer))
        GovAction era
wdrl <- [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount, Coin)]
withdrawal
        [Item [ProposalProcedure era]
prop0, Item [ProposalProcedure era]
prop1, Item [ProposalProcedure era]
prop2, Item [ProposalProcedure era]
prop3] <-
          (GovAction era -> ImpTestM era (ProposalProcedure era))
-> [GovAction era] -> ImpM (LedgerSpec era) [ProposalProcedure era]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
            GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal
            ( [ Item [GovAction era]
GovAction era
forall era. GovAction era
InfoAction
              , StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (EnactState era
ens EnactState era
-> Getting
     (StrictMaybe (GovPurposeId 'CommitteePurpose era))
     (EnactState era)
     (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (GovPurposeId 'CommitteePurpose era))
  (EnactState era)
  (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (GovPurposeId 'CommitteePurpose era)
 -> f (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> EnactState era -> f (EnactState era)
ensPrevCommitteeL)
              , Item [GovAction era]
GovAction era
forall era. GovAction era
InfoAction
              , Item [GovAction era]
GovAction era
wdrl
              ] ::
                [GovAction era]
            )
        ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
ProposalProcedure era
prop0
        ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
ProposalProcedure era
prop1
        let
          checkProps :: [ProposalProcedure era] -> ImpM (LedgerSpec era) ()
checkProps [ProposalProcedure era]
l = do
            OMap GovActionId (GovActionState era)
props <-
              SimpleGetter
  (NewEpochState era) (OMap GovActionId (GovActionState era))
-> ImpTestM era (OMap GovActionId (GovActionState era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (OMap GovActionId (GovActionState era))
 -> ImpTestM era (OMap GovActionId (GovActionState era)))
-> SimpleGetter
     (NewEpochState era) (OMap GovActionId (GovActionState era))
-> ImpTestM era (OMap GovActionId (GovActionState era))
forall a b. (a -> b) -> a -> b
$
                (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((OMap GovActionId (GovActionState era)
     -> Const r (OMap GovActionId (GovActionState era)))
    -> EpochState era -> Const r (EpochState era))
-> (OMap GovActionId (GovActionState era)
    -> Const r (OMap GovActionId (GovActionState era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL @era ((ConwayGovState era -> Const r (ConwayGovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((OMap GovActionId (GovActionState era)
     -> Const r (OMap GovActionId (GovActionState era)))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (OMap GovActionId (GovActionState era)
    -> Const r (OMap GovActionId (GovActionState era)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Const r (Proposals era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL ((Proposals era -> Const r (Proposals era))
 -> ConwayGovState era -> Const r (ConwayGovState era))
-> ((OMap GovActionId (GovActionState era)
     -> Const r (OMap GovActionId (GovActionState era)))
    -> Proposals era -> Const r (Proposals era))
-> (OMap GovActionId (GovActionState era)
    -> Const r (OMap GovActionId (GovActionState era)))
-> ConwayGovState era
-> Const r (ConwayGovState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OMap GovActionId (GovActionState era)
 -> Const r (OMap GovActionId (GovActionState era)))
-> Proposals era -> Const r (Proposals era)
forall era (f :: * -> *).
Functor f =>
(OMap GovActionId (GovActionState era)
 -> f (OMap GovActionId (GovActionState era)))
-> Proposals era -> f (Proposals era)
pPropsL
            ((GovActionId, GovActionState era) -> Anchor)
-> [(GovActionId, GovActionState era)] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProposalProcedure era -> Anchor
forall era. ProposalProcedure era -> Anchor
pProcAnchor (ProposalProcedure era -> Anchor)
-> ((GovActionId, GovActionState era) -> ProposalProcedure era)
-> (GovActionId, GovActionState era)
-> Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> ProposalProcedure era
forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure (GovActionState era -> ProposalProcedure era)
-> ((GovActionId, GovActionState era) -> GovActionState era)
-> (GovActionId, GovActionState era)
-> ProposalProcedure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovActionId, GovActionState era) -> GovActionState era
forall a b. (a, b) -> b
snd) (OMap GovActionId (GovActionState era)
-> [(GovActionId, GovActionState era)]
forall k v. Ord k => OMap k v -> [(k, v)]
OMap.assocList OMap GovActionId (GovActionState era)
props)
              [Anchor] -> [Anchor] -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` (ProposalProcedure era -> Anchor)
-> [ProposalProcedure era] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProposalProcedure era -> Anchor
forall era. ProposalProcedure era -> Anchor
pProcAnchor [ProposalProcedure era]
l
        [ProposalProcedure era] -> ImpM (LedgerSpec era) ()
checkProps [Item [ProposalProcedure era]
prop0, Item [ProposalProcedure era]
prop1]
        ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
ProposalProcedure era
prop2
        ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
ProposalProcedure era
prop3
        [ProposalProcedure era] -> ImpM (LedgerSpec era) ()
checkProps [Item [ProposalProcedure era]
prop0, Item [ProposalProcedure era]
prop1, Item [ProposalProcedure era]
prop2, Item [ProposalProcedure era]
prop3]
  where
    submitParameterChangeForest :: StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitParameterChangeForest = (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
submitGovActionForest ((StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
 -> StrictMaybe GovActionId
 -> [Tree ()]
 -> ImpTestM era [Tree GovActionId])
-> (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
forall a b. (a -> b) -> a -> b
$ StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction (StrictMaybe GovActionId -> ImpTestM era (GovAction era))
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
    submitParameterChangeTree :: StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree = (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
submitGovActionTree (StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction (StrictMaybe GovActionId -> ImpTestM era (GovAction era))
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction)
    submitConstitutionForest :: StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest = (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
submitGovActionForest ((StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
 -> StrictMaybe GovActionId
 -> [Tree ()]
 -> ImpTestM era [Tree GovActionId])
-> (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpM (LedgerSpec era) GovActionId)
-> (StrictMaybe GovActionId
    -> StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovActionId -> GovPurposeId 'ConstitutionPurpose era)
-> StrictMaybe GovActionId
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId
    paramAction :: StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction StrictMaybe GovActionId
p = StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
p (PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
500))

votingSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
votingSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
votingSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voting" (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
"VotersDoNotExist" (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
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      let ProtVer Version
major Natural
minor = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
      GovActionId
gaId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> GovAction era) -> ProtVer -> GovAction era
forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer Version
major (Natural -> Natural
forall a. Enum a => a -> a
succ Natural
minor)
      Credential 'HotCommitteeRole
hotCred <- KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred) GovActionId
gaId (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred]]
      KeyHash 'StakePool
poolId <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolId) GovActionId
gaId (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolId]]
      Credential 'DRepRole
dRepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
gaId (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred]]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep votes are removed" (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
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      GovActionId
gaId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      Credential 'DRepRole
dRepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
gaId
      GovActionState era
gas <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
      GovActionState era -> Map (Credential 'DRepRole) Vote
forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes GovActionState era
gas Map (Credential 'DRepRole) Vote
-> Map (Credential 'DRepRole) Vote -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [(Credential 'DRepRole
dRepCred, Vote
VoteNo)]
      let deposit :: Coin
deposit = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL
      Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxCert era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'DRepRole -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
dRepCred Coin
deposit])
      GovActionState era
gasAfterRemoval <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
      GovActionState era -> Map (Credential 'DRepRole) Vote
forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes GovActionState era
gasAfterRemoval Map (Credential 'DRepRole) Vote
-> Map (Credential 'DRepRole) Vote -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` []
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expired gov-actions" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      -- Voting for expired actions should fail
      (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
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
govActionId <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep)
        GovActionId
govActionId
        [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
VotingOnExpiredGovAction [(Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep, GovActionId
govActionId)]
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"non-existent gov-actions" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
govActionId <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      let dummyGaid :: GovActionId
dummyGaid = GovActionId
govActionId {gaidGovActionIx = GovActionIx 99} -- non-existent `GovActionId`
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep)
        GovActionId
dummyGaid
        [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty GovActionId -> ConwayGovPredFailure era
forall era. NonEmpty GovActionId -> ConwayGovPredFailure era
GovActionsDoNotExist (NonEmpty GovActionId -> ConwayGovPredFailure era)
-> NonEmpty GovActionId -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$ GovActionId -> NonEmpty GovActionId
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
dummyGaid]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on UpdateCommittee action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (Credential 'HotCommitteeRole
ccHot :| [Credential 'HotCommitteeRole]
_) <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      [(Credential 'ColdCommitteeRole, EpochInterval)]
newMembers <- ImpM
  (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochInterval)
-> ImpM
     (LedgerSpec era) [(Credential 'ColdCommitteeRole, EpochInterval)]
forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf (ImpM
   (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochInterval)
 -> ImpM
      (LedgerSpec era) [(Credential 'ColdCommitteeRole, EpochInterval)])
-> ImpM
     (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochInterval)
-> ImpM
     (LedgerSpec era) [(Credential 'ColdCommitteeRole, EpochInterval)]
forall a b. (a -> b) -> a -> b
$ do
        Credential 'ColdCommitteeRole
newCommitteeMember <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        Positive Word32
lifetime <- ImpM (LedgerSpec era) (Positive Word32)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        (Credential 'ColdCommitteeRole, EpochInterval)
-> ImpM
     (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochInterval)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'ColdCommitteeRole
newCommitteeMember, Word32 -> EpochInterval
EpochInterval Word32
lifetime)
      UnitInterval
threshold <- ImpM (LedgerSpec era) UnitInterval
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId
committeeUpdateId <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole, EpochInterval)]
newMembers UnitInterval
threshold
      let voter :: Voter
voter = Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHot
      Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        Voter
voter
        GovActionId
committeeUpdateId
        [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters [(Voter
voter, GovActionId
committeeUpdateId)]
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on NoConfidence action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      Credential 'HotCommitteeRole
hotCred :| [Credential 'HotCommitteeRole]
_ <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      GovActionId
gaid <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
      let voter :: Voter
voter = Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred
      Vote
-> Voter
-> GovActionId
-> ImpM
     (LedgerSpec era)
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
Vote
-> Voter
-> GovActionId
-> ImpTestM
     era
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
trySubmitVote Vote
VoteNo Voter
voter GovActionId
gaid
        ImpM
  (LedgerSpec era)
  (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
-> Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
forall a b. a -> Either a b
Left
          [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters [(Voter
voter, GovActionId
gaid)]
          ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member mixed with other voters can not vote on UpdateCommittee action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ImpM (LedgerSpec era) ()
forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"CC cannot ratify if below threshold" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> 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
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> 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
3
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
dRepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Credential 'ColdCommitteeRole
ccColdCred0 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
ccColdCred1 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
electionGovAction <-
        Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing
          Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
ccColdCred0, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
ccColdCred1, Word32 -> EpochInterval
EpochInterval Word32
10)
          ]
          (Integer
3 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
5)
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
electionGovAction
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
electionGovAction
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
electionGovAction
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      ImpM (LedgerSpec era) ()
forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Credential 'HotCommitteeRole
ccHotKey0 <- Credential 'ColdCommitteeRole
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
ccColdCred0
      Credential 'HotCommitteeRole
ccHotKey1 <- Credential 'ColdCommitteeRole
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
ccColdCred1
      Anchor
anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId
constitutionChangeId <-
        GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
          StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution
            StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
            Constitution
              { constitutionScript :: StrictMaybe ScriptHash
constitutionScript = StrictMaybe ScriptHash
forall a. StrictMaybe a
SNothing
              , constitutionAnchor :: Anchor
constitutionAnchor = Anchor
anchor
              }
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
constitutionChangeId
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHotKey0) GovActionId
constitutionChangeId
      Maybe (Credential 'HotCommitteeRole)
_ <- Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
ccColdCred0 StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHotKey1) GovActionId
constitutionChangeId
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
constitutionChangeId
      Maybe (GovActionState era) -> ImpM (LedgerSpec era) ()
forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr (Maybe (GovActionState era) -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (Maybe (GovActionState era))
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GovActionId -> ImpM (LedgerSpec era) (Maybe (GovActionState era))
forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId
constitutionChangeId
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
4
      Anchor
conAnchor <-
        SimpleGetter (NewEpochState era) Anchor
-> ImpM (LedgerSpec era) Anchor
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Anchor
 -> ImpM (LedgerSpec era) Anchor)
-> SimpleGetter (NewEpochState era) Anchor
-> ImpM (LedgerSpec era) Anchor
forall a b. (a -> b) -> a -> b
$
          (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL
            ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Anchor -> Const r Anchor)
    -> EpochState era -> Const r (EpochState era))
-> (Anchor -> Const r Anchor)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL
            ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Anchor -> Const r Anchor)
    -> LedgerState era -> Const r (LedgerState era))
-> (Anchor -> Const r Anchor)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Const r (UTxOState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL
            ((UTxOState era -> Const r (UTxOState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Anchor -> Const r Anchor)
    -> UTxOState era -> Const r (UTxOState era))
-> (Anchor -> Const r Anchor)
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> UTxOState era -> Const r (UTxOState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> UTxOState era -> Const r (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL
            ((ConwayGovState era -> Const r (ConwayGovState era))
 -> UTxOState era -> Const r (UTxOState era))
-> ((Anchor -> Const r Anchor)
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Anchor -> Const r Anchor)
-> UTxOState era
-> Const r (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Constitution era -> f (Constitution era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsConstitutionL
            ((Constitution era -> Const r (Constitution era))
 -> ConwayGovState era -> Const r (ConwayGovState era))
-> ((Anchor -> Const r Anchor)
    -> Constitution era -> Const r (Constitution era))
-> (Anchor -> Const r Anchor)
-> ConwayGovState era
-> Const r (ConwayGovState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Anchor -> Const r Anchor)
-> Constitution era -> Const r (Constitution era)
forall era (f :: * -> *).
Functor f =>
(Anchor -> f Anchor) -> Constitution era -> f (Constitution era)
constitutionAnchorL
      ImpM (LedgerSpec era) ()
forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Anchor
conAnchor Anchor -> Anchor -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldNotBe` Anchor
anchor
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can submit SPO votes" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      KeyHash 'StakePool
spoHash <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
spoHash
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      GovActionId
gaId <-
        StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
          PParamsUpdate era
forall a. Default a => a
def
            PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
100)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ @era Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoHash) GovActionId
gaId

constitutionSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
constitutionSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
constitutionSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Constitution proposals" (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
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"accepted for" (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
"empty PrevGovId before the first constitution is enacted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        --  Initial proposal does not need a GovPurposeId but after it is enacted, the
        --  following ones are not
        Maybe GovActionId
_ <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        -- Until the first proposal is enacted all proposals with empty GovPurposeIds are valid
        ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (Maybe GovActionId)
 -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"valid GovPurposeId" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        Constitution era
constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        GovActionId
gaidConstitutionProp <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing Constitution era
constitution Credential 'DRepRole
dRep NonEmpty (Credential 'HotCommitteeRole)
committeeMembers'
        Constitution era
constitution1 <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        ImpTestM era GovActionId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpTestM era GovActionId -> ImpM (LedgerSpec era) ())
-> ImpTestM era GovActionId -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution
            (GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovPurposeId 'ConstitutionPurpose era
 -> StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaidConstitutionProp)
            Constitution era
constitution1
            Credential 'DRepRole
dRep
            NonEmpty (Credential 'HotCommitteeRole)
committeeMembers'

    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"rejected for" (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
"empty PrevGovId after the first constitution was enacted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        Maybe GovActionId
mbGovActionId <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        Maybe GovActionId
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGovActionId ((GovActionId -> ImpM (LedgerSpec era) ())
 -> ImpM (LedgerSpec era) ())
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \GovActionId
govActionId -> do
          Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
govActionId
          NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
govActionId
          Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
          let invalidNewConstitutionGovAction :: GovAction era
invalidNewConstitutionGovAction =
                StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution
                  StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
                  Constitution era
constitution
          ProposalProcedure era
invalidNewConstitutionProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
invalidNewConstitutionGovAction
          ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            ProposalProcedure era
invalidNewConstitutionProposal
            [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
invalidNewConstitutionProposal
            ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"invalid index in GovPurposeId" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        Maybe GovActionId
mbGovActionId <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        Maybe GovActionId
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGovActionId ((GovActionId -> ImpM (LedgerSpec era) ())
 -> ImpM (LedgerSpec era) ())
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \GovActionId
govActionId -> do
          Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
          let invalidPrevGovActionId :: GovPurposeId 'ConstitutionPurpose era
invalidPrevGovActionId =
                -- Expected Ix = 0
                GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionId
govActionId {gaidGovActionIx = GovActionIx 1})
              invalidNewConstitutionGovAction :: GovAction era
invalidNewConstitutionGovAction =
                StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution
                  (GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'ConstitutionPurpose era
invalidPrevGovActionId)
                  Constitution era
constitution
          ProposalProcedure era
invalidNewConstitutionProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
invalidNewConstitutionGovAction
          ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            ProposalProcedure era
invalidNewConstitutionProposal
            [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
invalidNewConstitutionProposal
            ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"valid GovPurposeId but invalid purpose" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        Maybe GovActionId
mbGovActionId <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        Maybe GovActionId
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGovActionId ((GovActionId -> ImpM (LedgerSpec era) ())
 -> ImpM (LedgerSpec era) ())
-> (GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \GovActionId
govActionId -> do
          Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          let invalidNoConfidenceAction :: GovAction era
invalidNoConfidenceAction =
                StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> GovAction era
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovPurposeId 'CommitteePurpose era
 -> StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
govActionId
          ProposalProcedure era
invalidNoConfidenceProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
invalidNoConfidenceAction

          ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            ProposalProcedure era
invalidNoConfidenceProposal
            [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
invalidNoConfidenceProposal
            ]
  where
    submitConstitutionFailingBootstrap :: StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
prevGovId = do
      ProposalProcedure era
proposal <- (ProposalProcedure era, Constitution era) -> ProposalProcedure era
forall a b. (a, b) -> a
fst ((ProposalProcedure era, Constitution era)
 -> ProposalProcedure era)
-> ImpM (LedgerSpec era) (ProposalProcedure era, Constitution era)
-> ImpM (LedgerSpec era) (ProposalProcedure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (ProposalProcedure era, Constitution era)
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
prevGovId
      ProposalProcedure era
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal
        ProposalProcedure era
proposal
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [ConwayGovPredFailure era -> EraRuleFailure rule era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal)])

policySpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
policySpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
policySpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Policy" (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 -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"policy is respected by proposals" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      KeyHash 'Witness
keyHash <- ImpM (LedgerSpec era) (KeyHash 'Witness)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      ScriptHash
scriptHash <- NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript (NativeScript era -> ImpTestM era ScriptHash)
-> NativeScript era -> ImpTestM era ScriptHash
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (Timelock era -> StrictSeq (Timelock era)
forall a. a -> StrictSeq a
SSeq.singleton (KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature KeyHash 'Witness
keyHash))
      Anchor
anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId
_ <-
        StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution
          StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
          (Anchor -> StrictMaybe ScriptHash -> Constitution era
forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution Anchor
anchor (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash))
          Credential 'DRepRole
dRep
          NonEmpty (Credential 'HotCommitteeRole)
committeeMembers'
      ScriptHash
wrongScriptHash <-
        NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript (NativeScript era -> ImpTestM era ScriptHash)
-> NativeScript era -> ImpTestM era ScriptHash
forall a b. (a -> b) -> a -> b
$
          Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
1 (StrictSeq (NativeScript era) -> NativeScript era)
-> StrictSeq (NativeScript era) -> NativeScript era
forall a b. (a -> b) -> a -> b
$
            [Timelock era] -> StrictSeq (Timelock era)
forall a. [a] -> StrictSeq a
SSeq.fromList [StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf StrictSeq (Timelock era)
StrictSeq (NativeScript era)
forall a. Monoid a => a
mempty, StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf StrictSeq (Timelock era)
StrictSeq (NativeScript era)
forall a. Monoid a => a
mempty]
      String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"ParameterChange with correct policy succeeds" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        let pparamsUpdate :: PParamsUpdate era
pparamsUpdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Natural -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
1
        GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing PParamsUpdate era
pparamsUpdate (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash)) ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_

      String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"TreasuryWithdrawals with correct policy succeeds" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
        let withdrawals :: Map RewardAccount Coin
withdrawals = [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals Map RewardAccount Coin
withdrawals (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash)) ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_

      String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"ParameterChange with invalid policy fails" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        let pparamsUpdate :: PParamsUpdate era
pparamsUpdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Natural -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
2
        GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing PParamsUpdate era
pparamsUpdate (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash))
          ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProposalProcedure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpTestM era ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ProposalProcedure era
-> ImpTestM era ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash) (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash)]

      String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"TreasuryWithdrawals with invalid policy fails" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
        let withdrawals :: Map RewardAccount Coin
withdrawals = [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals Map RewardAccount Coin
withdrawals (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash))
          ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProposalProcedure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpTestM era ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ProposalProcedure era
-> ImpTestM era ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash) (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash)]

networkIdSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
networkIdSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
networkIdSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Network ID" (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
"Fails with invalid network ID in proposal return address" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
rewardCredential <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let badRewardAccount :: RewardAccount
badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential 'Staking
raCredential = Credential 'Staking
rewardCredential
              }
      ProposalProcedure era
proposal <- GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
forall era. GovAction era
InfoAction RewardAccount
badRewardAccount
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        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 =
                [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                    RewardAccount -> Network -> ConwayGovPredFailure era
forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                      RewardAccount
badRewardAccount
                      Network
Testnet
                ]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures =
                [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                    RewardAccount -> ConwayGovPredFailure era
forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist
                      RewardAccount
badRewardAccount
                , ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                    RewardAccount -> Network -> ConwayGovPredFailure era
forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                      RewardAccount
badRewardAccount
                      Network
Testnet
                ]
            }

withdrawalsSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
withdrawalsSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
withdrawalsSpec =
  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
"Fails predicate when treasury withdrawal has nonexistent return address" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      StrictMaybe ScriptHash
policy <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      RewardAccount
unregisteredRewardAccount <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) RewardAccount)
-> ImpM (LedgerSpec era) RewardAccount
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Credential 'Staking -> ImpM (LedgerSpec era) RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor (Credential 'Staking -> ImpM (LedgerSpec era) RewardAccount)
-> (KeyHash 'Staking -> Credential 'Staking)
-> KeyHash 'Staking
-> ImpM (LedgerSpec era) RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
      RewardAccount
registeredRewardAccount <- ImpM (LedgerSpec era) RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      let genPositiveCoin :: ImpM (LedgerSpec era) Coin
genPositiveCoin = Integer -> Coin
Coin (Integer -> Coin)
-> (Positive Integer -> Integer) -> Positive Integer -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> Coin)
-> ImpM (LedgerSpec era) (Positive Integer)
-> ImpM (LedgerSpec era) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Positive Integer)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      [(RewardAccount, Coin)]
withdrawals <-
        [ImpM (LedgerSpec era) (RewardAccount, Coin)]
-> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
          [ (RewardAccount
unregisteredRewardAccount,) (Coin -> (RewardAccount, Coin))
-> ImpM (LedgerSpec era) Coin
-> ImpM (LedgerSpec era) (RewardAccount, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
genPositiveCoin
          , (RewardAccount
registeredRewardAccount,) (Coin -> (RewardAccount, Coin))
-> ImpM (LedgerSpec era) Coin
-> ImpM (LedgerSpec era) (RewardAccount, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
genPositiveCoin
          ]
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals ([(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount, Coin)]
withdrawals) StrictMaybe ScriptHash
policy
      ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (Maybe GovActionId)
 -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        ProposalProcedure era
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal (SubmitFailureExpectation era
 -> ImpM (LedgerSpec era) (Maybe GovActionId))
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall a b. (a -> b) -> a -> b
$
          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 = [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
              , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures =
                  [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
                      NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [Item (NonEmpty RewardAccount)
RewardAccount
unregisteredRewardAccount]
                  ]
              }

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails with invalid network ID in withdrawal addresses" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
rewardCredential <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let badRewardAccount :: RewardAccount
badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential 'Staking
raCredential = Credential 'Staking
rewardCredential
              }
      ProposalProcedure era
proposal <-
        [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount
badRewardAccount, Integer -> Coin
Coin Integer
100_000_000)] ImpTestM era (GovAction era)
-> (GovAction era -> ImpTestM era (ProposalProcedure era))
-> ImpTestM era (ProposalProcedure era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal
      let idMismatch :: EraRuleFailure "LEDGER" era
idMismatch =
            ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
              Set RewardAccount -> Network -> ConwayGovPredFailure era
forall era.
Set RewardAccount -> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch (RewardAccount -> Set RewardAccount
forall a. a -> Set a
Set.singleton RewardAccount
badRewardAccount) Network
Testnet
          returnAddress :: EraRuleFailure "LEDGER" era
returnAddress =
            ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
              NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [Item (NonEmpty RewardAccount)
RewardAccount
badRewardAccount]
      ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (Maybe GovActionId)
 -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        ProposalProcedure era
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal (SubmitFailureExpectation era
 -> ImpM (LedgerSpec era) (Maybe GovActionId))
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall a b. (a -> b) -> a -> b
$
          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 = [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal, Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
idMismatch]
              , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
returnAddress, Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
EraRuleFailure "LEDGER" era
idMismatch]
              }

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for empty withdrawals" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [] ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
expectZeroTreasuryFailurePostBootstrap

      RewardAccount
rwdAccount1 <- ImpM (LedgerSpec era) RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount
rwdAccount1, Coin
forall t. Val t => t
zero)] ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
expectZeroTreasuryFailurePostBootstrap

      RewardAccount
rwdAccount2 <- ImpM (LedgerSpec era) RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      let withdrawals :: [(RewardAccount, Coin)]
withdrawals = [(RewardAccount
rwdAccount1, Coin
forall t. Val t => t
zero), (RewardAccount
rwdAccount2, Coin
forall t. Val t => t
zero)]

      [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount, Coin)]
withdrawals ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
expectZeroTreasuryFailurePostBootstrap

      GovAction era
wdrls <- [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction ([(RewardAccount, Coin)] -> ImpTestM era (GovAction era))
-> [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall a b. (a -> b) -> a -> b
$ [(RewardAccount, Coin)]
withdrawals [(RewardAccount, Coin)]
-> [(RewardAccount, Coin)] -> [(RewardAccount, Coin)]
forall a. [a] -> [a] -> [a]
++ [(RewardAccount
rwdAccount2, Integer -> Coin
Coin Integer
100_000)]
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
wdrls
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal]
  where
    expectZeroTreasuryFailurePostBootstrap :: GovAction era -> ImpM (LedgerSpec era) ()
expectZeroTreasuryFailurePostBootstrap GovAction era
wdrls = do
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
wdrls
      ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (Maybe GovActionId)
 -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        ProposalProcedure era
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal (SubmitFailureExpectation era
 -> ImpM (LedgerSpec era) (Maybe GovActionId))
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall a b. (a -> b) -> a -> b
$
          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 = [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal]
              , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
wdrls]
              }

    disallowedProposalFailure :: ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure = ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> (ProposalProcedure era -> ConwayGovPredFailure era)
-> ProposalProcedure era
-> EraRuleFailure "LEDGER" era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap

-- =========================================================
-- Proposing a HardFork should always use a new ProtVer that
-- can follow the one installed in the previous HardFork action.

-- | Tests the first hardfork in the Conway era where the PrevGovActionID is SNothing
firstHardForkFollows ::
  forall era.
  (ShelleyEraImp era, ConwayEraTxBody era) =>
  (ProtVer -> ProtVer) ->
  ImpTestM era ()
firstHardForkFollows :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
computeNewFromOld = do
  ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  GovAction era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ (GovAction era -> ImpTestM era ())
-> GovAction era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
computeNewFromOld ProtVer
protVer)

-- | Negative (deliberatey failing) first hardfork in the Conway era where the PrevGovActionID is SNothing
firstHardForkCantFollow ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  ImpTestM era ()
firstHardForkCantFollow :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
firstHardForkCantFollow = do
  ProtVer
protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 :: ProtVer
protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 :: ProtVer
protver2 = ProtVer -> ProtVer
cantFollow ProtVer
protver1
  ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
protver2
  ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
    ProposalProcedure era
proposal
    [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
        StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$
          Mismatch
            { mismatchSupplied :: ProtVer
mismatchSupplied = ProtVer
protver2
            , mismatchExpected :: ProtVer
mismatchExpected = ProtVer
protver0
            }
    ]

-- | Tests a second hardfork in the Conway era where the PrevGovActionID is SJust
secondHardForkFollows ::
  forall era.
  (ShelleyEraImp era, ConwayEraTxBody era) =>
  (ProtVer -> ProtVer) ->
  ImpTestM era ()
secondHardForkFollows :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
computeNewFromOld = do
  ProtVer
protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 :: ProtVer
protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 :: ProtVer
protver2 = ProtVer -> ProtVer
computeNewFromOld ProtVer
protver1
  GovActionId
gaid1 <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
protver1
  GovAction era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ (GovAction era -> ImpTestM era ())
-> GovAction era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaid1)) ProtVer
protver2

-- | Negative (deliberatey failing) first hardfork in the Conway era where the PrevGovActionID is SJust
secondHardForkCantFollow ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  ImpTestM era ()
secondHardForkCantFollow :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
secondHardForkCantFollow = do
  ProtVer
protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 :: ProtVer
protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 :: ProtVer
protver2 = ProtVer -> ProtVer
cantFollow ProtVer
protver1
  GovActionId
gaid1 <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
protver1) ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
  GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaid1)) ProtVer
protver2)
    ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProposalProcedure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ImpTestM era ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ProposalProcedure era
-> ImpTestM era ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
      ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
      [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
          StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow (GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaid1)) (Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$
            Mismatch
              { mismatchSupplied :: ProtVer
mismatchSupplied = ProtVer
protver2
              , mismatchExpected :: ProtVer
mismatchExpected = ProtVer
protver1
              }
      ]

ccVoteOnConstitutionFailsWithMultipleVotes ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes = do
  (Credential 'HotCommitteeRole
ccCred :| [Credential 'HotCommitteeRole]
_) <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
  (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
  Credential 'DRepRole
drepCred2 <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
  Credential 'ColdCommitteeRole
newCommitteeMember <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  GovActionId
committeeProposal <-
    Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
newCommitteeMember, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
  let
    voteTx :: Tx era
voteTx =
      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
& (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody era -> Identity (TxBody era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
            ((VotingProcedures era -> Identity (VotingProcedures era))
 -> TxBody era -> Identity (TxBody era))
-> VotingProcedures era -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
              ( [(Voter, Map GovActionId (VotingProcedure era))]
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred2
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccCred
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteNo StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ]
              )
  String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Try to vote as a committee member" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
      Tx era
voteTx
      [ ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
          NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters [(Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccCred, GovActionId
committeeProposal)]
      ]

bootstrapPhaseSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
bootstrapPhaseSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
bootstrapPhaseSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposing and voting" (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
"Parameter change" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      GovActionId
gid <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol} {era}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork initiation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      GovActionId
gid <-
        GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$
          StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer
curProtVer {pvMajor = nextMajorVersion})
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol} {era}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Info action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Treasury withdrawal" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      GovAction era
action <- [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
      ProposalProcedure era
proposal <- GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
action RewardAccount
rewardAccount
      ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
      ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"UpdateCommittee" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
cCred <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      let newMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newMembers = [(Credential 'ColdCommitteeRole
cCred, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
30))]
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newMembers (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NewConstitution" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      Constitution era
constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      ProposalProcedure era
proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing Constitution era
constitution
      ProposalProcedure era -> ImpM (LedgerSpec era) ()
forall {era} {rule :: Symbol}.
(PredicateFailure (EraRule "LEDGER" era)
 ~ PredicateFailure (EraRule rule era),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 ToExpr (PredicateFailure (EraRule rule era)),
 DecCBOR (PredicateFailure (EraRule rule era)),
 EncCBOR (PredicateFailure (EraRule rule era)),
 NFData (PredicateFailure (EraRule rule era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Eq (PredicateFailure (EraRule rule era)),
 Show (PredicateFailure (EraRule rule era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
  where
    checkProposalFailure :: ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal =
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpTestM era ())
-> SubmitFailureExpectation era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
        NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [ConwayGovPredFailure era -> EraRuleFailure rule era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure rule era)
-> ConwayGovPredFailure era -> EraRuleFailure rule era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
    checkVotingFailure :: Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure Voter
voter GovActionId
gid = do
      Vote
vote <- ImpM (LedgerSpec era) Vote
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      Vote
-> Voter
-> GovActionId
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
Vote
-> Voter
-> GovActionId
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote Voter
voter GovActionId
gid (SubmitFailureExpectation era -> ImpM (LedgerSpec era) ())
-> SubmitFailureExpectation era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [ConwayGovPredFailure era -> EraRuleFailure rule era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure rule era)
-> ConwayGovPredFailure era -> EraRuleFailure rule era
forall a b. (a -> b) -> a -> b
$ NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap [(Voter
voter, GovActionId
gid)]]