{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Credential
import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
import Cardano.Ledger.Shelley.LedgerState
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val (zero, (<->))
import Data.Default (def)
import Data.Foldable
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.KeyPair
import Test.Cardano.Ledger.Core.Rational ((%!))
import Test.Cardano.Ledger.Imp.Common

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))
votingSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
delayingActionsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMinSizeAffectsInFlightProposalsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
paramChangeAffectsProposalsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeExpiryResignationDiscountSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMaxTermLengthSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoVotesForHardForkInitiation
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoAndCCVotingSpec
  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Many CC Cold Credentials map to the same Hot Credential act as many 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
    Credential 'HotCommitteeRole
hotCred NE.:| [Credential 'HotCommitteeRole]
_ <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep (Integer
 -> ImpTestM
      era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment))
-> ImpM (LedgerSpec era) Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
10_000_000, Integer
1_000_000_000)
    Integer
deposit <- (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
1_000_000, Integer
100_000_000_000)
    GovActionId
gaId <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
deposit)
    Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred) GovActionId
gaId
    ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gaId
    Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
    GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaId
    ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
    -- Make sure all committee members authorize the same hot credential that just voted:
    [Credential 'ColdCommitteeRole]
committeeMembers' <- Set (Credential 'ColdCommitteeRole)
-> [Credential 'ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList (Set (Credential 'ColdCommitteeRole)
 -> [Credential 'ColdCommitteeRole])
-> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
-> ImpM (LedgerSpec era) [Credential 'ColdCommitteeRole]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
    case [Credential 'ColdCommitteeRole]
committeeMembers' of
      Credential 'ColdCommitteeRole
x : [Credential 'ColdCommitteeRole]
xs -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
 -> ImpM (LedgerSpec era) ())
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys (Credential 'HotCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'HotCommitteeRole
hotCred) (NonEmpty (Credential 'ColdCommitteeRole)
 -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole)))
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
x Credential 'ColdCommitteeRole
-> [Credential 'ColdCommitteeRole]
-> NonEmpty (Credential 'ColdCommitteeRole)
forall a. a -> [a] -> NonEmpty a
NE.:| [Credential 'ColdCommitteeRole]
xs
      [Credential 'ColdCommitteeRole]
_ -> String -> ImpM (LedgerSpec era) ()
forall a. HasCallStack => String -> a
error String
"Expected an initial committee"
    Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
    ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaId)

initiateHardForkWithLessThanMinimalCommitteeSize ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize =
  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hard Fork can still be initiated with less than minimal committee size" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole)
hotCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    (KeyHash 'StakePool
spoK1, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    (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. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
    [Credential 'ColdCommitteeRole]
committeeMembers' <- Set (Credential 'ColdCommitteeRole)
-> [Credential 'ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList (Set (Credential 'ColdCommitteeRole)
 -> [Credential 'ColdCommitteeRole])
-> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
-> ImpM (LedgerSpec era) [Credential 'ColdCommitteeRole]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
    Credential 'ColdCommitteeRole
committeeMember <- [Credential 'ColdCommitteeRole]
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements [Credential 'ColdCommitteeRole]
committeeMembers'
    StrictMaybe Anchor
anchor <- ImpM (LedgerSpec era) (StrictMaybe Anchor)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    Maybe (Credential 'HotCommitteeRole)
mHotCred <- Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
committeeMember StrictMaybe Anchor
anchor
    ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
    GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
    [Credential 'HotCommitteeRole]
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ ((NonEmpty (Credential 'HotCommitteeRole)
 -> [Credential 'HotCommitteeRole])
-> (Credential 'HotCommitteeRole
    -> NonEmpty (Credential 'HotCommitteeRole)
    -> [Credential 'HotCommitteeRole])
-> Maybe (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonEmpty (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. NonEmpty a -> [a]
NE.toList (\Credential 'HotCommitteeRole
hotCred -> (Credential 'HotCommitteeRole -> Bool)
-> NonEmpty (Credential 'HotCommitteeRole)
-> [Credential 'HotCommitteeRole]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (Credential 'HotCommitteeRole
-> Credential 'HotCommitteeRole -> Bool
forall a. Eq a => a -> a -> Bool
/= Credential 'HotCommitteeRole
hotCred)) Maybe (Credential 'HotCommitteeRole)
mHotCred NonEmpty (Credential 'HotCommitteeRole)
hotCs) GovActionId
gai
    Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoK1) GovActionId
gai
    if ProtVer -> Bool
bootstrapPhase ProtVer
protVer
      then do
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gai ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
      else do
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gai ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing

spoAndCCVotingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
spoAndCCVotingSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoAndCCVotingSpec = do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"When CC expired" (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 expireCommitteeMembers :: ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
expireCommitteeMembers = do
          NonEmpty (Credential 'HotCommitteeRole)
hotCs <- ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
          -- TODO: change the maxtermlength to make the test faster
          EpochInterval Word32
committeeMaxTermLength <-
            SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) EpochInterval
 -> ImpTestM era EpochInterval)
-> SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
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))
-> ((EpochInterval -> Const r EpochInterval)
    -> EpochState era -> Const r (EpochState era))
-> (EpochInterval -> Const r EpochInterval)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((EpochInterval -> Const r EpochInterval)
    -> PParams era -> Const r (PParams era))
-> (EpochInterval -> Const r EpochInterval)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Const r EpochInterval)
-> PParams era -> Const r (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
          Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs (Natural -> ImpM (LedgerSpec era) ())
-> Natural -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
committeeMaxTermLength
          Set (Credential 'ColdCommitteeRole)
ms <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
          -- Make sure that committee expired
          Set (Credential 'ColdCommitteeRole)
-> (Credential 'ColdCommitteeRole -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Credential 'ColdCommitteeRole)
ms Credential 'ColdCommitteeRole -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired
          NonEmpty (Credential 'HotCommitteeRole)
-> ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Credential 'HotCommitteeRole)
hotCs
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can't enact hard-fork" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
hotCs <- ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
expireCommitteeMembers
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer

      GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)

      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gai
      -- CC members expired so their votes don't count - we are stuck!
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCs GovActionId
gai

      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
      ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
protVer
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can't enact security group 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
      ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
expireCommitteeMembers
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      NonNegativeInterval
initialRefScriptBaseFee <- Lens' (PParams era) NonNegativeInterval
-> ImpTestM era NonNegativeInterval
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (NonNegativeInterval -> f NonNegativeInterval)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL

      GovActionId
gid <-
        StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
          PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. a -> StrictMaybe a
SJust (Integer
25 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid

      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

      ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
      Lens' (PParams era) NonNegativeInterval
-> ImpTestM era NonNegativeInterval
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (NonNegativeInterval -> f NonNegativeInterval)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL ImpTestM era NonNegativeInterval
-> NonNegativeInterval -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` NonNegativeInterval
initialRefScriptBaseFee
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"When CC threshold is 0" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    -- During the bootstrap phase, proposals that modify the committee are not allowed,
    -- hence we need to directly set the threshold for the initial members
    let
      modifyCommittee :: (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpTestM era ()
modifyCommittee StrictMaybe (Committee era) -> StrictMaybe (Committee era)
f = (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \NewEpochState era
nes ->
        NewEpochState era
nes
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Identity (GovState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Identity (StrictMaybe (Committee era)))
    -> GovState era -> Identity (GovState era))
-> (StrictMaybe (Committee era)
    -> Identity (StrictMaybe (Committee era)))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Identity (StrictMaybe (Committee era)))
-> GovState era -> Identity (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL ((StrictMaybe (Committee era)
  -> Identity (StrictMaybe (Committee era)))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era) -> StrictMaybe (Committee era)
f
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (DRepPulsingState era -> Identity (DRepPulsingState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL ((DRepPulsingState era -> Identity (DRepPulsingState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (DRepPulsingState era -> DRepPulsingState era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DRepPulsingState era -> DRepPulsingState era
modifyDRepPulser
        where
          modifyDRepPulser :: DRepPulsingState era -> DRepPulsingState era
modifyDRepPulser DRepPulsingState era
pulser =
            case DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
pulser of
              (PulsingSnapshot era
snapshot, RatifyState era
rState) -> PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snapshot (RatifyState era
rState RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (EnactState era -> Identity (EnactState era))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Identity (EnactState era))
 -> RatifyState era -> Identity (RatifyState era))
-> ((StrictMaybe (Committee era)
     -> Identity (StrictMaybe (Committee era)))
    -> EnactState era -> Identity (EnactState era))
-> (StrictMaybe (Committee era)
    -> Identity (StrictMaybe (Committee era)))
-> RatifyState era
-> Identity (RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Identity (StrictMaybe (Committee era)))
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> EnactState era -> f (EnactState era)
ensCommitteeL ((StrictMaybe (Committee era)
  -> Identity (StrictMaybe (Committee era)))
 -> RatifyState era -> Identity (RatifyState era))
-> (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> RatifyState era
-> RatifyState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era) -> StrictMaybe (Committee era)
f)
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can enact hard-fork during bootstrap" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
protVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
protVer {pvMajor = nextMajorVersion}
      (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpM (LedgerSpec era) ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraGov era) =>
(StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpTestM era ()
modifyCommittee ((StrictMaybe (Committee era) -> StrictMaybe (Committee era))
 -> ImpM (LedgerSpec era) ())
-> (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (Committee era -> Committee era)
-> StrictMaybe (Committee era) -> StrictMaybe (Committee era)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UnitInterval -> Identity UnitInterval)
-> Committee era -> Identity (Committee era)
forall era (f :: * -> *).
Functor f =>
(UnitInterval -> f UnitInterval)
-> Committee era -> f (Committee era)
committeeThresholdL ((UnitInterval -> Identity UnitInterval)
 -> Committee era -> Identity (Committee era))
-> UnitInterval -> Committee era -> Committee era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)

      GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)

      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gai

      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

      if ProtVer -> Bool
bootstrapPhase ProtVer
protVer
        then do
          ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
          ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer
        else do
          ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
          ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
protVer
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can enact security group parameter change during bootstrap" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      NonNegativeInterval
initialRefScriptBaseFee <- Lens' (PParams era) NonNegativeInterval
-> ImpTestM era NonNegativeInterval
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (NonNegativeInterval -> f NonNegativeInterval)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL
      (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpM (LedgerSpec era) ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraGov era) =>
(StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpTestM era ()
modifyCommittee ((StrictMaybe (Committee era) -> StrictMaybe (Committee era))
 -> ImpM (LedgerSpec era) ())
-> (StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (Committee era -> Committee era)
-> StrictMaybe (Committee era) -> StrictMaybe (Committee era)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UnitInterval -> Identity UnitInterval)
-> Committee era -> Identity (Committee era)
forall era (f :: * -> *).
Functor f =>
(UnitInterval -> f UnitInterval)
-> Committee era -> f (Committee era)
committeeThresholdL ((UnitInterval -> Identity UnitInterval)
 -> Committee era -> Identity (Committee era))
-> UnitInterval -> Committee era -> Committee era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)

      GovActionId
gai <-
        StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
          PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. a -> StrictMaybe a
SJust (Integer
25 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gai

      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

      NonNegativeInterval
newRefScriptBaseFee <- Lens' (PParams era) NonNegativeInterval
-> ImpTestM era NonNegativeInterval
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (NonNegativeInterval -> f NonNegativeInterval)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL
      if ProtVer -> Bool
bootstrapPhase ProtVer
protVer
        then do
          ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
          NonNegativeInterval
newRefScriptBaseFee NonNegativeInterval
-> NonNegativeInterval -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` (Integer
25 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        else do
          ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
          NonNegativeInterval
newRefScriptBaseFee NonNegativeInterval
-> NonNegativeInterval -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` NonNegativeInterval
initialRefScriptBaseFee

committeeExpiryResignationDiscountSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
committeeExpiryResignationDiscountSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeExpiryResignationDiscountSpec =
  -- Committee-update proposals are disallowed during bootstrap, so we can only run these tests post-bootstrap
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Expired and resigned committee members are discounted from quorum" (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
"Expired" (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
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole
committeeColdC1 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
committeeColdC2 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <-
        Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing
          Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
committeeColdC2, Word32 -> EpochInterval
EpochInterval Word32
2)
          ]
          (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiCC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiCC)
      Credential 'HotCommitteeRole
committeeHotC1 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC1
      Credential 'HotCommitteeRole
_committeeHotC2 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC2
      -- Submit a constitution with a CC vote
      GovActionId
gaiConstitution <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committeeHotC1) GovActionId
gaiConstitution
      -- Check for CC acceptance
      Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeExpired Credential 'ColdCommitteeRole
committeeColdC2
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- expire the second CC
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      -- Check for CC acceptance should fail
      Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired Credential 'ColdCommitteeRole
committeeColdC2
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Resigned" (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
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (Natural -> Identity Natural)
-> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCommitteeMinSizeL ((Natural -> Identity Natural)
 -> PParams era -> Identity (PParams era))
-> Natural -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole
committeeColdC1 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
committeeColdC2 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <-
        Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing
          Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
committeeColdC2, Word32 -> EpochInterval
EpochInterval Word32
10)
          ]
          (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiCC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiCC)
      Credential 'HotCommitteeRole
committeeHotC1 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC1
      Credential 'HotCommitteeRole
_committeeHotC2 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC2
      -- Submit a constitution with a CC vote
      GovActionId
gaiConstitution <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committeeHotC1) GovActionId
gaiConstitution
      -- Check for CC acceptance
      Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole
committeeColdC2
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- Resign the second CC
      Maybe (Credential 'HotCommitteeRole)
_ <- Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
committeeColdC2 StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
      -- Check for CC acceptance should fail
      Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole
committeeColdC2
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False

paramChangeAffectsProposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
paramChangeAffectsProposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
paramChangeAffectsProposalsSpec =
  -- These tests rely on submitting committee-update proposals and on drep votes, which are disallowed during bootstrap,
  -- so we can only run them post-bootstrap
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ParameterChange affects existing 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
    let submitTwoExampleProposalsAndVoteOnTheChild ::
          [(KeyHash 'StakePool, Vote)] ->
          [(Credential 'DRepRole, Vote)] ->
          ImpTestM era (GovActionId, GovActionId)
        submitTwoExampleProposalsAndVoteOnTheChild :: [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild [(KeyHash 'StakePool, Vote)]
spos [(Credential 'DRepRole, Vote)]
dreps = do
          Credential 'ColdCommitteeRole
committeeC <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
gaiParent <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
committeeC, Word32 -> EpochInterval
EpochInterval Word32
5)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- We submit a descendent proposal so that even though it is sufficiently
          -- voted on, it cannot be ratified before the ParameterChange proposal
          -- is enacted.
          GovActionId
gaiChild <-
            Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
              (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. a -> Maybe a
Just (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)))
              Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
              [(Credential 'ColdCommitteeRole
committeeC, Word32 -> EpochInterval
EpochInterval Word32
5)]
              (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          [(KeyHash 'StakePool, Vote)]
-> ((KeyHash 'StakePool, Vote) -> ImpTestM era ())
-> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(KeyHash 'StakePool, Vote)]
spos (((KeyHash 'StakePool, Vote) -> ImpTestM era ())
 -> ImpTestM era ())
-> ((KeyHash 'StakePool, Vote) -> ImpTestM era ())
-> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \(KeyHash 'StakePool
spo, Vote
vote) -> Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gaiChild
          [(Credential 'DRepRole, Vote)]
-> ((Credential 'DRepRole, Vote) -> ImpTestM era ())
-> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Credential 'DRepRole, Vote)]
dreps (((Credential 'DRepRole, Vote) -> ImpTestM era ())
 -> ImpTestM era ())
-> ((Credential 'DRepRole, Vote) -> ImpTestM era ())
-> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \(Credential 'DRepRole
drep, Vote
vote) -> Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiChild
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- Make the votes count
          (GovActionId, GovActionId)
-> ImpTestM era (GovActionId, GovActionId)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId
gaiParent, GovActionId
gaiChild)
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" (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 setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold UnitInterval
threshold =
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold
          getDrepVotingThresholds :: ImpTestM era DRepVotingThresholds
getDrepVotingThresholds = Lens' (PParams era) DRepVotingThresholds
-> ImpTestM era DRepVotingThresholds
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (DRepVotingThresholds -> f DRepVotingThresholds)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
          enactCommitteeUpdateThreshold :: UnitInterval
-> t (Credential 'DRepRole)
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
enactCommitteeUpdateThreshold UnitInterval
threshold t (Credential 'DRepRole)
dreps Credential 'HotCommitteeRole
hotCommitteeC = do
            DRepVotingThresholds
drepVotingThresholds <- ImpTestM era DRepVotingThresholds
getDrepVotingThresholds
            GovAction era
paramChange <-
              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
                    PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DRepVotingThresholds
 -> Identity (StrictMaybe DRepVotingThresholds))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL
                      ((StrictMaybe DRepVotingThresholds
  -> Identity (StrictMaybe DRepVotingThresholds))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe DRepVotingThresholds
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds -> StrictMaybe DRepVotingThresholds
forall a. a -> StrictMaybe a
SJust (DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> (DRepVotingThresholds -> DRepVotingThresholds)
-> DRepVotingThresholds
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL ((UnitInterval -> Identity UnitInterval)
 -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> UnitInterval -> DRepVotingThresholds -> DRepVotingThresholds
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
                )
            GovActionId
pcGai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
paramChange
            t (Credential 'DRepRole)
-> (Credential 'DRepRole -> ImpTestM era ()) -> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (Credential 'DRepRole)
dreps ((Credential 'DRepRole -> ImpTestM era ()) -> ImpTestM era ())
-> (Credential 'DRepRole -> ImpTestM era ()) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \Credential 'DRepRole
drep -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
pcGai
            Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
pcGai
            GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
pcGai ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            (DRepVotingThresholds
-> Getting UnitInterval DRepVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval DRepVotingThresholds UnitInterval
Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL) (DRepVotingThresholds -> UnitInterval)
-> ImpTestM era DRepVotingThresholds
-> ImpM (LedgerSpec era) UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpTestM era DRepVotingThresholds
getDrepVotingThresholds ImpM (LedgerSpec era) UnitInterval
-> UnitInterval -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` UnitInterval
threshold

      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Increasing the threshold prevents a hitherto-ratifiable proposal from being ratified" (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
        (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraPParams era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold (UnitInterval -> ImpTestM era ())
-> UnitInterval -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2 -- small threshold
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (GovActionId
_gaiParent, GovActionId
gaiChild) <- [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild [] [(Credential 'DRepRole
drep, Vote
VoteYes)]
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        UnitInterval
-> [Credential 'DRepRole]
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
forall {t :: * -> *}.
Foldable t =>
UnitInterval
-> t (Credential 'DRepRole)
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
enactCommitteeUpdateThreshold
          (Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          ([Item [Credential 'DRepRole]
Credential 'DRepRole
drepC, Item [Credential 'DRepRole]
Credential 'DRepRole
drep] :: [Credential 'DRepRole])
          Credential 'HotCommitteeRole
hotCommitteeC
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decreasing the threshold ratifies a hitherto-unratifiable proposal" (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
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraPParams era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold (UnitInterval -> ImpTestM era ())
-> UnitInterval -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1 -- too large threshold
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
3_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000
        (GovActionId
gaiParent, GovActionId
gaiChild) <-
          [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild [(KeyHash 'StakePool
spoC, Vote
VoteYes)] [(Credential 'DRepRole
drep, Vote
VoteYes)]
        GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaiChild
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        UnitInterval
-> [Credential 'DRepRole]
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
forall {t :: * -> *}.
Foldable t =>
UnitInterval
-> t (Credential 'DRepRole)
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
enactCommitteeUpdateThreshold
          (Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          ([Item [Credential 'DRepRole]
Credential 'DRepRole
drepC, Item [Credential 'DRepRole]
Credential 'DRepRole
drep] :: [Credential 'DRepRole])
          Credential 'HotCommitteeRole
hotCommitteeC
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        -- Not vote on the parent too to make sure both get enacted
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiParent
        -- bootstrap: 3 % 4 stake yes; 1 % 4 stake abstain; yes / stake - abstain > 1 % 2
        -- post-bootstrap: 3 % 4 stake yes; 1 % 4 stake no
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiParent
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- UpdateCommittee is a delaying action
        ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiChild)
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SPO" (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 setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
          setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold UnitInterval
threshold =
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold
          enactCommitteeUpdateThreshold :: UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpM (LedgerSpec era) ()
enactCommitteeUpdateThreshold UnitInterval
threshold Credential 'DRepRole
drepC Credential 'HotCommitteeRole
hotCommitteeC = do
            PoolVotingThresholds
poolVotingThresholds <- Lens' (PParams era) PoolVotingThresholds
-> ImpTestM era PoolVotingThresholds
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PoolVotingThresholds -> f PoolVotingThresholds)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
            GovAction era
paramChange <-
              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
                    PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe PoolVotingThresholds
 -> Identity (StrictMaybe PoolVotingThresholds))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
ppuPoolVotingThresholdsL
                      ((StrictMaybe PoolVotingThresholds
  -> Identity (StrictMaybe PoolVotingThresholds))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe PoolVotingThresholds
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds -> StrictMaybe PoolVotingThresholds
forall a. a -> StrictMaybe a
SJust (PoolVotingThresholds
poolVotingThresholds PoolVotingThresholds
-> (PoolVotingThresholds -> PoolVotingThresholds)
-> PoolVotingThresholds
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL ((UnitInterval -> Identity UnitInterval)
 -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> UnitInterval -> PoolVotingThresholds -> PoolVotingThresholds
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
                )
            GovActionId
pcGai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
paramChange
            Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
pcGai
            Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
pcGai
            Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            (PoolVotingThresholds
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL) (PoolVotingThresholds -> UnitInterval)
-> ImpTestM era PoolVotingThresholds
-> ImpM (LedgerSpec era) UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lens' (PParams era) PoolVotingThresholds
-> ImpTestM era PoolVotingThresholds
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PoolVotingThresholds -> f PoolVotingThresholds)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL) ImpM (LedgerSpec era) UnitInterval
-> UnitInterval -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` UnitInterval
threshold

      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Increasing the threshold prevents a hitherto-ratifiable proposal from being ratified" (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
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold (UnitInterval -> ImpTestM era ())
-> UnitInterval -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        (KeyHash 'StakePool
poolKH1, Credential 'Payment
_paymentC1, Credential 'Staking
_stakingC1) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000
        (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- Make the new pool distribution count
        -- bootstrap: 1 % 2 stake yes (2_000_000); 1 % 2 stake abstain; yes / stake - abstain == 1 % 2
        -- post-bootstrap: 1 % 2 stake yes (2_000_000); 1 % 4 stake didn't vote; 1 % 4 stake no
        (GovActionId
_gaiParent, GovActionId
gaiChild) <-
          [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild
            [(KeyHash 'StakePool
poolKH1, Vote
VoteYes), (KeyHash 'StakePool
poolKH2, Vote
VoteNo)]
            [(Credential 'DRepRole
drepC, Vote
VoteYes)]
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era))) =>
UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpM (LedgerSpec era) ()
enactCommitteeUpdateThreshold (Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) Credential 'DRepRole
drepC Credential 'HotCommitteeRole
hotCommitteeC
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decreasing the threshold ratifies a hitherto-unratifiable proposal" (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
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold (UnitInterval -> ImpTestM era ())
-> UnitInterval -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1 -- too large threshold
        (KeyHash 'StakePool
poolKH1, Credential 'Payment
_paymentC1, Credential 'Staking
_stakingC1) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4_000_000
        (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        -- bootstrap: 1 % 2 stake yes (2_000_000); 1 % 2 stake abstain; yes / stake - abstain == 1 % 2
        -- post-bootstrap: 1 % 2 stake yes (2_000_000); 1 % 4 stake didn't vote; 1 % 4 stake no
        (GovActionId
gaiParent, GovActionId
gaiChild) <-
          [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild
            [(KeyHash 'StakePool
poolKH1, Vote
VoteYes), (KeyHash 'StakePool
poolKH2, Vote
VoteNo)]
            [(Credential 'DRepRole
drepC, Vote
VoteYes)]
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era))) =>
UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpM (LedgerSpec era) ()
enactCommitteeUpdateThreshold (Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) Credential 'DRepRole
drepC Credential 'HotCommitteeRole
hotCommitteeC -- smaller threshold
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        -- Not vote on the parent too to make sure both get enacted
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiParent
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
gaiParent
        GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaiParent
        GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaiChild
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- UpdateCommittee is a delaying action
        ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiChild)
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"A parent ParameterChange proposal can prevent its child from being enacted" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      -- Setup one other DRep with equal stake
      (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
_ <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      -- Set a smaller DRep threshold
      DRepVotingThresholds
drepVotingThresholds <- Lens' (PParams era) DRepVotingThresholds
-> ImpTestM era DRepVotingThresholds
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (DRepVotingThresholds -> f DRepVotingThresholds)
-> PParams era -> f (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
        (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
          ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> (DRepVotingThresholds -> DRepVotingThresholds)
-> DRepVotingThresholds
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPGovGroupL ((UnitInterval -> Identity UnitInterval)
 -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> UnitInterval -> DRepVotingThresholds -> DRepVotingThresholds
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      -- Submit a parent-child sequence of ParameterChange proposals and vote on
      -- both equally, so that both may be ratified. But, the parent increases
      -- the threshold, and it should prevent the child from being ratified.
      let paramChange :: StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
paramChange StrictMaybe GovActionId
parent UnitInterval
threshold =
            StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction
              StrictMaybe GovActionId
parent
              ( PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                  PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe DRepVotingThresholds
 -> Identity (StrictMaybe DRepVotingThresholds))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL
                    ((StrictMaybe DRepVotingThresholds
  -> Identity (StrictMaybe DRepVotingThresholds))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe DRepVotingThresholds
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds -> StrictMaybe DRepVotingThresholds
forall a. a -> StrictMaybe a
SJust (DRepVotingThresholds
drepVotingThresholds DRepVotingThresholds
-> (DRepVotingThresholds -> DRepVotingThresholds)
-> DRepVotingThresholds
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPGovGroupL ((UnitInterval -> Identity UnitInterval)
 -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> UnitInterval -> DRepVotingThresholds -> DRepVotingThresholds
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
              )
      GovActionId
parentGai <- StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
paramChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ((Integer
90 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)) ImpTestM era (GovAction era)
-> (GovAction era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      GovActionId
childGai <- StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraImp era, ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
paramChange (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
parentGai) (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) ImpTestM era (GovAction era)
-> (GovAction era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
parentGai
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
parentGai
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
childGai
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
childGai
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
parentGai
      GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
childGai
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
parentGai ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
childGai ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
parentGai)
      GovPurposeId 'PParamUpdatePurpose era
-> Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era))
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
childGai) (Map
   (GovPurposeId 'PParamUpdatePurpose era)
   (PEdges (GovPurposeId 'PParamUpdatePurpose era))
 -> Bool)
-> ImpM
     (LedgerSpec era)
     (Map
        (GovPurposeId 'PParamUpdatePurpose era)
        (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
-> ImpTestM era Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM
  (LedgerSpec era)
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
childGai ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False

committeeMinSizeAffectsInFlightProposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
committeeMinSizeAffectsInFlightProposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMinSizeAffectsInFlightProposalsSpec =
  -- Treasury withdrawals are disallowed during bootstrap, so we can only run these tests post-bootstrap
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CommitteeMinSize affects in-flight 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
    let setCommitteeMinSize :: Natural -> ImpTestM era ()
setCommitteeMinSize Natural
n = (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> 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
n
        submitTreasuryWithdrawal :: Coin -> ImpM (LedgerSpec era) GovActionId
submitTreasuryWithdrawal Coin
amount = do
          RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
          [(RewardAccount, Coin)] -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount
rewardAccount, Coin
amount)]
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal fails to ratify due to an increase in CommitteeMinSize" (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
      ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      Coin
amount <- (Coin, Coin) -> ImpM (LedgerSpec era) Coin
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer -> Coin
Coin Integer
1, Integer -> Coin
Coin Integer
100_000_000)
      -- Ensure sufficient amount in the treasury
      Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
amount)
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      Natural -> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraPParams era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      GovActionId
gaiTW <- Coin -> ImpM (LedgerSpec era) GovActionId
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
Coin -> ImpM (LedgerSpec era) GovActionId
submitTreasuryWithdrawal Coin
amount
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gaiTW
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiTW
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      GovActionId
gaiPC <-
        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 -> ImpM (LedgerSpec era) GovActionId)
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$
          PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe 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
3
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gaiPC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiPC
      Coin
treasury <- SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      -- The ParameterChange prevents the TreasuryWithdrawal from being enacted,
      -- because it has higher priority.
      ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiPC)
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
currentProposalsShouldContain GovActionId
gaiTW
      SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL ImpM (LedgerSpec era) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
treasury
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal ratifies due to a decrease in CommitteeMinSize" (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
      ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Coin
amount <- (Coin, Coin) -> ImpM (LedgerSpec era) Coin
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer -> Coin
Coin Integer
1, Integer -> Coin
Coin Integer
100_000_000)
      -- Ensure sufficient amount in the treasury
      Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
amount)
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      Coin
treasury <- SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
      GovActionId
gaiTW <- Coin -> ImpM (LedgerSpec era) GovActionId
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
Coin -> ImpM (LedgerSpec era) GovActionId
submitTreasuryWithdrawal Coin
amount
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
gaiTW
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiTW
      Natural -> ImpTestM era ()
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, ConwayEraPParams era,
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era)),
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era))) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL ImpM (LedgerSpec era) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
treasury
      -- We do not enact the ParameterChange here because that does not pass
      -- ratification as the CC size is smaller than MinSize.
      -- We instead just add another Committee member to reach the CommitteeMinSize.
      Credential 'ColdCommitteeRole
coldCommitteeCred <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
coldCommitteeCred, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiCC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      Credential 'HotCommitteeRole
_hotCommitteeC' <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
coldCommitteeCred
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL ImpM (LedgerSpec era) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Coin
treasury Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
amount)

spoVotesForHardForkInitiation ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
spoVotesForHardForkInitiation :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoVotesForHardForkInitiation =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Counting of SPO votes" (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
"HardForkInitiation" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ((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
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtHardForkInitiationL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
forall a. Default a => a
def)
      NonEmpty (Credential 'HotCommitteeRole)
hotCCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoK1, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool
spoK2, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtHardForkInitiationL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
      ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCCs GovActionId
gai
      -- 1 % 4 stake yes; 3 % 4 stake no; yes / stake - abstain < 1 % 2
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoK1) GovActionId
gai
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gai
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gai ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
      -- 1 % 2 stake yes; 1 % 2 stake no; yes / stake - abstain = 1 % 2
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoK2) GovActionId
gai
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gai ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)

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
    -- These tests involve DRep voting, which is not possible in bootstrap,
    -- so we have to run them only post-bootstrap
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPO needs to vote on security-relevant parameter changes" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
ccCreds <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
khPool, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Coin
initMinFeeA <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL
      GovActionId
gaidThreshold <- String
-> ImpM (LedgerSpec era) GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Update StakePool thresholds" (ImpM (LedgerSpec era) GovActionId
 -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ do
        PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
        (PParams era
pp PParams era
-> Getting UnitInterval (PParams era) UnitInterval -> UnitInterval
forall s a. s -> Getting a s a -> a
^. (PoolVotingThresholds -> Const UnitInterval PoolVotingThresholds)
-> PParams era -> Const UnitInterval (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Const UnitInterval PoolVotingThresholds)
 -> PParams era -> Const UnitInterval (PParams era))
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> Getting UnitInterval (PParams era) UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
pvtPPSecurityGroupL) UnitInterval -> UnitInterval -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` (Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
        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
& (StrictMaybe PoolVotingThresholds
 -> Identity (StrictMaybe PoolVotingThresholds))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
ppuPoolVotingThresholdsL
                  ((StrictMaybe PoolVotingThresholds
  -> Identity (StrictMaybe PoolVotingThresholds))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe PoolVotingThresholds
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds -> StrictMaybe PoolVotingThresholds
forall a. a -> StrictMaybe a
SJust
                    PoolVotingThresholds
                      { pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
                      , pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                      , pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                      , pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                      , pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                      }
                PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuGovActionLifetimeL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe EpochInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval -> StrictMaybe EpochInterval
forall a. a -> StrictMaybe a
SJust (Word32 -> EpochInterval
EpochInterval Word32
15)
        GovAction era
ppUpdateGa <- 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
        GovActionId
gaidThreshold <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ppUpdateGa ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaidThreshold
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
ccCreds GovActionId
gaidThreshold
        GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaidThreshold
        GovActionId -> ImpM (LedgerSpec era) GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
gaidThreshold
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaidThreshold
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      let newMinFeeA :: Coin
newMinFeeA = Integer -> Coin
Coin Integer
1000
      GovActionId
gaidMinFee <- do
        PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
        String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Security group threshold should be 1/2" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
          (PParams era
pp PParams era
-> Getting UnitInterval (PParams era) UnitInterval -> UnitInterval
forall s a. s -> Getting a s a -> a
^. (PoolVotingThresholds -> Const UnitInterval PoolVotingThresholds)
-> PParams era -> Const UnitInterval (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Const UnitInterval PoolVotingThresholds)
 -> PParams era -> Const UnitInterval (PParams era))
-> Getting UnitInterval PoolVotingThresholds UnitInterval
-> Getting UnitInterval (PParams era) UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitInterval PoolVotingThresholds UnitInterval
Lens' PoolVotingThresholds UnitInterval
pvtPPSecurityGroupL) UnitInterval -> UnitInterval -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        GovAction era
ga <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
gaidThreshold)
            (PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe 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 Coin
newMinFeeA)
        GovActionId
gaidMinFee <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaidMinFee
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
ccCreds GovActionId
gaidMinFee
        GovActionId -> ImpM (LedgerSpec era) GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
gaidMinFee
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaidMinFee
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      do
        PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
        (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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
initMinFeeA
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
khPool) GovActionId
gaidMinFee
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpTestM era ()
forall era.
(ToExpr (InstantStake era), HasCallStack) =>
ImpTestM era ()
logInstantStake
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaidMinFee
      GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaidMinFee
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      (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. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
newMinFeeA
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Active voting stake" (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
"DRep" (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
"UTxOs contribute to active voting stake" (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
          -- Setup DRep delegation #1
          (Credential 'DRepRole
drep1, KeyHashObj KeyHash 'Staking
stakingKH1, KeyPair 'Payment
paymentKP1) <- 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_000
          -- Setup DRep delegation #2
          (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
_ <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000_000
          (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
addCCGaid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- Submit the vote
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
addCCGaid
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The vote should not result in a ratification
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
          -- Bump up the UTxO delegated
          -- to barely make the threshold (65 %! 100)
          KeyPair 'Staking
stakingKP1 <- KeyHash 'Staking -> ImpM (LedgerSpec era) (KeyPair 'Staking)
forall s (m :: * -> *) (r :: KeyRole).
(HasCallStack, HasKeyPairs s, MonadState s m) =>
KeyHash r -> m (KeyPair r)
getKeyPair KeyHash 'Staking
stakingKH1
          Addr -> Coin -> ImpTestM era ()
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era ()
sendCoinTo_ (KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
paymentKP1 KeyPair 'Staking
stakingKP1) (Coin -> Coin
forall t s. Inject t s => t -> s
inject (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
858_000_000)
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The same vote should now successfully ratify the proposal
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rewards contribute to active voting stake" (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
          -- Setup DRep delegation #1
          (Credential 'DRepRole
drep1, Credential 'Staking
staking1, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000_000
          -- Setup DRep delegation #2
          (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
_ <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000_000
          (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
addCCGaid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- Submit the vote
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
addCCGaid
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The vote should not result in a ratification
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
          -- Add to the rewards of the delegator to this DRep
          -- to barely make the threshold (61 %! 100)
          (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((UMap -> Identity UMap)
    -> EpochState era -> Identity (EpochState era))
-> (UMap -> Identity UMap)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Identity UMap)
-> EpochState era -> Identity (EpochState era)
forall era. EraCertState era => Lens' (EpochState era) UMap
Lens' (EpochState era) UMap
epochStateUMapL
              ((UMap -> Identity UMap)
 -> NewEpochState era -> Identity (NewEpochState era))
-> (UMap -> UMap) -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RDPair -> RDPair)
-> Credential 'Staking
-> UView (Credential 'Staking) RDPair
-> UMap
forall k. (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
UM.adjust
                (\(UM.RDPair CompactForm Coin
r CompactForm Coin
d) -> CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (CompactForm Coin
r CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
<> Word64 -> CompactForm Coin
UM.CompactCoin Word64
858_000_000) CompactForm Coin
d)
                Credential 'Staking
staking1
                (UView (Credential 'Staking) RDPair -> UMap)
-> (UMap -> UView (Credential 'Staking) RDPair) -> UMap -> UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap -> UView (Credential 'Staking) RDPair
UM.RewDepUView
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The same vote should now successfully ratify the proposal
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rewards contribute to active voting stake even in the absence of StakeDistr" (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
          let govActionLifetime :: Word32
govActionLifetime = Word32
5
              govActionDeposit :: Coin
govActionDeposit = Integer -> Coin
Coin Integer
1_000_000
              poolDeposit :: Coin
poolDeposit = Integer -> Coin
Coin Integer
858_000
          -- Only modify the applicable thresholds
          (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
poolDeposit
              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. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((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
govActionLifetime
              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
govActionLifetime
          -- Setup DRep delegation #1
          (KeyHash 'DRepRole
drepKH1, KeyHash 'Staking
stakingKH1) <- ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake
          -- Add rewards to delegation #1
          Credential 'Staking -> ImpTestM era ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward (Credential 'Staking -> ImpTestM era ())
-> Credential 'Staking -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1
          Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1) ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
          -- Setup DRep delegation #2
          (KeyHash 'DRepRole
_drepKH2, KeyHash 'Staking
stakingKH2) <- ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake
          (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Add rewards to delegation #2
          Credential 'Staking -> ImpTestM era ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward (Credential 'Staking -> ImpTestM era ())
-> Credential 'Staking -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH2
          Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH2) ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          Positive Word32
extra <- ImpM (LedgerSpec era) (Positive Word32)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
          let lifetime :: EpochInterval
lifetime = Word32 -> EpochInterval
EpochInterval (Word32
extra Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
govActionLifetime)
          GovActionId
addCCGaid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, EpochInterval
lifetime)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- Submit the vote
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter (Credential 'DRepRole -> Voter) -> Credential 'DRepRole -> Voter
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH1) GovActionId
addCCGaid
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The vote should not result in a ratification
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
          -- Increase the rewards of the delegator to this DRep
          -- to barely make the threshold (65 %! 100)
          Credential 'Staking -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
Credential 'Staking -> ImpTestM era ()
registerAndRetirePoolToMakeReward (Credential 'Staking -> ImpTestM era ())
-> Credential 'Staking -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1
          Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1) ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
poolDeposit Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
govActionDeposit
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          -- The same vote should now successfully ratify the proposal
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposal deposits contribute to active voting stake" (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
"Directly" (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
            -- Only modify the applicable thresholds
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1_000_000
            -- Setup DRep delegation without stake #1
            (KeyHash 'DRepRole
drepKH1, KeyHash 'Staking
stakingKH1) <- ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake
            -- Setup DRep delegation #2
            (Credential 'DRepRole
_drepKH2, Credential 'Staking
_stakingKH2, KeyPair 'Payment
_paymentKP2) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
            (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
            -- Make a note of the reward account for the delegator to DRep #1
            RewardAccount
dRepRewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor (Credential 'Staking -> ImpTestM era RewardAccount)
-> Credential 'Staking -> ImpTestM era RewardAccount
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1
            -- Submit the first committee proposal, the one we will test active voting stake against.
            -- The proposal deposit comes from the root UTxO
            Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId
addCCGaid <-
              GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
                (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
                RewardAccount
dRepRewardAccount
                ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
            -- Submit the vote from DRep #1
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter (Credential 'DRepRole -> Voter) -> Credential 'DRepRole -> Voter
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH1) GovActionId
addCCGaid
            Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The vote should not result in a ratification
            GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            -- Submit another proposal to bump up the active voting stake
            Credential 'ColdCommitteeRole
cc' <- 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
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc' (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
              (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
              RewardAccount
dRepRewardAccount
              ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The same vote should now successfully ratify the proposal
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
          String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"After switching delegations" (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
            -- Only modify the applicable thresholds
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1_000_000
            -- Setup DRep delegation without stake #1
            (KeyHash 'DRepRole
drepKH1, KeyHash 'Staking
stakingKH1) <- ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake
            -- Setup DRep delegation #2
            (Credential 'DRepRole
_drepKH2, Credential 'Staking
_stakingKH2, KeyPair 'Payment
_paymentKP2) <- 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
            -- Setup DRep delegation #3
            (KeyHash 'DRepRole
_drepKH3, KeyHash 'Staking
stakingKH3) <- ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake
            (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
            -- Make a note of the reward accounts for the delegators to DReps #1 and #3
            RewardAccount
dRepRewardAccount1 <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor (Credential 'Staking -> ImpTestM era RewardAccount)
-> Credential 'Staking -> ImpTestM era RewardAccount
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH1
            RewardAccount
dRepRewardAccount3 <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor (Credential 'Staking -> ImpTestM era RewardAccount)
-> Credential 'Staking -> ImpTestM era RewardAccount
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH3
            -- Submit committee proposals
            -- The proposal deposits comes from the root UTxO
            -- After this both stakingKH1 and stakingKH3 are expected to have 1_000_000 ADA of stake, each
            Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId
addCCGaid <-
              GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
                (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
                RewardAccount
dRepRewardAccount1
                ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
            Credential 'ColdCommitteeRole
cc' <- 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
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc' (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
              (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
              RewardAccount
dRepRewardAccount3
              ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
            -- Submit the vote from DRep #1
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter (Credential 'DRepRole -> Voter) -> Credential 'DRepRole -> Voter
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH1) GovActionId
addCCGaid
            Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The vote should not result in a ratification
            GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            -- Switch the delegation from DRep #3 to DRep #1
            String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Switch the delegation from DRep #3 to DRep #1" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
              TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
                Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                  ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
                    [ Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert
                        (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
stakingKH3)
                        (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential (Credential 'DRepRole -> DRep) -> Credential 'DRepRole -> DRep
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH1))
                    ]
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The same vote should now successfully ratify the proposal
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
      String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Predefined DReps" (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
"acceptedRatio with default DReps" (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
          (Credential 'DRepRole
drep1, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          (Credential 'DRepRole
_, Credential 'Staking
drep2Staking, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          GovActionId
paramChangeGovId <- 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 -> ImpM (LedgerSpec era) GovActionId)
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000)
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
paramChangeGovId

          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
paramChangeGovId ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

          KeyHash 'Staking
kh <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          RewardAccount
_ <- Credential 'Staking -> ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
          KeyPair 'Payment
_ <- Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysNoConfidence
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- AlwaysNoConfidence vote acts like a 'No' vote for actions other than NoConfidence
          GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
paramChangeGovId ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3

          KeyPair 'Payment
_ <- Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep Credential 'Staking
drep2Staking Coin
forall t. Val t => t
zero DRep
DRepAlwaysAbstain
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- AlwaysAbstain vote acts like 'Abstain' vote
          GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
paramChangeGovId ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

          GovActionId
noConfidenceGovId <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
noConfidenceGovId
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- AlwaysNoConfidence vote acts like 'Yes' for NoConfidence actions
          GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
noConfidenceGovId ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"AlwaysNoConfidence" (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
          (Credential 'DRepRole
drep1, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

          -- drep2 won't explicitly vote, but eventually delegate to AlwaysNoConfidence
          (Credential 'DRepRole
drep2, Credential 'Staking
drep2Staking, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          -- we register another drep with the same stake as drep1, which will vote No -
          -- in order to make it necessary to redelegate to AlwaysNoConfidence,
          -- rather than just unregister
          (Credential 'DRepRole
drep3, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
          (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

          GovActionId
noConfidenceGovId <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
noConfidenceGovId
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep3) GovActionId
noConfidenceGovId
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
noConfidenceGovId
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- drep1 doesn't have enough stake to enact NoConfidence
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
initialMembers

          -- drep2 unregisters, but NoConfidence still doesn't pass, because there's a tie between drep1 and drep3
          Credential 'DRepRole -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drep2
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False

          KeyPair 'Payment
_ <- Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep Credential 'Staking
drep2Staking Coin
forall t. Val t => t
zero DRep
DRepAlwaysNoConfidence
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"AlwaysAbstain" (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
          let getTreasury :: ImpTestM era Coin
getTreasury = SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL

          ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
          Coin -> ImpTestM era ()
forall era. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury (Coin -> ImpTestM era ()) -> Coin -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5_000_000

          (Credential 'DRepRole
drep1, Credential 'HotCommitteeRole
comMember, GovPurposeId 'CommitteePurpose era
_) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          Coin
initialTreasury <- ImpTestM era Coin
forall {era}. ImpTestM era Coin
getTreasury

          (Credential 'DRepRole
drep2, Credential 'Staking
drep2Staking, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
          GovActionId
govId <- [(RewardAccount, Coin)] -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount
rewardAccount, Coin
initialTreasury)]

          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
comMember) GovActionId
govId
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
govId
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep2) GovActionId
govId
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- drep1 doesn't have enough stake to enact the withdrawals
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
govId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          ImpTestM era Coin
forall {era}. ImpTestM era Coin
getTreasury ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
initialTreasury

          KeyPair 'Payment
_ <- Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep Credential 'Staking
drep2Staking Coin
forall t. Val t => t
zero DRep
DRepAlwaysAbstain

          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- the delegation turns the No vote into an Abstain, enough to pass the action
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
govId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          ImpTestM era Coin
forall {era}. ImpTestM era Coin
getTreasury ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
forall t. Val t => t
zero

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRepAlwaysNoConfidence is sufficient to pass NoConfidence" (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
          (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtMotionNoConfidenceL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtMotionNoConfidenceL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams era -> Identity (PParams era)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams era -> Identity (PParams era))
-> CoinPerByte -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
1)
          (Credential 'DRepRole
drep, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          KeyHash 'Staking
kh <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          RewardAccount
_ <- Credential 'Staking -> ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
          KeyPair 'Payment
_ <- Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) (Integer -> Coin
Coin Integer
300) DRep
DRepAlwaysNoConfidence
          GovActionId
noConfidence <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeId))
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
noConfidence
          GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
noConfidence
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
noConfidence)

      String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"StakePool" (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
"UTxOs contribute to active voting stake" (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
          -- Only modify the applicable thresholds
          (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
              ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> PoolVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
forall a. Default a => a
def
                { pvtCommitteeNormal = 51 %! 100
                , pvtCommitteeNoConfidence = 51 %! 100
                }
          ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ((PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
forall a. Default a => a
def)
          -- Setup Pool delegation #1
          (KeyHash 'StakePool
poolKH1, Credential 'Payment
delegatorCPayment1, Credential 'Staking
delegatorCStaking1) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          -- Setup Pool delegation #2
          (KeyHash 'StakePool
poolKH2, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
addCCGaid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- Submit the vote
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
addCCGaid
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH2) GovActionId
addCCGaid
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The vote should not result in a ratification
          GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
addCCGaid
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
          -- Bump up the UTxO delegated
          -- to barely make the threshold (51 %! 100)
          Addr -> Coin -> ImpTestM era ()
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era ()
sendCoinTo_ (Credential 'Payment -> Credential 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr Credential 'Payment
delegatorCPayment1 Credential 'Staking
delegatorCStaking1) (Integer -> Coin
Coin Integer
40_900_000)
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The same vote should now successfully ratify the proposal
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rewards contribute to active voting stake" (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
          -- Only modify the applicable thresholds
          (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
              ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> PoolVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
forall a. Default a => a
def
                { pvtCommitteeNormal = 51 %! 100
                , pvtCommitteeNoConfidence = 51 %! 100
                }
          ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ((PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
forall a. Default a => a
def)

          -- Setup Pool delegation #1
          (KeyHash 'StakePool
poolKH1, Credential 'Payment
_, Credential 'Staking
delegatorCStaking1) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          -- Setup Pool delegation #2
          (KeyHash 'StakePool
poolKH2, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
addCCGaid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          -- Submit the vote
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
addCCGaid
          Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH2) GovActionId
addCCGaid
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The vote should not result in a ratification
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
          -- Add to the rewards of the delegator to this SPO
          -- to barely make the threshold (51 %! 100)
          (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((UMap -> Identity UMap)
    -> EpochState era -> Identity (EpochState era))
-> (UMap -> Identity UMap)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Identity UMap)
-> EpochState era -> Identity (EpochState era)
forall era. EraCertState era => Lens' (EpochState era) UMap
Lens' (EpochState era) UMap
epochStateUMapL
              ((UMap -> Identity UMap)
 -> NewEpochState era -> Identity (NewEpochState era))
-> (UMap -> UMap) -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RDPair -> RDPair)
-> Credential 'Staking
-> UView (Credential 'Staking) RDPair
-> UMap
forall k. (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
UM.adjust
                (\(UM.RDPair CompactForm Coin
r CompactForm Coin
d) -> CompactForm Coin -> CompactForm Coin -> RDPair
UM.RDPair (CompactForm Coin
r CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
<> Word64 -> CompactForm Coin
UM.CompactCoin Word64
200_000_000) CompactForm Coin
d)
                Credential 'Staking
delegatorCStaking1
                (UView (Credential 'Staking) RDPair -> UMap)
-> (UMap -> UView (Credential 'Staking) RDPair) -> UMap -> UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap -> UView (Credential 'Staking) RDPair
UM.RewDepUView
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- The same vote should now successfully ratify the proposal
          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rewards contribute to active voting stake even in the absence of StakeDistr" (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
            let govActionLifetime :: Word32
govActionLifetime = Word32
5
                govActionDeposit :: Coin
govActionDeposit = Integer -> Coin
Coin Integer
1_000_000
                poolDeposit :: Coin
poolDeposit = Integer -> Coin
Coin Integer
200_000
            -- Only modify the applicable thresholds
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
                  ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> PoolVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
forall a. Default a => a
def
                    { pvtCommitteeNormal = 51 %! 100
                    , pvtCommitteeNoConfidence = 51 %! 100
                    }
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
poolDeposit
                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. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((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
5
                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
govActionLifetime
            ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ((PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
forall a. Default a => a
def)

            -- Setup Pool delegation #1
            (KeyHash 'StakePool
poolKH1, Credential 'Staking
delegatorCStaking1) <- ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake
            -- Add rewards to delegation #1
            Credential 'Staking -> ImpTestM era ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
delegatorCStaking1
            Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward Credential 'Staking
delegatorCStaking1 ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
            -- Setup Pool delegation #2
            (KeyHash 'StakePool
poolKH2, Credential 'Staking
delegatorCStaking2) <- ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake
            -- Add rewards to delegation #2
            Credential 'Staking -> ImpTestM era ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
delegatorCStaking2
            Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward Credential 'Staking
delegatorCStaking2 ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
            -- Submit a committee proposal
            Positive Word32
extra <- ImpM (LedgerSpec era) (Positive Word32)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
            Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            GovActionId
addCCGaid <-
              Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
                Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing
                Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
                [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval (Word32
extra Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
govActionLifetime))]
                (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
            -- Submit the vote
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
addCCGaid
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH2) GovActionId
addCCGaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The vote should not result in a ratification
            GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
addCCGaid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
addCCGaid
            -- Add to the rewards of the delegator to this SPO
            -- to barely make the threshold (51 %! 100)
            Credential 'Staking -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
Credential 'Staking -> ImpTestM era ()
registerAndRetirePoolToMakeReward Credential 'Staking
delegatorCStaking1
            Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward Credential 'Staking
delegatorCStaking1 ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
poolDeposit Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
govActionDeposit
            -- The same vote should now successfully ratify the proposal
            -- NOTE: It takes 2 epochs for SPO votes as opposed to 1 epoch
            -- for DRep votes to ratify a proposal.
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
        String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposal deposits contribute to active voting stake" (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
"Directly" (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
            -- Only modify the applicable thresholds
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
                  ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> PoolVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
forall a. Default a => a
def
                    { pvtCommitteeNormal = 51 %! 100
                    , pvtCommitteeNoConfidence = 51 %! 100
                    }
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
                  ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
forall a. Default a => a
def
                    { dvtCommitteeNormal = 0 %! 1
                    , dvtCommitteeNoConfidence = 0 %! 1
                    }
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
600_000
            -- Setup Pool delegation #1
            (KeyHash 'StakePool
poolKH1, Credential 'Staking
stakingC1) <- ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake
            -- Setup Pool delegation #2
            (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
            -- Make a note of the reward account for the delegator to SPO #1
            RewardAccount
spoRewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
stakingC1
            -- Submit the first committee proposal, the one we will test active voting stake against.
            -- The proposal deposit comes from the root UTxO
            Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId
addCCGaid <-
              GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
                (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
                RewardAccount
spoRewardAccount
                ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal

            -- Submit a yes vote from SPO #1 and a no vote from SPO #2
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
addCCGaid
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH2) GovActionId
addCCGaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The vote should not result in a ratification
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            -- Submit another proposal to bump up the active voting stake of SPO #1
            Credential 'ColdCommitteeRole
cc' <- 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
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc' (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
              (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
              RewardAccount
spoRewardAccount
              ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The same vote should now successfully ratify the proposal
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
          String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"After switching delegations" (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
            -- Only modify the applicable thresholds
            (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
                  ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> PoolVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
forall a. Default a => a
def
                    { pvtCommitteeNormal = 51 %! 100
                    , pvtCommitteeNoConfidence = 51 %! 100
                    }
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
                  ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> DRepVotingThresholds -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
forall a. Default a => a
def
                    { dvtCommitteeNormal = 0 %! 1
                    , dvtCommitteeNoConfidence = 0 %! 1
                    }
                PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1_000_000
            -- Setup Pool delegation #1
            (KeyHash 'StakePool
poolKH1, Credential 'Staking
stakingC1) <- ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake
            -- Setup Pool delegation #2
            (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
            -- Setup Pool delegation #3
            (KeyHash 'StakePool
_poolKH3, Credential 'Staking
stakingC3) <- ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake
            -- Make a note of the reward accounts for the delegators to SPOs #1 and #3
            RewardAccount
spoRewardAccount1 <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
stakingC1
            RewardAccount
spoRewardAccount3 <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
stakingC3
            -- Submit committee proposals
            -- The proposal deposits come from the root UTxO
            -- After this both stakingC1 and stakingC3 are expected to have 1_000_000 ADA of stake, each
            Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId
addCCGaid <-
              GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
                (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
                RewardAccount
spoRewardAccount1
                ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
            Credential 'ColdCommitteeRole
cc' <- 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
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' = Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
cc' (EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
              (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers' (Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100))
              RewardAccount
spoRewardAccount3
              ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era ()) -> ImpTestM era ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_
            -- Submit a yes vote from SPO #1 and a no vote from SPO #2
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
addCCGaid
            Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH2) GovActionId
addCCGaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The vote should not result in a ratification
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Switch the delegation from SPO #3 to SPO #1" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
              TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
                Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
mkDelegTxCert Credential 'Staking
stakingC3 (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKH1)]
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- The same vote should now successfully ratify the proposal
            ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
addCCGaid)
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Interaction between governing bodies" (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
"Motion of no-confidence" (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
        (Credential 'DRepRole
drep, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
        GovActionId
noConfidenceGovId <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)

        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
noConfidenceGovId
        Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
noConfidenceGovId
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

        -- DReps accepted the proposal
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        -- SPOs voted no, so NoConfidence won't be ratified, thus committee remains the same
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
initialMembers
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Update committee - normal state" (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
        (Credential 'DRepRole
drep, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        SJust Committee era
initialCommittee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
(StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
        let initialThreshold :: UnitInterval
initialThreshold = Committee era
initialCommittee Committee era
-> Getting UnitInterval (Committee era) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (Committee era) UnitInterval
forall era (f :: * -> *).
Functor f =>
(UnitInterval -> f UnitInterval)
-> Committee era -> f (Committee era)
committeeThresholdL
        GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId) Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
forall a. Monoid a => a
mempty (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)

        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
        Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

        -- DReps accepted the proposal
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        -- SPOs voted no, so committee won't be updated
        GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId
        SJust Committee era
currentCommittee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
(StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
        Committee era
currentCommittee Committee era
-> Getting UnitInterval (Committee era) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. Getting UnitInterval (Committee era) UnitInterval
forall era (f :: * -> *).
Functor f =>
(UnitInterval -> f UnitInterval)
-> Committee era -> f (Committee era)
committeeThresholdL UnitInterval -> UnitInterval -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` UnitInterval
initialThreshold
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hard-fork initiation" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
ccMembers <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
        Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
        let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor = nextMajorVersion}
        GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
ccMembers GovActionId
gid
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

        -- No changes so far, since DReps haven't voted yet
        ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- DReps voted yes too for the hard-fork, so protocol version is incremented
        ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
        String
"A governance action is automatically ratified if threshold is set to 0 for all related governance bodies"
        (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
          (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtMotionNoConfidenceL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
              PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtMotionNoConfidenceL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
          (Credential 'DRepRole
_drep, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

          -- There is a committee initially
          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldNotReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

          GovActionId
noConfidenceGovId <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)

          -- No votes were made but due to the 0 thresholds, every governance body accepted the gov action by default...
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          -- ...even the committee which is not allowed to vote on `NoConfidence` action
          GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
noConfidenceGovId ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- `NoConfidence` is ratified -> the committee is no more
          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SPO default votes" (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
"During bootstrap phase" (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
"Default vote is Abstain in general" (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 ()
whenBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC3, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

          GovActionId
gid <-
            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 -> ImpM (LedgerSpec era) GovActionId)
-> PParamsUpdate era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$
              PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. a -> StrictMaybe a
SJust (Integer
25 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is abstain:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN (default): 3; NO: 0 -> YES / total - ABSTAIN == 0 % 0"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the default vote is abstain:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN (default): 2; NO: 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes, another voted no and the default vote is abstain:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN (default): 1; NO: 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"Two SPOs voted yes, another voted no and the default vote is abstain:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 2; ABSTAIN (default): 0; NO: 1 -> YES / total - ABSTAIN == 2 % 3"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC3) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
3)

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation - default vote is No" (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 ()
whenBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
          ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
          Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
          let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor = nextMajorVersion}

          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
_spoC3, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

          GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 3 -> YES / total - ABSTAIN == 0 % 3"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 1 % 3"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes, another abstained and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 2 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

      String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"After bootstrap phase" (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
"Default vote is No in general" (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
          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
_spoC3, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

          Credential 'ColdCommitteeRole
cc <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
gid <- Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
5)] (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 3 -> YES / total - ABSTAIN == 0 % 3"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 1 % 3"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes, another abstained and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation - default vote is No" (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
          ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
          Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
          let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor = nextMajorVersion}

          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          NonEmpty (Credential 'HotCommitteeRole)
hotCs <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
          (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 0 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCs GovActionId
gid
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"Although the other SPO delegated its reward account to an AlwaysAbstain DRep,\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"since this is a HardForkInitiation action, their default vote remains no regardless:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC1 (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysAbstain
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes, the other explicitly abstained and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gid)

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Reward account delegated to AlwaysNoConfidence" (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
          (KeyHash 'StakePool
spoC, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 0 % 1"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Only the DReps accepted the proposal so far, so it should not be enacted yet" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldNotReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"The SPO delegated its reward account to an AlwaysNoConfidence DRep,\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"since this is a NoConfidence action, their default vote will now count as a yes:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysNoConfidence
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

        String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Reward account delegated to AlwaysAbstain" (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
          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

          GovActionId
gid <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"No SPO has voted so far and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 0 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Only the DReps accepted the proposal so far, so it should not be enacted yet" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
            ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldNotReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the default vote is no:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 Integer -> Integer -> Rational
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
            ( String
"One SPO voted yes and the other SPO delegated its reward account to an AlwaysAbstain DRep:\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
              KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC1 (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysAbstain
              GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid ImpTestM era Rational -> Rational -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers ImpTestM era (Set (Credential 'ColdCommitteeRole))
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty

delayingActionsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
delayingActionsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
delayingActionsSpec =
  -- All tests below are relying on submitting constitution of committe-update proposals, which are disallowed during bootstrap,
  -- so we can only run them post-bootstrap.
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delaying actions" (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
"A delaying action delays its child even when both ere proposed and ratified in the same epoch"
      (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap
      (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        GovActionId
gai0 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        GovActionId
gai1 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        GovActionId
gai2 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        GovActionId
gai3 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai2
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai3
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai3
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai3)
        ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'ConstitutionPurpose era)
  (PEdges (GovPurposeId 'ConstitutionPurpose era))
forall k a. Map k a
Map.empty
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
      String
"A delaying action delays all other actions even when all of them may be ratified in the same epoch"
      (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap
      (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        GovActionId
pGai0 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_000)
        GovActionId
pGai1 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
pGai0)
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_001)
        GovActionId
pGai2 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
pGai1)
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_002)
        GovActionId
cGai0 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        GovActionId
cGai1 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai2
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        -- here 'ParameterChange' action does not get enacted even though
        -- it is not related, since its priority is 4 while the priority
        -- for 'NewConstitution' is 2, so it gets delayed a second time
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'ConstitutionPurpose era)
  (PEdges (GovPurposeId 'ConstitutionPurpose era))
forall k a. Map k a
Map.empty
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        -- all three actions, pGai0, pGai1 and pGai2, are enacted one
        -- after the other in the same epoch
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'PParamUpdatePurpose era
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
pGai2)
        ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
-> Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'PParamUpdatePurpose era)
  (PEdges (GovPurposeId 'PParamUpdatePurpose era))
forall k a. Map k a
Map.empty
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"An action expires when delayed enough even after being ratified" (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
"Same lineage" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
        GovActionId
gai0 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        GovActionId
gai1 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        GovActionId
gai2 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        GovActionId
gai3 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai2
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai3
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai3
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'ConstitutionPurpose era)
  (PEdges (GovPurposeId 'ConstitutionPurpose era))
forall k a. Map k a
Map.empty
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Other lineage" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
        GovActionId
pGai0 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_000)
        GovActionId
pGai1 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
pGai0)
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_001)
        GovActionId
pGai2 <-
          StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
pGai1)
            (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((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
1_000_002)
        GovActionId
cGai0 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
        GovActionId
cGai1 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        GovActionId
cGai2 <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era GovActionId)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai2
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai0
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai0
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai1
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai1
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai2
        NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai2
        Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai2)
        ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
-> Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'ConstitutionPurpose era)
  (PEdges (GovPurposeId 'ConstitutionPurpose era))
forall k a. Map k a
Map.empty
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        -- all three actions, pGai0, pGai1 and pGai2, are expired here
        -- and nothing gets enacted
        ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
        ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
-> Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era))
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Map
  (GovPurposeId 'PParamUpdatePurpose era)
  (PEdges (GovPurposeId 'PParamUpdatePurpose era))
forall k a. Map k a
Map.empty
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"proposals to update the committee get delayed if the expiration exceeds the max term" (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
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
        EpochInterval
maxTermLength <- SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) EpochInterval
 -> ImpTestM era EpochInterval)
-> SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
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))
-> ((EpochInterval -> Const r EpochInterval)
    -> EpochState era -> Const r (EpochState era))
-> (EpochInterval -> Const r EpochInterval)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((EpochInterval -> Const r EpochInterval)
    -> PParams era -> Const r (PParams era))
-> (EpochInterval -> Const r EpochInterval)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Const r EpochInterval)
-> PParams era -> Const r (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL

        NonEmpty (Credential 'HotCommitteeRole)
hks <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

        (Set (Credential 'ColdCommitteeRole)
membersExceedingExpiry, EpochNo
exceedingExpiry) <-
          String
-> ImpM
     (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
-> ImpM
     (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Committee with members exceeding the maxTerm is not enacted" (ImpM
   (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
 -> ImpM
      (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo))
-> ImpM
     (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
-> ImpM
     (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
forall a b. (a -> b) -> a -> b
$ do
            -- submit a proposal for adding two members to the committee,
            -- one of which has a max term exceeding the maximum
            KeyHash 'ColdCommitteeRole
c3 <- ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            KeyHash 'ColdCommitteeRole
c4 <- ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
currentEpoch <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
            let exceedingExpiry :: EpochNo
exceedingExpiry = EpochNo -> EpochInterval -> EpochNo
addEpochInterval (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength) (Word32 -> EpochInterval
EpochInterval Word32
7)
                membersExceedingExpiry :: Map (Credential 'ColdCommitteeRole) EpochNo
membersExceedingExpiry = [(KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
c3, EpochNo
exceedingExpiry), (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
c4, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength)]
            GovPurposeId GovActionId
gaid <-
              StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
                StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
                Credential 'DRepRole
drep
                Set (Credential 'ColdCommitteeRole)
forall a. Set a
Set.empty
                Map (Credential 'ColdCommitteeRole) EpochNo
membersExceedingExpiry
            Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
            Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- the new committee has not been enacted
            Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers Set (Credential 'ColdCommitteeRole)
initialMembers
            (Set (Credential 'ColdCommitteeRole), EpochNo)
-> ImpM
     (LedgerSpec era) (Set (Credential 'ColdCommitteeRole), EpochNo)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
membersExceedingExpiry, EpochNo
exceedingExpiry)

        -- other actions get ratified and enacted
        GovActionId
govIdConst1 <- String -> ImpTestM era GovActionId -> ImpTestM era GovActionId
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Other actions are ratified and enacted" (ImpTestM era GovActionId -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ do
          (ProposalProcedure era
proposal, Constitution era
constitution) <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
          GovActionId
govIdConst1 <- ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
govIdConst1
          NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hks GovActionId
govIdConst1

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
curConstitution <- SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
          Constitution era
curConstitution Constitution era -> Constitution era -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution
          GovActionId -> ImpTestM era GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
govIdConst1

        -- after enough epochs pass, the expiration of the new members becomes acceptable
        -- and the new committee is enacted
        String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"New committee is enacted" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
          EpochNo
currentEpoch <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
          let delta :: Int
delta =
                Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
exceedingExpiry)
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength))
          Int -> ImpTestM era () -> ImpTestM era ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
delta ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch

          -- pass one more epoch after ratification, in order to be enacted
          ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers (Set (Credential 'ColdCommitteeRole) -> ImpTestM era ())
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
initialMembers Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'ColdCommitteeRole)
membersExceedingExpiry

        String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"New committee can vote" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
          (ProposalProcedure era
proposal, Constitution era
constitution) <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> ImpTestM era (ProposalProcedure era, Constitution era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
forall a b. (a -> b) -> a -> b
$ GovPurposeId 'ConstitutionPurpose era
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
govIdConst1)
          GovActionId
govIdConst2 <- ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal
          Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
govIdConst2
          [Credential 'HotCommitteeRole]
hks' <- (Credential 'ColdCommitteeRole
 -> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole))
-> [Credential 'ColdCommitteeRole]
-> ImpM (LedgerSpec era) [Credential 'HotCommitteeRole]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Credential 'ColdCommitteeRole
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey (Set (Credential 'ColdCommitteeRole)
-> [Credential 'ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList Set (Credential 'ColdCommitteeRole)
membersExceedingExpiry)
          [Credential 'HotCommitteeRole] -> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole]
hks' GovActionId
govIdConst2

          Natural -> ImpTestM era ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
curConstitution <- SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
          Constitution era
curConstitution Constitution era -> Constitution era -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

committeeMaxTermLengthSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
committeeMaxTermLengthSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMaxTermLengthSpec =
  -- Committee-update proposals are disallowed during bootstrap, so we can only run these tests post-bootstrap
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee members can serve full `CommitteeMaxTermLength`" (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
      electMembersWithMaxTermLength ::
        KeyHash 'StakePool ->
        Credential 'DRepRole ->
        ImpTestM era [Credential 'ColdCommitteeRole]
      electMembersWithMaxTermLength :: KeyHash 'StakePool
-> Credential 'DRepRole
-> ImpTestM era [Credential 'ColdCommitteeRole]
electMembersWithMaxTermLength KeyHash 'StakePool
spoC Credential 'DRepRole
drep = do
        Credential 'ColdCommitteeRole
m1 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        Credential 'ColdCommitteeRole
m2 <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        EpochNo
currentEpoch <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
        EpochInterval
maxTermLength <-
          SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) EpochInterval
 -> ImpTestM era EpochInterval)
-> SimpleGetter (NewEpochState era) EpochInterval
-> ImpTestM era EpochInterval
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))
-> ((EpochInterval -> Const r EpochInterval)
    -> EpochState era -> Const r (EpochState era))
-> (EpochInterval -> Const r EpochInterval)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((EpochInterval -> Const r EpochInterval)
    -> PParams era -> Const r (PParams era))
-> (EpochInterval -> Const r EpochInterval)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochInterval -> Const r EpochInterval)
-> PParams era -> Const r (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
        let expiry :: EpochNo
expiry = EpochNo -> EpochInterval -> EpochNo
addEpochInterval (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
1) EpochInterval
maxTermLength
            members :: Map (Credential 'ColdCommitteeRole) EpochNo
members = [(Credential 'ColdCommitteeRole
m1, EpochNo
expiry), (Credential 'ColdCommitteeRole
m2, EpochNo
expiry)]
        GovPurposeId GovActionId
gaid <-
          StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
            StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            Credential 'DRepRole
drep
            Set (Credential 'ColdCommitteeRole)
forall a. Set a
Set.empty
            Map (Credential 'ColdCommitteeRole) EpochNo
members
        Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
        [Credential 'ColdCommitteeRole]
-> ImpTestM era [Credential 'ColdCommitteeRole]
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item [Credential 'ColdCommitteeRole]
Credential 'ColdCommitteeRole
m1, Item [Credential 'ColdCommitteeRole]
Credential 'ColdCommitteeRole
m2]
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"maxTermLength = 0" (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
      -- ======== EPOCH e ========

      let termLength :: EpochInterval
termLength = Word32 -> EpochInterval
EpochInterval Word32
0
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
ppCommitteeMaxTermLengthL ((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
.~ EpochInterval
termLength

      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

      -- Setup new committee members with max term length of 0 epoch
      [Credential 'ColdCommitteeRole]
newMembers <- KeyHash 'StakePool
-> Credential 'DRepRole
-> ImpTestM era [Credential 'ColdCommitteeRole]
electMembersWithMaxTermLength KeyHash 'StakePool
spoC Credential 'DRepRole
drep

      ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor = nextMajorVersion}

      -- Create a proposal for a hard-fork initiation
      GovActionId
gid <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

      -- Accept the proposal with all the governing bodies except for the CC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+1 ========

      [Credential 'HotCommitteeRole]
hotCs <- (Credential 'ColdCommitteeRole
 -> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole))
-> [Credential 'ColdCommitteeRole]
-> ImpM (LedgerSpec era) [Credential 'HotCommitteeRole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Credential 'ColdCommitteeRole
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey [Credential 'ColdCommitteeRole]
newMembers
      -- CC members can now vote for the hard-fork
      [Credential 'HotCommitteeRole] -> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole]
hotCs GovActionId
gid

      -- Although elected, new CC members are not yet active at this point
      -- since it takes two epochs for their election to take effect, hence
      -- the check fails
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      (Credential 'ColdCommitteeRole -> ImpTestM era ())
-> [Credential 'ColdCommitteeRole] -> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole]
newMembers

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+2 ========

      -- Two epochs passed since the proposal and all the governing bodies except the
      -- CC have voted 'Yes' for the hard-fork immediately. However, since the CC could only
      -- vote in the next epoch, the hard-fork is not yet enacted...
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
      -- ...but now we can see that the CC accepted the proposal...
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- ...and that they are elected members now, albeit already expired ones
      Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers (Set (Credential 'ColdCommitteeRole) -> ImpTestM era ())
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
initialMembers Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
forall a. Semigroup a => a -> a -> a
<> [Credential 'ColdCommitteeRole]
-> Set (Credential 'ColdCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole]
newMembers
      (Credential 'ColdCommitteeRole -> ImpTestM era ())
-> [Credential 'ColdCommitteeRole] -> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired [Credential 'ColdCommitteeRole]
newMembers

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+3 ========

      -- Two epochs passed since the CCs also accepted the hard-fork, however
      -- it didn't get enacted because the CCs expired by now and thus
      -- their votes don't count
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
      ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"maxTermLength = 1" (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
      -- ======== EPOCH e ========

      let termLength :: EpochInterval
termLength = Word32 -> EpochInterval
EpochInterval Word32
1
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM 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
ppCommitteeMaxTermLengthL ((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
.~ EpochInterval
termLength

      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

      -- Setup new committee members with max term length of 1 epoch
      [Credential 'ColdCommitteeRole]
newMembers <- KeyHash 'StakePool
-> Credential 'DRepRole
-> ImpTestM era [Credential 'ColdCommitteeRole]
electMembersWithMaxTermLength KeyHash 'StakePool
spoC Credential 'DRepRole
drep

      ProtVer
curProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- Version -> ImpM (LedgerSpec era) Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion (Version -> ImpM (LedgerSpec era) Version)
-> Version -> ImpM (LedgerSpec era) Version
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor = nextMajorVersion}

      -- Create a proposal for a hard-fork initiation
      GovActionId
gid <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

      -- Accept the proposal with all the governing bodies except for the CC
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gid

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+1 ========

      [Credential 'HotCommitteeRole]
hotCs <- (Credential 'ColdCommitteeRole
 -> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole))
-> [Credential 'ColdCommitteeRole]
-> ImpM (LedgerSpec era) [Credential 'HotCommitteeRole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Credential 'ColdCommitteeRole
-> ImpM (LedgerSpec era) (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey [Credential 'ColdCommitteeRole]
newMembers
      -- CC members can now vote for the hard-fork
      [Credential 'HotCommitteeRole] -> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole]
hotCs GovActionId
gid

      -- Although elected, new CC members are not yet active at this point
      -- since it takes two epochs for their election to take effect, hence
      -- the check fails
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      (Credential 'ColdCommitteeRole -> ImpTestM era ())
-> [Credential 'ColdCommitteeRole] -> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole]
newMembers

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+2 ========

      -- Two epochs passed since the proposal and all the governing bodies except the
      -- CC have voted 'Yes' for the hard-fork immediately. However, since the CC could only
      -- vote in the next epoch, the hard-fork is not yet enacted...
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. StrictMaybe a
SNothing
      -- ...but now we can see that the CC accepted the proposal...
      GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid ImpTestM era Bool -> Bool -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- ...and that they are active elected members now
      Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers (Set (Credential 'ColdCommitteeRole) -> ImpTestM era ())
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
initialMembers Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
forall a. Semigroup a => a -> a -> a
<> [Credential 'ColdCommitteeRole]
-> Set (Credential 'ColdCommitteeRole)
forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole]
newMembers
      (Credential 'ColdCommitteeRole -> ImpTestM era ())
-> [Credential 'ColdCommitteeRole] -> ImpTestM era ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Credential 'ColdCommitteeRole -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeExpired [Credential 'ColdCommitteeRole]
newMembers

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      -- ======== EPOCH e+3 ========

      -- Two epochs passed since the CCs also accepted the hard-fork, which
      -- is now enacted since the CCs were active during the check
      ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose era
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gid)
      ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer