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

module Test.Cardano.Ledger.Conway.Imp.RatifySpec (
  spec,
  relevantDuringBootstrapSpec,
) 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.Keys
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.Class (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 (ImpTestState era)
spec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
spec = do
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
relevantDuringBootstrapSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
votingSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
delayingActionsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
spoVotesCommitteeUpdates
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeMinSizeAffectsInFlightProposalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
paramChangeAffectsProposalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeExpiryResignationDiscountSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeMaxTermLengthSpec

relevantDuringBootstrapSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
relevantDuringBootstrapSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
relevantDuringBootstrapSpec = do
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
spoVotesForHardForkInitiation
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
initiateHardForkWithLessThanMinimalCommitteeSize
  forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (EraCrypto era)
hotCred NE.:| [Credential 'HotCommitteeRole (EraCrypto era)]
_ <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
    (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep 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)
    Positive Integer
deposit <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    GovActionId (EraCrypto era)
gaId <- forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall 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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred) GovActionId (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gaId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
    forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gaId
    forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
    -- Make sure all committee members authorize the same hot credential that just voted:
    [Credential 'ColdCommitteeRole (EraCrypto era)]
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 (EraCrypto era)))
getCommitteeMembers
    case [Credential 'ColdCommitteeRole (EraCrypto era)]
committeeMembers' of
      Credential 'ColdCommitteeRole (EraCrypto era)
x : [Credential 'ColdCommitteeRole (EraCrypto era)]
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 (EraCrypto era))
-> NonEmpty (Credential 'ColdCommitteeRole (EraCrypto era))
-> ImpTestM
     era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerCommitteeHotKeys (forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'HotCommitteeRole (EraCrypto era)
hotCred) forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole (EraCrypto era)
x forall a. a -> [a] -> NonEmpty a
NE.:| [Credential 'ColdCommitteeRole (EraCrypto era)]
xs
      [Credential 'ColdCommitteeRole (EraCrypto era)]
_ -> 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaId)

initiateHardForkWithLessThanMinimalCommitteeSize ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
initiateHardForkWithLessThanMinimalCommitteeSize :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (EraCrypto era))
hotCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
    (KeyHash 'StakePool (EraCrypto era)
spoK1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)]
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 (EraCrypto era)))
getCommitteeMembers
    Credential 'ColdCommitteeRole (EraCrypto era)
committeeMember <- forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements [Credential 'ColdCommitteeRole (EraCrypto era)]
committeeMembers'
    StrictMaybe (Anchor (EraCrypto era))
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    Maybe (Credential 'HotCommitteeRole (EraCrypto era))
mHotCred <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> StrictMaybe (Anchor (EraCrypto era))
-> ImpTestM
     era (Maybe (Credential 'HotCommitteeRole (EraCrypto era)))
resignCommitteeColdKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeMember StrictMaybe (Anchor (EraCrypto era))
anchor
    ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
    GovActionId (EraCrypto era)
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. NonEmpty a -> [a]
NE.toList (\Credential 'HotCommitteeRole (EraCrypto era)
hotCred -> forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (forall a. Eq a => a -> a -> Bool
/= Credential 'HotCommitteeRole (EraCrypto era)
hotCred)) Maybe (Credential 'HotCommitteeRole (EraCrypto era))
mHotCred forall a b. (a -> b) -> a -> b
$ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCs) GovActionId (EraCrypto era)
gai
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoK1) GovActionId (EraCrypto era)
gai
    if ProtVer -> Bool
bootstrapPhase ProtVer
protVer
      then do
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)
      else do
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing

spoAndCCVotingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
spoAndCCVotingSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 :: ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
expireCommitteeMembers = do
          NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
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 (EraCrypto era))
ms <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
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 (EraCrypto era))
ms forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldBeExpired
          forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
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 (EraCrypto era))
hotCs <- ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
expireCommitteeMembers
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
      ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer

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

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

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

      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
expireCommitteeMembers
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gid <-
        forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a 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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gid

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

      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)

      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)
          forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer
        else do
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gai <-
        forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$
          forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            forall a b. a -> (a -> b) -> b
& forall era.
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)
          NonNegativeInterval
newRefScriptBaseFee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          NonNegativeInterval
newRefScriptBaseFee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` NonNegativeInterval
initialRefScriptBaseFee

committeeExpiryResignationDiscountSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
committeeExpiryResignationDiscountSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeExpiryResignationDiscountSpec =
  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
$ 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      GovActionId (EraCrypto era)
gaiCC <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaiCC)
      Credential 'HotCommitteeRole (EraCrypto era)
committeeHotC1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1
      Credential 'HotCommitteeRole (EraCrypto era)
_committeeHotC2 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      -- Submit a constitution with a CC vote
      (GovActionId (EraCrypto era)
gaiConstitution, Constitution era
_constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committeeHotC1) GovActionId (EraCrypto era)
gaiConstitution
      -- Check for CC acceptance
      forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldNotBeExpired Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era ()
ccShouldBeExpired Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      -- Elect a committee of 2 members
      Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      GovActionId (EraCrypto era)
gaiCC <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee
          forall a. Maybe a
Nothing
          forall a. Monoid a => a
mempty
          [ (Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1, Word32 -> EpochInterval
EpochInterval Word32
10)
          , (Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaiCC)
      Credential 'HotCommitteeRole (EraCrypto era)
committeeHotC1 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC1
      Credential 'HotCommitteeRole (EraCrypto era)
_committeeHotC2 <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      -- Submit a constitution with a CC vote
      (GovActionId (EraCrypto era)
gaiConstitution, Constitution era
_constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committeeHotC1) GovActionId (EraCrypto era)
gaiConstitution
      -- Check for CC acceptance
      forall era.
HasCallStack =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- Resign the second CC
      Maybe (Credential 'HotCommitteeRole (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> StrictMaybe (Anchor (EraCrypto era))
-> ImpTestM
     era (Maybe (Credential 'HotCommitteeRole (EraCrypto era)))
resignCommitteeColdKey Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2 forall a. StrictMaybe a
SNothing
      -- Check for CC acceptance should fail
      forall era.
HasCallStack =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole (EraCrypto era)
committeeColdC2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False

paramChangeAffectsProposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
paramChangeAffectsProposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
paramChangeAffectsProposalsSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ParameterChange affects existing proposals" forall a b. (a -> b) -> a -> b
$ do
    let largerThreshold :: UnitInterval
        largerThreshold :: UnitInterval
largerThreshold = Integer
51 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
        smallerThreshold :: UnitInterval
        smallerThreshold :: UnitInterval
smallerThreshold = Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        submitTwoExampleProposalsAndVoteOnTheChild ::
          [(KeyHash 'StakePool (EraCrypto era), Vote)] ->
          [(Credential 'DRepRole (EraCrypto era), Vote)] ->
          ImpTestM era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
        submitTwoExampleProposalsAndVoteOnTheChild :: [(KeyHash 'StakePool (EraCrypto era), Vote)]
-> [(Credential 'DRepRole (EraCrypto era), Vote)]
-> ImpTestM
     era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
submitTwoExampleProposalsAndVoteOnTheChild [(KeyHash 'StakePool (EraCrypto era), Vote)]
spos [(Credential 'DRepRole (EraCrypto era), Vote)]
dreps = do
          Credential 'ColdCommitteeRole (EraCrypto era)
committeeC <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
gaiParent <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
gaiChild <-
            forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee
              (forall a. a -> Maybe a
Just (forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaiParent)))
              forall a. Monoid a => a
mempty
              [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era), Vote)]
spos forall a b. (a -> b) -> a -> b
$ \(KeyHash 'StakePool (EraCrypto era)
spo, Vote
vote) -> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
vote (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spo) GovActionId (EraCrypto era)
gaiChild
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Credential 'DRepRole (EraCrypto era), Vote)]
dreps forall a b. (a -> b) -> a -> b
$ \(Credential 'DRepRole (EraCrypto era)
drep, Vote
vote) -> forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
vote (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gaiChild
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- Make the votes count
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId (EraCrypto era)
gaiParent, GovActionId (EraCrypto era)
gaiChild)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" forall a b. (a -> b) -> a -> b
$ do
      let setThreshold :: UnitInterval -> ImpTestM era ()
setThreshold 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
          enactThreshold :: UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
threshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC = 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) DRepVotingThresholds
ppDRepVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
10
            DRepVotingThresholds
drepVotingThresholds <- forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
            let paramChange :: GovAction era
paramChange =
                  forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                    forall a. StrictMaybe a
SNothing
                    ( forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                        forall a 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)
                    )
                    forall a. StrictMaybe a
SNothing
            GovActionId (EraCrypto era)
pcGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction GovAction era
paramChange
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
pcGai
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC) GovActionId (EraCrypto era)
pcGai
            forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      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
$ do
        (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
UnitInterval -> ImpTestM era ()
setThreshold UnitInterval
smallerThreshold
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        (GovActionId (EraCrypto era)
_gaiParent, GovActionId (EraCrypto era)
gaiChild) <- [(KeyHash 'StakePool (EraCrypto era), Vote)]
-> [(Credential 'DRepRole (EraCrypto era), Vote)]
-> ImpTestM
     era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
submitTwoExampleProposalsAndVoteOnTheChild [] [(Credential 'DRepRole (EraCrypto era)
drep, Vote
VoteYes)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era) =>
UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
largerThreshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
UnitInterval -> ImpTestM era ()
setThreshold UnitInterval
largerThreshold
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000
        (GovActionId (EraCrypto era)
gaiParent, GovActionId (EraCrypto era)
gaiChild) <-
          [(KeyHash 'StakePool (EraCrypto era), Vote)]
-> [(Credential 'DRepRole (EraCrypto era), Vote)]
-> ImpTestM
     era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
submitTwoExampleProposalsAndVoteOnTheChild [(KeyHash 'StakePool (EraCrypto era)
spoC, Vote
VoteYes)] [(Credential 'DRepRole (EraCrypto era)
drep, Vote
VoteYes)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era) =>
UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
smallerThreshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaiParent
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaiChild)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SPO" forall a b. (a -> b) -> a -> b
$ do
      let setThreshold :: UnitInterval -> ImpTestM era ()
          setThreshold :: UnitInterval -> ImpTestM era ()
setThreshold 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
          enactThreshold :: UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
threshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
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
            let paramChange :: GovAction era
paramChange =
                  forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                    forall a. StrictMaybe a
SNothing
                    ( forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                        forall a 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)
                    )
                    forall a. StrictMaybe a
SNothing
            GovActionId (EraCrypto era)
pcGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction GovAction era
paramChange
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
pcGai
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC) GovActionId (EraCrypto era)
pcGai
            forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      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
$ do
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setThreshold UnitInterval
smallerThreshold
        (KeyHash 'StakePool (EraCrypto era)
poolKH1, Credential 'Payment (EraCrypto era)
_paymentC1, Credential 'Staking (EraCrypto era)
_stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000
        (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_paymentC2, Credential 'Staking (EraCrypto era)
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
_gaiParent, GovActionId (EraCrypto era)
gaiChild) <-
          [(KeyHash 'StakePool (EraCrypto era), Vote)]
-> [(Credential 'DRepRole (EraCrypto era), Vote)]
-> ImpTestM
     era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
submitTwoExampleProposalsAndVoteOnTheChild
            [(KeyHash 'StakePool (EraCrypto era)
poolKH1, Vote
VoteYes), (KeyHash 'StakePool (EraCrypto era)
poolKH2, Vote
VoteNo)]
            [(Credential 'DRepRole (EraCrypto era)
drepC, Vote
VoteYes)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era) =>
UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
largerThreshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        -- This sets up a stake pool with 1_000_000 Coin
        (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        UnitInterval -> ImpTestM era ()
setThreshold UnitInterval
largerThreshold
        (KeyHash 'StakePool (EraCrypto era)
poolKH1, Credential 'Payment (EraCrypto era)
_paymentC1, Credential 'Staking (EraCrypto era)
_stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000
        (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_paymentC2, Credential 'Staking (EraCrypto era)
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gaiParent, GovActionId (EraCrypto era)
gaiChild) <-
          [(KeyHash 'StakePool (EraCrypto era), Vote)]
-> [(Credential 'DRepRole (EraCrypto era), Vote)]
-> ImpTestM
     era (GovActionId (EraCrypto era), GovActionId (EraCrypto era))
submitTwoExampleProposalsAndVoteOnTheChild
            [(KeyHash 'StakePool (EraCrypto era)
poolKH1, Vote
VoteYes), (KeyHash 'StakePool (EraCrypto era)
poolKH2, Vote
VoteNo)]
            [(Credential 'DRepRole (EraCrypto era)
drepC, Vote
VoteYes)]
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era) =>
UnitInterval
-> Credential 'DRepRole (EraCrypto era)
-> Credential 'HotCommitteeRole (EraCrypto era)
-> ImpTestM era ()
enactThreshold UnitInterval
smallerThreshold Credential 'DRepRole (EraCrypto era)
drepC Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gaiChild forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaiParent
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
gaiParent
        forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
gaiParent
        forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
gaiChild
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      -- Setup one other DRep with equal stake
      (Credential 'DRepRole (EraCrypto era),
 Credential 'Staking (EraCrypto era),
 KeyPair 'Payment (EraCrypto era))
_ <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      -- 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
.~ UnitInterval
smallerThreshold)
      -- 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 (GovPurposeId 'PParamUpdatePurpose era)
-> UnitInterval -> GovAction era
paramChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
parent UnitInterval
threshold =
            forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
              StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
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)
              )
              forall a. StrictMaybe a
SNothing
      GovActionId (EraCrypto era)
parentGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall {era}.
ConwayEraPParams era =>
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> UnitInterval -> GovAction era
paramChange forall a. StrictMaybe a
SNothing UnitInterval
largerThreshold
      GovActionId (EraCrypto era)
childGai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall {era}.
ConwayEraPParams era =>
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> UnitInterval -> GovAction era
paramChange (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
parentGai) UnitInterval
smallerThreshold
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
parentGai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs GovActionId (EraCrypto era)
parentGai
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
childGai
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs GovActionId (EraCrypto era)
childGai
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
parentGai
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
childGai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
parentGai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
childGai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
parentGai)
      forall k a. Ord k => k -> Map k a -> Bool
Map.member (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
childGai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False

committeeMinSizeAffectsInFlightProposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
committeeMinSizeAffectsInFlightProposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeMinSizeAffectsInFlightProposalsSpec =
  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 -> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawal Coin
amount = do
          RewardAccount (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawals [(RewardAccount (EraCrypto era)
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
$ do
      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 (EraCrypto era))
hotCommitteeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      GovActionId (EraCrypto era)
gaiTW <- forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
Coin -> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawal Coin
amount
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs GovActionId (EraCrypto era)
gaiTW
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaiTW
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiTW forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      GovActionId (EraCrypto era)
gaiPC <-
        forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$
          forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
            forall a b. a -> (a -> b) -> b
& forall era.
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 (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCommitteeCs GovActionId (EraCrypto era)
gaiPC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gaiPC)
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiTW forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
currentProposalsShouldContain GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC, GovPurposeId 'CommitteePurpose era
_) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      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 (EraCrypto era)
gaiTW <- forall {era}.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
Coin -> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawal Coin
amount
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCommitteeC) GovActionId (EraCrypto era)
gaiTW
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaiTW
      forall {era}.
(ShelleyEraImp era, ConwayEraPParams era) =>
Natural -> ImpTestM era ()
setCommitteeMinSize Natural
2
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiTW forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
coldCommitteeCred <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      GovActionId (EraCrypto era)
gaiCC <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaiCC
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaiCC
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      Credential 'HotCommitteeRole (EraCrypto era)
_hotCommitteeC' <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey Credential 'ColdCommitteeRole (EraCrypto era)
coldCommitteeCred
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gaiTW forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` (Coin
treasury forall t. Val t => t -> t -> t
<-> Coin
amount)

spoVotesCommitteeUpdates ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
spoVotesCommitteeUpdates :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
spoVotesCommitteeUpdates =
  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 => String -> SpecWith a -> SpecWith a
describe String
"All gov action other than HardForkInitiation" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" forall a b. (a -> b) -> a -> b
$ do
        (KeyHash 'StakePool (EraCrypto era)
spoK1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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
pvtMotionNoConfidenceL 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
        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)
        GovActionId (EraCrypto era)
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
        -- bootstrap: 1 % 4 stake yes; 3 % 4 stake abstain; yes / stake - abstain > 1 % 2
        -- post-bootstrap: 1 % 4 stake yes; 3 % 4 stake no; yes stake < 1 % 2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoK1) GovActionId (EraCrypto era)
gai
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ProtVer
pv <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
        if ProtVer -> Bool
bootstrapPhase ProtVer
pv
          then forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)
          else forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"CommitteeUpdate" forall a b. (a -> b) -> a -> b
$ do
        (KeyHash 'StakePool (EraCrypto era)
spoK1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
        (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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
pvtCommitteeNormalL 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
        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)
        Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
        GovActionId (EraCrypto era)
gai <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
cc, Word32 -> EpochInterval
EpochInterval Word32
5)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        -- bootstrap: 1 % 4 stake yes; 3 % 4 stake abstain; yes / stake - abstain > 1 % 2
        -- post-bootstrap: 1 % 4 stake yes; 3 % 4 stake no; yes stake < 1 % 2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoK1) GovActionId (EraCrypto era)
gai
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        ProtVer
pv <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
        if ProtVer -> Bool
bootstrapPhase ProtVer
pv
          then forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)
          else forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
spoVotesForHardForkInitiation ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
spoVotesForHardForkInitiation :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (EraCrypto era))
hotCCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (KeyHash 'StakePool (EraCrypto era)
spoK1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoK2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100_000_000
      (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hotCCs GovActionId (EraCrypto era)
gai
      -- 1 % 4 stake yes; 3 % 4 stake no; yes / stake - abstain < 1 % 2
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoK1) GovActionId (EraCrypto era)
gai
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
gai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoK2) GovActionId (EraCrypto era)
gai
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gai forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai)

votingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
votingSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
votingSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Voting" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, 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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
khPool, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      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 (EraCrypto era)
gaidThreshold <- forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` (Integer
51 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
        RewardAccount (EraCrypto era)
rew <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        let ppUpdate :: PParamsUpdate era
ppUpdate =
              forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
                forall a b. a -> (a -> b) -> b
& 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
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
                      , pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation = Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
                      , pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal = Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
                      , pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence = Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
                      }
                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
100)
        GovActionId (EraCrypto era)
gaidThreshold <-
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
            ProposalProcedure
              { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rew
              , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
ppUpdate forall a. StrictMaybe a
SNothing
              , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gaidThreshold
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccCreds GovActionId (EraCrypto era)
gaidThreshold
        forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gaidThreshold
        forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId (EraCrypto era)
gaidThreshold
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gaidThreshold
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      let newMinFeeA :: Coin
newMinFeeA = Integer -> Coin
Coin Integer
12_345
      GovActionId (EraCrypto era)
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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        RewardAccount (EraCrypto era)
rew <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
        GovActionId (EraCrypto era)
gaidMinFee <-
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
            ProposalProcedure
              { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rew
              , pProcGovAction :: GovAction era
pProcGovAction =
                  forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                    (forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
                    )
                    forall a. StrictMaybe a
SNothing
              , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
              , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
              }
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gaidMinFee
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccCreds GovActionId (EraCrypto era)
gaidMinFee
        forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId (EraCrypto era)
gaidMinFee
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Coin
initMinFeeA
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
khPool) GovActionId (EraCrypto era)
gaidMinFee
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era. HasCallStack => ImpTestM era ()
logStakeDistr
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gaidMinFee
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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
$ do
          -- Setup DRep delegation #1
          (Credential 'DRepRole (EraCrypto era)
drep1, KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1, KeyPair 'Payment (EraCrypto era)
paymentKP1) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000_000
          -- Setup DRep delegation #2
          (Credential 'DRepRole (EraCrypto era),
 Credential 'Staking (EraCrypto era),
 KeyPair 'Payment (EraCrypto era))
_ <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000_000
          (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
addCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          -- Bump up the UTxO delegated
          -- to barely make the threshold (51 %! 100)
          KeyPair 'Staking (EraCrypto era)
stakingKP1 <- forall s c (m :: * -> *) (r :: KeyRole).
(HasCallStack, HasKeyPairs s c, MonadState s m) =>
KeyHash r c -> m (KeyPair r c)
lookupKeyPair KeyHash 'Staking (EraCrypto era)
stakingKH1
          TxIn (EraCrypto era)
_ <- forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr (EraCrypto era) -> Coin -> ImpTestM era (TxIn (EraCrypto era))
sendCoinTo (forall c.
Crypto c =>
(KeyPair 'Payment c, KeyPair 'Staking c) -> Addr c
mkAddr (KeyPair 'Payment (EraCrypto era)
paymentKP1, KeyPair 'Staking (EraCrypto era)
stakingKP1)) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
200_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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ do
          -- Setup DRep delegation #1
          (Credential 'DRepRole (EraCrypto era)
drep1, Credential 'Staking (EraCrypto era)
staking1, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000_000
          -- Setup DRep delegation #2
          (Credential 'DRepRole (EraCrypto era),
 Credential 'Staking (EraCrypto era),
 KeyPair 'Payment (EraCrypto era))
_ <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000_000
          (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
addCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (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 (EraCrypto era))
epochStateUMapL
              forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k c. (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
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 (EraCrypto era)
staking1
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMap c -> UView c (Credential 'Staking c) 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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) 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 (EraCrypto era)
drepKH1, KeyHash 'Staking (EraCrypto era)
stakingKH1) <- forall era.
ConwayEraImp era =>
ImpTestM
  era
  (KeyHash 'DRepRole (EraCrypto era),
   KeyHash 'Staking (EraCrypto era))
setupDRepWithoutStake
          -- Add rewards to delegation #1
          forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
submitAndExpireProposalToMakeReward forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1) forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
          -- Setup DRep delegation #2
          (KeyHash 'DRepRole (EraCrypto era)
_drepKH2, KeyHash 'Staking (EraCrypto era)
stakingKH2) <- forall era.
ConwayEraImp era =>
ImpTestM
  era
  (KeyHash 'DRepRole (EraCrypto era),
   KeyHash 'Staking (EraCrypto era))
setupDRepWithoutStake
          (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
          -- Add rewards to delegation #2
          forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
submitAndExpireProposalToMakeReward forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH2
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH2) forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          Positive Word32
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 (EraCrypto era)
addCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. Credential 'DRepRole c -> Voter c
DRepVoter forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'DRepRole (EraCrypto era)
drepKH1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          -- Increase the rewards of the delegator to this DRep
          -- to barely make the threshold (51 %! 100)
          forall era.
ShelleyEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
registerAndRetirePoolToMakeReward forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1) forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
poolDeposit forall a. Semigroup a => a -> a -> a
<> Coin
govActionDeposit
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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
600_000
            -- Setup DRep delegation without stake #1
            (KeyHash 'DRepRole (EraCrypto era)
drepKH1, KeyHash 'Staking (EraCrypto era)
stakingKH1) <- forall era.
ConwayEraImp era =>
ImpTestM
  era
  (KeyHash 'DRepRole (EraCrypto era),
   KeyHash 'Staking (EraCrypto era))
setupDRepWithoutStake
            -- Setup DRep delegation #2
            (Credential 'DRepRole (EraCrypto era)
_drepKH2, Credential 'Staking (EraCrypto era)
_stakingKH2, KeyPair 'Payment (EraCrypto era)
_paymentKP2) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
            (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
            -- Make a note of the reward account for the delegator to DRep #1
            RewardAccount (EraCrypto era)
dRepRewardAccount <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
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 (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId (EraCrypto era)
addCCGaid <-
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
                ProposalProcedure
                  { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
600_000
                  , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
dRepRewardAccount
                  , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                  , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                  }
            -- Submit the vote from DRep #1
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. Credential 'DRepRole c -> Voter c
DRepVoter forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'DRepRole (EraCrypto era)
drepKH1) GovActionId (EraCrypto era)
addCCGaid
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
            forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
            -- Submit another proposal to bump up the active voting stake
            Credential 'ColdCommitteeRole (EraCrypto era)
cc' <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            let
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
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, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$
              ProposalProcedure
                { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
600_000
                , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
dRepRewardAccount
                , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                }
            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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
addCCGaid)
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"After switching delegations" 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 (EraCrypto era)
drepKH1, KeyHash 'Staking (EraCrypto era)
stakingKH1) <- forall era.
ConwayEraImp era =>
ImpTestM
  era
  (KeyHash 'DRepRole (EraCrypto era),
   KeyHash 'Staking (EraCrypto era))
setupDRepWithoutStake
            -- Setup DRep delegation #2
            (Credential 'DRepRole (EraCrypto era)
_drepKH2, Credential 'Staking (EraCrypto era)
_stakingKH2, KeyPair 'Payment (EraCrypto era)
_paymentKP2) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
            -- Setup DRep delegation #3
            (KeyHash 'DRepRole (EraCrypto era)
_drepKH3, KeyHash 'Staking (EraCrypto era)
stakingKH3) <- forall era.
ConwayEraImp era =>
ImpTestM
  era
  (KeyHash 'DRepRole (EraCrypto era),
   KeyHash 'Staking (EraCrypto era))
setupDRepWithoutStake
            (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
            -- Make a note of the reward accounts for the delegators to DReps #1 and #3
            RewardAccount (EraCrypto era)
dRepRewardAccount1 <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH1
            RewardAccount (EraCrypto era)
dRepRewardAccount3 <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
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 (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            Anchor (EraCrypto era)
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
            GovActionId (EraCrypto era)
addCCGaid <-
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
                ProposalProcedure
                  { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
1_000_000
                  , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
dRepRewardAccount1
                  , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                  , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
anchor
                  }
            Credential 'ColdCommitteeRole (EraCrypto era)
cc' <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            let
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc' forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            Anchor (EraCrypto era)
anchor' <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$
              ProposalProcedure
                { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
1_000_000
                , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
dRepRewardAccount3
                , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
anchor'
                }
            -- Submit the vote from DRep #1
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. Credential 'DRepRole c -> Voter c
DRepVoter forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'DRepRole (EraCrypto era)
drepKH1) GovActionId (EraCrypto era)
addCCGaid
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
            forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
DelegTxCert
                        (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
stakingKH3)
                        (forall c. DRep c -> Delegatee c
DelegVote (forall c. Credential 'DRepRole c -> DRep c
DRepCredential forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'DRepRole (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ do
          (Credential 'DRepRole (EraCrypto era)
drep1, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          (Credential 'DRepRole (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
drep2Staking, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000

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

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

          KeyHash 'Staking (EraCrypto era)
kh <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          RewardAccount (EraCrypto era)
_ <- forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
registerStakeCredential (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
kh)
          KeyPair 'Payment (EraCrypto era)
_ <- forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era)
-> Coin
-> DRep (EraCrypto era)
-> ImpTestM era (KeyPair 'Payment (EraCrypto era))
delegateToDRep (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
kh) (Integer -> Coin
Coin Integer
1_000_000) forall c. DRep c
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 (EraCrypto era) -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId (EraCrypto era)
paramChangeGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
3

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

          GovActionId (EraCrypto era)
noConfidenceGovId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep1) GovActionId (EraCrypto era)
noConfidenceGovId
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- AlwaysNoConfidence vote acts like 'Yes' for NoConfidence actions
          forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
          (Credential 'DRepRole (EraCrypto era)
drep1, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers

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

          -- 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 (EraCrypto era)
drep3, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
          (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

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

          KeyPair 'Payment (EraCrypto era)
_ <- forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era)
-> Coin
-> DRep (EraCrypto era)
-> ImpTestM era (KeyPair 'Payment (EraCrypto era))
delegateToDRep Credential 'Staking (EraCrypto era)
drep2Staking forall t. Val t => t
zero forall c. DRep c
DRepAlwaysNoConfidence
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5_000_000

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

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

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

          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
comMember) GovActionId (EraCrypto era)
govId
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep1) GovActionId (EraCrypto era)
govId
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep2) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
govId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall {era}. ImpTestM era Coin
getTreasury forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
initialTreasury

          KeyPair 'Payment (EraCrypto era)
_ <- forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era)
-> Coin
-> DRep (EraCrypto era)
-> ImpTestM era (KeyPair 'Payment (EraCrypto era))
delegateToDRep Credential 'Staking (EraCrypto era)
drep2Staking forall t. Val t => t
zero forall c. DRep c
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
govId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          forall {era}. ImpTestM era Coin
getTreasury forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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 (EraCrypto era)
drep, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          KeyHash 'Staking (EraCrypto era)
kh <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          RewardAccount (EraCrypto era)
_ <- forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
registerStakeCredential (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
kh)
          KeyPair 'Payment (EraCrypto era)
_ <- forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era)
-> Coin
-> DRep (EraCrypto era)
-> ImpTestM era (KeyPair 'Payment (EraCrypto era))
delegateToDRep (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'Staking (EraCrypto era)
kh) (Integer -> Coin
Coin Integer
300) forall c. DRep c
DRepAlwaysNoConfidence
          GovActionId (EraCrypto era)
noConfidence <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
noConfidence
          forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
noConfidence
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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 (EraCrypto era)
poolKH1, Credential 'Payment (EraCrypto era)
delegatorCPayment1, Credential 'Staking (EraCrypto era)
delegatorCStaking1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          -- Setup Pool delegation #2
          (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
addCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH2) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
addCCGaid
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          -- Bump up the UTxO delegated
          -- to barely make the threshold (51 %! 100)
          TxIn (EraCrypto era)
_ <-
            forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr (EraCrypto era) -> Coin -> ImpTestM era (TxIn (EraCrypto era))
sendCoinTo
              (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment (EraCrypto era)
delegatorCPayment1 (forall c. StakeCredential c -> StakeReference c
StakeRefBase Credential 'Staking (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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 (EraCrypto era)
poolKH1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
delegatorCStaking1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          -- Setup Pool delegation #2
          (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000_000
          forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          -- Submit a committee proposal
          Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
addCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH2) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era))
epochStateUMapL
              forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k c. (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
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 (EraCrypto era)
delegatorCStaking1
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMap c -> UView c (Credential 'Staking c) 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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 (EraCrypto era)
poolKH1, Credential 'Staking (EraCrypto era)
delegatorCStaking1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM
  era
  (KeyHash 'StakePool (EraCrypto era),
   Credential 'Staking (EraCrypto era))
setupPoolWithoutStake
          -- Add rewards to delegation #1
          forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking (EraCrypto era)
delegatorCStaking1
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward Credential 'Staking (EraCrypto era)
delegatorCStaking1 forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
          -- Setup Pool delegation #2
          (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Staking (EraCrypto era)
delegatorCStaking2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM
  era
  (KeyHash 'StakePool (EraCrypto era),
   Credential 'Staking (EraCrypto era))
setupPoolWithoutStake
          -- Add rewards to delegation #2
          forall era.
ConwayEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking (EraCrypto era)
delegatorCStaking2
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward Credential 'Staking (EraCrypto era)
delegatorCStaking2 forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
          GovActionId (EraCrypto era)
addCCGaid <-
            forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee
              forall a. Maybe a
Nothing
              forall a. Monoid a => a
mempty
              [(Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
addCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH2) GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
addCCGaid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
          forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
addCCGaid
          -- Add to the rewards of the delegator to this SPO
          -- to barely make the threshold (51 %! 100)
          forall era.
ShelleyEraImp era =>
Credential 'Staking (EraCrypto era) -> ImpTestM era ()
registerAndRetirePoolToMakeReward Credential 'Staking (EraCrypto era)
delegatorCStaking1
          forall era.
HasCallStack =>
Credential 'Staking (EraCrypto era) -> ImpTestM era Coin
lookupReward Credential 'Staking (EraCrypto era)
delegatorCStaking1 forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ 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 (EraCrypto era)
poolKH1, Credential 'Staking (EraCrypto era)
stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM
  era
  (KeyHash 'StakePool (EraCrypto era),
   Credential 'Staking (EraCrypto era))
setupPoolWithoutStake
            -- Setup Pool delegation #2
            (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_paymentC2, Credential 'Staking (EraCrypto era)
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
            -- Make a note of the reward account for the delegator to SPO #1
            RewardAccount (EraCrypto era)
spoRewardAccount <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor Credential 'Staking (EraCrypto era)
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 (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            Anchor (EraCrypto era)
anchor <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
            GovActionId (EraCrypto era)
addCCGaid <-
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
                ProposalProcedure
                  { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
600_000
                  , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
spoRewardAccount
                  , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                  , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
anchor
                  }
            -- Submit a yes vote from SPO #1 and a no vote from SPO #2
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
addCCGaid
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)
cc' <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            let
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc' forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            Anchor (EraCrypto era)
anchor' <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$
              ProposalProcedure
                { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
600_000
                , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
spoRewardAccount
                , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = Anchor (EraCrypto era)
anchor'
                }
            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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
addCCGaid)
          forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"After switching delegations" 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 (EraCrypto era)
poolKH1, Credential 'Staking (EraCrypto era)
stakingC1) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM
  era
  (KeyHash 'StakePool (EraCrypto era),
   Credential 'Staking (EraCrypto era))
setupPoolWithoutStake
            -- Setup Pool delegation #2
            (KeyHash 'StakePool (EraCrypto era)
poolKH2, Credential 'Payment (EraCrypto era)
_paymentC2, Credential 'Staking (EraCrypto era)
_stakingC2) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
            -- Setup Pool delegation #3
            (KeyHash 'StakePool (EraCrypto era)
_poolKH3, Credential 'Staking (EraCrypto era)
stakingC3) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM
  era
  (KeyHash 'StakePool (EraCrypto era),
   Credential 'Staking (EraCrypto era))
setupPoolWithoutStake
            -- Make a note of the reward accounts for the delegators to SPOs #1 and #3
            RewardAccount (EraCrypto era)
spoRewardAccount1 <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor Credential 'Staking (EraCrypto era)
stakingC1
            RewardAccount (EraCrypto era)
spoRewardAccount3 <- forall era.
Credential 'Staking (EraCrypto era)
-> ImpTestM era (RewardAccount (EraCrypto era))
getRewardAccountFor Credential 'Staking (EraCrypto era)
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 (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            EpochNo
curEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
            let
              newCommitteMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
cc forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)
            GovActionId (EraCrypto era)
addCCGaid <-
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
                ProposalProcedure
                  { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
1_000_000
                  , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
spoRewardAccount1
                  , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                  , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                  }
            Credential 'ColdCommitteeRole (EraCrypto era)
cc' <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            let
              newCommitteMembers' :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' = forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole (EraCrypto era)
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, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ forall a b. (a -> b) -> a -> b
$
              ProposalProcedure
                { pProcDeposit :: Coin
pProcDeposit = Integer -> Coin
Coin Integer
1_000_000
                , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
spoRewardAccount3
                , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee forall a. StrictMaybe a
SNothing forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
newCommitteMembers' (Integer
75 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100)
                , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
                }
            -- Submit a yes vote from SPO #1 and a no vote from SPO #2
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteYes (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH1) GovActionId (EraCrypto era)
addCCGaid
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
mkDelegTxCert Credential 'Staking (EraCrypto era)
stakingC3 (forall c. KeyHash 'StakePool c -> Delegatee c
DelegStake KeyHash 'StakePool (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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
$ do
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
        Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers
        GovActionId (EraCrypto era)
noConfidenceGovId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
committeeGovId)

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

        -- DReps accepted the proposal
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Update committee - normal state" forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
        (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> ImpTestM era ()
submitVote_ Vote
VoteNo (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

        -- DReps accepted the proposal
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
        -- SPOs voted no, so committee won't be updated
        forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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
$ do
        NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccMembers <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccMembers GovActionId (EraCrypto era)
gid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
gid
        forall era. ShelleyEraImp era => 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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 (EraCrypto era)
_drep, Credential 'HotCommitteeRole (EraCrypto era)
_, GovPurposeId 'CommitteePurpose era
committeeGovId) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole (EraCrypto era),
   Credential 'HotCommitteeRole (EraCrypto era),
   GovPurposeId 'CommitteePurpose era)
electBasicCommittee
          (KeyHash 'StakePool (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

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

          GovActionId (EraCrypto era)
noConfidenceGovId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. 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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
          forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isSpoAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
noConfidenceGovId forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era)))
getCommitteeMembers forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. Monoid a => a
mempty

delayingActionsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
delayingActionsSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
delayingActionsSpec =
  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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      GovActionId (EraCrypto era)
gai0 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a. StrictMaybe a
SNothing
      GovActionId (EraCrypto era)
gai1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai0
      GovActionId (EraCrypto era)
gai2 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai1
      GovActionId (EraCrypto era)
gai3 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai2
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai0
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai0
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai1
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai1
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai2
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai2
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai3
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai3
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai0)
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai1)
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai2)
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai3)
      forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        GovActionId (EraCrypto era)
pGai0 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall 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 (EraCrypto era)
pGai1 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
pGai2 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
cGai0 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a. StrictMaybe a
SNothing
        GovActionId (EraCrypto era)
cGai1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
cGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
cGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
cGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
cGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
cGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai2
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
cGai0)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
cGai1)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
pGai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose era)
     (PEdges (GovPurposeId 'PParamUpdatePurpose era)))
getParameterChangeProposals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
        GovActionId (EraCrypto era)
gai0 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a. StrictMaybe a
SNothing
        GovActionId (EraCrypto era)
gai1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai0
        GovActionId (EraCrypto era)
gai2 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai1
        GovActionId (EraCrypto era)
gai3 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
gai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
gai3
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
gai3
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai0)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai1)
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gai2)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Other lineage" forall a b. (a -> b) -> a -> b
$ do
        NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
        GovActionId (EraCrypto era)
pGai0 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            forall a. StrictMaybe a
SNothing
            forall a b. (a -> b) -> a -> b
$ forall 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 (EraCrypto era)
pGai1 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
pGai2 <-
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange
            (forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
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 (EraCrypto era)
cGai0 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a. StrictMaybe a
SNothing
        GovActionId (EraCrypto era)
cGai1 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
cGai0
        GovActionId (EraCrypto era)
cGai2 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
StrictMaybe (GovActionId (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
submitConstitutionGovAction forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust GovActionId (EraCrypto era)
cGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
cGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
cGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
cGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
cGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
cGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
cGai2
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai0
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai0
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai1
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai1
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
pGai2
        forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
pGai2
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
cGai0)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
cGai1)
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
getLastEnactedConstitution forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
cGai2)
        forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose era)
     (PEdges (GovPurposeId 'ConstitutionPurpose era)))
getConstitutionProposals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
        (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
        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 (EraCrypto era))
hks <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
        Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers

        (Set (Credential 'ColdCommitteeRole (EraCrypto era))
membersExceedingExpiry, EpochNo
exceedingExpiry) <-
          forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (EraCrypto era)
c3 <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
            KeyHash 'ColdCommitteeRole (EraCrypto era)
c4 <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
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 (EraCrypto era)) EpochNo
membersExceedingExpiry = [(forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'ColdCommitteeRole (EraCrypto era)
c3, EpochNo
exceedingExpiry), (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'ColdCommitteeRole (EraCrypto era)
c4, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
maxTermLength)]
            GovPurposeId GovActionId (EraCrypto era)
gaid <-
              forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole (EraCrypto era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
                forall a. StrictMaybe a
SNothing
                Credential 'DRepRole (EraCrypto era)
drep
                forall a. Set a
Set.empty
                Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
membersExceedingExpiry
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
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 (EraCrypto era))
-> ImpTestM era ()
expectMembers Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
membersExceedingExpiry, EpochNo
exceedingExpiry)

        -- other actions get ratified and enacted
        GovActionId (EraCrypto era)
govIdConst1 <- forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"Other actions are ratified and enacted" forall a b. (a -> b) -> a -> b
$ do
          (GovActionId (EraCrypto era)
govIdConst1, Constitution era
constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
govIdConst1
          forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
hks GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution
          forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId (EraCrypto era)
govIdConst1

        -- after enough epochs pass, the expiration of the new members becomes acceptable
        -- and the new committee is enacted
        forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (EraCrypto era))
-> ImpTestM era ()
expectMembers forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers forall a. Semigroup a => a -> a -> a
<> Set (Credential 'ColdCommitteeRole (EraCrypto era))
membersExceedingExpiry

        forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"New committee can vote" forall a b. (a -> b) -> a -> b
$ do
          (GovActionId (EraCrypto era)
govIdConst2, Constitution era
constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
govIdConst1)
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
govIdConst2
          [Credential 'HotCommitteeRole (EraCrypto era)]
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 (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey (forall a. Set a -> [a]
Set.toList Set (Credential 'ColdCommitteeRole (EraCrypto era))
membersExceedingExpiry)
          forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole (EraCrypto era)]
hks' GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

committeeMaxTermLengthSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
committeeMaxTermLengthSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
committeeMaxTermLengthSpec =
  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 (EraCrypto era) ->
        Credential 'DRepRole (EraCrypto era) ->
        ImpTestM era [Credential 'ColdCommitteeRole (EraCrypto era)]
      electMembersWithMaxTermLength :: KeyHash 'StakePool (EraCrypto era)
-> Credential 'DRepRole (EraCrypto era)
-> ImpTestM era [Credential 'ColdCommitteeRole (EraCrypto era)]
electMembersWithMaxTermLength KeyHash 'StakePool (EraCrypto era)
spoC Credential 'DRepRole (EraCrypto era)
drep = do
        Credential 'ColdCommitteeRole (EraCrypto era)
m1 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
        Credential 'ColdCommitteeRole (EraCrypto era)
m2 <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
        EpochNo
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 (EraCrypto era)) EpochNo
members = [(Credential 'ColdCommitteeRole (EraCrypto era)
m1, EpochNo
expiry), (Credential 'ColdCommitteeRole (EraCrypto era)
m2, EpochNo
expiry)]
        GovPurposeId GovActionId (EraCrypto era)
gaid <-
          forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole (EraCrypto era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
            forall a. StrictMaybe a
SNothing
            Credential 'DRepRole (EraCrypto era)
drep
            forall a. Set a
Set.empty
            Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaid
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Credential 'ColdCommitteeRole (EraCrypto era)
m1, Credential 'ColdCommitteeRole (EraCrypto era)
m2]
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"maxTermLength = 0" 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers

      -- Setup new committee members with max term length of 0 epoch
      [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers <- KeyHash 'StakePool (EraCrypto era)
-> Credential 'DRepRole (EraCrypto era)
-> ImpTestM era [Credential 'ColdCommitteeRole (EraCrypto era)]
electMembersWithMaxTermLength KeyHash 'StakePool (EraCrypto era)
spoC Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

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

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

      [Credential 'HotCommitteeRole (EraCrypto era)]
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 (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers
      -- CC members can now vote for the hard-fork
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole (EraCrypto era)]
hotCs GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole (EraCrypto era)]
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era))
-> ImpTestM era ()
expectMembers forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldBeExpired [Credential 'ColdCommitteeRole (EraCrypto era)]
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. StrictMaybe a
SNothing
      forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
      forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
      Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers

      -- Setup new committee members with max term length of 1 epoch
      [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers <- KeyHash 'StakePool (EraCrypto era)
-> Credential 'DRepRole (EraCrypto era)
-> ImpTestM era [Credential 'ColdCommitteeRole (EraCrypto era)]
electMembersWithMaxTermLength KeyHash 'StakePool (EraCrypto era)
spoC Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)
gid <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer

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

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

      [Credential 'HotCommitteeRole (EraCrypto era)]
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 (EraCrypto era)
-> ImpTestM era (Credential 'HotCommitteeRole (EraCrypto era))
registerCommitteeHotKey [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers
      -- CC members can now vote for the hard-fork
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ [Credential 'HotCommitteeRole (EraCrypto era)]
hotCs GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era ()
expectCommitteeMemberAbsence [Credential 'ColdCommitteeRole (EraCrypto era)]
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era) -> ImpTestM era Bool
isCommitteeAccepted GovActionId (EraCrypto era)
gid forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Bool
True
      -- ...and that they are active elected members now
      forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> ImpTestM era ()
expectMembers forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialMembers forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole (EraCrypto era)]
newMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole (EraCrypto era) -> ImpTestM era ()
ccShouldNotBeExpired [Credential 'ColdCommitteeRole (EraCrypto era)]
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
gid)
      forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer