{-# 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
  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))
proposalsSpec
  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))
policySpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
predicateFailuresSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec
  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))
hardForkSpec
  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))
networkIdSpec
  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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unknown CostModels" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Are accepted" forall a b. (a -> b) -> a -> b
$ do
      CostModels
costModels <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL
      CostModels
newCostModels <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
gai <-
        forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$
          forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
ppuCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust CostModels
newCostModels
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gai
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
      forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Predicate failures" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ProposalReturnAccountDoesNotExist" forall a b. (a -> b) -> a -> b
$ do
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall era. GovAction era
InfoAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
      RewardAccount
unregisteredRewardAccount <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj

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

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

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ProposalDepositIncorrect" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      Coin
actionDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
      Anchor
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      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 = forall era. GovAction era
InfoAction
            , pProcDeposit :: Coin
pProcDeposit = Coin
actionDeposit forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
            , pProcAnchor :: Anchor
pProcAnchor = Anchor
anchor
            }
        )
        [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
            forall era. Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect forall a b. (a -> b) -> a -> b
$
              Mismatch
                { mismatchSupplied :: Coin
mismatchSupplied = Coin
actionDeposit forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
                , mismatchExpected :: Coin
mismatchExpected = Coin
actionDeposit
                }
        ]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ConflictingCommitteeUpdate" forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
committeeC <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
      let action :: GovAction era
action =
            forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
              forall a. StrictMaybe a
SNothing
              (forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
committeeC)
              (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 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      let expectedFailure :: EraRuleFailure "LEDGER" era
expectedFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
Set (Credential 'ColdCommitteeRole) -> ConwayGovPredFailure era
ConflictingCommitteeUpdate forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
committeeC
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
action
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap forall a b. (a -> b) -> a -> b
$
          FailBoth
            { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures = [ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure ProposalProcedure era
proposal, EraRuleFailure "LEDGER" era
expectedFailure]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [EraRuleFailure "LEDGER" era
expectedFailure]
            }
  where
    disallowedProposalFailure :: ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"HardFork" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the first one (doesn't have a GovPurposeId) " forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" (forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
minorFollow)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" (forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
majorFollow)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" forall era.
(ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
firstHardForkCantFollow
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the second one (has a GovPurposeId)" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" (forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
minorFollow)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" (forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
majorFollow)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PParamUpdate" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PPU needs to be wellformed" 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 = forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
lbl forall a b. (a -> b) -> a -> b
$ do
            let ppUpdate :: PParamsUpdate era
ppUpdate =
                  forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                    forall a b. a -> (a -> b) -> b
& ASetter (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
lenz forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust a
val
            GovAction era
ga <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction forall a. StrictMaybe a
SNothing PParamsUpdate era
ppUpdate
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga
              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip
                forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
                [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal GovAction era
ga]
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxBBSizeL cannot be 0"
        forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL
        Word32
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxTxSizeL cannot be 0"
        forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL
        Word32
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxBHSizeL cannot be 0"
        forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL
        Word16
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuMaxValSizeL cannot be 0"
        forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxValSizeL
        Natural
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuCollateralPercentageL cannot be 0"
        forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCollateralPercentageL
        Natural
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuCommitteeMaxTermLengthL cannot be 0"
        forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuCommitteeMaxTermLengthL
        forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuGovActionLifetimeL cannot be 0"
        forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuGovActionLifetimeL
        forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
0
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuPoolDepositL cannot be 0"
        forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL
        forall t. Val t => t
zero
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuGovActionDepositL cannot be 0"
        forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL
        forall t. Val t => t
zero
      forall {rule :: Symbol} {era} {era} {a} {a}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era, InjectRuleFailure rule ConwayGovPredFailure era,
 EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpInit (LedgerSpec era))
testMalformedProposal
        String
"ppuDRepDepositL cannot be 0"
        forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL
        forall t. Val t => t
zero
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"PPU cannot be empty" forall a b. (a -> b) -> a -> b
$ do
        GovAction era
ga <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction forall a. StrictMaybe a
SNothing forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposals" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Consistency" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals submitted without proper parent fail" 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 forall a b. (a -> b) -> a -> b
$ Word16 -> GovActionIx
GovActionIx forall a b. (a -> b) -> a -> b
$ Word16
gaix forall a. Num a => a -> a -> a
+ Word16
999
        Node GovActionId
p1 [Node GovActionId
_p11 []] <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        GovAction era
parameterChangeAction <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ GovActionId -> GovActionId
mkCorruptGovActionId GovActionId
p1)
        ProposalProcedure era
parameterChangeProposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
parameterChangeAction
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
          ProposalProcedure era
parameterChangeProposal
          [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
parameterChangeProposal
          ]
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire" forall a b. (a -> b) -> a -> b
$ do
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
4
        GovActionId
p1 <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction forall a. StrictMaybe a
SNothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        Tree GovActionId
a <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            (forall a. a -> StrictMaybe a
SJust GovActionId
p1)
            forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ forall a. a -> [Tree a] -> Tree a
Node () []
              , forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        Tree GovActionId
b <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ forall a. a -> [Tree a] -> Tree a
Node
                            forall a. StrictMaybe a
SNothing
                            [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p1) [forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
a]
                            , forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
b
                            ]
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         ]
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing [forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree GovActionId
b]
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         ]
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire over multiple rounds" forall a b. (a -> b) -> a -> b
$ do
        let ppupdate :: PParamsUpdate era
ppupdate = forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000)
        let submitInitialProposal :: ImpM (LedgerSpec era) GovActionId
submitInitialProposal = forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
ppupdate
        let submitChildProposal :: GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
parent = forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange (forall a. a -> StrictMaybe a
SJust GovActionId
parent) PParamsUpdate era
ppupdate
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL 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
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ forall a. a -> [Tree a] -> Tree a
Node
                            forall a. StrictMaybe a
SNothing
                            [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p1) []
                            ]
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         ]

        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
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ forall a. a -> [Tree a] -> Tree a
Node
                            forall a. StrictMaybe a
SNothing
                            [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p1) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p11) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p2) []
                            ]
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         ]

        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
            (forall a. a -> StrictMaybe a
SJust GovActionId
p11)
            [ forall a. a -> [Tree a] -> Tree a
Node () []
            , forall a. a -> [Tree a] -> Tree a
Node () []
            ]
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [ forall a. a -> [Tree a] -> Tree a
Node
                            forall a. StrictMaybe a
SNothing
                            [ forall a. a -> [Tree a] -> Tree a
Node
                                (forall a. a -> StrictMaybe a
SJust GovActionId
p1)
                                [ forall a. a -> [Tree a] -> Tree a
Node
                                    (forall a. a -> StrictMaybe a
SJust GovActionId
p11)
                                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree GovActionId]
a)
                                ]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p2) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p21) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p3) []
                            ]
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         , forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing []
                         ]

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

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

        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, 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
            forall a. StrictMaybe a
SNothing
            [forall a. a -> [Tree a] -> Tree a
Node () []]
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Int -> a
!! Int
3) forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> [Tree a] -> Tree a
Node forall a. StrictMaybe a
SNothing [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p1) []]
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
p1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
p1
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Int -> a
!! Int
3) forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId
p1) []
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals are stored in the expected order" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
1_000_000_000
        EnactState era
ens <- forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
        RewardAccount
returnAddr <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
        [(RewardAccount, Coin)]
withdrawal <-
          (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RewardAccount
returnAddr,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Positive a -> a
getPositive
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary :: ImpTestM era (Positive Integer))
        GovAction era
wdrl <- 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] <-
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal
            ( [ forall era. GovAction era
InfoAction
              , forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (EnactState era
ens forall s a. s -> Getting a s a -> a
^. forall era.
Lens'
  (EnactState era) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
ensPrevCommitteeL)
              , forall era. GovAction era
InfoAction
              , GovAction era
wdrl
              ] ::
                [GovAction era]
            )
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
prop0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
prop1
        let
          checkProps :: [ProposalProcedure era] -> ImpM (LedgerSpec era) ()
checkProps [ProposalProcedure era]
l = do
            OMap GovActionId (GovActionState era)
props <-
              forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
                forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (Proposals era) (OMap GovActionId (GovActionState era))
pPropsL
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. ProposalProcedure era -> Anchor
pProcAnchor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k v. Ord k => OMap k v -> [(k, v)]
OMap.assocList OMap GovActionId (GovActionState era)
props)
              forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era. ProposalProcedure era -> Anchor
pProcAnchor [ProposalProcedure era]
l
        [ProposalProcedure era] -> ImpM (LedgerSpec era) ()
checkProps [Item [ProposalProcedure era]
prop0, Item [ProposalProcedure era]
prop1]
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [ProposalProcedure era]
prop2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ Item [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 = forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
submitGovActionForest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
    submitParameterChangeTree :: StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree = forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
submitGovActionTree (forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction)
    submitConstitutionForest :: StrictMaybe GovActionId
-> [Tree ()] -> ImpTestM era [Tree GovActionId]
submitConstitutionForest = forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> [Tree ()]
-> ImpTestM era [Tree GovActionId]
submitGovActionForest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId
    paramAction :: StrictMaybe GovActionId -> ImpTestM era (GovAction era)
paramAction StrictMaybe GovActionId
p = forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
p (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voting" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"VotersDoNotExist" forall a b. (a -> b) -> a -> b
$ do
      PParams era
pp <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      let ProtVer Version
major Natural
minor = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
      GovActionId
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer Version
major (forall a. Enum a => a -> a
succ Natural
minor)
      Credential 'HotCommitteeRole
hotCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      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 forall a b. (a -> b) -> a -> b
$
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred]]
      KeyHash 'StakePool
poolId <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      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 forall a b. (a -> b) -> a -> b
$
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolId]]
      Credential 'DRepRole
dRepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let votersDoNotExistFailure :: EraRuleFailure "LEDGER" era
votersDoNotExistFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist [Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred]
      Vote
vote <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      forall era.
ConwayEraImp era =>
Vote
-> Voter
-> GovActionId
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
gaId forall a b. (a -> b) -> a -> b
$
        forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap forall a b. (a -> b) -> a -> b
$
          FailBoth
            { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures =
                [EraRuleFailure "LEDGER" era
votersDoNotExistFailure, NonEmpty (Voter, GovActionId) -> EraRuleFailure "LEDGER" era
disallowedVoteFailure [(Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred, GovActionId
gaId)]]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures = [EraRuleFailure "LEDGER" era
votersDoNotExistFailure]
            }
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep votes are removed" forall a b. (a -> b) -> a -> b
$ do
      PParams era
pp <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      GovActionId
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall era. GovAction era
InfoAction
      Credential 'DRepRole
dRepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      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 <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
      forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes GovActionState era
gas 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 forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$ forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
dRepCred Coin
deposit])
      GovActionState era
gasAfterRemoval <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
      forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes GovActionState era
gasAfterRemoval forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` []
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expired gov-actions" forall a b. (a -> b) -> a -> b
$ do
      -- Voting for expired actions should fail
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL 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
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall era. GovAction era
InfoAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      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
        [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
VotingOnExpiredGovAction [(Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep, GovActionId
govActionId)]
        ]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"non-existent gov-actions" forall a b. (a -> b) -> a -> b
$ do
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      GovActionId
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall era. GovAction era
InfoAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      let dummyGaid :: GovActionId
dummyGaid = GovActionId
govActionId {gaidGovActionIx :: GovActionIx
gaidGovActionIx = Word16 -> GovActionIx
GovActionIx Word16
99} -- non-existent `GovActionId`
      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
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty GovActionId -> ConwayGovPredFailure era
GovActionsDoNotExist forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
dummyGaid]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on UpdateCommittee action" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      (Credential 'HotCommitteeRole
ccHot :| [Credential 'HotCommitteeRole]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      [(Credential 'ColdCommitteeRole, EpochInterval)]
newMembers <- forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf forall a b. (a -> b) -> a -> b
$ do
        Credential 'ColdCommitteeRole
newCommitteeMember <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        Positive Word32
lifetime <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'ColdCommitteeRole
newCommitteeMember, Word32 -> EpochInterval
EpochInterval Word32
lifetime)
      UnitInterval
threshold <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId
committeeUpdateId <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole, EpochInterval)]
newMembers UnitInterval
threshold
      let voter :: Voter
voter = Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHot
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        Voter
voter
        GovActionId
committeeUpdateId
        [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters [(Voter
voter, GovActionId
committeeUpdateId)]
        ]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on NoConfidence action" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      Credential 'HotCommitteeRole
hotCred :| [Credential 'HotCommitteeRole]
_ <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      GovActionId
gaid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
      let voter :: Voter
voter = Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred
      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
        forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a b. a -> Either a b
Left
          [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters [(Voter
voter, GovActionId
gaid)]
          ]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member mixed with other voters can not vote on UpdateCommittee action" forall a b. (a -> b) -> a -> b
$
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"CC cannot ratify if below threshold" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
3
          forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
dRepCred, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Credential 'ColdCommitteeRole
ccColdCred0 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
ccColdCred1 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
electionGovAction <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
ccColdCred0, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
ccColdCred1, Word32 -> EpochInterval
EpochInterval Word32
10)
          ]
          (Integer
3 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
5)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
electionGovAction
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
electionGovAction
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
electionGovAction
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Credential 'HotCommitteeRole
ccHotKey0 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
ccColdCred0
      Credential 'HotCommitteeRole
ccHotKey1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
ccColdCred1
      Anchor
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId
constitutionChangeId <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$
          forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution
            forall a. StrictMaybe a
SNothing
            Constitution
              { constitutionScript :: StrictMaybe ScriptHash
constitutionScript = forall a. StrictMaybe a
SNothing
              , constitutionAnchor :: Anchor
constitutionAnchor = Anchor
anchor
              }
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
constitutionChangeId
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHotKey0) GovActionId
constitutionChangeId
      Maybe (Credential 'HotCommitteeRole)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
ccColdCred0 forall a. StrictMaybe a
SNothing
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccHotKey1) GovActionId
constitutionChangeId
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
constitutionChangeId
      forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId
constitutionChangeId
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
4
      Anchor
conAnchor <-
        forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
          forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (Constitution era) Anchor
constitutionAnchorL
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Anchor
conAnchor forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldNotBe` Anchor
anchor
  where
    disallowedVoteFailure :: NonEmpty (Voter, GovActionId) -> EraRuleFailure "LEDGER" era
disallowedVoteFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap

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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Constitution proposals" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"accepted for" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"empty PrevGovId before the first constitution is enacted" 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
_ <- forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap forall a. StrictMaybe a
SNothing
        -- Until the first proposal is enacted all proposals with empty GovPurposeIds are valid
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap forall a. StrictMaybe a
SNothing
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"valid GovPurposeId" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, 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 <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        GovActionId
gaidConstitutionProp <- forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution forall a. StrictMaybe a
SNothing Constitution era
constitution Credential 'DRepRole
dRep NonEmpty (Credential 'HotCommitteeRole)
committeeMembers'
        Constitution era
constitution1 <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
          forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution
            (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaidConstitutionProp)
            Constitution era
constitution1
            Credential 'DRepRole
dRep
            NonEmpty (Credential 'HotCommitteeRole)
committeeMembers'

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

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

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

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

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"TreasuryWithdrawals with invalid policy fails" forall a b. (a -> b) -> a -> b
$ do
        RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
        let withdrawals :: Map RewardAccount Coin
withdrawals = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals Map RewardAccount Coin
withdrawals (forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash))
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash (forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash) (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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Network ID" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails with invalid network ID in proposal return address" forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
rewardCredential <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount forall era. GovAction era
InfoAction RewardAccount
badRewardAccount
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap forall a b. (a -> b) -> a -> b
$
          FailBoth
            { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures =
                [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
                    forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                      RewardAccount
badRewardAccount
                      Network
Testnet
                ]
            , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures =
                [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
                    forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist
                      RewardAccount
badRewardAccount
                , forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
                    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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Withdrawals" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails predicate when treasury withdrawal has nonexistent return address" forall a b. (a -> b) -> a -> b
$ do
      StrictMaybe ScriptHash
policy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      RewardAccount
unregisteredRewardAccount <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
      RewardAccount
registeredRewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      let genPositiveCoin :: ImpM (LedgerSpec era) Coin
genPositiveCoin = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Positive a -> a
getPositive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      [(RewardAccount, Coin)]
withdrawals <-
        forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ (RewardAccount
unregisteredRewardAccount,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
genPositiveCoin
          , (RewardAccount
registeredRewardAccount,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
genPositiveCoin
          ]
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall a b. (a -> b) -> a -> b
$ forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount, Coin)]
withdrawals) StrictMaybe ScriptHash
policy
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
        forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
          forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap forall a b. (a -> b) -> a -> b
$
            FailBoth
              { bootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures = [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
              , postBootstrapFailures :: NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures =
                  [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
                      forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [RewardAccount
unregisteredRewardAccount]
                  ]
              }

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

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

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

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

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

      GovAction era
wdrls <- forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction forall a b. (a -> b) -> a -> b
$ [(RewardAccount, Coin)]
withdrawals forall a. [a] -> [a] -> [a]
++ [(RewardAccount
rwdAccount2, Integer -> Coin
Coin Integer
100_000)]
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
wdrls
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
wdrls
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
        forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
          forall era. FailBoth era -> SubmitFailureExpectation era
FailBootstrapAndPostBootstrap 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 = [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
wdrls]
              }

    disallowedProposalFailure :: ProposalProcedure era -> EraRuleFailure "LEDGER" era
disallowedProposalFailure = forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation 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 <- 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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
protver2
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
    ProposalProcedure era
proposal
    [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
        forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow forall a. StrictMaybe a
SNothing 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 <- 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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
protver1
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (forall a. a -> StrictMaybe a
SJust (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 <- 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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
protver1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaid1)) ProtVer
protver2)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
      [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
          forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow (forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaid1)) 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]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
  (Credential 'DRepRole
drepCred, 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 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
  Credential 'ColdCommitteeRole
newCommitteeMember <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  GovActionId
committeeProposal <-
    forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
newCommitteeMember, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
  let
    voteTx :: Tx era
voteTx =
      forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
        forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
              ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred2
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccCred
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteNo forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes forall a. StrictMaybe a
SNothing
                    )
                  ]
              )
  forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Try to vote as a committee member" forall a b. (a -> b) -> a -> b
$
    forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
      Tx era
voteTx
      [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
          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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposing and voting" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Parameter change" forall a b. (a -> b) -> a -> b
$ do
      GovActionId
gid <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction forall a. StrictMaybe a
SNothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall {rule :: Symbol} {era} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork initiation" forall a b. (a -> b) -> a -> b
$ do
      ProtVer
curProtVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      GovActionId
gid <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$
          forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer
curProtVer {pvMajor :: Version
pvMajor = Version
nextMajorVersion})
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall {rule :: Symbol} {era} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Info action" forall a b. (a -> b) -> a -> b
$ do
      GovActionId
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall era. GovAction era
InfoAction
      (Credential 'HotCommitteeRole
committee :| [Credential 'HotCommitteeRole]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committee) GovActionId
gid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Treasury withdrawal" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      GovAction era
action <- forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
action RewardAccount
rewardAccount
      forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" forall a b. (a -> b) -> a -> b
$ do
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
      forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"UpdateCommittee" forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
cCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
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 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newMembers (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NewConstitution" forall a b. (a -> b) -> a -> b
$ do
      Constitution era
constitution <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution forall a. StrictMaybe a
SNothing Constitution era
constitution
      forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
  where
    checkProposalFailure :: ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal =
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
    checkVotingFailure :: Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure Voter
voter GovActionId
gid = do
      Vote
vote <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      forall era.
ConwayEraImp era =>
Vote
-> Voter
-> GovActionId
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote Voter
voter GovActionId
gid forall a b. (a -> b) -> a -> b
$
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap [(Voter
voter, GovActionId
gid)]]