{-# 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,
  relevantDuringBootstrapSpec,
) 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.Class (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 (ImpTestState era)
spec :: forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era) =>
SpecWith (ImpTestState era)
spec = do
  forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era) =>
SpecWith (ImpTestState era)
relevantDuringBootstrapSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
dRepVotingSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
treasurySpec

relevantDuringBootstrapSpec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleEvent "TICK" ConwayEpochEvent era
  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
  ) =>
  SpecWith (ImpTestState era)
relevantDuringBootstrapSpec :: forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era) =>
SpecWith (ImpTestState era)
relevantDuringBootstrapSpec = do
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
proposalsSpec
  forall era. ConwayEraImp era => SpecWith (ImpTestState era)
dRepSpec
  forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
SpecWith (ImpTestState era)
eventsSpec

proposalsSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
proposalsSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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)

      StrictMaybe (ScriptHash (EraCrypto era))
policy <-
        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)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (Constitution era) (StrictMaybe (ScriptHash (EraCrypto era)))
constitutionScriptL
      GovActionId (EraCrypto era)
govActionId <-
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal forall a b. (a -> b) -> a -> b
$
          ProposalProcedure
            { pProcDeposit :: Coin
pProcDeposit = Coin
deposit
            , pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
            , pProcGovAction :: GovAction era
pProcGovAction =
                forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                  forall a. StrictMaybe a
SNothing
                  (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
3000))
                  StrictMaybe (ScriptHash (EraCrypto era))
policy
            , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
            }
      forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId (EraCrypto era) -> ImpTestM era ()
expectPresentGovActionId GovActionId (EraCrypto era)
govActionId
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
initialValue
      forall era. RewardAccount (EraCrypto era) -> ImpTestM era Coin
getRewardAccountAmount RewardAccount (EraCrypto era)
rewardAccount forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
deposit
  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.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era (GovActionId (EraCrypto era))
submitGovAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {era}.
EraPParams era =>
StrictMaybe (GovActionId (EraCrypto era)) -> GovAction era
paramAction
    paramAction :: StrictMaybe (GovActionId (EraCrypto era)) -> GovAction era
paramAction StrictMaybe (GovActionId (EraCrypto era))
p =
      forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange (forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (GovActionId (EraCrypto era))
p) (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 (Integer -> Coin
Coin Integer
10)) forall a. StrictMaybe a
SNothing

dRepSpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
dRepSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
dRepSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" forall a b. (a -> b) -> a -> b
$ do
    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
        submitParamChangeProposal :: ImpTestM era (GovActionId (EraCrypto era))
submitParamChangeProposal =
          forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
3000)
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      GovActionId (EraCrypto era)
_ <- ImpTestM era (GovActionId (EraCrypto 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

      GovActionId (EraCrypto era)
_ <- ImpTestM era (GovActionId (EraCrypto 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)

      let submitParamChangeProposal :: ImpTestM era (GovActionId (EraCrypto era))
submitParamChangeProposal =
            forall era.
ConwayEraImp era =>
StrictMaybe (GovActionId (EraCrypto era))
-> PParamsUpdate era -> ImpTestM era (GovActionId (EraCrypto era))
submitParameterChange forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
3000)
      forall era. HasCallStack => EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
0

      -- epoch 0: we submit a proposal
      GovActionId (EraCrypto era)
_ <- ImpTestM era (GovActionId (EraCrypto 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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

      GovActionId (EraCrypto era)
_ <- ImpTestM era (GovActionId (EraCrypto 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 era. HasCallStack => String -> ImpTestM era ()
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 era. HasCallStack => String -> ImpTestM era ()
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 (ImpTestState era)
dRepVotingSpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
dRepVotingSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" forall a b. (a -> b) -> a -> b
$ do
    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
$ 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 era. HasCallStack => String -> ImpTestM era ()
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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
initialParamValue
      forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
      ImpTestM era Coin
getParamValue forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
proposedValue

treasurySpec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpTestState era)
treasurySpec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era)
treasurySpec =
  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
$ 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
$ do
      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 -- TODO: mark as bootstrap relevant
      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
  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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBe` Coin
withdrawalAmount
  forall a era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era 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 a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` Coin
withdrawalAmount

depositMovesToTreasuryWhenStakingAddressUnregisters :: ConwayEraImp era => ImpTestM era ()
depositMovesToTreasuryWhenStakingAddressUnregisters :: forall era. ConwayEraImp era => ImpTestM era ()
depositMovesToTreasuryWhenStakingAddressUnregisters = do
  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, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal
      ProposalProcedure
        { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
returnAddr
        , pProcGovAction :: GovAction era
pProcGovAction =
            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
10)) StrictMaybe (ScriptHash (EraCrypto era))
govPolicy
        , pProcDeposit :: Coin
pProcDeposit = Coin
govActionDeposit
        , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
        }
  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 (ImpTestState era)
eventsSpec :: forall era.
(ConwayEraImp era, InjectRuleEvent "TICK" ConwayEpochEvent era,
 Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era,
 Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era) =>
SpecWith (ImpTestState 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 :: ImpTestM era (GovActionId (EraCrypto era), ImpTestM era ())
proposeParameterChange = do
          CoinPerByte
newVal <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
          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 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.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL) forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadUnliftIO m) =>
m a -> a -> m ()
`shouldReturn` CoinPerByte
newVal)
      (GovActionId (EraCrypto era)
proposalA, ImpTestM era ()
checkProposedParameterA) <- ImpTestM era (GovActionId (EraCrypto era), ImpTestM era ())
proposeParameterChange
      (GovActionId (EraCrypto era)
proposalB, ImpTestM era ()
_) <- ImpTestM era (GovActionId (EraCrypto era), ImpTestM 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 era.
NFData a =>
String -> ImpTestM era a -> ImpTestM era a
impAnn String
"proposalC" forall a b. (a -> b) -> a -> b
$ do
        CoinPerByte
newVal <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
        forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era (GovActionId (EraCrypto era))
submitProposal
          ProposalProcedure
            { pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr = RewardAccount (EraCrypto era)
rewardAccount
            , pProcGovAction :: GovAction era
pProcGovAction =
                forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange
                  forall a. StrictMaybe a
SNothing
                  (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
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 a. StrictMaybe a
SNothing
            , pProcDeposit :: Coin
pProcDeposit = Coin
propDeposit
            , pProcAnchor :: Anchor (EraCrypto era)
pProcAnchor = forall a. Default a => a
def
            }
      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 :: ImpTestM 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) ImpTestM 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)
      ImpTestM 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
      ImpTestM 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)
                       ]