{-# 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) where

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

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

unknownCostModelsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
unknownCostModelsSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unknown CostModels" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Are accepted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      costModels <- Lens' (PParams era) CostModels -> ImpTestM era CostModels
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (CostModels -> f CostModels) -> PParams era -> f (PParams era)
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL
      newCostModels <- arbitrary
      hotCommitteeCs <- registerInitialCommittee
      (drepC, _, _) <- setupSingleDRep 1_000_000
      gai <-
        submitParameterChange SNothing $
          emptyPParamsUpdate
            & ppuCostModelsL .~ SJust newCostModels
      whenPostBootstrap $ submitYesVote_ (DRepVoter drepC) gai
      submitYesVoteCCs_ hotCommitteeCs gai
      passNEpochs 2
      getLastEnactedParameterChange `shouldReturn` SJust (GovPurposeId gai)
      getsPParams ppCostModelsL `shouldReturn` updateCostModels costModels newCostModels

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

      proposal <- mkProposalWithRewardAccount InfoAction unregisteredRewardAccount
      submitBootstrapAwareFailingProposal_ proposal $
        FailPostBootstrap
          [injectFailure $ ProposalReturnAccountDoesNotExist unregisteredRewardAccount]

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

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

hardForkSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
hardForkSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
hardForkSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"HardFork" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the first one (doesn't have a GovPurposeId) " (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
minorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
majorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" ImpTestM era ()
forall era. ConwayEraImp era => ImpTestM era ()
firstHardForkCantFollow
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hardfork is the second one (has a GovPurposeId)" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork minorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
minorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork majorFollow" ((ProtVer -> ProtVer) -> ImpTestM era ()
forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
majorFollow)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork cantFollow" ImpTestM era ()
forall era. ConwayEraImp era => ImpTestM era ()
secondHardForkCantFollow

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

proposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
proposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
proposalsSpec = do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposals" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Consistency" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals submitted without proper parent fail" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        let mkCorruptGovActionId :: GovActionId -> GovActionId
            mkCorruptGovActionId :: GovActionId -> GovActionId
mkCorruptGovActionId (GovActionId TxId
txi (GovActionIx Word16
gaix)) =
              TxId -> GovActionIx -> GovActionId
GovActionId TxId
txi (GovActionIx -> GovActionId) -> GovActionIx -> GovActionId
forall a b. (a -> b) -> a -> b
$ Word16 -> GovActionIx
GovActionIx (Word16 -> GovActionIx) -> Word16 -> GovActionIx
forall a b. (a -> b) -> a -> b
$ Word16
gaix Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
999
        Node p1 [Node _p11 []] <-
          StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            (Tree () -> ImpTestM era (Tree GovActionId))
-> Tree () -> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
              ()
              [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
              ]
        parameterChangeAction <- mkMinFeeUpdateGovAction (SJust $ mkCorruptGovActionId p1)
        parameterChangeProposal <- mkProposal parameterChangeAction
        submitFailingProposal
          parameterChangeProposal
          [ injectFailure $ InvalidPrevGovActionId parameterChangeProposal
          ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
4
        p1 <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
        passNEpochs 3
        a <-
          submitParameterChangeTree
            (SJust p1)
            $ Node
              ()
              [ Node () []
              , Node () []
              ]
        b <-
          submitParameterChangeTree
            SNothing
            $ Node
              ()
              [ Node () []
              ]
        getProposalsForest
          `shouldReturn` [ Node
                             SNothing
                             [ Node (SJust p1) [SJust <$> a]
                             , SJust <$> b
                             ]
                         , Node SNothing []
                         , Node SNothing []
                         , Node SNothing []
                         ]
        passNEpochs 3
        getProposalsForest
          `shouldReturn` [ Node SNothing [SJust <$> b]
                         , Node SNothing []
                         , Node SNothing []
                         , Node SNothing []
                         ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when proposals expire over multiple rounds" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        let ppupdate :: PParamsUpdate era
ppupdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000)
        let submitInitialProposal :: ImpM (LedgerSpec era) GovActionId
submitInitialProposal = StrictMaybe GovActionId
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
ppupdate
        let submitChildProposal :: GovActionId -> ImpM (LedgerSpec era) GovActionId
submitChildProposal GovActionId
parent = StrictMaybe GovActionId
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
parent) PParamsUpdate era
ppupdate
        (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
4
        p1 <- ImpM (LedgerSpec era) GovActionId
submitInitialProposal
        getProposalsForest
          `shouldReturn` [ Node
                             SNothing
                             [ Node (SJust p1) []
                             ]
                         , Node SNothing []
                         , Node SNothing []
                         , Node SNothing []
                         ]

        passEpoch
        p2 <- submitInitialProposal
        p11 <- submitChildProposal p1
        getProposalsForest
          `shouldReturn` [ Node
                             SNothing
                             [ Node (SJust p1) [Node (SJust p11) []]
                             , Node (SJust p2) []
                             ]
                         , Node SNothing []
                         , Node SNothing []
                         , Node SNothing []
                         ]

        passEpoch
        p3 <- submitInitialProposal
        p21 <- submitChildProposal p2
        a <-
          submitParameterChangeForest
            (SJust p11)
            [ Node () []
            , Node () []
            ]
        getProposalsForest
          `shouldReturn` [ Node
                             SNothing
                             [ Node
                                 (SJust p1)
                                 [ Node
                                     (SJust p11)
                                     (fmap SJust <$> a)
                                 ]
                             , Node (SJust p2) [Node (SJust p21) []]
                             , Node (SJust p3) []
                             ]
                         , Node SNothing []
                         , Node SNothing []
                         , Node SNothing []
                         ]

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

        getProposalsForest
          `shouldReturn` [ Node SNothing []
                         , Node SNothing []
                         , Node (SJust committeeGovActionId) []
                         , Node SNothing (fmap SJust <$> a)
                         ]
        passEpoch
        submitYesVote_ (DRepVoter dRep) p2
        submitYesVote_ (CommitteeVoter committeeMember) p2
        passNEpochs 2
        getProposalsForest
          `shouldReturn` [ Node SNothing []
                         , Node SNothing []
                         , Node (SJust committeeGovActionId) []
                         , SJust <$> b
                         ]
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Subtrees are pruned when competing proposals are enacted over multiple rounds" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        committeeMembers' <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
        (drepC, _, _) <- setupSingleDRep 1_000_000
        a@[ c
            , Node
                p2
                [ Node p21 []
                  , Node p22 []
                  ]
            , Node p3 []
            ] <-
          submitConstitutionForest
            SNothing
            [ Node
                ()
                [ Node
                    ()
                    [ Node () []
                    , Node () []
                    ]
                ]
            , Node
                ()
                [ Node () []
                , Node () []
                ]
            , Node () []
            ]
        submitYesVote_ (DRepVoter drepC) p2
        submitYesVoteCCs_ committeeMembers' p2
        submitYesVote_ (DRepVoter drepC) p21
        submitYesVoteCCs_ committeeMembers' p21
        submitYesVote_ (DRepVoter drepC) p3
        submitYesVoteCCs_ committeeMembers' p3 -- Two competing proposals break the tie based on proposal order
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node SNothing (fmap SJust <$> a)
        passEpoch
        p4 <- submitConstitution SNothing
        p31 <- submitConstitution $ SJust (GovPurposeId p3)
        p211 <- submitConstitution $ SJust (GovPurposeId p21)
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node
            SNothing
            [ SJust <$> c
            , Node
                (SJust p2)
                [ Node (SJust p21) [Node (SJust p211) []]
                , Node (SJust p22) []
                ]
            , Node (SJust p3) [Node (SJust p31) []]
            , Node (SJust p4) []
            ]
        passEpoch
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node
            (SJust p2)
            [ Node (SJust p21) [Node (SJust p211) []]
            , Node (SJust p22) []
            ]
        [ Node p212 []
          , Node p213 []
          , Node p214 []
          ] <-
          submitConstitutionForest
            (SJust p21)
            [ Node () []
            , Node () []
            , Node () []
            ]
        p2131 <- submitConstitution $ SJust (GovPurposeId p213)
        p2141 <- submitConstitution $ SJust (GovPurposeId p214)
        submitYesVote_ (DRepVoter drepC) p212
        submitYesVoteCCs_ committeeMembers' p212
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node
            (SJust p2)
            [ Node
                (SJust p21)
                [ Node (SJust p211) []
                , Node (SJust p212) []
                , Node (SJust p213) [Node (SJust p2131) []]
                , Node (SJust p214) [Node (SJust p2141) []]
                ]
            , Node (SJust p22) []
            ]
        passNEpochs 2
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p212) []
        props <- getProposals
        proposalsSize props `shouldBe` 0
      -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/923
      -- TODO: Re-enable after issues are resolved, by removing this override
      String
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall era.
ShelleyEraImp era =>
String -> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
disableInConformanceIt String
"Subtrees are pruned for both enactment and expiry over multiple rounds" (ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era)))
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        committeeMembers' <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
        (dRep, _, _) <- setupSingleDRep 1_000_000
        modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
        [ a@( Node
                p1
                [ b@( Node
                        p11
                        [ Node _p111 []
                          , Node _p112 []
                          ]
                      )
                  ]
              )
          , Node
              _p2
              [ Node _p21 []
                , Node _p22 []
                ]
          , Node p3 []
          ] <-
          submitConstitutionForest
            SNothing
            [ Node
                ()
                [ Node
                    ()
                    [ Node () []
                    , Node () []
                    ]
                ]
            , Node
                ()
                [ Node () []
                , Node () []
                ]
            , Node () []
            ]
        passNEpochs 2
        submitYesVote_ (DRepVoter dRep) p1
        submitYesVoteCCs_ committeeMembers' p1
        submitYesVote_ (DRepVoter dRep) p11
        submitYesVoteCCs_ committeeMembers' p11
        submitYesVote_ (DRepVoter dRep) p3
        submitYesVoteCCs_ committeeMembers' p3 -- Two competing proposals break the tie based on proposal order
        passNEpochs 2
        fmap (!! 3) getProposalsForest
          `shouldReturn` SJust
          <$> a
        passEpoch -- ConstitutionPurpose is a delayed action
        fmap (!! 3) getProposalsForest
          `shouldReturn` SJust
          <$> b
        passNEpochs 2
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p11) []
        c@[ Node _p113 []
            , Node _p114 []
            ] <-
          submitConstitutionForest
            (SJust p11)
            [ Node () []
            , Node () []
            ]
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p11) (fmap SJust <$> c)
        passNEpochs 4
        d@[ Node _p115 []
            , Node p116 []
            ] <-
          submitConstitutionForest
            (SJust p11)
            [ Node () []
            , Node () []
            ]
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p11) (fmap SJust <$> (c <> d))
        passNEpochs 2
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p11) (fmap SJust <$> d)
        submitYesVote_ (DRepVoter dRep) p116
        submitYesVoteCCs_ committeeMembers' p116
        passNEpochs 3
        fmap (!! 3) getProposalsForest
          `shouldReturn` Node (SJust p116) []
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Votes from subsequent epochs are considered for ratification" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
4

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

votingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
votingSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
votingSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voting" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"VotersDoNotExist" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      let pv@(ProtVer major minor) = pp ^. ppProtocolVersionL
      gaId <- submitGovAction $ HardForkInitiation SNothing $ ProtVer major (succ minor)
      hotCred <- KeyHashObj <$> freshKeyHash
      if hardforkConwayDisallowUnelectedCommitteeFromVoting pv
        then
          submitFailingVote
            (CommitteeVoter hotCred)
            gaId
            [ injectFailure $ UnelectedCommitteeVoters [hotCred]
            , injectFailure $ VotersDoNotExist [CommitteeVoter hotCred]
            ]
        else
          submitFailingVote
            (CommitteeVoter hotCred)
            gaId
            [injectFailure $ VotersDoNotExist [CommitteeVoter hotCred]]
      poolId <- freshKeyHash
      submitFailingVote
        (StakePoolVoter poolId)
        gaId
        [injectFailure $ VotersDoNotExist [StakePoolVoter poolId]]
      dRepCred <- KeyHashObj <$> freshKeyHash
      submitFailingVote
        (DRepVoter dRepCred)
        gaId
        [injectFailure $ VotersDoNotExist [DRepVoter dRepCred]]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep votes are removed" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      gaId <- submitGovAction InfoAction
      dRepCred <- KeyHashObj <$> registerDRep
      submitVote_ VoteNo (DRepVoter dRepCred) gaId
      gas <- getGovActionState gaId
      gasDRepVotes gas `shouldBe` [(dRepCred, VoteNo)]
      let deposit = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL
      submitTx_ $ mkBasicTx (mkBasicTxBody & certsTxBodyL .~ [UnRegDRepTxCert dRepCred deposit])
      gasAfterRemoval <- getGovActionState gaId
      gasDRepVotes gasAfterRemoval `shouldBe` []

    -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/923
    -- TODO: Re-enable after issues are resolved, by removing this override
    String
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall era.
ShelleyEraImp era =>
String -> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
disableInConformanceIt String
"expired gov-actions" (ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era)))
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      -- Voting for expired actions should fail
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
      (drep, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000
      govActionId <- mkProposal InfoAction >>= submitProposal
      passNEpochs 3
      submitFailingVote
        (DRepVoter drep)
        govActionId
        [ injectFailure $ VotingOnExpiredGovAction [(DRepVoter drep, govActionId)]
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"non-existent gov-actions" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000
      govActionId <- mkProposal InfoAction >>= submitProposal
      let dummyGaid = GovActionId
govActionId {gaidGovActionIx = GovActionIx 99} -- non-existent `GovActionId`
      submitFailingVote
        (DRepVoter drep)
        dummyGaid
        [injectFailure $ GovActionsDoNotExist $ pure dummyGaid]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on UpdateCommittee action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (ccHot :| _) <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      newMembers <- listOf $ do
        newCommitteeMember <- KeyHashObj <$> freshKeyHash
        Positive lifetime <- arbitrary
        pure (newCommitteeMember, EpochInterval lifetime)
      threshold <- arbitrary
      committeeUpdateId <- submitUpdateCommittee Nothing mempty newMembers threshold
      let voter = Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
ccHot
      submitFailingVote
        voter
        committeeUpdateId
        [ injectFailure $ DisallowedVoters [(voter, committeeUpdateId)]
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member can not vote on NoConfidence action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      hotCred :| _ <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      gaid <- submitGovAction $ NoConfidence SNothing
      let voter = Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
hotCred
      trySubmitVote VoteNo voter gaid
        `shouldReturn` Left
          [ injectFailure $ DisallowedVoters [(voter, gaid)]
          ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"committee member mixed with other voters can not vote on UpdateCommittee action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ImpM (LedgerSpec era) ()
forall era. ConwayEraImp era => ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes
    -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/923
    -- TODO: Re-enable after issues are resolved, by removing this override
    String
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall era.
ShelleyEraImp era =>
String -> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
disableInConformanceIt String
"CC cannot ratify if below threshold" (ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era)))
-> ImpM (LedgerSpec era) () -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
3
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (dRepCred, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000
      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
      ccColdCred0 <- KeyHashObj <$> freshKeyHash
      ccColdCred1 <- KeyHashObj <$> freshKeyHash
      electionGovAction <-
        submitUpdateCommittee
          Nothing
          mempty
          [ (ccColdCred0, EpochInterval 10)
          , (ccColdCred1, EpochInterval 10)
          ]
          (3 %! 5)
      submitYesVote_ (DRepVoter dRepCred) electionGovAction
      submitYesVote_ (StakePoolVoter spoC) electionGovAction
      logAcceptedRatio electionGovAction
      passNEpochs 3
      expectNoCurrentProposals
      ccHotKey0 <- registerCommitteeHotKey ccColdCred0
      ccHotKey1 <- registerCommitteeHotKey ccColdCred1
      anchor <- arbitrary
      constitutionChangeId <-
        submitGovAction $
          NewConstitution
            SNothing
            Constitution
              { constitutionScript = SNothing
              , constitutionAnchor = anchor
              }
      submitYesVote_ (DRepVoter dRepCred) constitutionChangeId
      submitYesVote_ (CommitteeVoter ccHotKey0) constitutionChangeId
      _ <- resignCommitteeColdKey ccColdCred0 SNothing
      submitYesVote_ (CommitteeVoter ccHotKey1) constitutionChangeId
      passEpoch
      logAcceptedRatio constitutionChangeId
      logToExpr =<< lookupGovActionState constitutionChangeId
      passNEpochs 4
      conAnchor <-
        getsNES $
          nesEsL
            . esLStateL
            . lsUTxOStateL
            . utxosGovStateL
            . constitutionGovStateL
            . constitutionAnchorL
      expectNoCurrentProposals
      conAnchor `shouldNotBe` anchor
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can submit SPO votes" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      spoHash <- ImpM (LedgerSpec era) (KeyHash StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      registerPool spoHash
      passNEpochs 3
      gaId <-
        submitParameterChange SNothing $
          def
            & ppuMinFeeAL .~ SJust (Coin 100)
      submitVote_ @era VoteYes (StakePoolVoter spoHash) gaId

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

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

          submitFailingProposal
            invalidNoConfidenceProposal
            [ injectFailure $ InvalidPrevGovActionId invalidNoConfidenceProposal
            ]
  where
    submitConstitutionFailingBootstrap :: StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpM (LedgerSpec era) (Maybe GovActionId)
submitConstitutionFailingBootstrap StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId = do
      proposal <- (ProposalProcedure era, Constitution era) -> ProposalProcedure era
forall a b. (a, b) -> a
fst ((ProposalProcedure era, Constitution era)
 -> ProposalProcedure era)
-> ImpM (LedgerSpec era) (ProposalProcedure era, Constitution era)
-> ImpM (LedgerSpec era) (ProposalProcedure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpM (LedgerSpec era) (ProposalProcedure era, Constitution era)
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId
      submitBootstrapAwareFailingProposal
        proposal
        (FailBootstrap [injectFailure (DisallowedProposalDuringBootstrap proposal)])

policySpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
policySpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
policySpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Policy" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"policy is respected by proposals" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      committeeMembers' <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      (dRep, _, _) <- setupSingleDRep 1_000_000
      keyHash <- freshKeyHash
      scriptHash <- impAddNativeScript $ RequireAllOf (SSeq.singleton (RequireSignature keyHash))
      anchor <- arbitrary
      _ <-
        enactConstitution
          SNothing
          (Constitution anchor (SJust scriptHash))
          dRep
          committeeMembers'
      wrongScriptHash <-
        impAddNativeScript $
          RequireMOf 1 $
            SSeq.fromList [RequireAnyOf mempty, RequireAllOf mempty]
      impAnn "ParameterChange with correct policy succeeds" $ do
        let pparamsUpdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Natural -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
1
        mkProposal (ParameterChange SNothing pparamsUpdate (SJust scriptHash)) >>= submitProposal_

      impAnn "TreasuryWithdrawals with correct policy succeeds" $ do
        rewardAccount <- registerRewardAccount
        let withdrawals = [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        mkProposal (TreasuryWithdrawals withdrawals (SJust scriptHash)) >>= submitProposal_

      impAnn "ParameterChange with invalid policy fails" $ do
        let pparamsUpdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Natural -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
2
        mkProposal (ParameterChange SNothing pparamsUpdate (SJust wrongScriptHash))
          >>= flip
            submitFailingProposal
            [injectFailure $ InvalidPolicyHash (SJust wrongScriptHash) (SJust scriptHash)]

      impAnn "TreasuryWithdrawals with invalid policy fails" $ do
        rewardAccount <- registerRewardAccount
        let withdrawals = [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
1000)]
        mkProposal (TreasuryWithdrawals withdrawals (SJust wrongScriptHash))
          >>= flip
            submitFailingProposal
            [injectFailure $ InvalidPolicyHash (SJust wrongScriptHash) (SJust scriptHash)]

networkIdSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
networkIdSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
networkIdSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Network ID" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails with invalid network ID in proposal return address" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      rewardCredential <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential Staking
raCredential = Credential Staking
rewardCredential
              }
      proposal <- mkProposalWithRewardAccount InfoAction badRewardAccount
      submitBootstrapAwareFailingProposal_ proposal $
        FailBootstrapAndPostBootstrap $
          FailBoth
            { bootstrapFailures =
                [ injectFailure $
                    ProposalProcedureNetworkIdMismatch
                      badRewardAccount
                      Testnet
                ]
            , postBootstrapFailures =
                [ injectFailure $
                    ProposalReturnAccountDoesNotExist
                      badRewardAccount
                , injectFailure $
                    ProposalProcedureNetworkIdMismatch
                      badRewardAccount
                      Testnet
                ]
            }

withdrawalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
withdrawalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
withdrawalsSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Withdrawals" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails predicate when treasury withdrawal has nonexistent return address" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      policy <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      unregisteredRewardAccount <- freshKeyHash >>= getRewardAccountFor . KeyHashObj
      registeredRewardAccount <- registerRewardAccount
      let genPositiveCoin = Integer -> Coin
Coin (Integer -> Coin)
-> (Positive Integer -> Integer) -> Positive Integer -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> Coin)
-> ImpM (LedgerSpec era) (Positive Integer)
-> ImpM (LedgerSpec era) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Positive Integer)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      withdrawals <-
        sequence
          [ (unregisteredRewardAccount,) <$> genPositiveCoin
          , (registeredRewardAccount,) <$> genPositiveCoin
          ]
      proposal <- mkProposal $ TreasuryWithdrawals (Map.fromList withdrawals) policy
      void $
        submitBootstrapAwareFailingProposal proposal $
          FailBootstrapAndPostBootstrap $
            FailBoth
              { bootstrapFailures = [injectFailure $ DisallowedProposalDuringBootstrap proposal]
              , postBootstrapFailures =
                  [ injectFailure $
                      TreasuryWithdrawalReturnAccountsDoNotExist [unregisteredRewardAccount]
                  ]
              }

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails with invalid network ID in withdrawal addresses" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      rewardCredential <- KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> ImpM (LedgerSpec era) (KeyHash Staking)
-> ImpM (LedgerSpec era) (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let badRewardAccount =
            RewardAccount
              { raNetwork :: Network
raNetwork = Network
Mainnet -- Our network is Testnet
              , raCredential :: Credential Staking
raCredential = Credential Staking
rewardCredential
              }
      proposal <-
        mkTreasuryWithdrawalsGovAction [(badRewardAccount, Coin 100_000_000)] >>= mkProposal
      let idMismatch =
            ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
              Set RewardAccount -> Network -> ConwayGovPredFailure era
forall era.
Set RewardAccount -> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch (RewardAccount -> Set RewardAccount
forall a. a -> Set a
Set.singleton RewardAccount
badRewardAccount) Network
Testnet
          returnAddress =
            ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
              NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist [Item (NonEmpty RewardAccount)
RewardAccount
badRewardAccount]
      void $
        submitBootstrapAwareFailingProposal proposal $
          FailBootstrapAndPostBootstrap $
            FailBoth
              { bootstrapFailures = [disallowedProposalFailure proposal, idMismatch]
              , postBootstrapFailures = [returnAddress, idMismatch]
              }

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

      rwdAccount1 <- ImpM (LedgerSpec era) RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      mkTreasuryWithdrawalsGovAction [(rwdAccount1, zero)] >>= expectZeroTreasuryFailurePostBootstrap

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

      mkTreasuryWithdrawalsGovAction withdrawals >>= expectZeroTreasuryFailurePostBootstrap

      wdrls <- mkTreasuryWithdrawalsGovAction $ withdrawals ++ [(rwdAccount2, Coin 100_000)]
      proposal <- mkProposal wdrls
      submitBootstrapAwareFailingProposal_ proposal $
        FailBootstrap [disallowedProposalFailure proposal]
  where
    expectZeroTreasuryFailurePostBootstrap :: GovAction era -> ImpM (LedgerSpec era) ()
expectZeroTreasuryFailurePostBootstrap GovAction era
wdrls = do
      proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
wdrls
      void $
        submitBootstrapAwareFailingProposal proposal $
          FailBootstrapAndPostBootstrap $
            FailBoth
              { bootstrapFailures = [disallowedProposalFailure proposal]
              , postBootstrapFailures = [injectFailure $ ZeroTreasuryWithdrawals wdrls]
              }

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

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

-- | Tests the first hardfork in the Conway era where the PrevGovActionID is SNothing
firstHardForkFollows ::
  forall era.
  ConwayEraImp era =>
  (ProtVer -> ProtVer) ->
  ImpTestM era ()
firstHardForkFollows :: forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
firstHardForkFollows ProtVer -> ProtVer
computeNewFromOld = do
  protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  submitGovAction_ $ HardForkInitiation SNothing (computeNewFromOld protVer)

-- | Negative (deliberatey failing) first hardfork in the Conway era where the PrevGovActionID is SNothing
firstHardForkCantFollow ::
  forall era.
  ConwayEraImp era =>
  ImpTestM era ()
firstHardForkCantFollow :: forall era. ConwayEraImp era => ImpTestM era ()
firstHardForkCantFollow = do
  protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 = ProtVer -> ProtVer
cantFollow ProtVer
protver1
  proposal <- mkProposal $ HardForkInitiation SNothing protver2
  submitFailingProposal
    proposal
    [ injectFailure $
        ProposalCantFollow SNothing $
          Mismatch
            { mismatchSupplied = protver2
            , mismatchExpected = protver0
            }
    ]

-- | Tests a second hardfork in the Conway era where the PrevGovActionID is SJust
secondHardForkFollows ::
  forall era.
  ConwayEraImp era =>
  (ProtVer -> ProtVer) ->
  ImpTestM era ()
secondHardForkFollows :: forall era.
ConwayEraImp era =>
(ProtVer -> ProtVer) -> ImpTestM era ()
secondHardForkFollows ProtVer -> ProtVer
computeNewFromOld = do
  protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 = ProtVer -> ProtVer
computeNewFromOld ProtVer
protver1
  gaid1 <- submitGovAction $ HardForkInitiation SNothing protver1
  submitGovAction_ $ HardForkInitiation (SJust (GovPurposeId gaid1)) protver2

-- | Negative (deliberatey failing) first hardfork in the Conway era where the PrevGovActionID is SJust
secondHardForkCantFollow ::
  forall era.
  ConwayEraImp era =>
  ImpTestM era ()
secondHardForkCantFollow :: forall era. ConwayEraImp era => ImpTestM era ()
secondHardForkCantFollow = do
  protver0 <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let protver1 = ProtVer -> ProtVer
minorFollow ProtVer
protver0
      protver2 = ProtVer -> ProtVer
cantFollow ProtVer
protver1
  gaid1 <- mkProposal (HardForkInitiation SNothing protver1) >>= submitProposal
  mkProposal (HardForkInitiation (SJust (GovPurposeId gaid1)) protver2)
    >>= flip
      submitFailingProposal
      [ injectFailure $
          ProposalCantFollow (SJust (GovPurposeId gaid1)) $
            Mismatch
              { mismatchSupplied = protver2
              , mismatchExpected = protver1
              }
      ]

ccVoteOnConstitutionFailsWithMultipleVotes ::
  forall era.
  ConwayEraImp era =>
  ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes :: forall era. ConwayEraImp era => ImpTestM era ()
ccVoteOnConstitutionFailsWithMultipleVotes = do
  (ccCred :| _) <- ImpTestM era (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
  (drepCred, _, _) <- setupSingleDRep 1_000_000
  drepCred2 <- KeyHashObj <$> registerDRep
  newCommitteeMember <- KeyHashObj <$> freshKeyHash
  committeeProposal <-
    submitUpdateCommittee Nothing mempty [(newCommitteeMember, EpochInterval 10)] (1 %! 2)
  let
    voteTx =
      TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx (TxBody TopTx era -> Tx TopTx era)
-> TxBody TopTx era -> Tx TopTx era
forall a b. (a -> b) -> a -> b
$
        TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
          TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL
            ((VotingProcedures era -> Identity (VotingProcedures era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> VotingProcedures era -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
              ( [(Voter, Map GovActionId (VotingProcedure era))]
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [
                    ( Credential DRepRole -> Voter
DRepVoter Credential DRepRole
drepCred2
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
ccCred
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteNo StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ,
                    ( Credential DRepRole -> Voter
DRepVoter Credential DRepRole
drepCred
                    , GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
committeeProposal (VotingProcedure era -> Map GovActionId (VotingProcedure era))
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$ Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
VoteYes StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    )
                  ]
              )
  impAnn "Try to vote as a committee member" $
    submitFailingTx
      voteTx
      [ injectFailure $
          DisallowedVoters [(CommitteeVoter ccCred, committeeProposal)]
      ]

bootstrapPhaseSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
bootstrapPhaseSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
bootstrapPhaseSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposing and voting" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Parameter change" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      gid <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      (committee :| _) <- registerInitialCommittee
      (drep, _, _) <- setupSingleDRep 1_000_000
      (spo, _, _) <- setupPoolWithStake $ Coin 42_000_000
      checkVotingFailure (DRepVoter drep) gid
      submitYesVote_ (StakePoolVoter spo) gid
      submitYesVote_ (CommitteeVoter committee) gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hardfork initiation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      nextMajorVersion <- succVersion $ pvMajor curProtVer
      gid <-
        submitGovAction $
          HardForkInitiation SNothing (curProtVer {pvMajor = nextMajorVersion})
      (committee :| _) <- registerInitialCommittee
      (drep, _, _) <- setupSingleDRep 1_000_000
      (spo, _, _) <- setupPoolWithStake $ Coin 42_000_000
      checkVotingFailure (DRepVoter drep) gid
      submitYesVote_ (StakePoolVoter spo) gid
      submitYesVote_ (CommitteeVoter committee) gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Info action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      (committee :| _) <- registerInitialCommittee
      (drep, _, _) <- setupSingleDRep 1_000_000
      (spo, _, _) <- setupPoolWithStake $ Coin 42_000_000
      submitYesVote_ (DRepVoter drep) gid
      submitYesVote_ (StakePoolVoter spo) gid
      submitYesVote_ (CommitteeVoter committee) gid
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Treasury withdrawal" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      action <- mkTreasuryWithdrawalsGovAction [(rewardAccount, Coin 1000)]
      proposal <- mkProposalWithRewardAccount action rewardAccount
      checkProposalFailure proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. StrictMaybe a
SNothing
      checkProposalFailure proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"UpdateCommittee" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      cCred <- KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      curEpochNo <- getsNES nesELL
      let newMembers = [(Credential ColdCommitteeRole
cCred, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
30))]
      proposal <- mkProposal $ UpdateCommittee SNothing mempty newMembers (1 %! 1)
      checkProposalFailure proposal
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NewConstitution" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      proposal <- mkProposal $ NewConstitution SNothing constitution
      checkProposalFailure proposal
  where
    checkProposalFailure :: ProposalProcedure era -> ImpTestM era ()
checkProposalFailure ProposalProcedure era
proposal =
      ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
proposal (SubmitFailureExpectation era -> ImpTestM era ())
-> SubmitFailureExpectation era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
        NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayGovPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
    checkVotingFailure :: Voter -> GovActionId -> ImpM (LedgerSpec era) ()
checkVotingFailure Voter
voter GovActionId
gid = do
      vote <- ImpM (LedgerSpec era) Vote
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      submitBootstrapAwareFailingVote vote voter gid $
        FailBootstrap [injectFailure $ DisallowedVotesDuringBootstrap [(voter, gid)]]