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

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

import Cardano.Ledger.Address
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.TxCert
import Cardano.Ledger.Credential
import Cardano.Ledger.DRep
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
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
votingSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
delayingActionsSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMinSizeAffectsInFlightProposalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
paramChangeAffectsProposalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeExpiryResignationDiscountSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
committeeMaxTermLengthSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoVotesForHardForkInitiation
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spoAndCCVotingSpec
  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" forall a b. (a -> b) -> a -> b
$ do
    Credential 'HotCommitteeRole
hotCred NE.:| [Credential 'HotCommitteeRole]
_ <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 <- 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 <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
deposit)
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCred) GovActionId
gaId
    forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gaId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
    forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaId
    forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
    -- Make sure all committee members authorize the same hot credential that just voted:
    [Credential 'ColdCommitteeRole]
committeeMembers' <- forall a. Set a -> [a]
Set.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
    case [Credential 'ColdCommitteeRole]
committeeMembers' of
      Credential 'ColdCommitteeRole
x : [Credential 'ColdCommitteeRole]
xs -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys (forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'HotCommitteeRole
hotCred) forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
x forall a. a -> [a] -> NonEmpty a
NE.:| [Credential 'ColdCommitteeRole]
xs
      [Credential 'ColdCommitteeRole]
_ -> forall a. HasCallStack => String -> a
error String
"Expected an initial committee"
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
    forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaId)

initiateHardForkWithLessThanMinimalCommitteeSize ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
initiateHardForkWithLessThanMinimalCommitteeSize =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Hard Fork can still be initiated with less than minimal committee size" forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole)
hotCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    (KeyHash 'StakePool
spoK1, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
    forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
    [Credential 'ColdCommitteeRole]
committeeMembers' <- forall a. Set a -> [a]
Set.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
    Credential 'ColdCommitteeRole
committeeMember <- forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements [Credential 'ColdCommitteeRole]
committeeMembers'
    StrictMaybe Anchor
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    Maybe (Credential 'HotCommitteeRole)
mHotCred <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
committeeMember StrictMaybe Anchor
anchor
    ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
    GovActionId
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. NonEmpty a -> [a]
NE.toList (\Credential 'HotCommitteeRole
hotCred -> forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (forall a. Eq a => a -> a -> Bool
/= Credential 'HotCommitteeRole
hotCred)) Maybe (Credential 'HotCommitteeRole)
mHotCred NonEmpty (Credential 'HotCommitteeRole)
hotCs) GovActionId
gai
    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
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
      else do
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"When CC expired" forall a b. (a -> b) -> a -> b
$ do
    let expireCommitteeMembers :: ImpM (LedgerSpec era) (NonEmpty (Credential 'HotCommitteeRole))
expireCommitteeMembers = do
          NonEmpty (Credential 'HotCommitteeRole)
hotCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
          -- TODO: change the maxtermlength to make the test faster
          EpochInterval Word32
committeeMaxTermLength <-
            forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
              forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
committeeMaxTermLength
          Set (Credential 'ColdCommitteeRole)
ms <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
          -- Make sure that committee expired
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Credential 'ColdCommitteeRole)
ms forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired
          forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Credential 'HotCommitteeRole)
hotCs
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can't enact hard-fork" 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer

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

      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!
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCs GovActionId
gai

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

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

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

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

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

      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` NonNegativeInterval
initialRefScriptBaseFee
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"When CC threshold is 0" 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 = forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES forall a b. (a -> b) -> a -> b
$ \NewEpochState era
nes ->
        NewEpochState era
nes
          forall a b. a -> (a -> b) -> b
& forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era) -> StrictMaybe (Committee era)
f
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL 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 forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
pulser of
              (PulsingSnapshot era
snapshot, RatifyState era
rState) -> forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snapshot (RatifyState era
rState forall a b. a -> (a -> b) -> b
& forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era) -> StrictMaybe (Committee era)
f)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"SPOs alone can enact hard-fork during bootstrap" forall a b. (a -> b) -> a -> b
$ do
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
protVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
protVer {pvMajor :: Version
pvMajor = Version
nextMajorVersion}
      forall {era}.
ConwayEraGov era =>
(StrictMaybe (Committee era) -> StrictMaybe (Committee era))
-> ImpTestM era ()
modifyCommittee forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. Lens' (Committee era) UnitInterval
committeeThresholdL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)

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

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

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

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

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

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

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

      NonNegativeInterval
newRefScriptBaseFee <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL
      if ProtVer -> Bool
bootstrapPhase ProtVer
protVer
        then do
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
          NonNegativeInterval
newRefScriptBaseFee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` (Integer
25 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        else do
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          NonNegativeInterval
newRefScriptBaseFee 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Expired and resigned committee members are discounted from quorum" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Expired" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole
committeeColdC1 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
committeeColdC2 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
committeeColdC2, Word32 -> EpochInterval
EpochInterval Word32
2)
          ]
          (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiCC)
      Credential 'HotCommitteeRole
committeeHotC1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC1
      Credential 'HotCommitteeRole
_committeeHotC2 <- 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 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
      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
      forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeExpired Credential 'ColdCommitteeRole
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- expire the second CC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      -- Check for CC acceptance should fail
      forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired Credential 'ColdCommitteeRole
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Resigned" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
2
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole
committeeColdC1 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'ColdCommitteeRole
committeeColdC2 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole
committeeColdC2, Word32 -> EpochInterval
EpochInterval Word32
10)
          ]
          (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiCC)
      Credential 'HotCommitteeRole
committeeHotC1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
committeeColdC1
      Credential 'HotCommitteeRole
_committeeHotC2 <- 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 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
      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
      forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- Resign the second CC
      Maybe (Credential 'HotCommitteeRole)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
committeeColdC2 forall a. StrictMaybe a
SNothing
      -- Check for CC acceptance should fail
      forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiConstitution 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ParameterChange affects existing proposals" 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 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          GovActionId
gaiParent <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
committeeC, Word32 -> EpochInterval
EpochInterval Word32
5)] (Integer
75 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 <-
            forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee
              (forall a. a -> Maybe a
Just (forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)))
              forall a. Monoid a => a
mempty
              [(Credential 'ColdCommitteeRole
committeeC, Word32 -> EpochInterval
EpochInterval Word32
5)]
              (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(KeyHash 'StakePool, Vote)]
spos forall a b. (a -> b) -> a -> b
$ \(KeyHash 'StakePool
spo, Vote
vote) -> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gaiChild
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Credential 'DRepRole, Vote)]
dreps forall a b. (a -> b) -> a -> b
$ \(Credential 'DRepRole
drep, Vote
vote) -> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaiChild
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- Make the votes count
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId
gaiParent, GovActionId
gaiChild)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" forall a b. (a -> b) -> a -> b
$ do
      let setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold UnitInterval
threshold =
            forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold
          getDrepVotingThresholds :: ImpTestM era DRepVotingThresholds
getDrepVotingThresholds = forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
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 <-
              forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction
                forall a. StrictMaybe a
SNothing
                ( forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL
                      forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (DRepVotingThresholds
drepVotingThresholds forall a b. a -> (a -> b) -> b
& Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
                )
            GovActionId
pcGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
paramChange
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (Credential 'DRepRole)
dreps forall a b. (a -> b) -> a -> b
$ \Credential 'DRepRole
drep -> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
pcGai
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
pcGai
            forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
pcGai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
            forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            (forall s a. s -> Getting a s a -> a
^. Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNormalL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpTestM era DRepVotingThresholds
getDrepVotingThresholds forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` UnitInterval
threshold

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Increasing the threshold prevents a hitherto-ratifiable proposal from being ratified" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2 -- small threshold
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (GovActionId
_gaiParent, GovActionId
gaiChild) <- [(KeyHash 'StakePool, Vote)]
-> [(Credential 'DRepRole, Vote)]
-> ImpTestM era (GovActionId, GovActionId)
submitTwoExampleProposalsAndVoteOnTheChild [] [(Credential 'DRepRole
drep, Vote
VoteYes)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        forall {t :: * -> *}.
Foldable t =>
UnitInterval
-> t (Credential 'DRepRole)
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
enactCommitteeUpdateThreshold
          (Integer
65 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          ([Credential 'DRepRole
drepC, Credential 'DRepRole
drep] :: [Credential 'DRepRole])
          Credential 'HotCommitteeRole
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decreasing the threshold ratifies a hitherto-unratifiable proposal" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap 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
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1 -- too large threshold
        (Credential 'DRepRole
drep, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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)]
        forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gaiChild
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall {t :: * -> *}.
Foldable t =>
UnitInterval
-> t (Credential 'DRepRole)
-> Credential 'HotCommitteeRole
-> ImpTestM era ()
enactCommitteeUpdateThreshold
          (Integer
65 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
          ([Credential 'DRepRole
drepC, Credential 'DRepRole
drep] :: [Credential 'DRepRole])
          Credential 'HotCommitteeRole
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaiChild 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
        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
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiParent
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- UpdateCommittee is a delaying action
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiChild)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SPO" forall a b. (a -> b) -> a -> b
$ do
      let setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
          setCommitteeUpdateThreshold :: UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold UnitInterval
threshold =
            forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL 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 <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
            GovAction era
paramChange <-
              forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction
                forall a. StrictMaybe a
SNothing
                ( forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
ppuPoolVotingThresholdsL
                      forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (PoolVotingThresholds
poolVotingThresholds forall a b. a -> (a -> b) -> b
& Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
                )
            GovActionId
pcGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
paramChange
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
pcGai
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
pcGai
            forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            (forall s a. s -> Getting a s a -> a
^. Lens' PoolVotingThresholds UnitInterval
pvtCommitteeNormalL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` UnitInterval
threshold

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Increasing the threshold prevents a hitherto-ratifiable proposal from being ratified" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap 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
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        (KeyHash 'StakePool
poolKH1, Credential 'Payment
_paymentC1, Credential 'Staking
_stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000
        (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        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)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        forall {era}.
ConwayEraImp era =>
UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpM (LedgerSpec era) ()
enactCommitteeUpdateThreshold (Integer
65 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) Credential 'DRepRole
drepC Credential 'HotCommitteeRole
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decreasing the threshold ratifies a hitherto-unratifiable proposal" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap 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
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setCommitteeUpdateThreshold forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1 -- too large threshold
        (KeyHash 'StakePool
poolKH1, Credential 'Payment
_paymentC1, Credential 'Staking
_stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
4_000_000
        (KeyHash 'StakePool
poolKH2, Credential 'Payment
_paymentC2, Credential 'Staking
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall {era}.
ConwayEraImp era =>
UnitInterval
-> Credential 'DRepRole
-> Credential 'HotCommitteeRole
-> ImpM (LedgerSpec era) ()
enactCommitteeUpdateThreshold (Integer
65 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) Credential 'DRepRole
drepC Credential 'HotCommitteeRole
hotCommitteeC -- smaller threshold
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaiChild 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
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiParent
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH1) GovActionId
gaiParent
        forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaiParent
        forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaiChild
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiParent)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- UpdateCommittee is a delaying action
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiChild)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"A parent ParameterChange proposal can prevent its child from being enacted" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      -- Setup one other DRep with equal stake
      (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 <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$
        forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
          forall s t a b. ASetter s t a b -> b -> s -> t
.~ (DRepVotingThresholds
drepVotingThresholds forall a b. a -> (a -> b) -> b
& Lens' DRepVotingThresholds UnitInterval
dvtPPGovGroupL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 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 =
            forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction
              StrictMaybe GovActionId
parent
              ( forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                  forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL
                    forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (DRepVotingThresholds
drepVotingThresholds forall a b. a -> (a -> b) -> b
& Lens' DRepVotingThresholds UnitInterval
dvtPPGovGroupL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
threshold)
              )
      GovActionId
parentGai <- forall {era}.
ConwayEraImp era =>
StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
paramChange forall a. StrictMaybe a
SNothing ((Integer
90 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      GovActionId
childGai <- forall {era}.
ConwayEraImp era =>
StrictMaybe GovActionId
-> UnitInterval -> ImpTestM era (GovAction era)
paramChange (forall a. a -> StrictMaybe a
SJust GovActionId
parentGai) (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
parentGai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
parentGai
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
childGai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
childGai
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
parentGai
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
childGai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
parentGai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
childGai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
parentGai)
      forall k a. Ord k => k -> Map k a -> Bool
Map.member (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
childGai) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
childGai 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CommitteeMinSize affects in-flight proposals" forall a b. (a -> b) -> a -> b
$ do
    let setCommitteeMinSize :: Natural -> ImpTestM era ()
setCommitteeMinSize Natural
n = forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL 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 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount
rewardAccount, Coin
amount)]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal fails to ratify due to an increase in CommitteeMinSize" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      Coin
amount <- 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
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$ forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
treasuryDonationTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
amount)
      NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      GovActionId
gaiTW <- forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
Coin -> ImpM (LedgerSpec era) GovActionId
submitTreasuryWithdrawal Coin
amount
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gaiTW
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiTW
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      GovActionId
gaiPC <-
        forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$
          forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Natural
3
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCommitteeCs GovActionId
gaiPC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiPC
      Coin
treasury <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      -- The ParameterChange prevents the TreasuryWithdrawal from being enacted,
      -- because it has higher priority.
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gaiPC)
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
currentProposalsShouldContain GovActionId
gaiTW
      forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
treasury
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal ratifies due to a decrease in CommitteeMinSize" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      (Credential 'DRepRole
drepC, Credential 'HotCommitteeRole
hotCommitteeC, 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
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Coin
amount <- 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
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$ forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. EraTxBody era => TxBody era
mkBasicTxBody forall a b. a -> (a -> b) -> b
& forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
treasuryDonationTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
amount)
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      Coin
treasury <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL
      GovActionId
gaiTW <- forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
Coin -> ImpM (LedgerSpec era) GovActionId
submitTreasuryWithdrawal Coin
amount
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
hotCommitteeC) GovActionId
gaiTW
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiTW
      forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL) 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 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      GovActionId
gaiCC <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
coldCommitteeCred, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      Credential 'HotCommitteeRole
_hotCommitteeC' <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
coldCommitteeCred
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaiTW forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Coin
treasury 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Counting of SPO votes" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation" forall a b. (a -> b) -> a -> b
$ do
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DRepVotingThresholds UnitInterval
dvtHardForkInitiationL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Default a => a
def)
      NonEmpty (Credential 'HotCommitteeRole)
hotCCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoK1, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool
spoK2, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PoolVotingThresholds UnitInterval
pvtHardForkInitiationL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
      ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      GovActionId
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
      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
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoK1) GovActionId
gai
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      -- 1 % 2 stake yes; 1 % 2 stake no; yes / stake - abstain = 1 % 2
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoK2) GovActionId
gai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gai forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)

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

          GovActionId
paramChangeGovId <- forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000)
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep1) GovActionId
paramChangeGovId

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

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

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

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

        forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"AlwaysNoConfidence" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
          (Credential 'DRepRole
drep1, Credential 'HotCommitteeRole
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          Set (Credential 'ColdCommitteeRole)
initialMembers <- 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
_) <- 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
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
          (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

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

          KeyPair 'Payment
_ <- forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep Credential 'Staking
drep2Staking forall t. Val t => t
zero DRep
DRepAlwaysNoConfidence
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. Monoid a => a
mempty
        forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"AlwaysAbstain" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
          let getTreasury :: ImpTestM era Coin
getTreasury = forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

          GovActionId
noConfidenceGovId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. 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...
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
noConfidenceGovId forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
noConfidenceGovId 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
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
noConfidenceGovId forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          -- `NoConfidence` is ratified -> the committee is no more
          forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. Monoid a => a
mempty

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN (default): 3; NO: 0 -> YES / total - ABSTAIN == 0 % 0"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN (default): 2; NO: 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN (default): 1; NO: 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteNo (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
2)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 2; ABSTAIN (default): 0; NO: 1 -> YES / total - ABSTAIN == 2 % 3"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC3) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
3)

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

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 3 -> YES / total - ABSTAIN == 0 % 3"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 1 % 3"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 2 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"After bootstrap phase" forall a b. (a -> b) -> a -> b
$ do
        forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Default vote is No in general" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
          (KeyHash 'StakePool
spoC1, Credential 'Payment
_payment, Credential 'Staking
_staking) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
spoC2, Credential 'Payment
_payment, Credential 'Staking
_staking) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
          (KeyHash 'StakePool
_spoC3, Credential 'Payment
_payment, Credential 'Staking
_staking) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 3 -> YES / total - ABSTAIN == 0 % 3"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 1 % 3"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

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

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

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 0 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"since this is a HardForkInitiation action, their default vote remains no regardless:\n"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC1 (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysAbstain
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
Abstain (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC1) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

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

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

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 0 % 1"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

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

          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" forall a b. (a -> b) -> a -> b
$
            forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldNotReturn` forall a. Monoid a => a
mempty

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"since this is a NoConfidence action, their default vote will now count as a yes:\n"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysNoConfidence
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

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

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

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

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

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 0; ABSTAIN: 0; NO (default): 2 -> YES / total - ABSTAIN == 0 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
0

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

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

          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" forall a b. (a -> b) -> a -> b
$
            forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldNotReturn` forall a. Monoid a => a
mempty

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 0; NO (default): 1 -> YES / total - ABSTAIN == 1 % 2"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC2) GovActionId
gid
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)

          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"
                forall a. Semigroup a => a -> a -> a
<> String
"YES: 1; ABSTAIN: 1; NO (default): 0 -> YES / total - ABSTAIN == 1 % 1"
            )
            forall a b. (a -> b) -> a -> b
$ do
              forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
spoC1 (Integer -> Coin
Coin Integer
1_000_000) DRep
DRepAlwaysAbstain
              forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Rational
1

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

          forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` 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.
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delaying actions" forall a b. (a -> b) -> a -> b
$ do
    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"
      forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap
      forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        GovActionId
gai0 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
        GovActionId
gai1 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        GovActionId
gai2 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        GovActionId
gai3 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai3
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai3
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai3)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
    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"
      forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap
      forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        GovActionId
pGai0 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_000)
        GovActionId
pGai1 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId
pGai0)
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_001)
        GovActionId
pGai2 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId
pGai1)
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_002)
        GovActionId
cGai0 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
        GovActionId
cGai1 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai2
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        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
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        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
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
pGai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"An action expires when delayed enough even after being ratified" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Same lineage" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
        GovActionId
gai0 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
        GovActionId
gai1 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        GovActionId
gai2 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        GovActionId
gai3 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gai3
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
gai3
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai0)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai1)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Other lineage" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
        GovActionId
pGai0 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_000)
        GovActionId
pGai1 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId
pGai0)
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_001)
        GovActionId
pGai2 <-
          forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId
pGai1)
            forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1_000_002)
        GovActionId
cGai0 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a. StrictMaybe a
SNothing
        GovActionId
cGai1 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        GovActionId
cGai2 <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
cGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
cGai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
pGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
pGai2
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai0)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai1)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
cGai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        -- all three actions, pGai0, pGai1 and pGai2, are expired here
        -- and nothing gets enacted
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall k a. Map k a
Map.empty
      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" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
        EpochInterval
maxTermLength <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL

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

        (Set (Credential 'ColdCommitteeRole)
membersExceedingExpiry, EpochNo
exceedingExpiry) <-
          forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Committee with members exceeding the maxTerm is not enacted" 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 <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            KeyHash 'ColdCommitteeRole
c4 <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
            EpochNo
currentEpoch <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
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 = [(forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
c3, EpochNo
exceedingExpiry), (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
c4, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength)]
            GovPurposeId GovActionId
gaid <-
              forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
                forall a. StrictMaybe a
SNothing
                Credential 'DRepRole
drep
                forall a. Set a
Set.empty
                Map (Credential 'ColdCommitteeRole) EpochNo
membersExceedingExpiry
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
            forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
            -- the new committee has not been enacted
            forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers Set (Credential 'ColdCommitteeRole)
initialMembers
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 <- forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Other actions are ratified and enacted" forall a b. (a -> b) -> a -> b
$ do
          (ProposalProcedure era
proposal, Constitution era
constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal forall a. StrictMaybe a
SNothing
          GovActionId
govIdConst1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
govIdConst1
          forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hks GovActionId
govIdConst1

          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
curConstitution <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
          Constitution era
curConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution
          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
        forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"New committee is enacted" forall a b. (a -> b) -> a -> b
$ do
          EpochNo
currentEpoch <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
          let delta :: Int
delta =
                forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo EpochNo
exceedingExpiry)
                  forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (EpochNo -> Word64
unEpochNo (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength))
          forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
delta forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch

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

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

          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Constitution era
curConstitution <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
          Constitution era
curConstitution 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
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee members can serve full `CommitteeMaxTermLength`" 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 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        Credential 'ColdCommitteeRole
m2 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        EpochNo
currentEpoch <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
        EpochInterval
maxTermLength <-
          forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
            forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
        let expiry :: EpochNo
expiry = EpochNo -> EpochInterval -> EpochNo
addEpochInterval (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch 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 <-
          forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
            forall a. StrictMaybe a
SNothing
            Credential 'DRepRole
drep
            forall a. Set a
Set.empty
            Map (Credential 'ColdCommitteeRole) EpochNo
members
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Credential 'ColdCommitteeRole
m1, Credential 'ColdCommitteeRole
m2]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"maxTermLength = 0" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      -- ======== EPOCH e ========

      let termLength :: EpochInterval
termLength = Word32 -> EpochInterval
EpochInterval Word32
0
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
termLength

      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole)
initialMembers <- 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 <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor :: Version
pvMajor = Version
nextMajorVersion}

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

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

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

      [Credential 'HotCommitteeRole]
hotCs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
      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
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole]
newMembers

      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...
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      -- ...but now we can see that the CC accepted the proposal...
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid 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
      forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
initialMembers forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole]
newMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired [Credential 'ColdCommitteeRole]
newMembers

      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
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"maxTermLength = 1" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      -- ======== EPOCH e ========

      let termLength :: EpochInterval
termLength = Word32 -> EpochInterval
EpochInterval Word32
1
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
termLength

      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole)
initialMembers <- 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 <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Version
nextMajorVersion <- forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
pvMajor ProtVer
curProtVer
      let nextProtVer :: ProtVer
nextProtVer = ProtVer
curProtVer {pvMajor :: Version
pvMajor = Version
nextMajorVersion}

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

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

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

      [Credential 'HotCommitteeRole]
hotCs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
      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
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole]
newMembers

      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...
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      -- ...but now we can see that the CC accepted the proposal...
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gid 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
      forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
initialMembers forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole]
newMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeExpired [Credential 'ColdCommitteeRole]
newMembers

      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
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gid)
      forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer