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

import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.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.Class (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 Data.Typeable (cast)
import Data.Word (Word64)
import Lens.Micro
import Test.Cardano.Ledger.Conway.ImpTest
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
  ) =>
  SpecWith (ImpTestState 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) =>
SpecWith (ImpTestState era)
spec = do
  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 (ImpTestState era)
relevantDuringBootstrapSpec
  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 (ImpTestState era)
treasuryWithdrawalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
noConfidenceSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
constitutionSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
actionPriorityCommitteePurposeSpec
  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 (ImpTestState era)
hardForkInitiationSpec

relevantDuringBootstrapSpec ::
  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 (ImpTestState era)
relevantDuringBootstrapSpec :: 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 (ImpTestState era)
relevantDuringBootstrapSpec = do
  forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (ImpTestState era)
hardForkInitiationNoDRepsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (ImpTestState 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 (ImpTestState era)
treasuryWithdrawalsSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Treasury withdrawals" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Modify EnactState as expected" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount (EraCrypto era)
rewardAcount1 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      GovActionId (EraCrypto era)
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawals [(RewardAccount (EraCrypto era)
rewardAcount1, Integer -> Coin
Coin Integer
666)]
      GovActionState era
gas <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
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 (EraCrypto era)
esGovActionId = GovActionId (EraCrypto era)
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 (EraCrypto era)) Coin
ensWithdrawals EnactState era
enactState' forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` [(forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
rewardAcount1, Integer -> Coin
Coin Integer
666)]

      RewardAccount (EraCrypto era)
rewardAcount2 <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      let withdrawals' :: [(RewardAccount (EraCrypto era), Coin)]
withdrawals' =
            [ (RewardAccount (EraCrypto era)
rewardAcount1, Integer -> Coin
Coin Integer
111)
            , (RewardAccount (EraCrypto era)
rewardAcount2, Integer -> Coin
Coin Integer
222)
            ]
      GovActionId (EraCrypto era)
govActionId' <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawals [(RewardAccount (EraCrypto era), Coin)]
withdrawals'
      GovActionState era
gas' <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
govActionId'
      let govAction' :: GovAction era
govAction' = forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas'
      let signal' :: EnactSignal era
signal' =
            EnactSignal
              { esGovActionId :: GovActionId (EraCrypto era)
esGovActionId = GovActionId (EraCrypto era)
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 (EraCrypto era)) Coin
ensWithdrawals EnactState era
enactState''
        forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` [ (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
rewardAcount1, Integer -> Coin
Coin Integer
777)
                   , (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
rewardAcount2, Integer -> Coin
Coin Integer
222)
                   ]
      forall era. EnactState era -> Coin
ensTreasury EnactState era
enactState'' forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      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 (EraCrypto era), Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpTestM era [(RewardAccount (EraCrypto era), 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 (EraCrypto era), Coin)]
-> Credential 'DRepRole (EraCrypto era)
-> NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
enactTreasuryWithdrawals [(RewardAccount (EraCrypto era), Coin)]
withdrawals Credential 'DRepRole (EraCrypto era)
drepC NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs
      forall {era} {b}.
Coin -> [(RewardAccount (EraCrypto era), b)] -> ImpTestM era ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount (EraCrypto era), 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 (EraCrypto era), Coin)]
withdrawals

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall t. Val t => t
zero
      forall {era} {b}.
[(RewardAccount (EraCrypto era), b)] -> ImpTestM era Coin
sumRewardAccounts [(RewardAccount (EraCrypto era), Coin)]
withdrawals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      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 (EraCrypto era), Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpTestM era [(RewardAccount (EraCrypto era), 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 (EraCrypto era), Coin)]
-> Credential 'DRepRole (EraCrypto era)
-> NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
-> ImpTestM era (GovActionId (EraCrypto era))
enactTreasuryWithdrawals [(RewardAccount (EraCrypto era), Coin)]
withdrawals Credential 'DRepRole (EraCrypto era)
drepC NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs
      forall {era} {b}.
Coin -> [(RewardAccount (EraCrypto era), b)] -> ImpTestM era ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount (EraCrypto era), 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
$ do
      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      forall era. 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 (EraCrypto era), Coin)]
withdrawals <- forall {era}.
ShelleyEraImp era =>
Coin -> Int -> ImpTestM era [(RewardAccount (EraCrypto era), Coin)]
genWithdrawalsExceeding Coin
initialTreasury Int
numWithdrawals

      forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (EraCrypto era), Coin)
w -> do
              GovActionId (EraCrypto era)
gaId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount (EraCrypto era), Coin)]
-> ImpTestM era (GovActionId (EraCrypto era))
submitTreasuryWithdrawals @era [(RewardAccount (EraCrypto era), Coin)
w]
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaId
              forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs GovActionId (EraCrypto era)
gaId
          )
          [(RewardAccount (EraCrypto era), 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 (EraCrypto era)
_, 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 (EraCrypto era), Coin)]
withdrawals

        forall {era}. ImpTestM era Coin
getTreasury forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
expectedTreasury
        -- check that the sum of the rewards matches what was spent from the treasury
        forall {era} {b}.
[(RewardAccount (EraCrypto era), b)] -> ImpTestM era Coin
sumRewardAccounts [(RewardAccount (EraCrypto era), Coin)]
withdrawals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (EraCrypto era), b)] -> ImpTestM era Coin
sumRewardAccounts [(RewardAccount (EraCrypto era), 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 (EraCrypto era) -> ImpTestM era Coin
getRewardAccountAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(RewardAccount (EraCrypto era), b)]
withdrawals
    genWithdrawalsExceeding :: Coin -> Int -> ImpTestM era [(RewardAccount (EraCrypto era), 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 (EraCrypto era))
registerRewardAccount
    checkNoWithdrawal :: Coin -> [(RewardAccount (EraCrypto era), b)] -> ImpTestM era ()
checkNoWithdrawal Coin
initialTreasury [(RewardAccount (EraCrypto era), b)]
withdrawals = do
      forall {era}. ImpTestM era Coin
getTreasury forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
initialTreasury
      forall {era} {b}.
[(RewardAccount (EraCrypto era), b)] -> ImpTestM era Coin
sumRewardAccounts [(RewardAccount (EraCrypto era), b)]
withdrawals forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (ImpTestState 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 (ImpTestState era)
hardForkInitiationSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"HardForkInitiation" forall a b. (a -> b) -> a -> b
$ do
    NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
    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 (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (Credential 'DRepRole (EraCrypto era)
dRep1, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
11_000_000
    (Credential 'DRepRole (EraCrypto era)
dRep2, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
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 (EraCrypto era)
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep1) GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId1) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 (ImpTestState 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 (ImpTestState 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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
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 (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId1) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
curProtVer
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer

pparamPredictionSpec :: ConwayEraImp era => SpecWith (ImpTestState era)
pparamPredictionSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (EraCrypto era))
committeeMembers' <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
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 (EraCrypto era),
 Credential 'Payment (EraCrypto era),
 Credential 'Staking (EraCrypto era))
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId1, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
22_000_000
    (KeyHash 'StakePool (EraCrypto era)
stakePoolId2, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
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 (EraCrypto era)
govActionId <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing ProtVer
nextProtVer
    forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeMembers' GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId1) GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
stakePoolId2) GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextProtVer

noConfidenceSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
noConfidenceSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
noConfidenceSpec =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NoConfidence" forall a b. (a -> b) -> a -> b
$ do
    forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
      PParams era
pp
        forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) 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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"There should not be a committee" forall a b. (a -> b) -> a -> b
$ StrictMaybe (Committee era)
committee forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` forall a. StrictMaybe a
SNothing
    KeyHash 'ColdCommitteeRole (EraCrypto era)
khCC <- forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
    Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialCommitteeMembers <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
getCommitteeMembers

    (Credential 'DRepRole (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
    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 (EraCrypto era)) EpochNo
committeeMap =
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj KeyHash 'ColdCommitteeRole (EraCrypto era)
khCC, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (Word32 -> EpochInterval
EpochInterval Word32
50))
            ]
    prevGaidCommittee :: GovPurposeId 'CommitteePurpose era
prevGaidCommittee@(GovPurposeId GovActionId (EraCrypto era)
gaidCommittee) <-
      forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole (EraCrypto era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
        forall a. StrictMaybe a
SNothing
        Credential 'DRepRole (EraCrypto era)
drep
        Set (Credential 'ColdCommitteeRole (EraCrypto era))
initialCommitteeMembers
        Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
committeeMap
    (KeyHash 'StakePool (EraCrypto era)
khSPO, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
    forall era. HasCallStack => ImpTestM era ()
logStakeDistr
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
khSPO) GovActionId (EraCrypto era)
gaidCommittee
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
4 forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` forall a. a -> StrictMaybe a
SJust (forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval -> Committee era
Committee Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
committeeMap forall a b. (a -> b) -> a -> b
$ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
    PParams era
pp <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
    RewardAccount (EraCrypto era)
returnAddr <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
    GovActionId (EraCrypto era)
gaidNoConf <-
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
        ProposalProcedure
          { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
returnAddr
          , pProcGovAction :: GovAction era
pProcGovAction = forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
prevGaidCommittee)
          , pProcDeposit :: Coin
pProcDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
          , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
          }
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
khSPO) GovActionId (EraCrypto era)
gaidNoConf
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drep) GovActionId (EraCrypto era)
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 => SpecWith (ImpTestState era)
constitutionSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 (EraCrypto era)
committeeMember1 :| [Item [Credential 'HotCommitteeRole (EraCrypto era)]
committeeMember2]) <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
    (Credential 'DRepRole (EraCrypto era)
dRep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
    (GovActionId (EraCrypto era)
govActionId, Constitution era
constitution) <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era), Constitution era)
submitConstitution forall a. StrictMaybe a
SNothing
    Constitution era
initialConstitution <- forall era. ConwayEraImp era => ImpTestM era (Constitution era)
getConstitution

    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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep) GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committeeMember1) GovActionId (EraCrypto era)
govActionId
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Item [Credential 'HotCommitteeRole (EraCrypto era)]
committeeMember2) GovActionId (EraCrypto era)
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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (EraCrypto era)
-> Vote
-> GovActionId (EraCrypto era)
-> Proposals era
-> Proposals era
proposalsAddVote
              (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
committeeMember1)
              Vote
VoteYes
              GovActionId (EraCrypto era)
govActionId
              ( forall era.
Voter (EraCrypto era)
-> Vote
-> GovActionId (EraCrypto era)
-> Proposals era
-> Proposals era
proposalsAddVote
                  (forall c. Credential 'HotCommitteeRole c -> Voter c
CommitteeVoter Item [Credential 'HotCommitteeRole (EraCrypto era)]
committeeMember2)
                  Vote
VoteYes
                  GovActionId (EraCrypto era)
govActionId
                  ( forall era.
Voter (EraCrypto era)
-> Vote
-> GovActionId (EraCrypto era)
-> Proposals era
-> Proposals era
proposalsAddVote
                      (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRep)
                      Vote
VoteYes
                      GovActionId (EraCrypto era)
govActionId
                      Proposals era
proposalsBeforeVotes
                  )
              )
      Proposals era
proposalsAfterVotes forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Proposals era
proposalsWithVotes

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

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

    forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
initialConstitution

    forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

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

    forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution

    forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` EnactState era
enactState

actionPriorityCommitteePurposeSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
actionPriorityCommitteePurposeSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
actionPriorityCommitteePurposeSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Competing proposals with different priorities" 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 (EraCrypto era)
drepC, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
poolKH, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
      Credential 'ColdCommitteeRole (EraCrypto era)
cc <- forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s c (m :: * -> *) (r :: KeyRole).
(HasKeyPairs s c, MonadState s m,
 HasStatefulGen (StateGenM s) m) =>
m (KeyHash r c)
freshKeyHash
      GovActionId (EraCrypto era)
gai1 <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> [(Credential 'ColdCommitteeRole (EraCrypto era), EpochInterval)]
-> UnitInterval
-> ImpTestM era (GovActionId (EraCrypto era))
submitUpdateCommittee forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole (EraCrypto era)
cc, Word32 -> EpochInterval
EpochInterval Word32
30)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
3)
      -- gai2 is the first action of a higher priority
      GovActionId (EraCrypto era)
gai2 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
      GovActionId (EraCrypto era)
gai3 <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence forall a. StrictMaybe a
SNothing
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ @[]
        ( \GovActionId (EraCrypto era)
gaid -> do
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
drepC) GovActionId (EraCrypto era)
gaid
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolKH) GovActionId (EraCrypto era)
gaid
        )
        [GovActionId (EraCrypto era)
gai1, GovActionId (EraCrypto era)
gai2, GovActionId (EraCrypto era)
gai3]
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose era))
getLastEnactedCommittee
        forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId GovActionId (EraCrypto era)
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` forall a. StrictMaybe a
SNothing

actionPrioritySpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
actionPrioritySpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
actionPrioritySpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Competing proposals ratified in the same epoch" forall a b. (a -> b) -> a -> b
$ do
    let val1 :: Coin
val1 = Integer -> Coin
Coin Integer
1_000_001
    let val2 :: Coin
val2 = Integer -> Coin
Coin Integer
1_000_002
    let val3 :: Coin
val3 = Integer -> Coin
Coin Integer
1_000_003

    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)

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

      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      NonEmpty (GovActionId (EraCrypto era))
gaids <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era)
-> ImpTestM era (NonEmpty (GovActionId (EraCrypto era)))
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 (EraCrypto era))
-> 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)
                forall a. StrictMaybe a
SNothing
            , forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> 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)
                forall a. StrictMaybe a
SNothing
            , forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> 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)
                forall a. StrictMaybe a
SNothing
            ]
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        ( \GovActionId (EraCrypto era)
gaid -> do
            forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gaid
            forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeCs GovActionId (EraCrypto era)
gaid
        )
        NonEmpty (GovActionId (EraCrypto era))
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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