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

module Test.Cardano.Ledger.Conway.Imp.GovSpec (
  spec,
  relevantDuringBootstrapSpec,
) 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 qualified Cardano.Ledger.Shelley.HardForks as HF
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.Class (Default (..))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
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 (ImpTestState era)
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
spec = do
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
relevantDuringBootstrapSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
constitutionSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
proposalsWithVotingSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
votingSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
policySpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
predicateFailuresSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
unknownCostModelsSpec

relevantDuringBootstrapSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
relevantDuringBootstrapSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
relevantDuringBootstrapSpec = do
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
withdrawalsSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
hardForkSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
pparamUpdateSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
proposalsSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
networkIdSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
bootstrapPhaseSpec

unknownCostModelsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
unknownCostModelsSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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.
(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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` CostModels -> CostModels -> CostModels
updateCostModels CostModels
costModels CostModels
newCostModels

predicateFailuresSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
predicateFailuresSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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
"ExpirationEpochTooSmall" 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
      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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      Anchor (EraCrypto era)
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      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
      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 = GovAction era
action
            , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
            , 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.
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]
    -- TODO: mark as bootstrap relevant
    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. Coin -> Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect (Coin
actionDeposit forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1) 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingGovAction
        GovAction era
action
        [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]

hardForkSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
hardForkSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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 (ImpTestState era)
pparamUpdateSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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 (ImpTestM 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
            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
            RewardAccount (EraCrypto era)
rew <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
            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
                ga :: GovAction era
ga = forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
ppUpdate forall a. StrictMaybe a
SNothing
            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)
rew
                  , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
ga
                  , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
                  , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                  }
              )
              [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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era, EraPParams era) =>
String
-> ASetter
     (PParamsUpdate era) (PParamsUpdate era) a (StrictMaybe a)
-> a
-> SpecWith (ImpTestState 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
        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
        RewardAccount (EraCrypto era)
rew <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        let ga :: GovAction era
ga = forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange forall a. StrictMaybe a
SNothing forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a. StrictMaybe a
SNothing
        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)
rew
              , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
ga
              , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
          )
          [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]

proposalsWithVotingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
proposalsWithVotingSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
proposalsWithVotingSpec =
  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
"Subtrees are pruned when competing proposals are enacted" 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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a. StrictMaybe a
SNothing
        GovActionId (EraCrypto era)
p31 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p3
        GovActionId (EraCrypto era)
p211 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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))
-> Forest () -> 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.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
p213
        GovActionId (EraCrypto era)
p2141 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Int
0
      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
$ 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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
"Subtrees are pruned for both enactment and expiry over multiple rounds" 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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
"Proposals are stored in the expected order" 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
      Coin
deposit <- 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
      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
      Map (RewardAccount (EraCrypto era)) Coin
withdrawal <-
        forall k a. k -> a -> Map k a
Map.singleton 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))
      let
        mkProp :: Text -> GovAction era -> ProposalProcedure era
mkProp Text
name GovAction era
action = do
          ProposalProcedure
            { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
returnAddr
            , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
action
            , pProcDeposit :: Coin
pProcDeposit = Coin
deposit
            , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall c. Url -> SafeHash c AnchorData -> Anchor c
Anchor (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
16 Text
name) forall a. Default a => a
def
            }
        prop0 :: ProposalProcedure era
prop0 = Text -> GovAction era -> ProposalProcedure era
mkProp Text
"prop0" forall era. GovAction era
InfoAction
        prop1 :: ProposalProcedure era
prop1 = Text -> GovAction era -> ProposalProcedure era
mkProp Text
"prop1" forall a b. (a -> b) -> a -> b
$ 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)
        prop2 :: ProposalProcedure era
prop2 = Text -> GovAction era -> ProposalProcedure era
mkProp Text
"prop2" forall era. GovAction era
InfoAction
        prop3 :: ProposalProcedure era
prop3 = Text -> GovAction era -> ProposalProcedure era
mkProp Text
"prop3" forall a b. (a -> b) -> a -> b
$ forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawal forall a. StrictMaybe a
SNothing
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ ProposalProcedure era
prop0
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ ProposalProcedure era
prop1
      let
        checkProps :: [ProposalProcedure era] -> ImpTestM 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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] -> ImpTestM era ()
checkProps [ProposalProcedure era
prop0, ProposalProcedure era
prop1]
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ ProposalProcedure era
prop2
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ ProposalProcedure era
prop3
      [ProposalProcedure era] -> ImpTestM era ()
checkProps [ProposalProcedure era
prop0, ProposalProcedure era
prop1, ProposalProcedure era
prop2, ProposalProcedure era
prop3]
  where
    submitConstitutionForest :: StrictMaybe (GovActionId (EraCrypto era))
-> Forest () -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitConstitutionForest = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> Forest ()
-> ImpTestM era (Forest (GovActionId (EraCrypto era)))
submitGovActionForest forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction

proposalsSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
proposalsSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
proposalsSpec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voters" 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        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)
dRepCred) GovActionId (EraCrypto era)
gaId [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]]
    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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` []
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposals" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Predicate failure when proposal deposit has nonexistent return address" forall a b. (a -> b) -> a -> b
$ do
      ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      RewardAccount (EraCrypto era)
registeredRewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      RewardAccount (EraCrypto era)
unregisteredRewardAccount <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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
      Coin
deposit <- 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
      let mkProposal :: RewardAccount (EraCrypto era) -> ProposalProcedure era
mkProposal RewardAccount (EraCrypto era)
rewardAccount =
            ProposalProcedure
              { pProcDeposit :: Coin
pProcDeposit = Coin
deposit
              , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
              , pProcGovAction :: GovAction era
pProcGovAction = forall era. GovAction era
InfoAction
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
anchor
              }
      if ProtVer -> Bool
HF.bootstrapPhase ProtVer
protVer
        then do
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$ RewardAccount (EraCrypto era) -> ProposalProcedure era
mkProposal RewardAccount (EraCrypto era)
registeredRewardAccount
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$ RewardAccount (EraCrypto era) -> ProposalProcedure era
mkProposal RewardAccount (EraCrypto era)
unregisteredRewardAccount
        else do
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$ RewardAccount (EraCrypto era) -> ProposalProcedure era
mkProposal RewardAccount (EraCrypto era)
registeredRewardAccount
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
            (RewardAccount (EraCrypto era) -> ProposalProcedure era
mkProposal RewardAccount (EraCrypto era)
unregisteredRewardAccount)
            [ 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 => 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 () []
              ]
        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
        RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        let parameterChangeAction :: GovAction era
parameterChangeAction =
              forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId forall a b. (a -> b) -> a -> b
$ forall c. GovActionId c -> GovActionId c
mkCorruptGovActionId GovActionId (EraCrypto era)
p1)
                (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
3000))
                forall a. StrictMaybe a
SNothing
            parameterChangeProposal :: ProposalProcedure era
parameterChangeProposal =
              ProposalProcedure
                { pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
                , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
                , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
parameterChangeAction
                , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                }
        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))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing (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
3000))
        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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
3000)
        let submitInitialProposal :: ImpTestM 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)
-> ImpTestM 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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
getProposalsForest
          forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p11 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p1
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
getProposalsForest
          forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p21 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p2
        [Tree (GovActionId (EraCrypto era))]
a <-
          StrictMaybe (GovActionId (EraCrypto era))
-> Forest () -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p31 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p3
        GovActionId (EraCrypto era)
p211 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p21
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
getProposalsForest
          forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p41 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p4
        GovActionId (EraCrypto era)
p311 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p31
        GovActionId (EraCrypto era)
p212 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p21
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
getProposalsForest
          forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 <- ImpTestM era (GovActionId (EraCrypto era))
submitInitialProposal
        GovActionId (EraCrypto era)
p51 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p5
        GovActionId (EraCrypto era)
p411 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p41
        GovActionId (EraCrypto era)
p312 <- GovActionId (EraCrypto era)
-> ImpTestM era (GovActionId (EraCrypto era))
submitChildProposal GovActionId (EraCrypto era)
p31
        forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe (GovActionId (EraCrypto era))))
getProposalsForest
          forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 []
                         ]
  where
    submitParameterChangeForest :: StrictMaybe (GovActionId (EraCrypto era))
-> Forest () -> ImpTestM era [Tree (GovActionId (EraCrypto era))]
submitParameterChangeForest = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> Forest ()
-> ImpTestM era (Forest (GovActionId (EraCrypto era)))
submitGovActionForest forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {era}.
EraPParams era =>
StrictMaybe (GovActionId (EraCrypto era)) -> GovAction era
paramAction
    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 a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {era}.
EraPParams era =>
StrictMaybe (GovActionId (EraCrypto era)) -> GovAction era
paramAction
    paramAction :: StrictMaybe (GovActionId (EraCrypto era)) -> GovAction era
paramAction StrictMaybe (GovActionId (EraCrypto era))
p =
      forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
10)) forall a. StrictMaybe a
SNothing

votingSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
votingSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
votingSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voting" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"fails for" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expired gov-actions" forall a b. (a -> b) -> a -> b
$ do
        -- Voting after the 3rd epoch 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, Constitution era
_) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
        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, Constitution era
_) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
        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
$ 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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
$ 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        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
$ 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldNotBe` Anchor (EraCrypto era)
anchor

constitutionSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
constitutionSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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
        (GovActionId (EraCrypto era), Constitution era)
_ <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution 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 era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution 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
$ 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
        (GovActionId (EraCrypto era)
govActionId, Constitution era
_constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
        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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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
        (GovActionId (EraCrypto era)
govActionId, Constitution era
_constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
        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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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
        (GovActionId (EraCrypto era)
govActionId, Constitution era
_constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
        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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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
          ]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"submitted successfully with valid GovPurposeId" 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
1

      Constitution era
curConstitution <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
      DRepPulsingState era
initialPulser <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL
      EnactState era
initialEnactState <- forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState

      (GovActionId (EraCrypto era)
govActionId, Constitution era
_) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
      Constitution era
curConstitution' <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"Constitution has not been enacted yet" forall a b. (a -> b) -> a -> b
$
        Constitution era
curConstitution' forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
curConstitution

      ConwayGovState era
govState <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL
      let expectedProposals :: Proposals era
expectedProposals = ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL
          expectedPulser :: DRepPulsingState era
expectedPulser = ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL
      EnactState era
expectedEnactState <- forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"EnactState reflects the submitted governance action" forall a b. (a -> b) -> a -> b
$ do
        EnactState era
expectedEnactState forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` EnactState era
initialEnactState

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"Proposals contain the submitted proposal" forall a b. (a -> b) -> a -> b
$
        Proposals era
expectedProposals forall a (m :: * -> *).
(HasCallStack, Show a, MonadIO m) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` \Proposals era
props -> GovActionId (EraCrypto era)
govActionId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall era.
Proposals era -> StrictSeq (GovActionId (EraCrypto era))
proposalsIds Proposals era
props

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"Pulser has not changed" forall a b. (a -> b) -> a -> b
$
        DRepPulsingState era
expectedPulser forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` DRepPulsingState era
initialPulser

      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"Proposal gets removed after expiry" forall a b. (a -> b) -> a -> b
$ do
        ConwayGovState era
govStateFinal <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL
        let ratifyState :: RatifyState era
ratifyState = forall era. DRepPulsingState era -> RatifyState era
extractDRepPulsingState (ConwayGovState era
govStateFinal forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL)
        forall era. RatifyState era -> Set (GovActionId (EraCrypto era))
rsExpired RatifyState era
ratifyState forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` forall a. a -> Set a
Set.singleton GovActionId (EraCrypto era)
govActionId

policySpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpTestState era)
policySpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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
$ 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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]
      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
      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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
        RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
          ProposalProcedure
            { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
            , pProcGovAction :: GovAction era
pProcGovAction = 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)
            , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
            , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
            }

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
          ProposalProcedure
            { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
            , pProcGovAction :: GovAction era
pProcGovAction = 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)
            , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
            , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
            }

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"ParameterChange 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
          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
        Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (GovActionId (EraCrypto era))
res <-
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
ProposalProcedure era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
        (GovActionId (EraCrypto era)))
trySubmitProposal
            ProposalProcedure
              { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
              , pProcGovAction :: GovAction era
pProcGovAction = 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)
              , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
        Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (GovActionId (EraCrypto era))
res
          forall a b (m :: * -> *).
(HasCallStack, Show a, Eq a, Show b, MonadIO m) =>
Either a b -> a -> m ()
`shouldBeLeft` [ 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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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)
              ]
        Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (GovActionId (EraCrypto era))
res <-
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
ProposalProcedure era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
        (GovActionId (EraCrypto era)))
trySubmitProposal
            ProposalProcedure
              { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
              , pProcGovAction :: GovAction era
pProcGovAction = 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)
              , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
        Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  (GovActionId (EraCrypto era))
res
          forall a b (m :: * -> *).
(HasCallStack, Show a, Eq a, Show b, MonadIO m) =>
Either a b -> a -> m ()
`shouldBeLeft` [ 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 (ImpTestState era)
networkIdSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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
              }
      Coin
propDeposit <- 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
      ProtVer
pv <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      let proposal :: ProposalProcedure era
proposal =
            ProposalProcedure
              { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
badRewardAccount
              , pProcGovAction :: GovAction era
pProcGovAction = forall era. GovAction era
InfoAction
              , pProcDeposit :: Coin
pProcDeposit = Coin
propDeposit
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
      if ProtVer -> Bool
HF.bootstrapPhase ProtVer
pv
        then
          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.
RewardAccount (EraCrypto era)
-> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch
                  RewardAccount (EraCrypto era)
badRewardAccount
                  Network
Testnet
            ]
        else
          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.
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 (ImpTestState era)
withdrawalsSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 :: ImpTestM 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
          withdrawalAccountDoesNotExist :: ConwayGovPredFailure era
withdrawalAccountDoesNotExist = forall era.
NonEmpty (RewardAccount (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [RewardAccount (EraCrypto era)
unregisteredRewardAccount]
      [(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
<$> ImpTestM era Coin
genPositiveCoin
          , (RewardAccount (EraCrypto era)
registeredRewardAccount,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpTestM era Coin
genPositiveCoin
          ]
      [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [ConwayGovPredFailure era
withdrawalAccountDoesNotExist] [] 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 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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
              }
          wdrls :: GovAction era
wdrls = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals (forall k a. k -> a -> Map k a
Map.singleton RewardAccount (EraCrypto era)
badRewardAccount forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000) forall a. StrictMaybe a
SNothing
          idMismatch :: ConwayGovPredFailure era
idMismatch = forall era.
Set (RewardAccount (EraCrypto era))
-> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch (forall a. a -> Set a
Set.singleton RewardAccount (EraCrypto era)
badRewardAccount) Network
Testnet
          returnAddress :: ConwayGovPredFailure era
returnAddress = forall era.
NonEmpty (RewardAccount (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [RewardAccount (EraCrypto era)
badRewardAccount]
      [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [ConwayGovPredFailure era
returnAddress, ConwayGovPredFailure era
idMismatch] [ConwayGovPredFailure era
idMismatch] GovAction era
wdrls

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for empty withdrawals" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount (EraCrypto era)
rwdAccount1 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      RewardAccount (EraCrypto era)
rwdAccount2 <- 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)
rwdAccount1, forall t. Val t => t
zero), (RewardAccount (EraCrypto era)
rwdAccount2, forall t. Val t => t
zero)]
      let wdrls :: GovAction era
wdrls = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals forall k a. Map k a
Map.empty forall a. StrictMaybe a
SNothing
       in [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals forall era. GovAction era
wdrls] [] forall era. GovAction era
wdrls

      let wdrls :: GovAction era
wdrls = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals [(RewardAccount (EraCrypto era)
rwdAccount1, forall t. Val t => t
zero)] forall a. StrictMaybe a
SNothing
       in [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
wdrls] [] GovAction era
wdrls

      let wdrls :: GovAction era
wdrls = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawals forall a. StrictMaybe a
SNothing
       in [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
wdrls] [] GovAction era
wdrls

      RewardAccount (EraCrypto era)
rwdAccountRegistered <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      let wdrls :: GovAction era
wdrls = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals [(RewardAccount (EraCrypto era)
rwdAccountRegistered, forall t. Val t => t
zero)] forall a. StrictMaybe a
SNothing
       in [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
wdrls] [] GovAction era
wdrls

      ProtVer
curProtVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      let wdrls :: Map (RewardAccount (EraCrypto era)) Coin
wdrls = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RewardAccount (EraCrypto era)
rwdAccount2 (Integer -> Coin
Coin Integer
100_000) Map (RewardAccount (EraCrypto era)) Coin
withdrawals
          ga :: GovAction era
ga = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
wdrls forall a. StrictMaybe a
SNothing
       in if ProtVer -> Bool
HF.bootstrapPhase ProtVer
curProtVer
            then do
              [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [] [] GovAction era
ga
            else
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ GovAction era
ga
  where
    expectPredFailures ::
      [ConwayGovPredFailure era] -> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
    expectPredFailures :: [ConwayGovPredFailure era]
-> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era ()
expectPredFailures [ConwayGovPredFailure era]
predFailures [ConwayGovPredFailure era]
bootstrapPredFailures GovAction era
wdrl = do
      ProtVer
curProtVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      ProposalProcedure era
propP <- forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount GovAction era
wdrl
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
        ProposalProcedure era
propP
        ( forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( if ProtVer -> Bool
HF.bootstrapPhase ProtVer
curProtVer
                    then forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
propP forall a. a -> [a] -> NonEmpty a
NE.:| [ConwayGovPredFailure era]
bootstrapPredFailures
                    else forall a. [a] -> NonEmpty a
NE.fromList [ConwayGovPredFailure era]
predFailures
                )
        )

proposalWithRewardAccount ::
  forall era.
  ConwayEraImp era =>
  GovAction era ->
  ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount :: forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount GovAction era
action = do
  RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
  Coin
govActionDeposit <- 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ProposalProcedure
      { pProcDeposit :: Coin
pProcDeposit = Coin
govActionDeposit
      , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
      , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
action
      , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
      }

-- =========================================================
-- 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
  RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
  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 protver0 :: ProtVer
protver0 = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
      protver1 :: ProtVer
protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 :: ProtVer
protver2 = ProtVer -> ProtVer
cantFollow ProtVer
protver1
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
    ( ProposalProcedure
        { pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
        , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
        , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
protver2
        , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
        }
    )
    [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)
-> ProtVer -> ProtVer -> ConwayGovPredFailure era
ProposalCantFollow forall a. StrictMaybe a
SNothing ProtVer
protver2 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
  RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
  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 protver0 :: ProtVer
protver0 = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
      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, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
      ProposalProcedure
        { pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
        , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
        , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
protver1
        , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
        }
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal
    ( ProposalProcedure
        { pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
        , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
        , pProcGovAction :: GovAction era
pProcGovAction = 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
        , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
        }
    )
    [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)
-> ProtVer -> 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)) ProtVer
protver2 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (ImpTestState era)
bootstrapPhaseSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpTestState era)
bootstrapPhaseSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposing and voting during bootstrap phase" 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))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing (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
3000))
      (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} {era} {rule :: Symbol}.
(EraCrypto era ~ EraCrypto era,
 EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM 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 {era} {era} {rule :: Symbol}.
(EraCrypto era ~ EraCrypto era,
 EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM 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
      Coin
govActionDeposit <- 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
      let action :: GovAction era
action = forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals [(RewardAccount (EraCrypto era)
rewardAccount, Integer -> Coin
Coin Integer
1000)] forall a. StrictMaybe a
SNothing
      let proposal :: ProposalProcedure era
proposal =
            ProposalProcedure
              { pProcDeposit :: Coin
pProcDeposit = Coin
govActionDeposit
              , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
              , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
action
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
      forall {rule :: Symbol} {era}.
(EraRuleFailure rule era ~ PredicateFailure (EraRule "LEDGER" era),
 ShelleyEraImp era, ConwayEraTxBody 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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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),
 ShelleyEraImp era, ConwayEraTxBody 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 :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) 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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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),
 ShelleyEraImp era, ConwayEraTxBody 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.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
proposalWithRewardAccount 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),
 ShelleyEraImp era, ConwayEraTxBody era,
 InjectRuleFailure rule ConwayGovPredFailure era) =>
ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal
  where
    checkProposalFailure :: ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal = do
      ProtVer
curProtVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
HF.bootstrapPhase ProtVer
curProtVer) forall a b. (a -> b) -> a -> b
$
        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. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
    checkVotingFailure :: Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
checkVotingFailure Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
gid = do
      ProtVer
curProtVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
HF.bootstrapPhase ProtVer
curProtVer) forall a b. (a -> b) -> a -> b
$
        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)
gid [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)]]