{-# 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 (EraCrypto era))
_tree <-
        StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
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 (EraCrypto era))
-> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction forall a. StrictMaybe a
SNothing
      GovActionId (EraCrypto era)
govActionId <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
          GovAction era
parameterChangeAction
          RewardAccount (EraCrypto era)
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 (EraCrypto era))
submitProposal
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
expectPresentGovActionId GovActionId (EraCrypto era)
govActionId
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
expectMissingGovActionId GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Coin
getRewardAccountAmount RewardAccount (EraCrypto era)
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 (EraCrypto era)
govActionId <- forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era)
govActionId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall era.
Proposals era -> StrictSeq (GovActionId (EraCrypto era))
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 (EraCrypto era))
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 (EraCrypto era)
govActionId
  where
    submitParameterChangeTree :: StrictMaybe (GovActionId (EraCrypto era))
-> Tree () -> ImpTestM era (Tree (GovActionId (EraCrypto era)))
submitParameterChangeTree = forall era.
(StrictMaybe (GovActionId (EraCrypto era))
 -> ImpTestM era (GovActionId (EraCrypto era)))
-> StrictMaybe (GovActionId (EraCrypto era))
-> Tree ()
-> ImpTestM era (Tree (GovActionId (EraCrypto era)))
submitGovActionTree forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> 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 (EraCrypto era))
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 (EraCrypto era))
-> 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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000

      EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
      let
        -- 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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)
drep, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      EpochNo
startEpochNo <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL
      let
        -- 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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
1
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)
drep1, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000 -- Receives an expiry update transaction certificate
      (Credential 'DRepRole (EraCrypto era)
drep2, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000 -- Turns inactive due to natural expiry
      (Credential 'DRepRole (EraCrypto era)
drep3, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000 -- Unregisters and gets deleted
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      GovActionId (EraCrypto era)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep3 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0

      forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole (EraCrypto era) -> ImpTestM era ()
updateDRep Credential 'DRepRole (EraCrypto era)
drep1 -- DRep expiry becomes (current epoch (4) + drep activity (4) - dormant epochs (2))
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole (EraCrypto era) -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
2
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
0
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> ImpTestM era ()
expectDRepNotRegistered Credential 'DRepRole (EraCrypto era)
drep3

      GovActionId (EraCrypto era)
_ <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5 -- 6 + 3
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
5
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
3
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4

      GovActionId (EraCrypto era)
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4
        forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
4

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

      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
1
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
7
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
10
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
6
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
drep1 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
8
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole (EraCrypto era)
drep2 forall a b. (a -> b) -> a -> b
$ Word32 -> EpochNo
offDRepActivity Word32
10
      forall era.
HasCallStack =>
Credential 'DRepRole (EraCrypto era) -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole (EraCrypto era)
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 (EraCrypto era)
_ <- forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole (EraCrypto era))
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 (EraCrypto era)
gid <- forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing PParamsUpdate era
proposedUpdate

      NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeHotCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (Credential 'DRepRole (EraCrypto era)
dRepCred, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
      (KeyHash 'StakePool (EraCrypto era)
spoC, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
gid
      do
        Bool
isAccepted <- forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
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 (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
gid
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoC) GovActionId (EraCrypto era)
gid
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeHotCreds GovActionId (EraCrypto era)
gid
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gid
      do
        Bool
isAccepted <- forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era) =>
GovActionId (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Bool
isDRepAccepted GovActionId (EraCrypto era)
gid
        forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Gov action should be accepted" Bool
isAccepted
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
gid
      forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
logRatificationChecks GovActionId (EraCrypto era)
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      RewardAccount (EraCrypto era)
rewardAccountOther <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      StrictMaybe (ScriptHash (EraCrypto era))
govPolicy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (ScriptHash (EraCrypto era)))
getGovPolicy
      forall era.
(HasCallStack, ConwayEraImp era) =>
[GovAction era] -> ImpTestM era ()
treasuryWithdrawalExpectation
        [ forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals (forall k a. k -> a -> Map k a
Map.singleton RewardAccount (EraCrypto era)
rewardAccount (Integer -> Coin
Coin Integer
667)) StrictMaybe (ScriptHash (EraCrypto era))
govPolicy
        , forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals (forall k a. k -> a -> Map k a
Map.singleton RewardAccount (EraCrypto era)
rewardAccountOther (Integer -> Coin
Coin Integer
668)) StrictMaybe (ScriptHash (EraCrypto era))
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 (EraCrypto era))
committeeHotCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
  (Credential 'DRepRole (EraCrypto era)
dRepCred, Credential 'Staking (EraCrypto era)
_, KeyPair 'Payment (EraCrypto era)
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era
     (Credential 'DRepRole (EraCrypto era),
      Credential 'Staking (EraCrypto era),
      KeyPair 'Payment (EraCrypto era))
setupSingleDRep Integer
1_000_000
  Coin
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 (EraCrypto era)
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
  StrictMaybe (ScriptHash (EraCrypto era))
govPolicy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (ScriptHash (EraCrypto era)))
getGovPolicy
  (GovActionId (EraCrypto era)
govActionId NE.:| [GovActionId (EraCrypto era)]
_) <-
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era)
-> ImpTestM era (NonEmpty (GovActionId (EraCrypto era)))
submitGovActions forall a b. (a -> b) -> a -> b
$
      forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals (forall k a. k -> a -> Map k a
Map.singleton RewardAccount (EraCrypto era)
rewardAccount Coin
withdrawalAmount) StrictMaybe (ScriptHash (EraCrypto era))
govPolicy
        forall a. a -> [a] -> NonEmpty a
NE.:| [GovAction era]
extraWithdrawals
  forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. Credential 'DRepRole c -> Voter c
DRepVoter Credential 'DRepRole (EraCrypto era)
dRepCred) GovActionId (EraCrypto era)
govActionId
  forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
committeeHotCreds GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Coin
lookupReward (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era ()
expectMissingGovActionId GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era Coin
lookupReward (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
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 (EraCrypto era)
returnAddr <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
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 (EraCrypto era))
govPolicy <- forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (ScriptHash (EraCrypto era)))
getGovPolicy
  GovActionId (EraCrypto era)
gaid <-
    forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
      ( forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
          forall a. StrictMaybe a
SNothing
          (forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe 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 (EraCrypto era))
govPolicy
      )
      RewardAccount (EraCrypto era)
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 (EraCrypto era))
submitProposal
  forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
expectPresentGovActionId GovActionId (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount (EraCrypto era)
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 =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert forall a b. (a -> b) -> a -> b
$ forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
returnAddr)
  forall era. RewardAccount (EraCrypto era) -> ImpTestM era ()
expectNotRegisteredRewardAddress RewardAccount (EraCrypto era)
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 (EraCrypto era) -> ImpTestM era ()
expectMissingGovActionId GovActionId (EraCrypto era)
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 (EraCrypto era))
ccCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era (NonEmpty (Credential 'HotCommitteeRole (EraCrypto era)))
registerInitialCommittee
      (KeyHash 'StakePool (EraCrypto era)
spoCred, Credential 'Payment (EraCrypto era)
_, Credential 'Staking (EraCrypto era)
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era
     (KeyHash 'StakePool (EraCrypto era),
      Credential 'Payment (EraCrypto era),
      Credential 'Staking (EraCrypto era))
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

      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 (EraCrypto era), 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 (EraCrypto era)
proposal <- forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
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 (EraCrypto era)
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 (EraCrypto era)
proposalA, ImpM (LedgerSpec era) ()
checkProposedParameterA) <- ImpM
  (LedgerSpec era)
  (GovActionId (EraCrypto era), ImpM (LedgerSpec era) ())
proposeParameterChange
      (GovActionId (EraCrypto era)
proposalB, ImpM (LedgerSpec era) ()
_) <- ImpM
  (LedgerSpec era)
  (GovActionId (EraCrypto era), ImpM (LedgerSpec era) ())
proposeParameterChange
      rewardAccount :: RewardAccount (EraCrypto era)
rewardAccount@(RewardAccount Network
_ Credential 'Staking (EraCrypto era)
rewardCred) <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era (RewardAccount (EraCrypto era))
registerRewardAccount
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- prevent proposalC expiry and force it's deletion due to conflit.
      GovActionId (EraCrypto era)
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 (EraCrypto era))
-> 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 (EraCrypto era)
-> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount
          GovAction era
paramChange
          RewardAccount (EraCrypto era)
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 (EraCrypto era))
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 (EraCrypto era)) 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 (EraCrypto era) -> ImpTestM era ()
logAcceptedRatio GovActionId (EraCrypto era)
proposalA
      forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter (EraCrypto era)
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVote_ (forall c. KeyHash 'StakePool c -> Voter c
StakePoolVoter KeyHash 'StakePool (EraCrypto era)
spoCred) GovActionId (EraCrypto era)
proposalA
      forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole (EraCrypto era))
-> GovActionId (EraCrypto era) -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole (EraCrypto era))
ccCreds GovActionId (EraCrypto era)
proposalA
      GovActionState era
gasA <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
proposalA
      GovActionState era
gasB <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
proposalB
      GovActionState era
gasC <- forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era (GovActionState era)
getGovActionState GovActionId (EraCrypto era)
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 =>
StakeCredential (EraCrypto era) -> TxCert era
UnRegTxCert Credential 'Staking (EraCrypto era)
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 (EraCrypto era)) 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 (EraCrypto era)
proposalC Coin
propDeposit)
                       ]