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

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

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

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

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

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

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

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

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

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

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

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

      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Proposal gets removed after expiry" forall a b. (a -> b) -> a -> b
$ do
        ConwayGovState era
govStateFinal <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL
        let ratifyState :: RatifyState era
ratifyState = forall era. DRepPulsingState era -> RatifyState era
extractDRepPulsingState (ConwayGovState era
govStateFinal forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL)
        forall era. RatifyState era -> Set GovActionId
rsExpired RatifyState era
ratifyState forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. a -> Set a
Set.singleton GovActionId
govActionId
  where
    submitParameterChangeTree :: StrictMaybe GovActionId
-> Tree () -> ImpTestM era (Tree GovActionId)
submitParameterChangeTree = forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
submitGovActionTree forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" forall a b. (a -> b) -> a -> b
$ do
    let submitParamChangeProposal :: ImpM (LedgerSpec era) ()
submitParamChangeProposal = forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction forall a. StrictMaybe a
SNothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry is updated based on the number of dormant epochs" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL 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
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000

      EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
      let
        -- compute the epoch number that is an offset from starting epoch number
        offDRepActivity :: Word32 -> EpochNo
offDRepActivity = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> EpochInterval
EpochInterval
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

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

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

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

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 5
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep 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
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
103

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 6
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
103
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry is not updated for inactive DReps" forall a b. (a -> b) -> a -> b
$ do
      let
        drepActivity :: Word32
drepActivity = Word32
2
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL 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
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
      let
        -- 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 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity forall a. Num a => a -> a -> a
+ Word32
offset)

      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

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

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 3
      -- proposal has expired
      -- drep has expired
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
1
      forall era.
HasCallStack =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep 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
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 4
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
2
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 5
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep 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
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- entering epoch 6
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"expiry updates are correct for a mixture of cases" forall a b. (a -> b) -> a -> b
$ do
      let
        drepActivity :: Word32
drepActivity = Word32
4
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
          forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
      EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
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 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity forall a. Num a => a -> a -> a
+ Word32
offset)
      (Credential 'DRepRole
drep1, 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
_) <- 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
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000 -- Unregisters and gets deleted
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

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

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

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

      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))
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drep3
      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
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
3
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
      forall era. HasCallStack => Credential 'DRepRole -> ImpTestM era ()
expectDRepNotRegistered Credential 'DRepRole
drep3

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

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

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

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

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

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

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

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep registration should succeed" forall a b. (a -> b) -> a -> b
$ do
      forall t. HasCallStack => String -> ImpM t ()
logString String
"Stake distribution before DRep registration:"
      forall era. HasCallStack => ImpTestM era ()
logStakeDistr
      KeyHash 'DRepRole
_ <- forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      forall t. HasCallStack => String -> ImpM t ()
logString String
"Stake distribution after DRep registration:"
      forall era. HasCallStack => ImpTestM era ()
logStakeDistr
      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 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" 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
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"proposal is accepted after two epochs" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DRepVotingThresholds UnitInterval
dvtPPEconomicGroupL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
      let getParamValue :: ImpTestM era Coin
getParamValue = forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL)
      Coin
initialParamValue <- ImpTestM era Coin
getParamValue

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

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

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

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      do
        Bool
isAccepted <- forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gid
        forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Gov action should be accepted" Bool
isAccepted
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
gid
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gid
      ImpTestM era Coin
getParamValue forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
initialParamValue
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpTestM era Coin
getParamValue 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.
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Treasury" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"TreasuryWithdrawal" forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ do
      forall era.
(HasCallStack, ConwayEraImp era) =>
[GovAction era] -> ImpTestM era ()
treasuryWithdrawalExpectation []

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

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
      String
"deposit is moved to treasury when the reward address is not registered"
      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
  forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
  Coin
withdrawalAmount <- 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:
  forall era. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury Coin
withdrawalAmount
  NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
  (Credential 'DRepRole
dRepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
  Coin
treasuryStart <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL
  Coin
treasuryStart forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
withdrawalAmount
  RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
  StrictMaybe ScriptHash
govPolicy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
  (GovActionId
govActionId NE.:| [GovActionId]
_) <-
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions forall a b. (a -> b) -> a -> b
$
      forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount Coin
withdrawalAmount) StrictMaybe ScriptHash
govPolicy
        forall a. a -> [a] -> NonEmpty a
NE.:| [GovAction era]
extraWithdrawals
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRepCred) GovActionId
govActionId
  forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeHotCreds GovActionId
govActionId
  forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- 1st epoch crossing starts DRep pulser
  forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal should not be received yet" forall a b. (a -> b) -> a -> b
$
    forall era.
HasCallStack =>
Credential 'Staking -> ImpTestM era Coin
lookupReward (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAccount) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. Monoid a => a
mempty
  forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- 2nd epoch crossing enacts all the ratified actions
  forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
govActionId
  Coin
treasuryEnd <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL
  forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal deducted from treasury" forall a b. (a -> b) -> a -> b
$
    Coin
treasuryStart forall t. Val t => t -> t -> t
<-> Coin
treasuryEnd forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
withdrawalAmount
  forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Withdrawal received by reward account" forall a b. (a -> b) -> a -> b
$
    forall era.
HasCallStack =>
Credential 'Staking -> ImpTestM era Coin
lookupReward (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAccount) 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
  forall era. ShelleyEraImp era => ImpTestM era ()
disableTreasuryExpansion
  Coin
initialTreasury <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL
  forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
    PParams era
pp
      forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
8
      forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
0
  RewardAccount
returnAddr <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
  Coin
govActionDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
  StrictMaybe ScriptHash
govPolicy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
  GovActionId
gaid <-
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
      ( forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
          forall a. StrictMaybe a
SNothing
          (forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
1000000))
          StrictMaybe ScriptHash
govPolicy
      )
      RewardAccount
returnAddr
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal
  forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectPresentGovActionId GovActionId
gaid
  forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
  forall era. HasCallStack => Coin -> ImpTestM era ()
expectTreasury Coin
initialTreasury
  forall era. RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
returnAddr
  forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
    forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
      forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
          (forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert forall a b. (a -> b) -> a -> b
$ RewardAccount -> Credential 'Staking
raCredential RewardAccount
returnAddr)
  forall era. RewardAccount -> ImpTestM era ()
expectNotRegisteredRewardAddress RewardAccount
returnAddr
  forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
  forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
gaid
  forall era. HasCallStack => Coin -> ImpTestM era ()
expectTreasury forall a b. (a -> b) -> a -> b
$ Coin
initialTreasury 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 = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Events" forall a b. (a -> b) -> a -> b
$ do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"emits event" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"GovInfoEvent" forall a b. (a -> b) -> a -> b
$ do
      NonEmpty (Credential 'HotCommitteeRole)
ccCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      (KeyHash 'StakePool
spoCred, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

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