{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

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

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (EpochInterval (..), addEpochInterval)
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.Rules (
  ConwayEpochEvent (GovInfoEvent),
  ConwayNewEpochEvent (..),
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules (Event, ShelleyTickEvent (..))
import Cardano.Ledger.Val
import Control.Monad.Writer (listen)
import Data.Default (Default (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Tree
import Data.Typeable (cast)
import Lens.Micro
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Rational (IsRatio (..), (%!))
import Test.Cardano.Ledger.Imp.Common

spec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
dRepVotingSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
treasurySpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
proposalsSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
dRepSpec
  SpecWith (ImpInit (LedgerSpec era))
forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
eventsSpec

proposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
proposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
proposalsSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Proposals" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals survive multiple epochs without any activity" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      -- + 2 epochs to pass to get the desired effect
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
4
      Tree GovActionId
_tree <-
        StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (Tree () -> ImpTestM era (Tree GovActionId))
-> Tree () -> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$
          () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
            ()
            [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node
                ()
                [ () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
                ]
            , () -> [Tree ()] -> Tree ()
forall a. a -> [Tree a] -> Tree a
Node () []
            ]

      Proposals era
forest <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
5
      Proposals era
forest' <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
      Proposals era
forest' Proposals era -> Proposals era -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Proposals era
forest
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      Proposals era
forest'' <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
      Proposals era
forest'' Proposals era -> Proposals era -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Proposals era
forall a. Default a => a
def
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Expired proposal deposit refunded" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      let deposit :: Coin
deposit = Integer -> Coin
Coin Integer
999
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
1
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
deposit
      RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount

      Coin
initialValue <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL)

      GovAction era
parameterChangeAction <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
      GovActionId
govActionId <-
        GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
          GovAction era
parameterChangeAction
          RewardAccount
rewardAccount
          ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectPresentGovActionId GovActionId
govActionId
      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
govActionId

      SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL) ImpTestM era Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
initialValue
      RewardAccount -> ImpTestM era Coin
forall era. EraCertState era => RewardAccount -> ImpTestM era Coin
getRewardAccountAmount RewardAccount
rewardAccount ImpTestM era Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
deposit

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Proposals are expired and removed as expected" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
1

      Constitution era
curConstitution <- SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
      DRepPulsingState era
initialPulser <- SimpleGetter (NewEpochState era) (DRepPulsingState era)
-> ImpTestM era (DRepPulsingState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (DRepPulsingState era)
 -> ImpTestM era (DRepPulsingState era))
-> SimpleGetter (NewEpochState era) (DRepPulsingState era)
-> ImpTestM era (DRepPulsingState era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((DRepPulsingState era -> Const r (DRepPulsingState era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (DRepPulsingState era -> Const r (DRepPulsingState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> Const r (DRepPulsingState era))
-> GovState era -> Const r (GovState era)
(DRepPulsingState era -> Const r (DRepPulsingState era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL
      EnactState era
initialEnactState <- ImpTestM era (EnactState era)
forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState

      GovActionId
govActionId <- StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpM (LedgerSpec era) GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall a. StrictMaybe a
SNothing
      Constitution era
curConstitution' <- SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
      String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Constitution has not been enacted yet" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        Constitution era
curConstitution' Constitution era -> Constitution era -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
curConstitution

      ConwayGovState era
govState <- SimpleGetter (NewEpochState era) (ConwayGovState era)
-> ImpTestM era (ConwayGovState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL
      let expectedProposals :: Proposals era
expectedProposals = ConwayGovState era
govState ConwayGovState era
-> Getting (Proposals era) (ConwayGovState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. Getting (Proposals era) (ConwayGovState era) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL
          expectedPulser :: DRepPulsingState era
expectedPulser = ConwayGovState era
govState ConwayGovState era
-> Getting
     (DRepPulsingState era) (ConwayGovState era) (DRepPulsingState era)
-> DRepPulsingState era
forall s a. s -> Getting a s a -> a
^. Getting
  (DRepPulsingState era) (ConwayGovState era) (DRepPulsingState era)
forall era (f :: * -> *).
Functor f =>
(DRepPulsingState era -> f (DRepPulsingState era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsDRepPulsingStateL
      EnactState era
expectedEnactState <- ImpTestM era (EnactState era)
forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState

      String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"EnactState reflects the submitted governance action" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EnactState era
expectedEnactState EnactState era -> EnactState era -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EnactState era
initialEnactState

      String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Proposals contain the submitted proposal" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        Proposals era
expectedProposals Proposals era
-> (Proposals era -> Bool) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` \Proposals era
props -> GovActionId
govActionId GovActionId -> StrictSeq GovActionId -> Bool
forall a. Eq a => a -> StrictSeq a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Proposals era -> StrictSeq GovActionId
forall era. Proposals era -> StrictSeq GovActionId
proposalsIds Proposals era
props

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

      Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Proposal gets removed after expiry" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        ConwayGovState era
govStateFinal <- SimpleGetter (NewEpochState era) (ConwayGovState era)
-> ImpTestM era (ConwayGovState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL
        let ratifyState :: RatifyState era
ratifyState = DRepPulsingState era -> RatifyState era
forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState (ConwayGovState era
govStateFinal ConwayGovState era
-> Getting
     (DRepPulsingState era) (ConwayGovState era) (DRepPulsingState era)
-> DRepPulsingState era
forall s a. s -> Getting a s a -> a
^. Getting
  (DRepPulsingState era) (ConwayGovState era) (DRepPulsingState era)
forall era (f :: * -> *).
Functor f =>
(DRepPulsingState era -> f (DRepPulsingState era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsDRepPulsingStateL)
        RatifyState era -> Set GovActionId
forall era. RatifyState era -> Set GovActionId
rsExpired RatifyState era
ratifyState Set GovActionId -> Set GovActionId -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` GovActionId -> Set GovActionId
forall a. a -> Set a
Set.singleton GovActionId
govActionId
  where
    submitParameterChangeTree :: StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree = (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
submitGovActionTree ((StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
 -> StrictMaybe GovActionId
 -> Tree ()
 -> ImpTestM era (Tree GovActionId))
-> (StrictMaybe GovActionId -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction (StrictMaybe GovActionId -> ImpTestM era (GovAction era))
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> StrictMaybe GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction

dRepSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
dRepSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
dRepSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    let submitParamChangeProposal :: ImpM (LedgerSpec era) ()
submitParamChangeProposal = StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry is updated based on the number of dormant epochs" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

      EpochNo
startEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      let
        -- compute the epoch number that is an offset from starting epoch number
        offDRepActivity :: Word32 -> EpochNo
offDRepActivity = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (EpochInterval -> EpochNo)
-> (Word32 -> EpochInterval) -> Word32 -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> EpochInterval
EpochInterval
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      ImpM (LedgerSpec era) ()
submitParamChangeProposal
      Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
2 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
100

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 3
      -- proposal has expired
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
100

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 4
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
2
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
100

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 5
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
100

      ImpM (LedgerSpec era) ()
submitParamChangeProposal
      -- number of dormant epochs is added to the drep expiry and reset to 0
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
103

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 6
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
103
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry is not updated for inactive DReps" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      let
        drepActivity :: Word32
drepActivity = Word32
2
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
      (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      EpochNo
startEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      let
        -- compute the epoch number that is an offset from starting epoch number plus
        -- the ppDRepActivity parameter
        offDRepActivity :: Word32 -> EpochNo
offDRepActivity Word32
offset =
          EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
offset)

      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      ImpM (LedgerSpec era) ()
submitParamChangeProposal
      Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
2 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 3
      -- proposal has expired
      -- drep has expired
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
1
      Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False -- numDormantEpochs is added to the drep exiry calculation
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 4
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
2
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 5
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3

      ImpM (LedgerSpec era) ()
submitParamChangeProposal
      -- number of dormant epochs is added to the drep, considering they are not actually expired,
      -- and is reset to 0
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 6
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry updates are correct for a mixture of cases" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      let
        drepActivity :: Word32
drepActivity = Word32
4
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
      EpochNo
startEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      let
        -- compute the epoch number that is an offset from starting epoch number plus
        -- the ppDRepActivity parameter
        offDRepActivity :: Word32 -> EpochNo
offDRepActivity Word32
offset =
          EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
offset)
      (Credential 'DRepRole
drep1, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000 -- Receives an expiry update transaction certificate
      (Credential 'DRepRole
drep2, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000 -- Turns inactive due to natural expiry
      (Credential 'DRepRole
drep3, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000 -- Unregisters and gets deleted
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      GovActionId
_ <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
2 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep3 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 3
      -- proposal has expired
      ImpM (LedgerSpec era) ()
forall era. (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectCurrentProposals
      ImpM (LedgerSpec era) ()
forall era. (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectPulserProposals
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep3 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 4
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
2
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep3 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0

      Credential 'DRepRole -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole -> ImpTestM era ()
updateDRep Credential 'DRepRole
drep1 -- DRep expiry becomes (current epoch (4) + drep activity (4) - dormant epochs (2))
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      Credential 'DRepRole -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drep3
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 5
      -- Updated drep1 shows their new expiry
      -- numDormantEpochs bumps up further
      -- drep3 has unregistered
      -- drep2 has not expired since we now have dormant epochs
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
      Credential 'DRepRole -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
expectDRepNotRegistered Credential 'DRepRole
drep3

      GovActionId
_ <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      -- number of dormant epochs is added to the dreps expiry, and reset to 0
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5 -- 6 + 3
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3 -- 4 + 3
      Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
2 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4

      GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction

      Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
2 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4

      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep2) GovActionId
gai

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
7
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
10
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
11

      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
2
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
8
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
10
      Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
12

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep registration should succeed" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      String -> ImpM (LedgerSpec era) ()
forall t. HasCallStack => String -> ImpM t ()
logString String
"Stake distribution before DRep registration:"
      ImpM (LedgerSpec era) ()
forall era.
(ToExpr (InstantStake era), HasCallStack) =>
ImpTestM era ()
logInstantStake
      KeyHash 'DRepRole
_ <- ImpTestM era (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      String -> ImpM (LedgerSpec era) ()
forall t. HasCallStack => String -> ImpM t ()
logString String
"Stake distribution after DRep registration:"
      ImpM (LedgerSpec era) ()
forall era.
(ToExpr (InstantStake era), HasCallStack) =>
ImpTestM era ()
logInstantStake
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch

dRepVotingSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
dRepVotingSpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
dRepVotingSpec =
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    -- DRep voting for anything other than Info is disallowed during bootstrap,
    -- so we can only run this test post-bootstrap
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"proposal is accepted after two epochs" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPEconomicGroupL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
      let getParamValue :: ImpTestM era Coin
getParamValue = SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL)
      Coin
initialParamValue <- ImpTestM era Coin
getParamValue

      let proposedValue :: Coin
proposedValue = Coin
initialParamValue Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
300
      let proposedUpdate :: PParamsUpdate era
proposedUpdate = PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
proposedValue

      -- Submit NewConstitution proposal two epoch too early to check that the action
      -- doesn't expire prematurely (ppGovActionLifetimeL is set to two epochs)
      String -> ImpTestM era ()
forall t. HasCallStack => String -> ImpM t ()
logString String
"Submitting new minFee proposal"
      GovActionId
gid <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
proposedUpdate

      NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (Credential 'DRepRole
dRepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gid
      do
        Bool
isAccepted <- GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gid
        String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Gov action should not be accepted" (Bool -> ImpTestM era ()) -> Bool -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
isAccepted
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
gid
      Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds GovActionId
gid
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gid
      do
        Bool
isAccepted <- GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gid
        String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Gov action should be accepted" Bool
isAccepted

      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      do
        Bool
isAccepted <- GovActionId -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gid
        String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Gov action should be accepted" Bool
isAccepted
      GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gid
      GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gid
      ImpTestM era Coin
getParamValue ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
initialParamValue
      ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpTestM era Coin
getParamValue ImpTestM era Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
proposedValue

treasurySpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
treasurySpec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
treasurySpec =
  -- Treasury withdrawal are disallowed during bootstrap,
  -- so we can run tests that submit such proposal only post-bootstrap.
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Treasury" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      [GovAction era] -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraImp era) =>
[GovAction era] -> ImpTestM era ()
treasuryWithdrawalExpectation []

    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawalExtra" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ ImpTestM era () -> ImpTestM era ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
      ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
      RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      RewardAccount
rewardAccountOther <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      StrictMaybe ScriptHash
govPolicy <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      [GovAction era] -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraImp era) =>
[GovAction era] -> ImpTestM era ()
treasuryWithdrawalExpectation
        [ Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount (Integer -> Coin
Coin Integer
667)) StrictMaybe ScriptHash
govPolicy
        , Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccountOther (Integer -> Coin
Coin Integer
668)) StrictMaybe ScriptHash
govPolicy
        ]

    String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
      String
"deposit is moved to treasury when the reward address is not registered"
      ImpTestM era ()
forall era. ConwayEraImp era => ImpTestM era ()
depositMovesToTreasuryWhenStakingAddressUnregisters

treasuryWithdrawalExpectation ::
  forall era.
  (HasCallStack, ConwayEraImp era) =>
  [GovAction era] ->
  ImpTestM era ()
treasuryWithdrawalExpectation :: forall era.
(HasCallStack, ConwayEraImp era) =>
[GovAction era] -> ImpTestM era ()
treasuryWithdrawalExpectation [GovAction era]
extraWithdrawals = do
  ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
  Coin
withdrawalAmount <- (Coin, Coin) -> ImpM (LedgerSpec era) Coin
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer -> Coin
Coin Integer
1, Integer -> Coin
Coin Integer
1_000_000_000)
  -- Before making a withdrawal, we need to make sure there is enough money in the treasury:
  Coin -> ImpTestM era ()
forall era. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury Coin
withdrawalAmount
  NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
  (Credential 'DRepRole
dRepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
  Coin
treasuryStart <- SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
  Coin
treasuryStart Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
withdrawalAmount
  RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
  StrictMaybe ScriptHash
govPolicy <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
  (GovActionId
govActionId NE.:| [GovActionId]
_) <-
    NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions (NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId))
-> NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
forall a b. (a -> b) -> a -> b
$
      Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount Coin
withdrawalAmount) StrictMaybe ScriptHash
govPolicy
        GovAction era -> [GovAction era] -> NonEmpty (GovAction era)
forall a. a -> [a] -> NonEmpty a
NE.:| [GovAction era]
extraWithdrawals
  Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
govActionId
  NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds GovActionId
govActionId
  ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- 1st epoch crossing starts DRep pulser
  String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal should not be received yet" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Credential 'Staking -> ImpM (LedgerSpec era) Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAccount) ImpM (LedgerSpec era) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
forall a. Monoid a => a
mempty
  ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- 2nd epoch crossing enacts all the ratified actions
  GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
govActionId
  Coin
treasuryEnd <- SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
  String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal deducted from treasury" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Coin
treasuryStart Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
treasuryEnd Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
withdrawalAmount
  String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal received by reward account" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Credential 'Staking -> ImpM (LedgerSpec era) Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getReward (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAccount) ImpM (LedgerSpec era) Coin -> Coin -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
withdrawalAmount

depositMovesToTreasuryWhenStakingAddressUnregisters :: ConwayEraImp era => ImpTestM era ()
depositMovesToTreasuryWhenStakingAddressUnregisters :: forall era. ConwayEraImp era => ImpTestM era ()
depositMovesToTreasuryWhenStakingAddressUnregisters = do
  ImpTestM era ()
forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
  Coin
initialTreasury <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
  (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
    PParams era
pp
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
8
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
0
  RewardAccount
returnAddr <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
  Coin
govActionDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL
  StrictMaybe ScriptHash
govPolicy <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
  GovActionId
gaid <-
    GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
      ( StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
          StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall a. StrictMaybe a
SNothing
          (PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000000))
          StrictMaybe ScriptHash
govPolicy
      )
      RewardAccount
returnAddr
      ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
  GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectPresentGovActionId GovActionId
gaid
  Int -> ImpTestM era () -> ImpTestM era ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
  Coin -> ImpTestM era ()
forall era. HasCallStack => Coin -> ImpTestM era ()
expectTreasury Coin
initialTreasury
  RewardAccount -> ImpTestM era ()
forall era. EraCertState era => RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
returnAddr
  Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton
          (Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert (Credential 'Staking -> TxCert era)
-> Credential 'Staking -> TxCert era
forall a b. (a -> b) -> a -> b
$ RewardAccount -> Credential 'Staking
raCredential RewardAccount
returnAddr)
  RewardAccount -> ImpTestM era ()
forall era. EraCertState era => RewardAccount -> ImpTestM era ()
expectNotRegisteredRewardAddress RewardAccount
returnAddr
  Int -> ImpTestM era () -> ImpTestM era ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 ImpTestM era ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
  GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
gaid
  Coin -> ImpTestM era ()
forall era. HasCallStack => Coin -> ImpTestM era ()
expectTreasury (Coin -> ImpTestM era ()) -> Coin -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Coin
initialTreasury Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
govActionDeposit

eventsSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
eventsSpec :: forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
SpecWith (ImpInit (LedgerSpec era))
eventsSpec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Events" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"emits event" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"GovInfoEvent" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
ccCreds <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoCred, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

      let actionLifetime :: Word32
actionLifetime = Word32
10
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
actionLifetime
          PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (PoolVotingThresholds -> Identity PoolVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL ((PoolVotingThresholds -> Identity PoolVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> PoolVotingThresholds -> Identity PoolVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> PoolVotingThresholds -> Identity PoolVotingThresholds
Lens' PoolVotingThresholds UnitInterval
pvtPPSecurityGroupL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (DRepVotingThresholds -> Identity DRepVotingThresholds)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL ((DRepVotingThresholds -> Identity DRepVotingThresholds)
 -> PParams era -> Identity (PParams era))
-> ((UnitInterval -> Identity UnitInterval)
    -> DRepVotingThresholds -> Identity DRepVotingThresholds)
-> (UnitInterval -> Identity UnitInterval)
-> PParams era
-> Identity (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInterval -> Identity UnitInterval)
-> DRepVotingThresholds -> Identity DRepVotingThresholds
Lens' DRepVotingThresholds UnitInterval
dvtPPEconomicGroupL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
forall a. Default a => a
def)
      Coin
propDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL
      let
        proposeParameterChange :: ImpM (LedgerSpec era) (GovActionId, ImpM (LedgerSpec era) ())
proposeParameterChange = do
          CoinPerByte
newVal <- Coin -> CoinPerByte
CoinPerByte (Coin -> CoinPerByte)
-> (Integer -> Coin) -> Integer -> CoinPerByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> CoinPerByte)
-> ImpM (LedgerSpec era) Integer
-> ImpM (LedgerSpec era) CoinPerByte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall a. Random a => (a, a) -> ImpM (LedgerSpec era) a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Integer
3000, Integer
6500)
          GovActionId
proposal <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era GovActionId)
-> PParamsUpdate era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL ((StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe CoinPerByte
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinPerByte -> StrictMaybe CoinPerByte
forall a. a -> StrictMaybe a
SJust CoinPerByte
newVal
          (GovActionId, ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (GovActionId, ImpM (LedgerSpec era) ())
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (GovActionId
proposal, SimpleGetter (NewEpochState era) CoinPerByte
-> ImpM (LedgerSpec era) CoinPerByte
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((CoinPerByte -> Const r CoinPerByte)
    -> EpochState era -> Const r (EpochState era))
-> (CoinPerByte -> Const r CoinPerByte)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((CoinPerByte -> Const r CoinPerByte)
    -> PParams era -> Const r (PParams era))
-> (CoinPerByte -> Const r CoinPerByte)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoinPerByte -> Const r CoinPerByte)
-> PParams era -> Const r (PParams era)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL) ImpM (LedgerSpec era) CoinPerByte
-> CoinPerByte -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` CoinPerByte
newVal)
      (GovActionId
proposalA, ImpM (LedgerSpec era) ()
checkProposedParameterA) <- ImpM (LedgerSpec era) (GovActionId, ImpM (LedgerSpec era) ())
proposeParameterChange
      (GovActionId
proposalB, ImpM (LedgerSpec era) ()
_) <- ImpM (LedgerSpec era) (GovActionId, ImpM (LedgerSpec era) ())
proposeParameterChange
      rewardAccount :: RewardAccount
rewardAccount@(RewardAccount Network
_ Credential 'Staking
rewardCred) <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- prevent proposalC expiry and force it's deletion due to conflit.
      GovActionId
proposalC <- String -> ImpTestM era GovActionId -> ImpTestM era GovActionId
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"proposalC" (ImpTestM era GovActionId -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ do
        CoinPerByte
newVal <- Coin -> CoinPerByte
CoinPerByte (Coin -> CoinPerByte)
-> (Integer -> Coin) -> Integer -> CoinPerByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> CoinPerByte)
-> ImpM (LedgerSpec era) Integer
-> ImpM (LedgerSpec era) CoinPerByte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall a. Random a => (a, a) -> ImpM (LedgerSpec era) a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Integer
3000, Integer
6500)
        GovAction era
paramChange <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era (GovAction era))
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall a b. (a -> b) -> a -> b
$ (PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL ((StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe CoinPerByte
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinPerByte -> StrictMaybe CoinPerByte
forall a. a -> StrictMaybe a
SJust CoinPerByte
newVal)
        GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
          GovAction era
paramChange
          RewardAccount
rewardAccount
          ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
      let
        isGovInfoEvent :: SomeSTSEvent era -> Bool
isGovInfoEvent (SomeSTSEvent Event (EraRule rule era)
ev)
          | Just (TickNewEpochEvent (EpochEvent (GovInfoEvent {})) :: ShelleyTickEvent era) <- Event (EraRule rule era) -> Maybe (ShelleyTickEvent era)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Event (EraRule rule era)
ev = Bool
True
        isGovInfoEvent SomeSTSEvent era
_ = Bool
False
        passEpochWithNoDroppedActions :: ImpM (LedgerSpec era) ()
passEpochWithNoDroppedActions = do
          (()
_, [SomeSTSEvent era]
evs) <- ImpM (LedgerSpec era) ()
-> ImpM (LedgerSpec era) ((), [SomeSTSEvent era])
forall a.
ImpM (LedgerSpec era) a
-> ImpM (LedgerSpec era) (a, [SomeSTSEvent era])
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
          (SomeSTSEvent era -> Bool)
-> [SomeSTSEvent era] -> [SomeSTSEvent era]
forall a. (a -> Bool) -> [a] -> [a]
filter SomeSTSEvent era -> Bool
isGovInfoEvent [SomeSTSEvent era]
evs
            [SomeSTSEvent era]
-> [SomeSTSEvent era] -> ImpM (LedgerSpec era) ()
forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` [ 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" (Event (EraRule "TICK" era) -> Item [SomeSTSEvent era])
-> (ConwayEpochEvent era -> Event (EraRule "TICK" era))
-> ConwayEpochEvent era
-> Item [SomeSTSEvent era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayEpochEvent era -> EraRuleEvent "TICK" era
ConwayEpochEvent era -> Event (EraRule "TICK" era)
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (ConwayEpochEvent era -> Item [SomeSTSEvent era])
-> ConwayEpochEvent era -> Item [SomeSTSEvent era]
forall a b. (a -> b) -> a -> b
$
                               Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
forall era.
Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
GovInfoEvent Set (GovActionState era)
forall a. Monoid a => a
mempty Set (GovActionState era)
forall a. Monoid a => a
mempty Set (GovActionState era)
forall a. Monoid a => a
mempty Map GovActionId Coin
forall a. Monoid a => a
mempty
                           ]
      Int -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
actionLifetime Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ImpM (LedgerSpec era) ()
passEpochWithNoDroppedActions
      GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
proposalA
      Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoCred) GovActionId
proposalA
      NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
ccCreds GovActionId
proposalA
      GovActionState era
gasA <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
proposalA
      GovActionState era
gasB <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
proposalB
      GovActionState era
gasC <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
proposalC
      Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton (Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
rewardCred)
      ImpM (LedgerSpec era) ()
passEpochWithNoDroppedActions
      (()
_, [SomeSTSEvent era]
evs) <- ImpM (LedgerSpec era) ()
-> ImpM (LedgerSpec era) ((), [SomeSTSEvent era])
forall a.
ImpM (LedgerSpec era) a
-> ImpM (LedgerSpec era) (a, [SomeSTSEvent era])
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpM (LedgerSpec era) ()
checkProposedParameterA
      let
        filteredEvs :: [SomeSTSEvent era]
filteredEvs = (SomeSTSEvent era -> Bool)
-> [SomeSTSEvent era] -> [SomeSTSEvent era]
forall a. (a -> Bool) -> [a] -> [a]
filter SomeSTSEvent era -> Bool
isGovInfoEvent [SomeSTSEvent era]
evs
      [SomeSTSEvent era]
filteredEvs
        [SomeSTSEvent era]
-> [SomeSTSEvent era] -> ImpM (LedgerSpec era) ()
forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` [ 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" (Event (EraRule "TICK" era) -> Item [SomeSTSEvent era])
-> (ConwayEpochEvent era -> Event (EraRule "TICK" era))
-> ConwayEpochEvent era
-> Item [SomeSTSEvent era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayEpochEvent era -> EraRuleEvent "TICK" era
ConwayEpochEvent era -> Event (EraRule "TICK" era)
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleEvent rule t era =>
t era -> EraRuleEvent rule era
injectEvent (ConwayEpochEvent era -> Item [SomeSTSEvent era])
-> ConwayEpochEvent era -> Item [SomeSTSEvent era]
forall a b. (a -> b) -> a -> b
$
                           Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
forall era.
Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
GovInfoEvent
                             (GovActionState era -> Set (GovActionState era)
forall a. a -> Set a
Set.singleton GovActionState era
gasA)
                             (GovActionState era -> Set (GovActionState era)
forall a. a -> Set a
Set.singleton GovActionState era
gasC)
                             (GovActionState era -> Set (GovActionState era)
forall a. a -> Set a
Set.singleton GovActionState era
gasB)
                             (GovActionId -> Coin -> Map GovActionId Coin
forall k a. k -> a -> Map k a
Map.singleton GovActionId
proposalC Coin
propDeposit)
                       ]