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

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

import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.Rules
import Cardano.Ledger.Credential
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules (ShelleyTickEvent (..))
import Cardano.Ledger.Val (zero, (<->))
import Control.Monad (forM)
import Control.Monad.Writer (listen)
import Control.State.Transition.Extended (STS (..))
import Data.Default (def)
import Data.Foldable as F (foldl', traverse_)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Typeable (cast)
import Data.Word (Word64)
import Lens.Micro
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Arbitrary (uniformSubSet)
import Test.Cardano.Ledger.Core.Rational
import Test.Cardano.Ledger.Imp.Common
import Type.Reflection (Typeable)

spec ::
  forall era.
  ( ConwayEraImp era
  , NFData (Event (EraRule "ENACT" era))
  , ToExpr (Event (EraRule "ENACT" era))
  , Eq (Event (EraRule "ENACT" era))
  , Typeable (Event (EraRule "ENACT" era))
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era, NFData (Event (EraRule "ENACT" era)),
 ToExpr (Event (EraRule "ENACT" era)),
 Eq (Event (EraRule "ENACT" era)),
 Typeable (Event (EraRule "ENACT" era)),
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 InjectRuleEvent "TICK" ConwayEpochEvent era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
committeeSpec
  forall era.
(ConwayEraImp era, NFData (Event (EraRule "ENACT" era)),
 ToExpr (Event (EraRule "ENACT" era)),
 Eq (Event (EraRule "ENACT" era)),
 Typeable (Event (EraRule "ENACT" era))) =>
SpecWith (ImpInit (LedgerSpec era))
treasuryWithdrawalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
noConfidenceSpec
  forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 InjectRuleEvent "TICK" ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
constitutionSpec
  forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
actionPrioritySpec
  forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 InjectRuleEvent "TICK" ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationNoDRepsSpec
  forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
pparamPredictionSpec

treasuryWithdrawalsSpec ::
  forall era.
  ( ConwayEraImp era
  , NFData (Event (EraRule "ENACT" era))
  , ToExpr (Event (EraRule "ENACT" era))
  , Eq (Event (EraRule "ENACT" era))
  , Typeable (Event (EraRule "ENACT" era))
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
treasuryWithdrawalsSpec :: forall era.
(ConwayEraImp era, NFData (Event (EraRule "ENACT" era)),
 ToExpr (Event (EraRule "ENACT" era)),
 Eq (Event (EraRule "ENACT" era)),
 Typeable (Event (EraRule "ENACT" era))) =>
SpecWith (ImpInit (LedgerSpec era))
treasuryWithdrawalsSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Treasury withdrawals" forall a b. (a -> b) -> a -> b
$ do
    -- Treasury withdrawals are disallowed in bootstrap, so we're running these tests only post-bootstrap
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Modify EnactState as expected" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      RewardAccount
rewardAcount1 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      GovActionId
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount
rewardAcount1, Integer -> Coin
Coin Integer
666)]
      GovActionState era
gas <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId
      let govAction :: GovAction era
govAction = forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas
      EnactState era
enactStateInit <- forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
      let signal :: EnactSignal era
signal =
            EnactSignal
              { esGovActionId :: GovActionId
esGovActionId = GovActionId
govActionId
              , esGovAction :: GovAction era
esGovAction = GovAction era
govAction
              }
          enactState :: EnactState era
enactState =
            EnactState era
enactStateInit
              { ensTreasury :: Coin
ensTreasury = Integer -> Coin
Coin Integer
1000
              }
      EnactState era
enactState' <- forall (rule :: Symbol) era.
(HasCallStack, KnownSymbol rule, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 NFData (State (EraRule rule era)),
 NFData (Event (EraRule rule era)),
 ToExpr (Event (EraRule rule era)), Eq (Event (EraRule rule era)),
 Typeable (Event (EraRule rule era))) =>
Environment (EraRule rule era)
-> State (EraRule rule era)
-> Signal (EraRule rule era)
-> ImpTestM era (State (EraRule rule era))
runImpRule @"ENACT" () EnactState era
enactState EnactSignal era
signal
      forall era. EnactState era -> Map (Credential 'Staking) Coin
ensWithdrawals EnactState era
enactState' forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [(RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAcount1, Integer -> Coin
Coin Integer
666)]

      RewardAccount
rewardAcount2 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      let withdrawals' :: [(RewardAccount, Coin)]
withdrawals' =
            [ (RewardAccount
rewardAcount1, Integer -> Coin
Coin Integer
111)
            , (RewardAccount
rewardAcount2, Integer -> Coin
Coin Integer
222)
            ]
      GovActionId
govActionId' <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount, Coin)]
withdrawals'
      GovActionState era
gas' <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId'
      let govAction' :: GovAction era
govAction' = forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas'
      let signal' :: EnactSignal era
signal' =
            EnactSignal
              { esGovActionId :: GovActionId
esGovActionId = GovActionId
govActionId'
              , esGovAction :: GovAction era
esGovAction = GovAction era
govAction'
              }

      EnactState era
enactState'' <- forall (rule :: Symbol) era.
(HasCallStack, KnownSymbol rule, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 NFData (State (EraRule rule era)),
 NFData (Event (EraRule rule era)),
 ToExpr (Event (EraRule rule era)), Eq (Event (EraRule rule era)),
 Typeable (Event (EraRule rule era))) =>
Environment (EraRule rule era)
-> State (EraRule rule era)
-> Signal (EraRule rule era)
-> ImpTestM era (State (EraRule rule era))
runImpRule @"ENACT" () EnactState era
enactState' EnactSignal era
signal'

      forall era. EnactState era -> Map (Credential 'Staking) Coin
ensWithdrawals EnactState era
enactState''
        forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [ (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAcount1, Integer -> Coin
Coin Integer
777)
                   , (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAcount2, Integer -> Coin
Coin Integer
222)
                   ]
      forall era. EnactState era -> Coin
ensTreasury EnactState era
enactState'' forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Integer -> Coin
Coin Integer
1

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Withdrawals exceeding treasury submitted in a single proposal" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      NonEmpty (Credential 'HotCommitteeRole)
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      Coin
initialTreasury <- forall {era}. ImpTestM era Coin
getTreasury
      Int
numWithdrawals <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
10)
      [(RewardAccount, Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
genWithdrawalsExceeding Coin
initialTreasury Int
numWithdrawals

      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
[(RewardAccount, Coin)]
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactTreasuryWithdrawals [(RewardAccount, Coin)]
withdrawals Credential 'DRepRole
drepC NonEmpty (Credential 'HotCommitteeRole)
committeeCs
      forall {b} {era}.
Coin -> [(RewardAccount, b)] -> ImpM (LedgerSpec era) ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount, Coin)]
withdrawals

      let sumRequested :: Coin
sumRequested = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a, b) -> b
snd [(RewardAccount, Coin)]
withdrawals

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Submit a treasury donation that can cover the withdrawals" forall a b. (a -> b) -> a -> b
$ do
        let tx :: Tx era
tx =
              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. ConwayEraTxBody era => Lens' (TxBody era) Coin
treasuryDonationTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin
sumRequested forall t. Val t => t -> t -> t
<-> Coin
initialTreasury)
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall {era}. ImpTestM era Coin
getTreasury forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall t. Val t => t
zero
      forall {b} {era}.
[(RewardAccount, b)] -> ImpM (LedgerSpec era) Coin
sumRewardAccounts [(RewardAccount, Coin)]
withdrawals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
sumRequested

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Withdrawals exceeding maxBound Word64 submitted in a single proposal" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      NonEmpty (Credential 'HotCommitteeRole)
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      Coin
initialTreasury <- forall {era}. ImpTestM era Coin
getTreasury
      Int
numWithdrawals <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
10)
      [(RewardAccount, Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
genWithdrawalsExceeding (Integer -> Coin
Coin (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64))) Int
numWithdrawals
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
[(RewardAccount, Coin)]
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactTreasuryWithdrawals [(RewardAccount, Coin)]
withdrawals Credential 'DRepRole
drepC NonEmpty (Credential 'HotCommitteeRole)
committeeCs
      forall {b} {era}.
Coin -> [(RewardAccount, b)] -> ImpM (LedgerSpec era) ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount, Coin)]
withdrawals

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Withdrawals exceeding treasury submitted in several proposals within the same epoch" forall a b. (a -> b) -> a -> b
$
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
        forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
        NonEmpty (Credential 'HotCommitteeRole)
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
        (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        forall era. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5_000_000
        Coin
initialTreasury <- forall {era}. ImpTestM era Coin
getTreasury
        Int
numWithdrawals <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int
10)
        [(RewardAccount, Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
genWithdrawalsExceeding Coin
initialTreasury Int
numWithdrawals

        forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"submit in individual proposals in the same epoch" forall a b. (a -> b) -> a -> b
$ do
          forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
            ( \(RewardAccount, Coin)
w -> do
                GovActionId
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals @era [(RewardAccount, Coin)
w]
                forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaId
                forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeCs GovActionId
gaId
            )
            [(RewardAccount, Coin)]
withdrawals
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2

          let expectedTreasury :: Coin
expectedTreasury =
                forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
                  ( \Coin
acc (RewardAccount
_, Coin
x) ->
                      if Coin
acc forall a. Ord a => a -> a -> Bool
>= Coin
x
                        then Coin
acc forall t. Val t => t -> t -> t
<-> Coin
x
                        else Coin
acc
                  )
                  Coin
initialTreasury
                  [(RewardAccount, Coin)]
withdrawals

          forall {era}. ImpTestM era Coin
getTreasury forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
expectedTreasury
          -- check that the sum of the rewards matches what was spent from the treasury
          forall {b} {era}.
[(RewardAccount, b)] -> ImpM (LedgerSpec era) Coin
sumRewardAccounts [(RewardAccount, Coin)]
withdrawals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (Coin
initialTreasury forall t. Val t => t -> t -> t
<-> Coin
expectedTreasury)
  where
    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)
    sumRewardAccounts :: [(RewardAccount, b)] -> ImpM (LedgerSpec era) Coin
sumRewardAccounts [(RewardAccount, b)]
withdrawals = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall era. RewardAccount -> ImpTestM era Coin
getRewardAccountAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(RewardAccount, b)]
withdrawals
    genWithdrawalsExceeding :: Coin -> Int -> ImpM (LedgerSpec era) [(RewardAccount, Coin)]
genWithdrawalsExceeding (Coin Integer
val) Int
n = do
      [Integer]
vals <- forall {m :: * -> *} {a}.
(MonadGen m, Random a, Integral a) =>
a -> Int -> m [a]
genValuesExceeding Integer
val Int
n
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Integer -> Coin
Coin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
vals) forall a b. (a -> b) -> a -> b
$ \Coin
coin -> (,Coin
coin) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
    checkNoWithdrawal :: Coin -> [(RewardAccount, b)] -> ImpM (LedgerSpec era) ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount, b)]
withdrawals = do
      forall {era}. ImpTestM era Coin
getTreasury forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
initialTreasury
      forall {b} {era}.
[(RewardAccount, b)] -> ImpM (LedgerSpec era) Coin
sumRewardAccounts [(RewardAccount, b)]
withdrawals forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall t. Val t => t
zero
    genValuesExceeding :: a -> Int -> m [a]
genValuesExceeding a
val Int
n = do
      [a]
pcts <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
n forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (a
1, a
100)
      let tot :: a
tot = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
pcts
      let amounts :: [a]
amounts = forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((a
x forall a. Num a => a -> a -> a
* a
val) forall a. Integral a => a -> a -> Ratio a
% a
tot)) [a]
pcts
      let minNeeded :: a
minNeeded = forall a. Ord a => a -> a -> a
max a
0 (a
val forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
amounts forall a. Num a => a -> a -> a
+ a
1)
      a
excess <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (a
minNeeded, a
val forall a. Num a => a -> a -> a
+ a
1)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a
excess forall a. a -> [a] -> [a]
: [a]
amounts

hardForkInitiationSpec ::
  forall era.
  ( ConwayEraImp era
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationSpec :: forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 InjectRuleEvent "TICK" ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    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) 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
.~ Integer
2 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3
        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
pvtHardForkInitiationL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
2 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3
    (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId1, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId2, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (Credential 'DRepRole
dRep1, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
11_000_000
    (Credential 'DRepRole
dRep2, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
11_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
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep1) GovActionId
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId1) GovActionId
govActionId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a b. a -> (a -> b) -> b
& forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep2) GovActionId
govActionId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a b. a -> (a -> b) -> b
& forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId2) GovActionId
govActionId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a b. a -> (a -> b) -> b
& forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ forall era (rule :: Symbol).
(Typeable (Event (EraRule rule era)),
 Eq (Event (EraRule rule era)),
 ToExpr (Event (EraRule rule era))) =>
Event (EraRule rule era) -> SomeSTSEvent era
SomeSTSEvent @era @"TICK" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent forall a b. (a -> b) -> a -> b
$
              forall era. Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
HardForkEvent (forall era. ProtVer -> ConwayHardForkEvent era
ConwayHardForkEvent ProtVer
nextProtVer)
          ]

    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer

hardForkInitiationNoDRepsSpec ::
  forall era.
  ( ConwayEraImp era
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationNoDRepsSpec :: forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 InjectRuleEvent "TICK" ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
hardForkInitiationNoDRepsSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation without DRep voting" forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    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
2 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3
    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)
    (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId1, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId2, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_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
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId1) GovActionId
govActionId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a b. a -> (a -> b) -> b
& forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId2) GovActionId
govActionId
    forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a b. a -> (a -> b) -> b
& forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ forall era (rule :: Symbol).
(Typeable (Event (EraRule rule era)),
 Eq (Event (EraRule rule era)),
 ToExpr (Event (EraRule rule era))) =>
Event (EraRule rule era) -> SomeSTSEvent era
SomeSTSEvent @era @"TICK" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent forall a b. (a -> b) -> a -> b
$
              forall era. Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
HardForkEvent (forall era. ProtVer -> ConwayHardForkEvent era
ConwayHardForkEvent ProtVer
nextProtVer)
          ]
    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer

pparamPredictionSpec :: ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
pparamPredictionSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
pparamPredictionSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"futurePParams" forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    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
2 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3
    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)
    (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId1, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool
stakePoolId2, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_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
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers' GovActionId
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId1) GovActionId
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
stakePoolId2) GovActionId
govActionId
    forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    forall era. ImpTestM era ()
advanceToPointOfNoReturn
    forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    forall era. EraGov era => ImpTestM era ProtVer
getProtVer forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer

noConfidenceSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
noConfidenceSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
noConfidenceSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
    forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
      PParams era
pp
        forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DRepVotingThresholds UnitInterval
dvtCommitteeNoConfidenceL 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 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
pvtCommitteeNoConfidenceL 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 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
.~ Word32 -> EpochInterval
EpochInterval Word32
200
    let
      getCommittee :: ImpTestM era (StrictMaybe (Committee era))
getCommittee =
        forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
          forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
      assertNoCommittee :: HasCallStack => ImpTestM era ()
      assertNoCommittee :: HasCallStack => ImpTestM era ()
assertNoCommittee =
        do
          StrictMaybe (Committee era)
committee <- ImpTestM era (StrictMaybe (Committee era))
getCommittee
          forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"There should not be a committee" forall a b. (a -> b) -> a -> b
$ StrictMaybe (Committee era)
committee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. StrictMaybe a
SNothing
    KeyHash 'ColdCommitteeRole
khCC <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    Set (Credential 'ColdCommitteeRole)
initialCommitteeMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

    (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
    EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
    let committeeMap :: Map (Credential 'ColdCommitteeRole) EpochNo
committeeMap =
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
khCC, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (Word32 -> EpochInterval
EpochInterval Word32
50))
            ]
    prevGaidCommittee :: GovPurposeId 'CommitteePurpose era
prevGaidCommittee@(GovPurposeId GovActionId
gaidCommittee) <-
      forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
        forall a. StrictMaybe a
SNothing
        Credential 'DRepRole
drep
        Set (Credential 'ColdCommitteeRole)
initialCommitteeMembers
        Map (Credential 'ColdCommitteeRole) EpochNo
committeeMap
    (KeyHash 'StakePool
khSPO, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
    forall era. HasCallStack => ImpTestM era ()
logStakeDistr
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
khSPO) GovActionId
gaidCommittee
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
4 forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Committee should be elected" forall a b. (a -> b) -> a -> b
$ do
      StrictMaybe (Committee era)
committee <- ImpTestM era (StrictMaybe (Committee era))
getCommittee
      StrictMaybe (Committee era)
committee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. a -> StrictMaybe a
SJust (forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee Map (Credential 'ColdCommitteeRole) EpochNo
committeeMap forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
    GovActionId
gaidNoConf <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
prevGaidCommittee)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
khSPO) GovActionId
gaidNoConf
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaidNoConf
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
4 forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    HasCallStack => ImpTestM era ()
assertNoCommittee

constitutionSpec ::
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
constitutionSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
constitutionSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Constitution" forall a b. (a -> b) -> a -> b
$ do
    (Credential 'HotCommitteeRole
committeeMember1 :| [Item [Credential 'HotCommitteeRole]
committeeMember2]) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
    (Credential 'DRepRole
dRep, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
    Constitution era
initialConstitution <- forall era. ConwayEraImp era => ImpTestM era (Constitution era)
getConstitution
    (ProposalProcedure era
proposal, Constitution era
constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal forall a. StrictMaybe a
SNothing
    Maybe GovActionId
mbGovActionId <-
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal)]
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGovActionId forall a b. (a -> b) -> a -> b
$ \GovActionId
govActionId -> do
      Proposals era
proposalsBeforeVotes <- 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) (Proposals era)
proposalsGovStateL
      DRepPulsingState era
pulserBeforeVotes <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL

      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
govActionId
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committeeMember1) GovActionId
govActionId
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Item [Credential 'HotCommitteeRole]
committeeMember2) GovActionId
govActionId

      Proposals era
proposalsAfterVotes <- 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) (Proposals era)
proposalsGovStateL
      DRepPulsingState era
pulserAfterVotes <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Votes are recorded in the proposals" forall a b. (a -> b) -> a -> b
$ do
        let proposalsWithVotes :: Proposals era
proposalsWithVotes =
              forall era.
Voter -> Vote -> GovActionId -> Proposals era -> Proposals era
proposalsAddVote
                (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
committeeMember1)
                Vote
VoteYes
                GovActionId
govActionId
                ( forall era.
Voter -> Vote -> GovActionId -> Proposals era -> Proposals era
proposalsAddVote
                    (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Item [Credential 'HotCommitteeRole]
committeeMember2)
                    Vote
VoteYes
                    GovActionId
govActionId
                    ( forall era.
Voter -> Vote -> GovActionId -> Proposals era -> Proposals era
proposalsAddVote
                        (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep)
                        Vote
VoteYes
                        GovActionId
govActionId
                        Proposals era
proposalsBeforeVotes
                    )
                )
        Proposals era
proposalsAfterVotes forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Proposals era
proposalsWithVotes

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

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"New constitution is not enacted after one epoch" forall a b. (a -> b) -> a -> b
$ do
        Constitution era
constitutionAfterOneEpoch <- 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
constitutionAfterOneEpoch forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
initialConstitution

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Pulser should reflect the constitution to be enacted" forall a b. (a -> b) -> a -> b
$ do
        DRepPulsingState era
pulser <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL
        let ratifyState :: RatifyState era
ratifyState = forall era. DRepPulsingState era -> RatifyState era
extractDRepPulsingState DRepPulsingState era
pulser
        forall era. GovActionState era -> GovActionId
gasId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted RatifyState era
ratifyState forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` GovActionId
govActionId forall a. a -> Seq a -> Seq a
Seq.:<| forall a. Seq a
Seq.Empty
        forall era. RatifyState era -> EnactState era
rsEnactState RatifyState era
ratifyState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (EnactState era) (Constitution era)
ensConstitutionL forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Constitution is enacted after two epochs" forall a b. (a -> b) -> a -> b
$ do
        Constitution era
curConstitution <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
        Constitution era
curConstitution forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Pulser is reset" forall a b. (a -> b) -> a -> b
$ do
        DRepPulsingState era
pulser <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL
        let pulserRatifyState :: RatifyState era
pulserRatifyState = forall era. DRepPulsingState era -> RatifyState era
extractDRepPulsingState DRepPulsingState era
pulser
        forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted RatifyState era
pulserRatifyState forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. Seq a
Seq.empty
        EnactState era
enactState <- forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
        forall era. RatifyState era -> EnactState era
rsEnactState RatifyState era
pulserRatifyState forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EnactState era
enactState

actionPrioritySpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
actionPrioritySpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
actionPrioritySpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Competing proposals" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"higher action priority wins" forall a b. (a -> b) -> a -> b
$ do
      (Credential 'DRepRole
drepC, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
poolKH, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
      Credential 'ColdCommitteeRole
cc <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      ProposalProcedure era
proposal <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
30)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)
      Maybe GovActionId
mbGai1 <-
        forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
          forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGai1 forall a b. (a -> b) -> a -> b
$ \GovActionId
gai1 -> do
        -- gai2 is the first action of a higher priority
        GovActionId
gai2 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
        GovActionId
gai3 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ @[]
          ( \GovActionId
gaid -> do
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepC) GovActionId
gaid
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
poolKH) GovActionId
gaid
          )
          [GovActionId
gai1, GovActionId
gai2, GovActionId
gai3]
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee
          forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai2)
        forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals

        StrictMaybe (Committee era)
committee <-
          forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$
            forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
        StrictMaybe (Committee era)
committee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. StrictMaybe a
SNothing

    -- distinct constitutional values for minFee
    let genMinFeeVals :: ImpM (LedgerSpec era) (Coin, Coin, Coin)
genMinFeeVals =
          (\Integer
x Integer
y Integer
z -> (Integer -> Coin
Coin Integer
x, Integer -> Coin
Coin Integer
y, Integer -> Coin
Coin Integer
z))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
30, Integer
330)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
330, Integer
660)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
660, Integer
1000)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"proposals of same priority are enacted in order of submission" 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) PoolVotingThresholds
ppPoolVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PoolVotingThresholds UnitInterval
pvtPPSecurityGroupL 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 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
dvtPPEconomicGroupL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Default a => a
def)
      (Coin
val1, Coin
val2, Coin
val3) <- ImpM (LedgerSpec era) (Coin, Coin, Coin)
genMinFeeVals

      NonEmpty (Credential 'HotCommitteeRole)
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      GovActionId
pGai0 <-
        forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
          forall a. StrictMaybe a
SNothing
          forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
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
val1
      GovActionId
pGai1 <-
        forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
          (forall a. a -> StrictMaybe a
SJust GovActionId
pGai0)
          forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
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
val2
      GovActionId
pGai2 <-
        forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange
          (forall a. a -> StrictMaybe a
SJust GovActionId
pGai1)
          forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
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
val3
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ @[]
        ( \GovActionId
gaid -> do
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
            forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeCs GovActionId
gaid
        )
        [GovActionId
pGai0, GovActionId
pGai1, GovActionId
pGai2]
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
getLastEnactedParameterChange
        forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
pGai2)
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals
      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. 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)
        forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
val3

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"only the first action of a transaction gets enacted" 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) PoolVotingThresholds
ppPoolVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PoolVotingThresholds UnitInterval
pvtPPSecurityGroupL 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 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
dvtPPEconomicGroupL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Default a => a
def)
      (Coin
val1, Coin
val2, Coin
val3) <- ImpM (LedgerSpec era) (Coin, Coin, Coin)
genMinFeeVals

      NonEmpty (Credential 'HotCommitteeRole)
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      StrictMaybe ScriptHash
policy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      NonEmpty GovActionId
gaids <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions forall a b. (a -> b) -> a -> b
$
          forall a. [a] -> NonEmpty a
NE.fromList
            [ forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
                forall a. StrictMaybe a
SNothing
                (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Coin
val1)
                StrictMaybe ScriptHash
policy
            , forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
                forall a. StrictMaybe a
SNothing
                (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Coin
val2)
                StrictMaybe ScriptHash
policy
            , forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
                forall a. StrictMaybe a
SNothing
                (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Coin
val3)
                StrictMaybe ScriptHash
policy
            ]
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        ( \GovActionId
gaid -> do
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid
            forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeCs GovActionId
gaid
        )
        NonEmpty GovActionId
gaids
      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. 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)
        forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
val1
      forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals

expectHardForkEvents ::
  forall era.
  ( ConwayEraImp era
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  ) =>
  [SomeSTSEvent era] ->
  [SomeSTSEvent era] ->
  ImpTestM era ()
expectHardForkEvents :: forall era.
(ConwayEraImp era,
 Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
[SomeSTSEvent era] -> [SomeSTSEvent era] -> ImpTestM era ()
expectHardForkEvents [SomeSTSEvent era]
actual [SomeSTSEvent era]
expected =
  forall a. (a -> Bool) -> [a] -> [a]
filter SomeSTSEvent era -> Bool
isHardForkEvent [SomeSTSEvent era]
actual forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` [SomeSTSEvent era]
expected
  where
    isHardForkEvent :: SomeSTSEvent era -> Bool
isHardForkEvent (SomeSTSEvent Event (EraRule rule era)
ev)
      | Just
          (TickNewEpochEvent (EpochEvent (HardForkEvent (ConwayHardForkEvent ProtVer
_))) :: ShelleyTickEvent era) <-
          forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Event (EraRule rule era)
ev =
          Bool
True
      | Bool
otherwise = Bool
False

committeeSpec ::
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
committeeSpec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
committeeSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee enactment" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Enact UpdateCommitee with lengthy lifetime" forall a b. (a -> b) -> a -> b
$ do
      NonNegative Natural
n <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
n
      (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      Credential 'ColdCommitteeRole
cc <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      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
      ProposalProcedure era
proposal <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval (Word32
committeeMaxTermLength forall a. Num a => a -> a -> a
+ Word32
2))] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      Maybe GovActionId
mbSecondAddCCGaid <-
        forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
          forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbSecondAddCCGaid forall a b. (a -> b) -> a -> b
$ \GovActionId
secondAddCCGaid -> do
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
secondAddCCGaid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
secondAddCCGaid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- Due to longer than allowed lifetime we have to wait an extra epoch for this new action to be enacted
        forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence Credential 'ColdCommitteeRole
cc
        forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberPresence Credential 'ColdCommitteeRole
cc

    -- A CC that has resigned will need to be first voted out and then voted in to be considered active
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"CC re-election" forall a b. (a -> b) -> a -> b
$ do
      (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      -- Add a fresh CC
      Credential 'ColdCommitteeRole
cc <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      ProposalProcedure era
proposal <-
        forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
10)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
      Maybe GovActionId
mbAddCCGaid <-
        forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
          forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbAddCCGaid forall a b. (a -> b) -> a -> b
$ \GovActionId
addCCGaid -> do
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
addCCGaid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
addCCGaid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- Confirm that they are added
        forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberPresence Credential 'ColdCommitteeRole
cc
        -- Confirm their hot key registration
        Credential 'HotCommitteeRole
_hotKey <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
cc
        forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole
cc
        -- Have them resign
        Maybe (Credential 'HotCommitteeRole)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
cc forall a. StrictMaybe a
SNothing
        forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole
cc
        -- Re-add the same CC
        GovActionId
reAddCCGaid <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
20)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
reAddCCGaid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
reAddCCGaid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- Confirm that they are still resigned
        forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole
cc
        -- Remove them
        GovActionId
removeCCGaid <-
          forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee (forall a. a -> Maybe a
Just (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
reAddCCGaid)) (forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
cc) [] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
removeCCGaid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
removeCCGaid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- Confirm that they have been removed
        forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence Credential 'ColdCommitteeRole
cc
        GovActionId
secondAddCCGaid <-
          forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
cc, Word32 -> EpochInterval
EpochInterval Word32
20)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
secondAddCCGaid
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
secondAddCCGaid
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        -- Confirm that they have been added
        forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberPresence Credential 'ColdCommitteeRole
cc
        -- Confirm that after registering a hot key, they are active
        Credential 'HotCommitteeRole
_hotKey <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
cc
        forall era.
HasCallStack =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole
cc
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Removing CC with UpdateCommittee" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Non registered" forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        Set (Credential 'ColdCommitteeRole)
initialCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
        forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr Set (Credential 'ColdCommitteeRole)
initialCommittee
        Set (Credential 'ColdCommitteeRole)
initialCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null
        ProposalProcedure era
proposal <-
          forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
initialCommittee forall a. Monoid a => a
mempty (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        Maybe GovActionId
mbRemoveCCGaid <-
          forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
            forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbRemoveCCGaid forall a b. (a -> b) -> a -> b
$ \GovActionId
removeCCGaid -> do
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
removeCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
removeCCGaid
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Set (Credential 'ColdCommitteeRole)
finalCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
          forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr Set (Credential 'ColdCommitteeRole)
finalCommittee
          Set (Credential 'ColdCommitteeRole)
finalCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` forall a. Set a -> Bool
Set.null
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Registered" forall a b. (a -> b) -> a -> b
$ do
        (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
        forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
        Set (Credential 'ColdCommitteeRole)
initialCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
        forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr Set (Credential 'ColdCommitteeRole)
initialCommittee
        Set (Credential 'ColdCommitteeRole)
initialCommittee forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Set a -> [a]
Set.toList Set (Credential 'ColdCommitteeRole)
initialCommittee) forall a b. (a -> b) -> a -> b
$ \Credential 'ColdCommitteeRole
kh -> do
          Credential 'HotCommitteeRole
ccHotCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          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. 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.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
kh Credential 'HotCommitteeRole
ccHotCred)
        [(Credential 'ColdCommitteeRole, EpochInterval)]
newCommittee <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        Set (Credential 'ColdCommitteeRole)
initialSubCommittee <- forall g (m :: * -> *). HasStatefulGen g m => m g
askStatefulGen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall g (m :: * -> *) k.
(StatefulGen g m, Ord k) =>
Maybe Int -> Set k -> g -> m (Set k)
uniformSubSet forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
initialCommittee
        ProposalProcedure era
proposal <-
          forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing Set (Credential 'ColdCommitteeRole)
initialSubCommittee [(Credential 'ColdCommitteeRole, EpochInterval)]
newCommittee (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
        Maybe GovActionId
mbRemoveCCGaid <-
          forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
            forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbRemoveCCGaid forall a b. (a -> b) -> a -> b
$ \GovActionId
removeCCGaid -> do
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
removeCCGaid
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
removeCCGaid
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          Set (Credential 'ColdCommitteeRole)
finalCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
          forall a t. (HasCallStack, ToExpr a) => a -> ImpM t ()
logToExpr Set (Credential 'ColdCommitteeRole)
finalCommittee
          Set (Credential 'ColdCommitteeRole)
finalCommittee
            forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set (Credential 'ColdCommitteeRole)
initialCommittee forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set (Credential 'ColdCommitteeRole)
initialSubCommittee) (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Credential 'ColdCommitteeRole, EpochInterval)]
newCommittee)