{-# 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 (EraCrypto era))
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      GovActionId (EraCrypto era)
gai <-
        forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs GovActionId (EraCrypto era)
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era)
unregisteredRewardAccount <- forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj

      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount forall era. GovAction era
InfoAction RewardAccount (EraCrypto era)
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 (EraCrypto era) -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist RewardAccount (EraCrypto era)
unregisteredRewardAccount]

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ExpirationEpochTooSmall" forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole (EraCrypto era)
committeeC <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      let expiration :: EpochNo
expiration = Word64 -> EpochNo
EpochNo Word64
1
          action :: GovAction era
action =
            forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)
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 (EraCrypto era)) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
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 (EraCrypto era)
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 (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
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 (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
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 (EraCrypto era)
committeeC <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
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 (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
              forall a. StrictMaybe a
SNothing
              (forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole (EraCrypto era)
committeeC)
              (forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era))
-> ConwayGovPredFailure era
ConflictingCommitteeUpdate forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era))
-> 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 (EraCrypto era))
-> 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 c -> GovActionId c
            mkCorruptGovActionId :: forall c. GovActionId c -> GovActionId c
mkCorruptGovActionId (GovActionId TxId c
txi (GovActionIx Word16
gaix)) =
              forall c. TxId c -> GovActionIx -> GovActionId c
GovActionId TxId c
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 (EraCrypto era)
p1 [Node GovActionId (EraCrypto era)
_p11 []] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
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 (EraCrypto era))
-> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall c. GovActionId c -> GovActionId c
mkCorruptGovActionId GovActionId (EraCrypto era)
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 (EraCrypto era)
p1 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
submitGovAction
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
        Tree (GovActionId (EraCrypto era))
a <-
          StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
submitParameterChangeTree
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))
b <-
          StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
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 (EraCrypto era))))
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 (EraCrypto era)
p1) [forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree (GovActionId (EraCrypto era))
a]
                            , forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree (GovActionId (EraCrypto era))
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 (EraCrypto era))))
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 (EraCrypto era))
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 (EraCrypto era))
submitInitialProposal = forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
ppupdate
        let submitChildProposal :: GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
parent = forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p1 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era)
p2 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p11 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p1
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
p1) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p11) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p3 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p21 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p2
        [Tree (GovActionId (EraCrypto era))]
a <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitParameterChangeForest
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p1)
                                [ forall a. a -> [Tree a] -> Tree a
Node
                                    (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))]
a)
                                ]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p2) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p4 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p31 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p3
        GovActionId (EraCrypto era)
p211 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p21
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
p1)
                                [ forall a. a -> [Tree a] -> Tree a
Node
                                    (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))]
a)
                                ]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p2) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []]]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p3) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p31) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p2) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []]]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p3) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p31) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p5 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p41 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p4
        GovActionId (EraCrypto era)
p311 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p31
        GovActionId (EraCrypto era)
p212 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p21
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
p2)
                                [ forall a. a -> [Tree a] -> Tree a
Node
                                    (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21)
                                    [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []
                                    , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p212) []
                                    ]
                                ]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p3) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p31) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p311) []]]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p4) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p41) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p6 <- ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p51 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p5
        GovActionId (EraCrypto era)
p411 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p41
        GovActionId (EraCrypto era)
p312 <- GovActionId (EraCrypto era)
-> ImpM (LedgerSpec era) (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p31
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
p3)
                                [ forall a. a -> [Tree a] -> Tree a
Node
                                    (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p31)
                                    [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p311) []
                                    , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p312) []
                                    ]
                                ]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p4) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p41) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p411) []]]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p5) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p51) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p4) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p41) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p411) []]]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p5) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p51) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p5) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p51) []]
                            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
dRep, Credential 'HotCommitteeRole (EraCrypto era)
committeeMember, GovPurposeId GovActionId (EraCrypto era)
committeeGovActionId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        a :: [Tree (GovActionId (EraCrypto era))]
a@[ Item [Tree (GovActionId (EraCrypto era))]
_
            , b :: Item [Tree (GovActionId (EraCrypto era))]
b@(Node GovActionId (EraCrypto era)
p2 [Tree (GovActionId (EraCrypto era))]
_)
            ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))]
a)
                         ]
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committeeMember) GovActionId (EraCrypto era)
p2
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
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 (EraCrypto era)
committeeGovActionId) []
                         , forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        a :: [Tree (GovActionId (EraCrypto era))]
a@[ Item [Tree (GovActionId (EraCrypto era))]
c
            , Node
                GovActionId (EraCrypto era)
p2
                [ Node GovActionId (EraCrypto era)
p21 []
                  , Node GovActionId (EraCrypto era)
p22 []
                  ]
            , Node GovActionId (EraCrypto era)
p3 []
            ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
p2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
p2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
p21
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
p21
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
p3
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era))]
a)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        GovActionId (EraCrypto era)
p4 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitution forall a. StrictMaybe a
SNothing
        GovActionId (EraCrypto era)
p31 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
p3)
        GovActionId (EraCrypto era)
p211 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era))]
c
            , forall a. a -> [Tree a] -> Tree a
Node
                (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p2)
                [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []]
                , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p22) []
                ]
            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p3) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p31) []]
            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p2)
            [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []]
            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p22) []
            ]
        [ Node GovActionId (EraCrypto era)
p212 []
          , Node GovActionId (EraCrypto era)
p213 []
          , Node GovActionId (EraCrypto era)
p214 []
          ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitConstitutionForest
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
p2131 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
p213)
        GovActionId (EraCrypto era)
p2141 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
p214)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
p212
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
p2)
            [ forall a. a -> [Tree a] -> Tree a
Node
                (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p21)
                [ forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p211) []
                , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p212) []
                , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p213) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p2131) []]
                , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p214) [forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p2141) []]
                ]
            , forall a. a -> [Tree a] -> Tree a
Node (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
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 (EraCrypto era))]
a@( Node
                GovActionId (EraCrypto era)
p1
                [ b :: Item [Tree (GovActionId (EraCrypto era))]
b@( Node
                        GovActionId (EraCrypto era)
p11
                        [ Node GovActionId (EraCrypto era)
_p111 []
                          , Node GovActionId (EraCrypto era)
_p112 []
                          ]
                      )
                  ]
              )
          , Node
              GovActionId (EraCrypto era)
_p2
              [ Node GovActionId (EraCrypto era)
_p21 []
                , Node GovActionId (EraCrypto era)
_p22 []
                ]
          , Node GovActionId (EraCrypto era)
p3 []
          ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
p1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p11
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
p11
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p3
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era))]
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 (EraCrypto era))))
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 (EraCrypto era))]
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 (EraCrypto era))))
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 (EraCrypto era)
p11) []
        c :: [Tree (GovActionId (EraCrypto era))]
c@[ Node GovActionId (EraCrypto era)
_p113 []
            , Node GovActionId (EraCrypto era)
_p114 []
            ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitConstitutionForest
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))]
c)
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
4
        d :: [Tree (GovActionId (EraCrypto era))]
d@[ Node GovActionId (EraCrypto era)
_p115 []
            , Node GovActionId (EraCrypto era)
p116 []
            ] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitConstitutionForest
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))]
c forall a. Semigroup a => a -> a -> a
<> [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))]
d)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p116
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        [Node GovActionId (EraCrypto era)
p1 []] <-
          StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
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 (EraCrypto era))))
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 (EraCrypto era)
p1) []]
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
p1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))))
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 (EraCrypto era)
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 (EraCrypto era)
returnAddr <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        [(RewardAccount (EraCrypto era), Coin)]
withdrawal <-
          (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RewardAccount (EraCrypto era)
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 (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount (EraCrypto era), 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 (EraCrypto era)) (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 (EraCrypto era)) (GovActionState era))
pPropsL
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. ProposalProcedure era -> Anchor (EraCrypto era)
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 (EraCrypto era)) (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 (EraCrypto era)
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 (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitParameterChangeForest = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()]
-> ImpTestM era (Forest (GovActionId (EraCrypto era)))
submitGovActionForest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
submitGovAction
    submitParameterChangeTree :: StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
submitParameterChangeTree = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> Tree ()
-> ImpTestM era (Tree (GovActionId (EraCrypto era)))
submitGovActionTree (forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
submitGovAction)
    submitConstitutionForest :: StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()] -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitConstitutionForest = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> [Tree ()]
-> ImpTestM era (Forest (GovActionId (EraCrypto era)))
submitGovActionForest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId
    paramAction :: StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovAction era)
paramAction StrictMaybe (GovActionId (EraCrypto era))
p = forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe (GovActionId (EraCrypto era))
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 (EraCrypto era)
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era)
hotCred <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred) GovActionId (EraCrypto era)
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 (EraCrypto era)) -> ConwayGovPredFailure era
VotersDoNotExist [forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred]]
      KeyHash 'StakePool (EraCrypto era)
poolId <- forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolId) GovActionId (EraCrypto era)
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 (EraCrypto era)) -> ConwayGovPredFailure era
VotersDoNotExist [forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolId]]
      Credential 'DRepRole (EraCrypto era)
dRepCred <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
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 (EraCrypto era)) -> ConwayGovPredFailure era
VotersDoNotExist [forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred]
      Vote
vote <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      forall era.
ConwayEraImp era =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
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 (EraCrypto era), GovActionId (EraCrypto era))
-> EraRuleFailure "LEDGER" era
disallowedVoteFailure [(forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred, GovActionId (EraCrypto era)
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 (EraCrypto era)
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall era. GovAction era
InfoAction
      Credential 'DRepRole (EraCrypto era)
dRepCred <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole (EraCrypto era))
registerDRep
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
gaId
      GovActionState era
gas <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
gaId
      forall era.
GovActionState era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
gasDRepVotes GovActionState era
gas forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [(Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole (EraCrypto era)
dRepCred Coin
deposit])
      GovActionState era
gasAfterRemoval <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
gaId
      forall era.
GovActionState era
-> Map (Credential 'DRepRole (EraCrypto era)) 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      GovActionId (EraCrypto era)
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 (EraCrypto era))
submitProposal
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep)
        GovActionId (EraCrypto era)
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 (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
VotingOnExpiredGovAction [(forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep, GovActionId (EraCrypto era)
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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      GovActionId (EraCrypto era)
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 (EraCrypto era))
submitProposal
      let dummyGaid :: GovActionId (EraCrypto era)
dummyGaid = GovActionId (EraCrypto era)
govActionId {gaidGovActionIx :: GovActionIx
gaidGovActionIx = Word16 -> GovActionIx
GovActionIx Word16
99} -- non-existent `GovActionId`
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep)
        GovActionId (EraCrypto era)
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 (EraCrypto era)) -> ConwayGovPredFailure era
GovActionsDoNotExist forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId (EraCrypto era)
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 (EraCrypto era)
ccHot :| [Credential 'HotCommitteeRole (EraCrypto era)]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
newMembers <- forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf forall a b. (a -> b) -> a -> b
$ do
        Credential 'ColdCommitteeRole (EraCrypto era)
newCommitteeMember <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
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 (EraCrypto era)
newCommitteeMember, Word32 -> EpochInterval
EpochInterval Word32
lifetime)
      UnitInterval
threshold <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId (EraCrypto era)
committeeUpdateId <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
newMembers UnitInterval
threshold
      let voter :: Voter (EraCrypto era)
voter = forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
ccHot
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote
        Voter (EraCrypto era)
voter
        GovActionId (EraCrypto era)
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 (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVoters [(Voter (EraCrypto era)
voter, GovActionId (EraCrypto era)
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 (EraCrypto era)
hotCred :| [Credential 'HotCommitteeRole (EraCrypto era)]
_ <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      GovActionId (EraCrypto era)
gaid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era)
voter = forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
        (TxId (EraCrypto era)))
trySubmitVote Vote
VoteNo Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
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 (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVoters [(Voter (EraCrypto era)
voter, GovActionId (EraCrypto era)
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 (EraCrypto era)
dRepCred, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred0 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred1 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      GovActionId (EraCrypto era)
electionGovAction <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred0, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
electionGovAction
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
electionGovAction
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
electionGovAction
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Credential 'HotCommitteeRole (EraCrypto era)
ccHotKey0 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred0
      Credential 'HotCommitteeRole (EraCrypto era)
ccHotKey1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred1
      Anchor (EraCrypto era)
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId (EraCrypto era)
constitutionChangeId <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era))
constitutionScript = forall a. StrictMaybe a
SNothing
              , constitutionAnchor :: Anchor (EraCrypto era)
constitutionAnchor = Anchor (EraCrypto era)
anchor
              }
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
constitutionChangeId
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
ccHotKey0) GovActionId (EraCrypto era)
constitutionChangeId
      Maybe (Credential 'HotCommitteeRole (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> StrictMaybe (Anchor (EraCrypto era))
-> ImpTestM
     era (Maybe (Credential 'HotCommitteeRole (EraCrypto era)))
resignCommitteeColdKey Credential 'ColdCommitteeRole (EraCrypto era)
ccColdCred0 forall a. StrictMaybe a
SNothing
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
ccHotKey1) GovActionId (EraCrypto era)
constitutionChangeId
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
constitutionChangeId
      forall a era. (HasCallStack, ToExpr a) => a -> ImpTestM era ()
logToExpr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall era.
ConwayEraGov era =>
GovActionId (EraCrypto era)
-> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId (EraCrypto era)
constitutionChangeId
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
4
      Anchor (EraCrypto era)
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 (EraCrypto era))
constitutionAnchorL
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      Anchor (EraCrypto era)
conAnchor forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldNotBe` Anchor (EraCrypto era)
anchor
  where
    disallowedVoteFailure :: NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> 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 (EraCrypto era), GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
_ <- 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 (EraCrypto era)))
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 (EraCrypto era)))
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        Constitution era
constitution <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        GovActionId (EraCrypto era)
gaidConstitutionProp <- forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole (EraCrypto era)
-> NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
enactConstitution forall a. StrictMaybe a
SNothing Constitution era
constitution Credential 'DRepRole (EraCrypto era)
dRep NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
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 (EraCrypto era)
-> NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
enactConstitution
            (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaidConstitutionProp)
            Constitution era
constitution1
            Credential 'DRepRole (EraCrypto era)
dRep
            NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        Maybe (GovActionId (EraCrypto era))
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 (EraCrypto era)))
submitConstitutionFailingBootstrap forall a. StrictMaybe a
SNothing
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GovActionId (EraCrypto era))
mbGovActionId forall a b. (a -> b) -> a -> b
$ \GovActionId (EraCrypto era)
govActionId -> do
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
govActionId
          forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
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 (EraCrypto era))
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 (EraCrypto era)))
submitConstitutionFailingBootstrap forall a. StrictMaybe a
SNothing
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GovActionId (EraCrypto era))
mbGovActionId forall a b. (a -> b) -> a -> b
$ \GovActionId (EraCrypto era)
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId (GovActionId (EraCrypto era)
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 (EraCrypto era))
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 (EraCrypto era)))
submitConstitutionFailingBootstrap forall a. StrictMaybe a
SNothing
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GovActionId (EraCrypto era))
mbGovActionId forall a b. (a -> b) -> a -> b
$ \GovActionId (EraCrypto era)
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era)))
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 (EraCrypto era)))
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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      KeyHash 'Witness (EraCrypto era)
keyHash <- forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      ScriptHash (EraCrypto era)
scriptHash <- forall era.
EraScript era =>
NativeScript era -> ImpTestM era (ScriptHash (EraCrypto era))
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 (EraCrypto era) -> NativeScript era
RequireSignature KeyHash 'Witness (EraCrypto era)
keyHash))
      Anchor (EraCrypto era)
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      GovActionId (EraCrypto era)
_ <-
        forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era
-> Credential 'DRepRole (EraCrypto era)
-> NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
enactConstitution
          forall a. StrictMaybe a
SNothing
          (forall era.
Anchor (EraCrypto era)
-> StrictMaybe (ScriptHash (EraCrypto era)) -> Constitution era
Constitution Anchor (EraCrypto era)
anchor (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
scriptHash))
          Credential 'DRepRole (EraCrypto era)
dRep
          NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers'
      ScriptHash (EraCrypto era)
wrongScriptHash <-
        forall era.
EraScript era =>
NativeScript era -> ImpTestM era (ScriptHash (EraCrypto era))
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 (EraCrypto era))
-> GovAction era
ParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
pparamsUpdate (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        let withdrawals :: Map (RewardAccount (EraCrypto era)) Coin
withdrawals = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount (EraCrypto era)
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawals (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era))
-> GovAction era
ParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
pparamsUpdate (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> ConwayGovPredFailure era
InvalidPolicyHash (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
wrongScriptHash) (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        let withdrawals :: Map (RewardAccount (EraCrypto era)) Coin
withdrawals = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount (EraCrypto era)
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawals (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> ConwayGovPredFailure era
InvalidPolicyHash (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
wrongScriptHash) (forall a. a -> StrictMaybe a
SJust ScriptHash (EraCrypto era)
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 (EraCrypto era)
rewardCredential <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      let badRewardAccount :: RewardAccount (EraCrypto era)
badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential 'Staking (EraCrypto era)
raCredential = Credential 'Staking (EraCrypto era)
rewardCredential
              }
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount forall era. GovAction era
InfoAction RewardAccount (EraCrypto era)
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 (EraCrypto era)
-> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                      RewardAccount (EraCrypto era)
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 (EraCrypto era) -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist
                      RewardAccount (EraCrypto era)
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 (EraCrypto era)
-> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                      RewardAccount (EraCrypto era)
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 (EraCrypto era))
policy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (ScriptHash (EraCrypto era)))
getGovPolicy
      RewardAccount (EraCrypto era)
unregisteredRewardAccount <- forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj
      RewardAccount (EraCrypto era)
registeredRewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
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 (EraCrypto era), Coin)]
withdrawals <-
        forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ (RewardAccount (EraCrypto era)
unregisteredRewardAccount,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) Coin
genPositiveCoin
          , (RewardAccount (EraCrypto era)
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 (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount (EraCrypto era), Coin)]
withdrawals) StrictMaybe (ScriptHash (EraCrypto era))
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 (EraCrypto 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. 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 (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [RewardAccount (EraCrypto era)
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 (EraCrypto era)
rewardCredential <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
      let badRewardAccount :: RewardAccount (EraCrypto era)
badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential 'Staking (EraCrypto era)
raCredential = Credential 'Staking (EraCrypto era)
rewardCredential
              }
      ProposalProcedure era
proposal <-
        forall era.
ConwayEraGov era =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount (EraCrypto era)
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 (EraCrypto era))
-> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch (forall a. a -> Set a
Set.singleton RewardAccount (EraCrypto era)
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 (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [RewardAccount (EraCrypto era)
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 (EraCrypto 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
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 (EraCrypto era), 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 (EraCrypto era)
rwdAccount1 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      forall era.
ConwayEraGov era =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount (EraCrypto era)
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 (EraCrypto era)
rwdAccount2 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      let withdrawals :: [(RewardAccount (EraCrypto era), Coin)]
withdrawals = [(RewardAccount (EraCrypto era)
rwdAccount1, forall t. Val t => t
zero), (RewardAccount (EraCrypto era)
rwdAccount2, forall t. Val t => t
zero)]

      forall era.
ConwayEraGov era =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount (EraCrypto era), 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 (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction forall a b. (a -> b) -> a -> b
$ [(RewardAccount (EraCrypto era), Coin)]
withdrawals forall a. [a] -> [a] -> [a]
++ [(RewardAccount (EraCrypto era)
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 (EraCrypto 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]
              , 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 (EraCrypto era)
gaid1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto 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
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era)
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 (EraCrypto era))
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 (EraCrypto era)
ccCred :| [Credential 'HotCommitteeRole (EraCrypto era)]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
  (Credential 'DRepRole (EraCrypto era)
drepCred, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
  Credential 'DRepRole (EraCrypto era)
drepCred2 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole (EraCrypto era))
registerDRep
  Credential 'ColdCommitteeRole (EraCrypto era)
newCommitteeMember <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
freshKeyHash
  GovActionId (EraCrypto era)
committeeProposal <-
    forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era))
  (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
              ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepCred2
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId (EraCrypto era)
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era.
Vote -> StrictMaybe (Anchor (EraCrypto era)) -> VotingProcedure era
VotingProcedure Vote
VoteYes forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
ccCred
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId (EraCrypto era)
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era.
Vote -> StrictMaybe (Anchor (EraCrypto era)) -> VotingProcedure era
VotingProcedure Vote
VoteNo forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepCred
                    , forall k a. k -> a -> Map k a
Map.singleton GovActionId (EraCrypto era)
committeeProposal forall a b. (a -> b) -> a -> b
$ forall era.
Vote -> StrictMaybe (Anchor (EraCrypto era)) -> 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 (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVoters [(forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
ccCred, GovActionId (EraCrypto era)
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 (EraCrypto era)
gid <- forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
submitGovAction
      (Credential 'HotCommitteeRole (EraCrypto era)
committee :| [Credential 'HotCommitteeRole (EraCrypto era)]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spo, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
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),
 EraCrypto era ~ EraCrypto era, ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpM (LedgerSpec era) ()
checkVotingFailure (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spo) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committee) GovActionId (EraCrypto era)
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 (EraCrypto era)
gid <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto 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
curProtVer {pvMajor :: Version
pvMajor = Version
nextMajorVersion})
      (Credential 'HotCommitteeRole (EraCrypto era)
committee :| [Credential 'HotCommitteeRole (EraCrypto era)]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spo, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
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),
 EraCrypto era ~ EraCrypto era, ConwayEraImp era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpM (LedgerSpec era) ()
checkVotingFailure (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spo) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committee) GovActionId (EraCrypto era)
gid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Info action" forall a b. (a -> b) -> a -> b
$ do
      GovActionId (EraCrypto era)
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall era. GovAction era
InfoAction
      (Credential 'HotCommitteeRole (EraCrypto era)
committee :| [Credential 'HotCommitteeRole (EraCrypto era)]
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spo, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spo) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committee) GovActionId (EraCrypto era)
gid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Treasury withdrawal" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      GovAction era
action <- forall era.
ConwayEraGov era =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount (EraCrypto era)
rewardAccount, Integer -> Coin
Coin Integer
1000)]
      ProposalProcedure era
proposal <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
action RewardAccount (EraCrypto era)
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 (EraCrypto era)
cCred <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s c, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r c)
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 (EraCrypto era)) EpochNo
newMembers = [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpM (LedgerSpec era) ()
checkVotingFailure Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
gid = do
      Vote
vote <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      forall era.
ConwayEraImp era =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
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 (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap [(Voter (EraCrypto era)
voter, GovActionId (EraCrypto era)
gid)]]