{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Conway.ImpTest (
  module Test.Cardano.Ledger.Babbage.ImpTest,
  ConwayEraImp,
  enactConstitution,
  enactTreasuryWithdrawals,
  submitGovAction,
  submitGovAction_,
  submitGovActions,
  submitProposal,
  submitAndExpireProposalToMakeReward,
  submitProposal_,
  submitProposals,
  submitFailingProposal,
  trySubmitGovAction,
  trySubmitGovActions,
  trySubmitProposal,
  trySubmitProposals,
  mkConstitutionProposal,
  mkProposal,
  mkProposalWithRewardAccount,
  mkTreasuryWithdrawalsGovAction,
  submitTreasuryWithdrawals,
  submitVote,
  submitVote_,
  submitYesVote_,
  submitFailingVote,
  trySubmitVote,
  genRegTxCert,
  genUnRegTxCert,
  registerDRep,
  unRegisterDRep,
  updateDRep,
  delegateToDRep,
  setupSingleDRep,
  setupDRepWithoutStake,
  setupPoolWithStake,
  setupPoolWithoutStake,
  conwayModifyPParams,
  getProposals,
  getEnactState,
  getGovActionState,
  lookupGovActionState,
  expectPresentGovActionId,
  expectMissingGovActionId,
  getRatifyEnv,
  calculateDRepAcceptedRatio,
  calculatePoolAcceptedRatio,
  calculateCommitteeAcceptedRatio,
  logAcceptedRatio,
  isDRepAccepted,
  isSpoAccepted,
  isCommitteeAccepted,
  getCommitteeMembers,
  getConstitution,
  registerInitialCommittee,
  logRatificationChecks,
  resignCommitteeColdKey,
  registerCommitteeHotKey,
  registerCommitteeHotKeys,
  logCurPParams,
  electCommittee,
  electBasicCommittee,
  proposalsShowDebug,
  getGovPolicy,
  submitFailingGovAction,
  submitGovActionForest,
  submitGovActionTree,
  getProposalsForest,
  logProposalsForest,
  logProposalsForestDiff,
  getCCExpiry,
  ccShouldBeExpired,
  ccShouldNotBeExpired,
  ccShouldBeResigned,
  ccShouldNotBeResigned,
  getLastEnactedCommittee,
  getLastEnactedConstitution,
  submitParameterChange,
  mkMinFeeUpdateGovAction,
  mkParameterChangeGovAction,
  mkUpdateCommitteeProposal,
  submitUpdateCommittee,
  expectCommitteeMemberPresence,
  expectCommitteeMemberAbsence,
  getLastEnactedParameterChange,
  getLastEnactedHardForkInitiation,
  getConstitutionProposals,
  getParameterChangeProposals,
  expectNumDormantEpochs,
  submitConstitution,
  isDRepExpired,
  expectDRepExpiry,
  expectActualDRepExpiry,
  expectDRepNotRegistered,
  expectCurrentProposals,
  expectNoCurrentProposals,
  expectPulserProposals,
  expectNoPulserProposals,
  currentProposalsShouldContain,
  ifBootstrap,
  whenBootstrap,
  whenPostBootstrap,
  submitYesVoteCCs_,
  donateToTreasury,
  expectMembers,
  showConwayTxBalance,
  logConwayTxBalance,
  submitBootstrapAware,
  submitBootstrapAwareFailingVote,
  submitBootstrapAwareFailingProposal,
  submitBootstrapAwareFailingProposal_,
  SubmitFailureExpectation (..),
  FailBoth (..),
  delegateSPORewardAddressToDRep_,
  getCommittee,
) where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.Allegra.Scripts (Timelock)
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  EpochNo (..),
  ShelleyBase,
  StrictMaybe (..),
  UnitInterval,
  addEpochInterval,
  binOpEpochNo,
  inject,
  textToUrl,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams (..))
import Cardano.Ledger.Conway.Rules (
  ConwayCertPredFailure (..),
  ConwayCertsPredFailure (..),
  ConwayDelegPredFailure (..),
  ConwayLedgerPredFailure (..),
  EnactSignal,
  committeeAccepted,
  committeeAcceptedRatio,
  dRepAccepted,
  dRepAcceptedRatio,
  prevActionAsExpected,
  spoAccepted,
  spoAcceptedRatio,
  validCommitteeTerm,
  withdrawalCanWithdraw,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.Tx (AlonzoTx)
import Cardano.Ledger.Conway.TxCert (Delegatee (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep
import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..), hashPlutusScript)
import Cardano.Ledger.PoolParams (PoolParams (..), ppRewardAccount)
import qualified Cardano.Ledger.Shelley.HardForks as HardForks (bootstrapPhase)
import Cardano.Ledger.Shelley.LedgerState (
  curPParamsEpochStateL,
  epochStateGovStateL,
  epochStatePoolParamsL,
  esLStateL,
  lsCertStateL,
  lsUTxOStateL,
  nesELL,
  nesEpochStateL,
  nesEsL,
  nesPdL,
  newEpochStateGovStateL,
  produced,
  unifiedL,
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.TxIn (TxId (..))
import Cardano.Ledger.UMap (dRepMap)
import qualified Cardano.Ledger.UMap as UMap
import Cardano.Ledger.Val (Val (..), (<->))
import Control.Monad (forM)
import Control.Monad.Trans.Fail.String (errorFail)
import Control.State.Transition.Extended (STS (..))
import Data.Bifunctor (bimap)
import Data.Default (Default (..))
import Data.Foldable (Foldable (..))
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Data.Tree
import qualified GHC.Exts as GHC (fromList)
import Lens.Micro
import Prettyprinter (align, hsep, viaShow, vsep)
import Test.Cardano.Ledger.Babbage.ImpTest
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.Era
import Test.Cardano.Ledger.Conway.TreeDiff (tableDoc)
import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus (testingCostModel)
import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript)

-- | Modify the PParams in the current state with the given function
conwayModifyPParams ::
  ConwayEraGov era =>
  (PParams era -> PParams era) ->
  ImpTestM era ()
conwayModifyPParams :: forall era.
ConwayEraGov era =>
(PParams era -> PParams era) -> ImpTestM era ()
conwayModifyPParams PParams era -> PParams era
f = (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ \NewEpochState era
nes ->
  NewEpochState era
nes
    NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((PParams era -> Identity (PParams era))
    -> EpochState era -> Identity (EpochState era))
-> (PParams era -> Identity (PParams era))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (PParams era -> PParams era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PParams era -> PParams era
f
    NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Identity (GovState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((DRepPulsingState era -> Identity (DRepPulsingState era))
    -> GovState era -> Identity (GovState era))
-> (DRepPulsingState era -> Identity (DRepPulsingState era))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> Identity (DRepPulsingState era))
-> GovState era -> Identity (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL ((DRepPulsingState era -> Identity (DRepPulsingState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (DRepPulsingState era -> DRepPulsingState era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DRepPulsingState era -> DRepPulsingState era
modifyDRepPulser
  where
    modifyDRepPulser :: DRepPulsingState era -> DRepPulsingState era
modifyDRepPulser DRepPulsingState era
pulser =
      case DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
pulser of
        (PulsingSnapshot era
snapshot, RatifyState era
ratifyState) ->
          PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snapshot (RatifyState era
ratifyState RatifyState era
-> (RatifyState era -> RatifyState era) -> RatifyState era
forall a b. a -> (a -> b) -> b
& (EnactState era -> Identity (EnactState era))
-> RatifyState era -> Identity (RatifyState era)
forall era (f :: * -> *).
Functor f =>
(EnactState era -> f (EnactState era))
-> RatifyState era -> f (RatifyState era)
rsEnactStateL ((EnactState era -> Identity (EnactState era))
 -> RatifyState era -> Identity (RatifyState era))
-> ((PParams era -> Identity (PParams era))
    -> EnactState era -> Identity (EnactState era))
-> (PParams era -> Identity (PParams era))
-> RatifyState era
-> Identity (RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> EnactState era -> f (EnactState era)
ensCurPParamsL ((PParams era -> Identity (PParams era))
 -> RatifyState era -> Identity (RatifyState era))
-> (PParams era -> PParams era)
-> RatifyState era
-> RatifyState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PParams era -> PParams era
f)

instance ShelleyEraImp ConwayEra where
  initGenesis :: forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadFail m) =>
m (Genesis ConwayEra)
initGenesis = do
    KeyHash 'ColdCommitteeRole
kh1 <- m (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    KeyHash 'ColdCommitteeRole
kh2 <- m (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    let
      ccExpiryEpochNo :: EpochNo
ccExpiryEpochNo = EpochNo -> EpochInterval -> EpochNo
addEpochInterval (forall era. Era era => EpochNo
impEraStartEpochNo @ConwayEra) (Word32 -> EpochInterval
EpochInterval Word32
15)
      committee :: Committee ConwayEra
committee = Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee ConwayEra
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee [(KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
kh1, EpochNo
ccExpiryEpochNo), (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'ColdCommitteeRole
kh2, EpochNo
ccExpiryEpochNo)] (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
      constitutionAnchor :: Anchor
constitutionAnchor =
        Anchor
          { anchorUrl :: Url
anchorUrl = Fail Url -> Url
forall a. HasCallStack => Fail a -> a
errorFail (Fail Url -> Url) -> Fail Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Fail Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
128 Text
"https://cardano-constitution.crypto"
          , anchorDataHash :: SafeHash AnchorData
anchorDataHash = AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated (ByteString -> AnchorData
AnchorData ByteString
"Cardano Constitution Content")
          }
      guardrailScriptHash :: ScriptHash
guardrailScriptHash = Plutus 'PlutusV3 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus 'PlutusV3
guardrailScript
    ConwayGenesis -> m ConwayGenesis
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ConwayGenesis
        { cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams =
            UpgradeConwayPParams
              { ucppPoolVotingThresholds :: HKD Identity PoolVotingThresholds
ucppPoolVotingThresholds =
                  PoolVotingThresholds
                    { pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    }
              , ucppDRepVotingThresholds :: HKD Identity DRepVotingThresholds
ucppDRepVotingThresholds =
                  DRepVotingThresholds
                    { dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution = Integer
65 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtPPNetworkGroup :: UnitInterval
dvtPPNetworkGroup = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtPPEconomicGroup :: UnitInterval
dvtPPEconomicGroup = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtPPTechnicalGroup :: UnitInterval
dvtPPTechnicalGroup = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtPPGovGroup :: UnitInterval
dvtPPGovGroup = Integer
75 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    , dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal = Integer
51 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
100
                    }
              , ucppCommitteeMinSize :: HKD Identity Word16
ucppCommitteeMinSize = Word16
HKD Identity Word16
1
              , ucppCommitteeMaxTermLength :: HKD Identity EpochInterval
ucppCommitteeMaxTermLength = Word32 -> EpochInterval
EpochInterval Word32
20
              , ucppGovActionLifetime :: HKD Identity EpochInterval
ucppGovActionLifetime = Word32 -> EpochInterval
EpochInterval Word32
30
              , ucppGovActionDeposit :: HKD Identity Coin
ucppGovActionDeposit = Integer -> Coin
Coin Integer
123
              , ucppDRepDeposit :: HKD Identity Coin
ucppDRepDeposit = Integer -> Coin
Coin Integer
70_000_000
              , ucppDRepActivity :: HKD Identity EpochInterval
ucppDRepActivity = Word32 -> EpochInterval
EpochInterval Word32
100
              , ucppMinFeeRefScriptCostPerByte :: HKD Identity NonNegativeInterval
ucppMinFeeRefScriptCostPerByte = Integer
15 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
              , ucppPlutusV3CostModel :: HKD Identity CostModel
ucppPlutusV3CostModel = HasCallStack => Language -> CostModel
Language -> CostModel
testingCostModel Language
PlutusV3
              }
        , cgConstitution :: Constitution ConwayEra
cgConstitution = Anchor -> StrictMaybe ScriptHash -> Constitution ConwayEra
forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution Anchor
constitutionAnchor (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
guardrailScriptHash)
        , cgCommittee :: Committee ConwayEra
cgCommittee = Committee ConwayEra
committee
        , cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgDelegs = ListMap (Credential 'Staking) Delegatee
forall a. Monoid a => a
mempty
        , cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
cgInitialDReps = ListMap (Credential 'DRepRole) DRepState
forall a. Monoid a => a
mempty
        }

  impSatisfyNativeScript :: Set (KeyHash 'Witness)
-> TxBody ConwayEra
-> NativeScript ConwayEra
-> ImpTestM
     ConwayEra (Maybe (Map (KeyHash 'Witness) (KeyPair 'Witness)))
impSatisfyNativeScript = Set (KeyHash 'Witness)
-> TxBody ConwayEra
-> NativeScript ConwayEra
-> ImpTestM
     ConwayEra (Maybe (Map (KeyHash 'Witness) (KeyPair 'Witness)))
forall era.
(AllegraEraScript era, AllegraEraTxBody era,
 NativeScript era ~ Timelock era) =>
Set (KeyHash 'Witness)
-> TxBody era
-> NativeScript era
-> ImpTestM era (Maybe (Map (KeyHash 'Witness) (KeyPair 'Witness)))
impAllegraSatisfyNativeScript

  modifyPParams :: (PParams ConwayEra -> PParams ConwayEra) -> ImpTestM ConwayEra ()
modifyPParams = (PParams ConwayEra -> PParams ConwayEra) -> ImpTestM ConwayEra ()
forall era.
ConwayEraGov era =>
(PParams era -> PParams era) -> ImpTestM era ()
conwayModifyPParams

  fixupTx :: HasCallStack => Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)
fixupTx = Tx ConwayEra -> ImpTestM ConwayEra (Tx ConwayEra)
forall era.
(HasCallStack, AlonzoEraImp era, BabbageEraTxBody era) =>
Tx era -> ImpTestM era (Tx era)
babbageFixupTx
  expectTxSuccess :: HasCallStack => Tx ConwayEra -> ImpTestM ConwayEra ()
expectTxSuccess = Tx ConwayEra -> ImpTestM ConwayEra ()
forall era.
(HasCallStack, AlonzoEraImp era, BabbageEraTxBody era) =>
Tx era -> ImpTestM era ()
impBabbageExpectTxSuccess

instance MaryEraImp ConwayEra

instance AlonzoEraImp ConwayEra where
  scriptTestContexts :: Map ScriptHash ScriptTestContext
scriptTestContexts =
    SLanguage 'PlutusV1 -> Map ScriptHash ScriptTestContext
forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Map ScriptHash ScriptTestContext
plutusTestScripts SLanguage 'PlutusV1
SPlutusV1
      Map ScriptHash ScriptTestContext
-> Map ScriptHash ScriptTestContext
-> Map ScriptHash ScriptTestContext
forall a. Semigroup a => a -> a -> a
<> SLanguage 'PlutusV2 -> Map ScriptHash ScriptTestContext
forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Map ScriptHash ScriptTestContext
plutusTestScripts SLanguage 'PlutusV2
SPlutusV2
      Map ScriptHash ScriptTestContext
-> Map ScriptHash ScriptTestContext
-> Map ScriptHash ScriptTestContext
forall a. Semigroup a => a -> a -> a
<> SLanguage 'PlutusV3 -> Map ScriptHash ScriptTestContext
forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> Map ScriptHash ScriptTestContext
plutusTestScripts SLanguage 'PlutusV3
SPlutusV3

class
  ( AlonzoEraImp era
  , ConwayEraTest era
  , ConwayEraTxCert era
  , STS (EraRule "ENACT" era)
  , BaseM (EraRule "ENACT" era) ~ ShelleyBase
  , State (EraRule "ENACT" era) ~ EnactState era
  , Signal (EraRule "ENACT" era) ~ EnactSignal era
  , Environment (EraRule "ENACT" era) ~ ()
  , NativeScript era ~ Timelock era
  , GovState era ~ ConwayGovState era
  ) =>
  ConwayEraImp era

instance ConwayEraImp ConwayEra

registerInitialCommittee ::
  (HasCallStack, ConwayEraImp era) =>
  ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee :: forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee = do
  [Credential 'ColdCommitteeRole]
committeeMembers <- Set (Credential 'ColdCommitteeRole)
-> [Credential 'ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList (Set (Credential 'ColdCommitteeRole)
 -> [Credential 'ColdCommitteeRole])
-> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
-> ImpM (LedgerSpec era) [Credential 'ColdCommitteeRole]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
  case [Credential 'ColdCommitteeRole]
committeeMembers of
    Credential 'ColdCommitteeRole
x : [Credential 'ColdCommitteeRole]
xs -> ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
-> ImpTestM era (Credential 'HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash) (NonEmpty (Credential 'ColdCommitteeRole)
 -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole)))
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
x Credential 'ColdCommitteeRole
-> [Credential 'ColdCommitteeRole]
-> NonEmpty (Credential 'ColdCommitteeRole)
forall a. a -> [a] -> NonEmpty a
NE.:| [Credential 'ColdCommitteeRole]
xs
    [] -> String -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a. HasCallStack => String -> a
error String
"Expected an initial committee"

-- | Submit a transaction that registers a new DRep and return the keyhash
-- belonging to that DRep
registerDRep :: ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep :: forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep = do
  -- Register a DRep
  KeyHash 'DRepRole
khDRep <- ImpTestM era (KeyHash 'DRepRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
  String -> Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Register DRep" (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton
          ( Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert
              (KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
khDRep)
              (PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL)
              StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
          )
  Map (Credential 'DRepRole) DRepState
dreps <- SimpleGetter
  (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
 -> ImpTestM era (Map (Credential 'DRepRole) DRepState))
-> SimpleGetter
     (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const r (Map (Credential 'DRepRole) DRepState))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
  Map (Credential 'DRepRole) DRepState
dreps Map (Credential 'DRepRole) DRepState
-> (Map (Credential 'DRepRole) DRepState -> Bool)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
khDRep)
  KeyHash 'DRepRole -> ImpTestM era (KeyHash 'DRepRole)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyHash 'DRepRole
khDRep

-- | Submit a transaction that unregisters a given DRep
unRegisterDRep ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxCert era
  , ConwayEraCertState era
  ) =>
  Credential 'DRepRole ->
  ImpTestM era ()
unRegisterDRep :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drep = do
  DRepState
drepState <- Credential 'DRepRole -> ImpTestM era DRepState
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era DRepState
getDRepState Credential 'DRepRole
drep
  let refund :: Coin
refund = DRepState -> Coin
drepDeposit DRepState
drepState
  String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"UnRegister DRep" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton (Credential 'DRepRole -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
drep Coin
refund)

genUnRegTxCert ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxCert era
  ) =>
  Credential 'Staking ->
  ImpTestM era (TxCert era)
genUnRegTxCert :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'Staking -> ImpTestM era (TxCert era)
genUnRegTxCert Credential 'Staking
stakingCredential = do
  UMap
umap <- SimpleGetter (NewEpochState era) UMap -> ImpTestM era UMap
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (UMap -> Const r UMap)
-> NewEpochState era -> Const r (NewEpochState era)
forall era. EraCertState era => Lens' (NewEpochState era) UMap
SimpleGetter (NewEpochState era) UMap
Lens' (NewEpochState era) UMap
unifiedL
  let mumapDeposit :: Maybe Coin
mumapDeposit = RDPair -> Coin
UMap.rdDepositCoin (RDPair -> Coin) -> Maybe RDPair -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Staking
-> UView (Credential 'Staking) RDPair -> Maybe RDPair
forall k v. k -> UView k v -> Maybe v
UMap.lookup Credential 'Staking
stakingCredential (UMap -> UView (Credential 'Staking) RDPair
UMap.RewDepUView UMap
umap)
  case Maybe Coin
mumapDeposit of
    Maybe Coin
Nothing -> TxCert era -> ImpTestM era (TxCert era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxCert era -> ImpTestM era (TxCert era))
-> TxCert era -> ImpTestM era (TxCert era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
stakingCredential
    Just Coin
umapDeposit ->
      [TxCert era] -> ImpTestM era (TxCert era)
forall (m :: * -> *) a. MonadGen m => [a] -> m a
elements
        [ Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
stakingCredential
        , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
stakingCredential Coin
umapDeposit
        ]

genRegTxCert ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxCert era
  ) =>
  Credential 'Staking ->
  ImpTestM era (TxCert era)
genRegTxCert :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'Staking -> ImpTestM era (TxCert era)
genRegTxCert Credential 'Staking
stakingCredential =
  [ImpM (LedgerSpec era) (TxCert era)]
-> ImpM (LedgerSpec era) (TxCert era)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
oneof
    [ TxCert era -> ImpM (LedgerSpec era) (TxCert era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxCert era -> ImpM (LedgerSpec era) (TxCert era))
-> TxCert era -> ImpM (LedgerSpec era) (TxCert era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert Credential 'Staking
stakingCredential
    , Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
stakingCredential
        (Coin -> TxCert era)
-> ImpM (LedgerSpec era) Coin -> ImpM (LedgerSpec era) (TxCert era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleGetter (NewEpochState era) Coin -> ImpM (LedgerSpec era) Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL)
    ]

-- | Submit a transaction that updates a given DRep
updateDRep ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxCert era
  ) =>
  Credential 'DRepRole ->
  ImpTestM era ()
updateDRep :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole -> ImpTestM era ()
updateDRep Credential 'DRepRole
drep = do
  StrictMaybe Anchor
mAnchor <- ImpM (LedgerSpec era) (StrictMaybe Anchor)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
  String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Update DRep" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton (Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> StrictMaybe Anchor -> TxCert era
UpdateDRepTxCert Credential 'DRepRole
drep StrictMaybe Anchor
mAnchor)

-- | In contrast to `setupSingleDRep`, this function does not make a UTxO entry
-- that could count as delegated stake to the DRep
setupDRepWithoutStake ::
  ConwayEraImp era =>
  ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake :: forall era.
ConwayEraImp era =>
ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
setupDRepWithoutStake = do
  KeyHash 'DRepRole
drepKH <- ImpTestM era (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
  KeyHash 'Staking
delegatorKH <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  Coin
deposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
  String -> Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Delegate to DRep" (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
          [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
              (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
delegatorKH)
              (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential (Credential 'DRepRole -> DRep) -> Credential 'DRepRole -> DRep
forall a b. (a -> b) -> a -> b
$ KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH))
              Coin
deposit
          ]
  (KeyHash 'DRepRole, KeyHash 'Staking)
-> ImpTestM era (KeyHash 'DRepRole, KeyHash 'Staking)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash 'DRepRole
drepKH, KeyHash 'Staking
delegatorKH)

-- | Registers a new DRep, registers its stake credentials and delegates the specified amount of ADA to it.
setupSingleDRep ::
  ConwayEraImp era =>
  Integer ->
  ImpTestM era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep :: forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
stake = do
  KeyHash 'DRepRole
drepKH <- ImpTestM era (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
  KeyHash 'Staking
delegatorKH <- ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  Coin
deposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
  let tx :: Tx era
tx =
        TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
delegatorKH) Coin
deposit]
  Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx
  KeyPair 'Payment
spendingKP <-
    Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
delegatorKH) (Integer -> Coin
Coin Integer
stake) (Credential 'DRepRole -> DRep
DRepCredential (KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH))
  (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
drepKH, KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
delegatorKH, KeyPair 'Payment
spendingKP)

delegateToDRep ::
  ConwayEraImp era =>
  Credential 'Staking ->
  Coin ->
  DRep ->
  ImpTestM era (KeyPair 'Payment)
delegateToDRep :: forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep Credential 'Staking
cred Coin
stake DRep
dRep = do
  (KeyHash 'Payment
_, KeyPair 'Payment
spendingKP) <- ImpM (LedgerSpec era) (KeyHash 'Payment, KeyPair 'Payment)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r, KeyPair r)
freshKeyPair

  String -> Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Delegate to DRep" (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL
        ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxOut era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut era -> StrictSeq (TxOut era)
forall a. a -> StrictSeq a
SSeq.singleton (Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (KeyPair 'Payment -> Credential 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
spendingKP Credential 'Staking
cred) (Coin -> Value era
forall t s. Inject t s => t -> s
inject Coin
stake))
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote DRep
dRep)]
  KeyPair 'Payment -> ImpTestM era (KeyPair 'Payment)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyPair 'Payment
spendingKP

getDRepState ::
  (HasCallStack, ConwayEraCertState era) =>
  Credential 'DRepRole ->
  ImpTestM era DRepState
getDRepState :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era DRepState
getDRepState Credential 'DRepRole
dRepCred = do
  Map (Credential 'DRepRole) DRepState
drepsState <- SimpleGetter
  (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
 -> ImpTestM era (Map (Credential 'DRepRole) DRepState))
-> SimpleGetter
     (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const r (Map (Credential 'DRepRole) DRepState))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
  case Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
dRepCred Map (Credential 'DRepRole) DRepState
drepsState of
    Maybe DRepState
Nothing -> String -> ImpTestM era DRepState
forall a. HasCallStack => String -> a
error (String -> ImpTestM era DRepState)
-> String -> ImpTestM era DRepState
forall a b. (a -> b) -> a -> b
$ String
"Expected for DRep " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Credential 'DRepRole -> String
forall a. Show a => a -> String
show Credential 'DRepRole
dRepCred String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be present in the CertState"
    Just DRepState
state -> DRepState -> ImpTestM era DRepState
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRepState
state

-- | Sets up a stake pool with coin delegated to it.
--
-- NOTE: This uses the `RegDepositDelegTxCert` for delegating, so it has to be
-- in Conway. The Shelley version of this function would have to separately
-- register the staking credential and then delegate it.
setupPoolWithStake ::
  (ShelleyEraImp era, ConwayEraTxCert era) =>
  Coin ->
  ImpTestM era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake Coin
delegCoin = do
  KeyHash 'StakePool
khPool <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  KeyHash 'StakePool -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
khPool
  Credential 'Payment
credDelegatorPayment <- KeyHash 'Payment -> Credential 'Payment
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Payment -> Credential 'Payment)
-> ImpM (LedgerSpec era) (KeyHash 'Payment)
-> ImpM (LedgerSpec era) (Credential 'Payment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Payment)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  Credential 'Staking
credDelegatorStaking <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  Addr -> Coin -> ImpTestM era ()
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era ()
sendCoinTo_ (Credential 'Payment -> Credential 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr Credential 'Payment
credDelegatorPayment Credential 'Staking
credDelegatorStaking) Coin
delegCoin
  PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
  String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Delegate to stake pool" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
          [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
              Credential 'Staking
credDelegatorStaking
              (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
khPool)
              (PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL)
          ]
  (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash 'StakePool
khPool, Credential 'Payment
credDelegatorPayment, Credential 'Staking
credDelegatorStaking)

setupPoolWithoutStake ::
  (ShelleyEraImp era, ConwayEraTxCert era) =>
  ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
setupPoolWithoutStake = do
  KeyHash 'StakePool
khPool <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  KeyHash 'StakePool -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
khPool
  Credential 'Staking
credDelegatorStaking <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  Coin
deposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
  String -> Tx era -> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Delegate to stake pool" (Tx era -> ImpTestM era ()) -> Tx era -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
          [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
              Credential 'Staking
credDelegatorStaking
              (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
khPool)
              Coin
deposit
          ]
  (KeyHash 'StakePool, Credential 'Staking)
-> ImpTestM era (KeyHash 'StakePool, Credential 'Staking)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash 'StakePool
khPool, Credential 'Staking
credDelegatorStaking)

-- | Submits a transaction with a Vote for the given governance action as
-- some voter
submitVote ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  Vote ->
  Voter ->
  GovActionId ->
  ImpTestM era TxId
submitVote :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era TxId
submitVote Vote
vote Voter
voter GovActionId
gaId = Vote
-> Voter
-> GovActionId
-> ImpM
     (LedgerSpec era)
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
Vote
-> Voter
-> GovActionId
-> ImpTestM
     era
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
trySubmitVote Vote
vote Voter
voter GovActionId
gaId ImpM
  (LedgerSpec era)
  (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
    -> ImpM (LedgerSpec era) TxId)
-> ImpM (LedgerSpec era) TxId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
-> ImpM (LedgerSpec era) TxId
forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m b
expectRightDeep

-- | Submits a transaction that votes "Yes" for the given governance action as
-- some voter
submitYesVote_ ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  Voter ->
  GovActionId ->
  ImpTestM era ()
submitYesVote_ :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ Voter
voter GovActionId
gaId = ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) TxId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era TxId
submitVote Vote
VoteYes Voter
voter GovActionId
gaId

submitVote_ ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  Vote ->
  Voter ->
  GovActionId ->
  ImpTestM era ()
submitVote_ :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote Voter
voter GovActionId
gaId = ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) TxId -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) TxId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era TxId
submitVote Vote
vote Voter
voter GovActionId
gaId

submitFailingVote ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  Voter ->
  GovActionId ->
  NonEmpty (PredicateFailure (EraRule "LEDGER" era)) ->
  ImpTestM era ()
submitFailingVote :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote Voter
voter GovActionId
gaId NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure =
  Vote
-> Voter
-> GovActionId
-> ImpM
     (LedgerSpec era)
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
Vote
-> Voter
-> GovActionId
-> ImpTestM
     era
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
trySubmitVote Vote
VoteYes Voter
voter GovActionId
gaId ImpM
  (LedgerSpec era)
  (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
    -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b (m :: * -> *).
(HasCallStack, ToExpr a, ToExpr b, Eq a, MonadIO m) =>
Either a b -> a -> m ()
`shouldBeLeftExpr` NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure)

-- | Submits a transaction that votes "Yes" for the given governance action as
-- some voter, and expects an `Either` result.
trySubmitVote ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  ) =>
  Vote ->
  Voter ->
  GovActionId ->
  ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
trySubmitVote :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
Vote
-> Voter
-> GovActionId
-> ImpTestM
     era
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
trySubmitVote Vote
vote Voter
voter GovActionId
gaId =
  (Either
   (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
   (Tx era)
 -> Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
-> ImpM
     (LedgerSpec era)
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (Tx era -> TxId)
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
     (Tx era)
-> Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a, b) -> a
fst Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx) (ImpM
   (LedgerSpec era)
   (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
      (Tx era))
 -> ImpM
      (LedgerSpec era)
      (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId))
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
-> ImpM
     (LedgerSpec era)
     (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
forall a b. (a -> b) -> a -> b
$
    Tx era
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitTx (Tx era
 -> ImpM
      (LedgerSpec era)
      (Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
         (Tx era)))
-> Tx era
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall a b. (a -> b) -> a -> b
$
      TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((VotingProcedures era -> Identity (VotingProcedures era))
    -> TxBody era -> Identity (TxBody era))
-> (VotingProcedures era -> Identity (VotingProcedures era))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody era -> Identity (TxBody era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
          ((VotingProcedures era -> Identity (VotingProcedures era))
 -> Tx era -> Identity (Tx era))
-> VotingProcedures era -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
            ( Voter
-> Map GovActionId (VotingProcedure era)
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. k -> a -> Map k a
Map.singleton
                Voter
voter
                ( GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton
                    GovActionId
gaId
                    ( VotingProcedure
                        { vProcVote :: Vote
vProcVote = Vote
vote
                        , vProcAnchor :: StrictMaybe Anchor
vProcAnchor = StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                        }
                    )
                )
            )

submitProposal_ ::
  (ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
  ProposalProcedure era ->
  ImpTestM era ()
submitProposal_ :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era ()
submitProposal_ = ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ())
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ProposalProcedure era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal

submitProposal ::
  (ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
  ProposalProcedure era ->
  ImpTestM era GovActionId
submitProposal :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal = ProposalProcedure era
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
ProposalProcedure era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitProposal ProposalProcedure era
proposal ImpM
  (LedgerSpec era)
  (Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
    -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr

submitProposals ::
  (ShelleyEraImp era, ConwayEraGov era, ConwayEraTxBody era, HasCallStack) =>
  NE.NonEmpty (ProposalProcedure era) ->
  ImpTestM era (NE.NonEmpty GovActionId)
submitProposals :: forall era.
(ShelleyEraImp era, ConwayEraGov era, ConwayEraTxBody era,
 HasCallStack) =>
NonEmpty (ProposalProcedure era)
-> ImpTestM era (NonEmpty GovActionId)
submitProposals NonEmpty (ProposalProcedure era)
proposals = do
  EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
  Tx era
tx <- NonEmpty (ProposalProcedure era)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (ProposalProcedure era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitProposals NonEmpty (ProposalProcedure era)
proposals ImpM
  (LedgerSpec era)
  (Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
     (Tx era))
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
      (Tx era)
    -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) (Tx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
  (Tx era)
-> ImpM (LedgerSpec era) (Tx era)
forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr
  let txId :: TxId
txId = Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
tx
      proposalsWithGovActionId :: NonEmpty (GovActionId, ProposalProcedure era)
proposalsWithGovActionId =
        (Word16
 -> ProposalProcedure era -> (GovActionId, ProposalProcedure era))
-> NonEmpty Word16
-> NonEmpty (ProposalProcedure era)
-> NonEmpty (GovActionId, ProposalProcedure era)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\Word16
idx ProposalProcedure era
p -> (TxId -> GovActionIx -> GovActionId
GovActionId TxId
txId (Word16 -> GovActionIx
GovActionIx Word16
idx), ProposalProcedure era
p)) (Word16
0 Word16 -> [Word16] -> NonEmpty Word16
forall a. a -> [a] -> NonEmpty a
NE.:| [Word16
Item [Word16]
1 ..]) NonEmpty (ProposalProcedure era)
proposals
  NonEmpty (GovActionId, ProposalProcedure era)
-> ((GovActionId, ProposalProcedure era)
    -> ImpM (LedgerSpec era) GovActionId)
-> ImpTestM era (NonEmpty GovActionId)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (GovActionId, ProposalProcedure era)
proposalsWithGovActionId (((GovActionId, ProposalProcedure era)
  -> ImpM (LedgerSpec era) GovActionId)
 -> ImpTestM era (NonEmpty GovActionId))
-> ((GovActionId, ProposalProcedure era)
    -> ImpM (LedgerSpec era) GovActionId)
-> ImpTestM era (NonEmpty GovActionId)
forall a b. (a -> b) -> a -> b
$ \(GovActionId
govActionId, ProposalProcedure era
proposal) -> do
    GovActionState era
govActionState <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId
    GovActionState era
govActionState
      GovActionState era
-> GovActionState era -> ImpM (LedgerSpec era) ()
forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` GovActionState
        { gasId :: GovActionId
gasId = GovActionId
govActionId
        , gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes = Map (Credential 'HotCommitteeRole) Vote
forall a. Monoid a => a
mempty
        , gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasDRepVotes = Map (Credential 'DRepRole) Vote
forall a. Monoid a => a
mempty
        , gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasStakePoolVotes = Map (KeyHash 'StakePool) Vote
forall a. Monoid a => a
mempty
        , gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure = ProposalProcedure era
proposal
        , gasProposedIn :: EpochNo
gasProposedIn = EpochNo
curEpochNo
        , gasExpiresAfter :: EpochNo
gasExpiresAfter = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL)
        }
    GovActionId -> ImpM (LedgerSpec era) GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
govActionId

-- | Submits a transaction that proposes the given proposal
trySubmitProposal ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  ) =>
  ProposalProcedure era ->
  ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitProposal :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
ProposalProcedure era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitProposal ProposalProcedure era
proposal = do
  Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
  (Tx era)
res <- NonEmpty (ProposalProcedure era)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (ProposalProcedure era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitProposals (ProposalProcedure era -> NonEmpty (ProposalProcedure era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProposalProcedure era
proposal)
  Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
 -> ImpTestM
      era
      (Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId))
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall a b. (a -> b) -> a -> b
$ case Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
  (Tx era)
res of
    Right Tx era
tx ->
      GovActionId
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
forall a b. b -> Either a b
Right
        GovActionId
          { gaidTxId :: TxId
gaidTxId = Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
tx
          , gaidGovActionIx :: GovActionIx
gaidGovActionIx = Word16 -> GovActionIx
GovActionIx Word16
0
          }
    Left (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
err, Tx era
_) -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
forall a b. a -> Either a b
Left NonEmpty (PredicateFailure (EraRule "LEDGER" era))
err

trySubmitProposals ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  ) =>
  NE.NonEmpty (ProposalProcedure era) ->
  ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era) (Tx era))
trySubmitProposals :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (ProposalProcedure era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitProposals NonEmpty (ProposalProcedure era)
proposals = do
  Tx era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitTx (Tx era
 -> ImpTestM
      era
      (Either
         (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
         (Tx era)))
-> Tx era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((OSet (ProposalProcedure era)
     -> Identity (OSet (ProposalProcedure era)))
    -> TxBody era -> Identity (TxBody era))
-> (OSet (ProposalProcedure era)
    -> Identity (OSet (ProposalProcedure era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OSet (ProposalProcedure era)
 -> Identity (OSet (ProposalProcedure era)))
-> TxBody era -> Identity (TxBody era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL ((OSet (ProposalProcedure era)
  -> Identity (OSet (ProposalProcedure era)))
 -> Tx era -> Identity (Tx era))
-> OSet (ProposalProcedure era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OSet (ProposalProcedure era))]
-> OSet (ProposalProcedure era)
forall l. IsList l => [Item l] -> l
GHC.fromList (NonEmpty (ProposalProcedure era) -> [ProposalProcedure era]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (ProposalProcedure era)
proposals)

submitFailingProposal ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  ProposalProcedure era ->
  NonEmpty (PredicateFailure (EraRule "LEDGER" era)) ->
  ImpTestM era ()
submitFailingProposal :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal ProposalProcedure era
proposal NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure =
  ProposalProcedure era
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
ProposalProcedure era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitProposal ProposalProcedure era
proposal ImpM
  (LedgerSpec era)
  (Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
    -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b (m :: * -> *).
(HasCallStack, ToExpr a, ToExpr b, Eq a, MonadIO m) =>
Either a b -> a -> m ()
`shouldBeLeftExpr` NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure)

-- | Submits a transaction that proposes the given governance action. For proposing
-- multiple actions in the same transaciton use `trySubmitGovActions` instead.
trySubmitGovAction ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  ) =>
  GovAction era ->
  ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitGovAction :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitGovAction GovAction era
ga = do
  let mkGovActionId :: Tx era -> GovActionId
mkGovActionId Tx era
tx = TxId -> GovActionIx -> GovActionId
GovActionId (Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
tx) (Word16 -> GovActionIx
GovActionIx Word16
0)
  ((NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (Tx era -> GovActionId)
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
     (Tx era)
-> Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a, b) -> a
fst Tx era -> GovActionId
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTx era) =>
Tx era -> GovActionId
mkGovActionId (Either
   (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
   (Tx era)
 -> Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (GovAction era)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (GovAction era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitGovActions (GovAction era -> NonEmpty (GovAction era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovAction era
ga)

submitAndExpireProposalToMakeReward ::
  ConwayEraImp era =>
  Credential 'Staking ->
  ImpTestM era ()
submitAndExpireProposalToMakeReward :: forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
stakingC = do
  RewardAccount
rewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
stakingC
  PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
  let
    EpochInterval Word32
lifetime = PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL
    deposit :: Coin
deposit = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL
  GovActionId
gai <-
    ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal (ProposalProcedure era -> ImpTestM era GovActionId)
-> ProposalProcedure era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
      ProposalProcedure
        { pProcDeposit :: Coin
pProcDeposit = Coin
deposit
        , pProcReturnAddr :: RewardAccount
pProcReturnAddr = RewardAccount
rewardAccount
        , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
forall era. GovAction era
InfoAction
        , pProcAnchor :: Anchor
pProcAnchor = Anchor
forall a. Default a => a
def
        }
  Nat -> ImpTestM era ()
forall era. ShelleyEraImp era => Nat -> ImpTestM era ()
passNEpochs (Nat -> ImpTestM era ()) -> Nat -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Nat
2 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Word32 -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lifetime
  GovActionId -> ImpTestM era ()
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
gai

-- | Submits a transaction that proposes the given governance action
trySubmitGovActions ::
  (ShelleyEraImp era, ConwayEraTxBody era) =>
  NE.NonEmpty (GovAction era) ->
  ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era) (Tx era))
trySubmitGovActions :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (GovAction era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitGovActions NonEmpty (GovAction era)
gas = do
  NonEmpty (ProposalProcedure era)
proposals <- (GovAction era -> ImpM (LedgerSpec era) (ProposalProcedure era))
-> NonEmpty (GovAction era)
-> ImpM (LedgerSpec era) (NonEmpty (ProposalProcedure era))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse GovAction era -> ImpM (LedgerSpec era) (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal NonEmpty (GovAction era)
gas
  NonEmpty (ProposalProcedure era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (ProposalProcedure era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitProposals NonEmpty (ProposalProcedure era)
proposals

mkProposalWithRewardAccount ::
  (ShelleyEraImp era, ConwayEraTxBody era) =>
  GovAction era ->
  RewardAccount ->
  ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
ga RewardAccount
rewardAccount = do
  Coin
deposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
    -> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
 -> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL
  Anchor
anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
  ProposalProcedure era -> ImpTestM era (ProposalProcedure era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ProposalProcedure
      { pProcDeposit :: Coin
pProcDeposit = Coin
deposit
      , pProcReturnAddr :: RewardAccount
pProcReturnAddr = RewardAccount
rewardAccount
      , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
ga
      , pProcAnchor :: Anchor
pProcAnchor = Anchor
anchor
      }

mkProposal ::
  (ShelleyEraImp era, ConwayEraTxBody era) =>
  GovAction era ->
  ImpTestM era (ProposalProcedure era)
mkProposal :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
ga = do
  RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
  GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> RewardAccount -> ImpTestM era (ProposalProcedure era)
mkProposalWithRewardAccount GovAction era
ga RewardAccount
rewardAccount

submitGovAction ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  GovAction era ->
  ImpTestM era GovActionId
submitGovAction :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
ga = do
  GovActionId
gaId NE.:| [GovActionId]
_ <- NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions (GovAction era -> NonEmpty (GovAction era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovAction era
ga)
  GovActionId -> ImpTestM era GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
gaId

submitGovAction_ ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  GovAction era ->
  ImpTestM era ()
submitGovAction_ :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ = ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ())
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction

submitGovActions ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  NE.NonEmpty (GovAction era) ->
  ImpTestM era (NE.NonEmpty GovActionId)
submitGovActions :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions NonEmpty (GovAction era)
gas = do
  Tx era
tx <- NonEmpty (GovAction era)
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
NonEmpty (GovAction era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
        (Tx era))
trySubmitGovActions NonEmpty (GovAction era)
gas ImpM
  (LedgerSpec era)
  (Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
     (Tx era))
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
      (Tx era)
    -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) (Tx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era)), Tx era)
  (Tx era)
-> ImpM (LedgerSpec era) (Tx era)
forall a (m :: * -> *) b.
(HasCallStack, ToExpr a, MonadIO m) =>
Either a b -> m b
expectRightExpr
  let txId :: TxId
txId = Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
tx
  NonEmpty GovActionId -> ImpTestM era (NonEmpty GovActionId)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty GovActionId -> ImpTestM era (NonEmpty GovActionId))
-> NonEmpty GovActionId -> ImpTestM era (NonEmpty GovActionId)
forall a b. (a -> b) -> a -> b
$ (Word16 -> GovAction era -> GovActionId)
-> NonEmpty Word16
-> NonEmpty (GovAction era)
-> NonEmpty GovActionId
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\Word16
idx GovAction era
_ -> TxId -> GovActionIx -> GovActionId
GovActionId TxId
txId (Word16 -> GovActionIx
GovActionIx Word16
idx)) (Word16
0 Word16 -> [Word16] -> NonEmpty Word16
forall a. a -> [a] -> NonEmpty a
NE.:| [Word16
Item [Word16]
1 ..]) NonEmpty (GovAction era)
gas

mkTreasuryWithdrawalsGovAction ::
  ConwayEraGov era =>
  [(RewardAccount, Coin)] ->
  ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction :: forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount, Coin)]
wdrls =
  Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals ([(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RewardAccount, Coin)]
wdrls) (StrictMaybe ScriptHash -> GovAction era)
-> ImpM (LedgerSpec era) (StrictMaybe ScriptHash)
-> ImpM (LedgerSpec era) (GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy

submitTreasuryWithdrawals ::
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , ConwayEraGov era
  ) =>
  [(RewardAccount, Coin)] ->
  ImpTestM era GovActionId
submitTreasuryWithdrawals :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount, Coin)]
wdrls =
  [(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(RewardAccount, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction [(RewardAccount, Coin)]
wdrls ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction

enactTreasuryWithdrawals ::
  ConwayEraImp era =>
  [(RewardAccount, Coin)] ->
  Credential 'DRepRole ->
  NonEmpty (Credential 'HotCommitteeRole) ->
  ImpTestM era GovActionId
enactTreasuryWithdrawals :: forall era.
ConwayEraImp era =>
[(RewardAccount, Coin)]
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactTreasuryWithdrawals [(RewardAccount, Coin)]
withdrawals Credential 'DRepRole
dRep NonEmpty (Credential 'HotCommitteeRole)
cms = do
  GovActionId
gaId <- [(RewardAccount, Coin)] -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, ConwayEraGov era) =>
[(RewardAccount, Coin)] -> ImpTestM era GovActionId
submitTreasuryWithdrawals [(RewardAccount, Coin)]
withdrawals
  Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
gaId
  NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
cms GovActionId
gaId
  Nat -> ImpTestM era ()
forall era. ShelleyEraImp era => Nat -> ImpTestM era ()
passNEpochs Nat
2
  GovActionId -> ImpTestM era GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
gaId

submitParameterChange ::
  ConwayEraImp era =>
  StrictMaybe GovActionId ->
  PParamsUpdate era ->
  ImpTestM era GovActionId
submitParameterChange :: forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era GovActionId
submitParameterChange StrictMaybe GovActionId
parent PParamsUpdate era
ppu =
  StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
parent PParamsUpdate era
ppu ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction

mkParameterChangeGovAction ::
  ConwayEraImp era =>
  StrictMaybe GovActionId ->
  PParamsUpdate era ->
  ImpTestM era (GovAction era)
mkParameterChangeGovAction :: forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
parent PParamsUpdate era
ppu =
  StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange (GovActionId -> GovPurposeId 'PParamUpdatePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId (GovActionId -> GovPurposeId 'PParamUpdatePurpose)
-> StrictMaybe GovActionId
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe GovActionId
parent) PParamsUpdate era
ppu (StrictMaybe ScriptHash -> GovAction era)
-> ImpM (LedgerSpec era) (StrictMaybe ScriptHash)
-> ImpM (LedgerSpec era) (GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy

mkMinFeeUpdateGovAction ::
  ConwayEraImp era =>
  StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction :: forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
p = do
  Integer
minFeeValue <- (Integer, Integer) -> ImpM (LedgerSpec era) Integer
forall g (m :: * -> *) a.
(HasStatefulGen g m, UniformRange a) =>
(a, a) -> m a
uniformRM (Integer
30, Integer
1000)
  StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
p (PParamsUpdate era
forall a. Default a => a
def PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
minFeeValue))

getGovPolicy :: ConwayEraGov era => ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy =
  SimpleGetter (NewEpochState era) (StrictMaybe ScriptHash)
-> ImpTestM era (StrictMaybe ScriptHash)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe ScriptHash)
 -> ImpTestM era (StrictMaybe ScriptHash))
-> SimpleGetter (NewEpochState era) (StrictMaybe ScriptHash)
-> ImpTestM era (StrictMaybe ScriptHash)
forall a b. (a -> b) -> a -> b
$
    (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEpochStateL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
    -> EpochState era -> Const r (EpochState era))
-> (StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL ((Constitution era -> Const r (Constitution era))
 -> GovState era -> Const r (GovState era))
-> ((StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
    -> Constitution era -> Const r (Constitution era))
-> (StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
-> GovState era
-> Const r (GovState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe ScriptHash -> Const r (StrictMaybe ScriptHash))
-> Constitution era -> Const r (Constitution era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe ScriptHash -> f (StrictMaybe ScriptHash))
-> Constitution era -> f (Constitution era)
constitutionScriptL

submitFailingGovAction ::
  forall era.
  ( ShelleyEraImp era
  , ConwayEraTxBody era
  , HasCallStack
  ) =>
  GovAction era ->
  NonEmpty (PredicateFailure (EraRule "LEDGER" era)) ->
  ImpTestM era ()
submitFailingGovAction :: forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingGovAction GovAction era
ga NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure = GovAction era
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
trySubmitGovAction GovAction era
ga ImpM
  (LedgerSpec era)
  (Either
     (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId)
-> (Either
      (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
    -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either
  (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall a b (m :: * -> *).
(HasCallStack, ToExpr a, ToExpr b, Eq a, MonadIO m) =>
Either a b -> a -> m ()
`shouldBeLeftExpr` NonEmpty (PredicateFailure (EraRule "LEDGER" era))
expectedFailure)

getEnactState :: ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState :: forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState = GovState era -> EnactState era
forall era. ConwayEraGov era => GovState era -> EnactState era
mkEnactState (GovState era -> EnactState era)
-> ImpM (LedgerSpec era) (GovState era)
-> ImpM (LedgerSpec era) (EnactState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleGetter (NewEpochState era) (GovState era)
-> ImpM (LedgerSpec era) (GovState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((GovState era -> Const r (GovState era))
    -> EpochState era -> Const r (EpochState era))
-> (GovState era -> Const r (GovState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL)

getProposals :: ConwayEraGov era => ImpTestM era (Proposals era)
getProposals :: forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals = SimpleGetter (NewEpochState era) (Proposals era)
-> ImpTestM era (Proposals era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Proposals era)
 -> ImpTestM era (Proposals era))
-> SimpleGetter (NewEpochState era) (Proposals era)
-> ImpTestM era (Proposals era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Const r (GovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Proposals era -> Const r (Proposals era))
    -> GovState era -> Const r (GovState era))
-> (Proposals era -> Const r (Proposals era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Const r (Proposals era))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL

logProposalsForest :: (ConwayEraGov era, HasCallStack) => ImpTestM era ()
logProposalsForest :: forall era. (ConwayEraGov era, HasCallStack) => ImpTestM era ()
logProposalsForest = do
  Proposals era
proposals <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  Doc AnsiStyle -> ImpTestM era ()
forall t. HasCallStack => Doc AnsiStyle -> ImpM t ()
logDoc (Doc AnsiStyle -> ImpTestM era ())
-> Doc AnsiStyle -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Proposals era -> Bool -> Doc AnsiStyle
forall era. Proposals era -> Bool -> Doc AnsiStyle
proposalsShowDebug Proposals era
proposals Bool
True

getCommitteeMembers ::
  ConwayEraImp era =>
  ImpTestM era (Set.Set (Credential 'ColdCommitteeRole))
getCommitteeMembers :: forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers = do
  StrictMaybe (Committee era)
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
(StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  Set (Credential 'ColdCommitteeRole)
-> ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Credential 'ColdCommitteeRole)
 -> ImpTestM era (Set (Credential 'ColdCommitteeRole)))
-> Set (Credential 'ColdCommitteeRole)
-> ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall k a. Map k a -> Set k
Map.keysSet (Map (Credential 'ColdCommitteeRole) EpochNo
 -> Set (Credential 'ColdCommitteeRole))
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall a b. (a -> b) -> a -> b
$ (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee

getLastEnactedCommittee ::
  ConwayEraGov era => ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose))
getLastEnactedCommittee :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose))
getLastEnactedCommittee = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  StrictMaybe (GovPurposeId 'CommitteePurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe (GovPurposeId 'CommitteePurpose)
 -> ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose)))
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'CommitteePurpose))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (StrictMaybe (GovPurposeId 'CommitteePurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> Proposals era
-> Const
     (StrictMaybe (GovPurposeId 'CommitteePurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const
      (StrictMaybe (GovPurposeId 'CommitteePurpose)) (Proposals era))
-> ((StrictMaybe (GovPurposeId 'CommitteePurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'CommitteePurpose))
          (StrictMaybe (GovPurposeId 'CommitteePurpose)))
    -> GovRelation PRoot
    -> Const
         (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> Getting
     (StrictMaybe (GovPurposeId 'CommitteePurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'CommitteePurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'CommitteePurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'CommitteePurpose))
      (PRoot (GovPurposeId 'CommitteePurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL ((PRoot (GovPurposeId 'CommitteePurpose)
  -> Const
       (StrictMaybe (GovPurposeId 'CommitteePurpose))
       (PRoot (GovPurposeId 'CommitteePurpose)))
 -> GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> ((StrictMaybe (GovPurposeId 'CommitteePurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'CommitteePurpose))
          (StrictMaybe (GovPurposeId 'CommitteePurpose)))
    -> PRoot (GovPurposeId 'CommitteePurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'CommitteePurpose))
         (PRoot (GovPurposeId 'CommitteePurpose)))
-> (StrictMaybe (GovPurposeId 'CommitteePurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'CommitteePurpose))
         (StrictMaybe (GovPurposeId 'CommitteePurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'CommitteePurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'CommitteePurpose))
      (StrictMaybe (GovPurposeId 'CommitteePurpose)))
-> PRoot (GovPurposeId 'CommitteePurpose)
-> Const
     (StrictMaybe (GovPurposeId 'CommitteePurpose))
     (PRoot (GovPurposeId 'CommitteePurpose))
forall a (f :: * -> *).
Functor f =>
(StrictMaybe a -> f (StrictMaybe a)) -> PRoot a -> f (PRoot a)
prRootL

getConstitution ::
  ConwayEraImp era =>
  ImpTestM era (Constitution era)
getConstitution :: forall era. ConwayEraImp era => ImpTestM era (Constitution era)
getConstitution = SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL

getLastEnactedConstitution ::
  ConwayEraGov era => ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
getLastEnactedConstitution :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
getLastEnactedConstitution = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe (GovPurposeId 'ConstitutionPurpose)
 -> ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose)))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
      (GovRelation PRoot))
-> Proposals era
-> Const
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
       (GovRelation PRoot))
 -> Proposals era
 -> Const
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose)) (Proposals era))
-> ((StrictMaybe (GovPurposeId 'ConstitutionPurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
          (StrictMaybe (GovPurposeId 'ConstitutionPurpose)))
    -> GovRelation PRoot
    -> Const
         (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
         (GovRelation PRoot))
-> Getting
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'ConstitutionPurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
      (PRoot (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
     (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL ((PRoot (GovPurposeId 'ConstitutionPurpose)
  -> Const
       (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
       (PRoot (GovPurposeId 'ConstitutionPurpose)))
 -> GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
      (GovRelation PRoot))
-> ((StrictMaybe (GovPurposeId 'ConstitutionPurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
          (StrictMaybe (GovPurposeId 'ConstitutionPurpose)))
    -> PRoot (GovPurposeId 'ConstitutionPurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
         (PRoot (GovPurposeId 'ConstitutionPurpose)))
-> (StrictMaybe (GovPurposeId 'ConstitutionPurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
         (StrictMaybe (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
     (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'ConstitutionPurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose)))
-> PRoot (GovPurposeId 'ConstitutionPurpose)
-> Const
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose))
     (PRoot (GovPurposeId 'ConstitutionPurpose))
forall a (f :: * -> *).
Functor f =>
(StrictMaybe a -> f (StrictMaybe a)) -> PRoot a -> f (PRoot a)
prRootL

getLastEnactedParameterChange ::
  ConwayEraGov era => ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
getLastEnactedParameterChange :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
getLastEnactedParameterChange = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
 -> ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
      (GovRelation PRoot))
-> Proposals era
-> Const
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
       (GovRelation PRoot))
 -> Proposals era
 -> Const
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)) (Proposals era))
-> ((StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
          (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)))
    -> GovRelation PRoot
    -> Const
         (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
         (GovRelation PRoot))
-> Getting
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'PParamUpdatePurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
      (PRoot (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
     (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL ((PRoot (GovPurposeId 'PParamUpdatePurpose)
  -> Const
       (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
       (PRoot (GovPurposeId 'PParamUpdatePurpose)))
 -> GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
      (GovRelation PRoot))
-> ((StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
          (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)))
    -> PRoot (GovPurposeId 'PParamUpdatePurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
         (PRoot (GovPurposeId 'PParamUpdatePurpose)))
-> (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
         (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
     (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)))
-> PRoot (GovPurposeId 'PParamUpdatePurpose)
-> Const
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
     (PRoot (GovPurposeId 'PParamUpdatePurpose))
forall a (f :: * -> *).
Functor f =>
(StrictMaybe a -> f (StrictMaybe a)) -> PRoot a -> f (PRoot a)
prRootL

getLastEnactedHardForkInitiation ::
  ConwayEraGov era => ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
getLastEnactedHardForkInitiation :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
getLastEnactedHardForkInitiation = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe (GovPurposeId 'HardForkPurpose)
 -> ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose)))
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
-> Proposals era
-> Const
     (StrictMaybe (GovPurposeId 'HardForkPurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const
      (StrictMaybe (GovPurposeId 'HardForkPurpose)) (Proposals era))
-> ((StrictMaybe (GovPurposeId 'HardForkPurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'HardForkPurpose))
          (StrictMaybe (GovPurposeId 'HardForkPurpose)))
    -> GovRelation PRoot
    -> Const
         (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
-> Getting
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
     (Proposals era)
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'HardForkPurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'HardForkPurpose))
      (PRoot (GovPurposeId 'HardForkPurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL ((PRoot (GovPurposeId 'HardForkPurpose)
  -> Const
       (StrictMaybe (GovPurposeId 'HardForkPurpose))
       (PRoot (GovPurposeId 'HardForkPurpose)))
 -> GovRelation PRoot
 -> Const
      (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
-> ((StrictMaybe (GovPurposeId 'HardForkPurpose)
     -> Const
          (StrictMaybe (GovPurposeId 'HardForkPurpose))
          (StrictMaybe (GovPurposeId 'HardForkPurpose)))
    -> PRoot (GovPurposeId 'HardForkPurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'HardForkPurpose))
         (PRoot (GovPurposeId 'HardForkPurpose)))
-> (StrictMaybe (GovPurposeId 'HardForkPurpose)
    -> Const
         (StrictMaybe (GovPurposeId 'HardForkPurpose))
         (StrictMaybe (GovPurposeId 'HardForkPurpose)))
-> GovRelation PRoot
-> Const
     (StrictMaybe (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId 'HardForkPurpose)
 -> Const
      (StrictMaybe (GovPurposeId 'HardForkPurpose))
      (StrictMaybe (GovPurposeId 'HardForkPurpose)))
-> PRoot (GovPurposeId 'HardForkPurpose)
-> Const
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
     (PRoot (GovPurposeId 'HardForkPurpose))
forall a (f :: * -> *).
Functor f =>
(StrictMaybe a -> f (StrictMaybe a)) -> PRoot a -> f (PRoot a)
prRootL

getConstitutionProposals ::
  ConwayEraGov era =>
  ImpTestM
    era
    ( Map.Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose))
    )
getConstitutionProposals :: forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'ConstitutionPurpose)
     (PEdges (GovPurposeId 'ConstitutionPurpose)))
getConstitutionProposals = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  Map
  (GovPurposeId 'ConstitutionPurpose)
  (PEdges (GovPurposeId 'ConstitutionPurpose))
-> ImpTestM
     era
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map
   (GovPurposeId 'ConstitutionPurpose)
   (PEdges (GovPurposeId 'ConstitutionPurpose))
 -> ImpTestM
      era
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose))))
-> Map
     (GovPurposeId 'ConstitutionPurpose)
     (PEdges (GovPurposeId 'ConstitutionPurpose))
-> ImpTestM
     era
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
-> Map
     (GovPurposeId 'ConstitutionPurpose)
     (PEdges (GovPurposeId 'ConstitutionPurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'ConstitutionPurpose)
          (PEdges (GovPurposeId 'ConstitutionPurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'ConstitutionPurpose)
       (PEdges (GovPurposeId 'ConstitutionPurpose))
     -> Const
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose)))
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'ConstitutionPurpose)
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (PGraph (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL ((PGraph (GovPurposeId 'ConstitutionPurpose)
  -> Const
       (Map
          (GovPurposeId 'ConstitutionPurpose)
          (PEdges (GovPurposeId 'ConstitutionPurpose)))
       (PGraph (GovPurposeId 'ConstitutionPurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'ConstitutionPurpose)
       (PEdges (GovPurposeId 'ConstitutionPurpose))
     -> Const
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose)))
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose))))
    -> PGraph (GovPurposeId 'ConstitutionPurpose)
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (PGraph (GovPurposeId 'ConstitutionPurpose)))
-> (Map
      (GovPurposeId 'ConstitutionPurpose)
      (PEdges (GovPurposeId 'ConstitutionPurpose))
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'ConstitutionPurpose)
   (PEdges (GovPurposeId 'ConstitutionPurpose))
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose))))
-> PGraph (GovPurposeId 'ConstitutionPurpose)
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (PGraph (GovPurposeId 'ConstitutionPurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL

getParameterChangeProposals ::
  ConwayEraGov era =>
  ImpTestM
    era
    ( Map.Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose))
    )
getParameterChangeProposals :: forall era.
ConwayEraGov era =>
ImpTestM
  era
  (Map
     (GovPurposeId 'PParamUpdatePurpose)
     (PEdges (GovPurposeId 'PParamUpdatePurpose)))
getParameterChangeProposals = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  Map
  (GovPurposeId 'PParamUpdatePurpose)
  (PEdges (GovPurposeId 'PParamUpdatePurpose))
-> ImpTestM
     era
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map
   (GovPurposeId 'PParamUpdatePurpose)
   (PEdges (GovPurposeId 'PParamUpdatePurpose))
 -> ImpTestM
      era
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose))))
-> Map
     (GovPurposeId 'PParamUpdatePurpose)
     (PEdges (GovPurposeId 'PParamUpdatePurpose))
-> ImpTestM
     era
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
-> Map
     (GovPurposeId 'PParamUpdatePurpose)
     (PEdges (GovPurposeId 'PParamUpdatePurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'PParamUpdatePurpose)
          (PEdges (GovPurposeId 'PParamUpdatePurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'PParamUpdatePurpose)
       (PEdges (GovPurposeId 'PParamUpdatePurpose))
     -> Const
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose)))
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'PParamUpdatePurpose)
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (PGraph (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL ((PGraph (GovPurposeId 'PParamUpdatePurpose)
  -> Const
       (Map
          (GovPurposeId 'PParamUpdatePurpose)
          (PEdges (GovPurposeId 'PParamUpdatePurpose)))
       (PGraph (GovPurposeId 'PParamUpdatePurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'PParamUpdatePurpose)
       (PEdges (GovPurposeId 'PParamUpdatePurpose))
     -> Const
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose)))
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose))))
    -> PGraph (GovPurposeId 'PParamUpdatePurpose)
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (PGraph (GovPurposeId 'PParamUpdatePurpose)))
-> (Map
      (GovPurposeId 'PParamUpdatePurpose)
      (PEdges (GovPurposeId 'PParamUpdatePurpose))
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'PParamUpdatePurpose)
   (PEdges (GovPurposeId 'PParamUpdatePurpose))
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose))))
-> PGraph (GovPurposeId 'PParamUpdatePurpose)
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (PGraph (GovPurposeId 'PParamUpdatePurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL

logProposalsForestDiff ::
  ( Era era
  , ToExpr (PParamsHKD StrictMaybe era)
  , HasCallStack
  ) =>
  Proposals era ->
  Proposals era ->
  ImpTestM era ()
logProposalsForestDiff :: forall era.
(Era era, ToExpr (PParamsHKD StrictMaybe era), HasCallStack) =>
Proposals era -> Proposals era -> ImpTestM era ()
logProposalsForestDiff Proposals era
pf1 Proposals era
pf2 = Doc AnsiStyle -> ImpM (LedgerSpec era) ()
forall t. HasCallStack => Doc AnsiStyle -> ImpM t ()
logDoc (Doc AnsiStyle -> ImpM (LedgerSpec era) ())
-> Doc AnsiStyle -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep [Item [Doc AnsiStyle]
Doc AnsiStyle
"Proposals Forest Diff:", Proposals era -> Proposals era -> Doc AnsiStyle
forall a. ToExpr a => a -> a -> Doc AnsiStyle
diffExpr Proposals era
pf1 Proposals era
pf2]

-- | Looks up the governance action state corresponding to the governance action id
lookupGovActionState ::
  ConwayEraGov era =>
  GovActionId ->
  ImpTestM era (Maybe (GovActionState era))
lookupGovActionState :: forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId
aId = GovActionId -> Proposals era -> Maybe (GovActionState era)
forall era.
GovActionId -> Proposals era -> Maybe (GovActionState era)
proposalsLookupId GovActionId
aId (Proposals era -> Maybe (GovActionState era))
-> ImpM (LedgerSpec era) (Proposals era)
-> ImpM (LedgerSpec era) (Maybe (GovActionState era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals

-- | Looks up the governance action state corresponding to the governance action id
getGovActionState ::
  (HasCallStack, ConwayEraGov era) =>
  GovActionId ->
  ImpTestM era (GovActionState era)
getGovActionState :: forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId =
  String
-> ImpM (LedgerSpec era) (GovActionState era)
-> ImpM (LedgerSpec era) (GovActionState era)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Expecting an action state" (ImpM (LedgerSpec era) (GovActionState era)
 -> ImpM (LedgerSpec era) (GovActionState era))
-> ImpM (LedgerSpec era) (GovActionState era)
-> ImpM (LedgerSpec era) (GovActionState era)
forall a b. (a -> b) -> a -> b
$ do
    GovActionId -> ImpTestM era (Maybe (GovActionState era))
forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId
govActionId ImpTestM era (Maybe (GovActionState era))
-> (Maybe (GovActionState era)
    -> ImpM (LedgerSpec era) (GovActionState era))
-> ImpM (LedgerSpec era) (GovActionState era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (GovActionState era)
Nothing ->
        String -> ImpM (LedgerSpec era) (GovActionState era)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure (String -> ImpM (LedgerSpec era) (GovActionState era))
-> String -> ImpM (LedgerSpec era) (GovActionState era)
forall a b. (a -> b) -> a -> b
$ String
"Could not find action state for govActionId: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GovActionId -> String
forall a. Show a => a -> String
show GovActionId
govActionId
      Just GovActionState era
govActionState -> GovActionState era -> ImpM (LedgerSpec era) (GovActionState era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionState era
govActionState

expectPresentGovActionId ::
  (HasCallStack, ConwayEraGov era) =>
  GovActionId ->
  ImpTestM era ()
expectPresentGovActionId :: forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectPresentGovActionId GovActionId
govActionId = ImpM (LedgerSpec era) (GovActionState era)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (GovActionState era)
 -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) (GovActionState era)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ GovActionId -> ImpM (LedgerSpec era) (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId

expectMissingGovActionId ::
  (HasCallStack, ConwayEraGov era) =>
  GovActionId ->
  ImpTestM era ()
expectMissingGovActionId :: forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
expectMissingGovActionId GovActionId
govActionId =
  String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Expecting for gov action state to be missing" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
    GovActionId -> ImpTestM era (Maybe (GovActionState era))
forall era.
ConwayEraGov era =>
GovActionId -> ImpTestM era (Maybe (GovActionState era))
lookupGovActionState GovActionId
govActionId ImpTestM era (Maybe (GovActionState era))
-> (Maybe (GovActionState era) -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just GovActionState era
_ ->
        String -> ImpM (LedgerSpec era) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure (String -> ImpM (LedgerSpec era) ())
-> String -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ String
"Found gov action state for govActionId: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GovActionId -> String
forall a. ToExpr a => a -> String
ansiExprString GovActionId
govActionId
      Maybe (GovActionState era)
Nothing -> () -> ImpM (LedgerSpec era) ()
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Builds a RatifyEnv from the current state
getRatifyEnv :: (ConwayEraGov era, ConwayEraCertState era) => ImpTestM era (RatifyEnv era)
getRatifyEnv :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv = do
  EpochNo
eNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  InstantStake era
instantStake <- SimpleGetter (NewEpochState era) (InstantStake era)
-> ImpTestM era (InstantStake era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES Getting r (NewEpochState era) (InstantStake era)
SimpleGetter (NewEpochState era) (InstantStake era)
forall era. SimpleGetter (NewEpochState era) (InstantStake era)
forall (t :: * -> *) era.
CanGetInstantStake t =>
SimpleGetter (t era) (InstantStake era)
instantStakeG
  PoolDistr
poolDistr <- SimpleGetter (NewEpochState era) PoolDistr
-> ImpTestM era PoolDistr
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (PoolDistr -> Const r PoolDistr)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) PoolDistr
forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> NewEpochState era -> f (NewEpochState era)
nesPdL
  Map DRep (CompactForm Coin)
drepDistr <- SimpleGetter (NewEpochState era) (Map DRep (CompactForm Coin))
-> ImpTestM era (Map DRep (CompactForm Coin))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Map DRep (CompactForm Coin))
 -> ImpTestM era (Map DRep (CompactForm Coin)))
-> SimpleGetter (NewEpochState era) (Map DRep (CompactForm Coin))
-> ImpTestM era (Map DRep (CompactForm Coin))
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map DRep (CompactForm Coin)
     -> Const r (Map DRep (CompactForm Coin)))
    -> EpochState era -> Const r (EpochState era))
-> (Map DRep (CompactForm Coin)
    -> Const r (Map DRep (CompactForm Coin)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> Const r (DRepPulsingState era))
-> EpochState era -> Const r (EpochState era)
forall era.
ConwayEraGov era =>
Lens' (EpochState era) (DRepPulsingState era)
Lens' (EpochState era) (DRepPulsingState era)
epochStateDRepPulsingStateL ((DRepPulsingState era -> Const r (DRepPulsingState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map DRep (CompactForm Coin)
     -> Const r (Map DRep (CompactForm Coin)))
    -> DRepPulsingState era -> Const r (DRepPulsingState era))
-> (Map DRep (CompactForm Coin)
    -> Const r (Map DRep (CompactForm Coin)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DRep (CompactForm Coin)
 -> Const r (Map DRep (CompactForm Coin)))
-> DRepPulsingState era -> Const r (DRepPulsingState era)
forall era.
EraStake era =>
SimpleGetter (DRepPulsingState era) (Map DRep (CompactForm Coin))
SimpleGetter (DRepPulsingState era) (Map DRep (CompactForm Coin))
psDRepDistrG
  Map (Credential 'DRepRole) DRepState
drepState <- SimpleGetter
  (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
 -> ImpTestM era (Map (Credential 'DRepRole) DRepState))
-> SimpleGetter
     (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const r (Map (Credential 'DRepRole) DRepState))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
  CommitteeState era
committeeState <- SimpleGetter (NewEpochState era) (CommitteeState era)
-> ImpTestM era (CommitteeState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (CommitteeState era)
 -> ImpTestM era (CommitteeState era))
-> SimpleGetter (NewEpochState era) (CommitteeState era)
-> ImpTestM era (CommitteeState era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((CommitteeState era -> Const r (CommitteeState era))
    -> EpochState era -> Const r (EpochState era))
-> (CommitteeState era -> Const r (CommitteeState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((CommitteeState era -> Const r (CommitteeState era))
    -> LedgerState era -> Const r (LedgerState era))
-> (CommitteeState era -> Const r (CommitteeState era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((CommitteeState era -> Const r (CommitteeState era))
    -> CertState era -> Const r (CertState era))
-> (CommitteeState era -> Const r (CommitteeState era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((CommitteeState era -> Const r (CommitteeState era))
    -> VState era -> Const r (VState era))
-> (CommitteeState era -> Const r (CommitteeState era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era -> Const r (CommitteeState era))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL
  UMap
umap <- SimpleGetter (NewEpochState era) UMap -> ImpTestM era UMap
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (UMap -> Const r UMap)
-> NewEpochState era -> Const r (NewEpochState era)
forall era. EraCertState era => Lens' (NewEpochState era) UMap
SimpleGetter (NewEpochState era) UMap
Lens' (NewEpochState era) UMap
unifiedL
  Map (KeyHash 'StakePool) PoolParams
poolPs <- SimpleGetter
  (NewEpochState era) (Map (KeyHash 'StakePool) PoolParams)
-> ImpTestM era (Map (KeyHash 'StakePool) PoolParams)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (Map (KeyHash 'StakePool) PoolParams)
 -> ImpTestM era (Map (KeyHash 'StakePool) PoolParams))
-> SimpleGetter
     (NewEpochState era) (Map (KeyHash 'StakePool) PoolParams)
-> ImpTestM era (Map (KeyHash 'StakePool) PoolParams)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const r (Map (KeyHash 'StakePool) PoolParams))
    -> EpochState era -> Const r (EpochState era))
-> (Map (KeyHash 'StakePool) PoolParams
    -> Const r (Map (KeyHash 'StakePool) PoolParams))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
 -> Const r (Map (KeyHash 'StakePool) PoolParams))
-> EpochState era -> Const r (EpochState era)
forall era.
EraCertState era =>
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL
  RatifyEnv era -> ImpTestM era (RatifyEnv era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    RatifyEnv
      { reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
poolDistr
      , reInstantStake :: InstantStake era
reInstantStake = InstantStake era
instantStake
      , reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
drepState
      , reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
drepDistr
      , reCurrentEpoch :: EpochNo
reCurrentEpoch = EpochNo
eNo EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
- EpochNo
1
      , reCommitteeState :: CommitteeState era
reCommitteeState = CommitteeState era
committeeState
      , reDelegatees :: Map (Credential 'Staking) DRep
reDelegatees = UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
umap
      , rePoolParams :: Map (KeyHash 'StakePool) PoolParams
rePoolParams = Map (KeyHash 'StakePool) PoolParams
poolPs
      }

ccShouldNotBeExpired ::
  (HasCallStack, ConwayEraGov era) =>
  Credential 'ColdCommitteeRole ->
  ImpTestM era ()
ccShouldNotBeExpired :: forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeExpired Credential 'ColdCommitteeRole
coldC = do
  EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  EpochNo
ccExpiryEpochNo <- Credential 'ColdCommitteeRole -> ImpTestM era EpochNo
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era EpochNo
getCCExpiry Credential 'ColdCommitteeRole
coldC
  EpochNo
curEpochNo EpochNo -> (EpochNo -> Bool) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` (EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
ccExpiryEpochNo)

ccShouldBeExpired ::
  (HasCallStack, ConwayEraGov era) =>
  Credential 'ColdCommitteeRole ->
  ImpTestM era ()
ccShouldBeExpired :: forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeExpired Credential 'ColdCommitteeRole
coldC = do
  EpochNo
curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  EpochNo
ccExpiryEpochNo <- Credential 'ColdCommitteeRole -> ImpTestM era EpochNo
forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era EpochNo
getCCExpiry Credential 'ColdCommitteeRole
coldC
  EpochNo
curEpochNo EpochNo -> (EpochNo -> Bool) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` (EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
> EpochNo
ccExpiryEpochNo)

getCCExpiry ::
  (HasCallStack, ConwayEraGov era) =>
  Credential 'ColdCommitteeRole ->
  ImpTestM era EpochNo
getCCExpiry :: forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era EpochNo
getCCExpiry Credential 'ColdCommitteeRole
coldC = do
  StrictMaybe (Committee era)
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> EpochState era -> Const r (EpochState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  case StrictMaybe (Committee era)
committee of
    StrictMaybe (Committee era)
SNothing -> String -> ImpTestM era EpochNo
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure String
"There is no committee"
    SJust Committee {Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers :: forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers} ->
      case Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Maybe EpochNo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldC Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers of
        Maybe EpochNo
Nothing -> String -> ImpTestM era EpochNo
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure (String -> ImpTestM era EpochNo) -> String -> ImpTestM era EpochNo
forall a b. (a -> b) -> a -> b
$ String
"Committee not found for cold credential: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Credential 'ColdCommitteeRole -> String
forall a. Show a => a -> String
show Credential 'ColdCommitteeRole
coldC
        Just EpochNo
epochNo -> EpochNo -> ImpTestM era EpochNo
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
epochNo

-- | Test the resignation status for a CC cold key to be resigned
ccShouldBeResigned ::
  (HasCallStack, ConwayEraCertState era) => Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldBeResigned Credential 'ColdCommitteeRole
coldK = do
  Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeeCreds <-
    SimpleGetter
  (NewEpochState era)
  (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era)
   (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
 -> ImpTestM
      era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> SimpleGetter
     (NewEpochState era)
     (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era -> Const r (CommitteeState era))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL ((CommitteeState era -> Const r (CommitteeState era))
 -> VState era -> Const r (VState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CommitteeState era -> Const r (CommitteeState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> VState era
-> Const r (VState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> Const
      r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> Const r (CommitteeState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> f (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> f (CommitteeState era)
csCommitteeCredsL
  CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole)
authHk (CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole))
-> Maybe CommitteeAuthorization
-> Maybe (Maybe (Credential 'HotCommitteeRole))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldK Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeeCreds Maybe (Maybe (Credential 'HotCommitteeRole))
-> Maybe (Maybe (Credential 'HotCommitteeRole)) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Maybe (Credential 'HotCommitteeRole)
-> Maybe (Maybe (Credential 'HotCommitteeRole))
forall a. a -> Maybe a
Just Maybe (Credential 'HotCommitteeRole)
forall a. Maybe a
Nothing

-- | Test the resignation status for a CC cold key to not be resigned
ccShouldNotBeResigned ::
  (HasCallStack, ConwayEraCertState era) => Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
ccShouldNotBeResigned Credential 'ColdCommitteeRole
coldK = do
  Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeeCreds <-
    SimpleGetter
  (NewEpochState era)
  (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era)
   (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
 -> ImpTestM
      era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> SimpleGetter
     (NewEpochState era)
     (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era -> Const r (CommitteeState era))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL ((CommitteeState era -> Const r (CommitteeState era))
 -> VState era -> Const r (VState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CommitteeState era -> Const r (CommitteeState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> VState era
-> Const r (VState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> Const
      r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> Const r (CommitteeState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> f (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> f (CommitteeState era)
csCommitteeCredsL
  (Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldK Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeeCreds Maybe CommitteeAuthorization
-> (CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole))
-> Maybe (Credential 'HotCommitteeRole)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole)
authHk) Maybe (Credential 'HotCommitteeRole)
-> (Maybe (Credential 'HotCommitteeRole) -> Bool)
-> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Maybe (Credential 'HotCommitteeRole) -> Bool
forall a. Maybe a -> Bool
isJust

authHk :: CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole)
authHk :: CommitteeAuthorization -> Maybe (Credential 'HotCommitteeRole)
authHk (CommitteeHotCredential Credential 'HotCommitteeRole
hk) = Credential 'HotCommitteeRole
-> Maybe (Credential 'HotCommitteeRole)
forall a. a -> Maybe a
Just Credential 'HotCommitteeRole
hk
authHk CommitteeAuthorization
_ = Maybe (Credential 'HotCommitteeRole)
forall a. Maybe a
Nothing

-- | Calculates the ratio of DReps that have voted for the governance action
calculateDRepAcceptedRatio ::
  forall era.
  (HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era Rational
calculateDRepAcceptedRatio :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
gaId = do
  RatifyEnv era
ratEnv <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv
  GovActionState era
gas <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  Rational -> ImpTestM era Rational
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> ImpTestM era Rational)
-> Rational -> ImpTestM era Rational
forall a b. (a -> b) -> a -> b
$
    forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio @era
      RatifyEnv era
ratEnv
      (GovActionState era
gas GovActionState era
-> Getting
     (Map (Credential 'DRepRole) Vote)
     (GovActionState era)
     (Map (Credential 'DRepRole) Vote)
-> Map (Credential 'DRepRole) Vote
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'DRepRole) Vote)
  (GovActionState era)
  (Map (Credential 'DRepRole) Vote)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) Vote
 -> f (Map (Credential 'DRepRole) Vote))
-> GovActionState era -> f (GovActionState era)
gasDRepVotesL)
      (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)

-- | Calculates the ratio of Committee members that have voted for the governance
-- action
calculateCommitteeAcceptedRatio ::
  forall era.
  (HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era Rational
calculateCommitteeAcceptedRatio :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateCommitteeAcceptedRatio GovActionId
gaId = do
  EpochNo
eNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  RatifyEnv {CommitteeState era
reCommitteeState :: forall era. RatifyEnv era -> CommitteeState era
reCommitteeState :: CommitteeState era
reCommitteeState} <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv
  GovActionState {Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes} <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  StrictMaybe (Committee era)
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> EpochState era -> Const r (EpochState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  let
    members :: Map (Credential 'ColdCommitteeRole) EpochNo
members = (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers @era) StrictMaybe (Committee era)
committee
  Rational -> ImpTestM era Rational
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> ImpTestM era Rational)
-> Rational -> ImpTestM era Rational
forall a b. (a -> b) -> a -> b
$
    Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio
      Map (Credential 'ColdCommitteeRole) EpochNo
members
      Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes
      CommitteeState era
reCommitteeState
      EpochNo
eNo

calculatePoolAcceptedRatio ::
  (ConwayEraGov era, ConwayEraCertState era) => GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
gaId = do
  RatifyEnv era
ratEnv <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv
  GovActionState era
gas <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  ProtVer
pv <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  Rational -> ImpTestM era Rational
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> ImpTestM era Rational)
-> Rational -> ImpTestM era Rational
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> GovActionState era -> ProtVer -> Rational
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Rational
spoAcceptedRatio RatifyEnv era
ratEnv GovActionState era
gas ProtVer
pv

-- | Logs the ratios of accepted votes per category
logAcceptedRatio ::
  (HasCallStack, ConwayEraGov era, ConwayEraCertState era) => GovActionId -> ImpTestM era ()
logAcceptedRatio :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logAcceptedRatio GovActionId
aId = do
  Rational
dRepRatio <- GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateDRepAcceptedRatio GovActionId
aId
  Rational
committeeRatio <- GovActionId -> ImpTestM era Rational
forall era.
(HasCallStack, ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculateCommitteeAcceptedRatio GovActionId
aId
  Rational
spoRatio <- GovActionId -> ImpTestM era Rational
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
GovActionId -> ImpTestM era Rational
calculatePoolAcceptedRatio GovActionId
aId
  Doc AnsiStyle -> ImpTestM era ()
forall t. HasCallStack => Doc AnsiStyle -> ImpM t ()
logDoc (Doc AnsiStyle -> ImpTestM era ())
-> Doc AnsiStyle -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Maybe (Doc AnsiStyle) -> [(String, Doc AnsiStyle)] -> Doc AnsiStyle
tableDoc
      (Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just Doc AnsiStyle
"ACCEPTED RATIOS")
      [ (String
"DRep accepted ratio:", Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Rational
dRepRatio)
      , (String
"Committee accepted ratio:", Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Rational
committeeRatio)
      , (String
"SPO accepted ratio:", Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Rational
spoRatio)
      ]

getRatifyEnvAndState ::
  (ConwayEraGov era, ConwayEraCertState era) => ImpTestM era (RatifyEnv era, RatifyState era)
getRatifyEnvAndState :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era, RatifyState era)
getRatifyEnvAndState = do
  RatifyEnv era
ratifyEnv <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv
  EnactState era
enactState <- ImpTestM era (EnactState era)
forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
  let ratifyState :: RatifyState era
ratifyState =
        RatifyState
          { rsEnactState :: EnactState era
rsEnactState = EnactState era
enactState
          , rsEnacted :: Seq (GovActionState era)
rsEnacted = Seq (GovActionState era)
forall a. Monoid a => a
mempty
          , rsExpired :: Set GovActionId
rsExpired = Set GovActionId
forall a. Monoid a => a
mempty
          , rsDelayed :: Bool
rsDelayed = Bool
False
          }
  (RatifyEnv era, RatifyState era)
-> ImpTestM era (RatifyEnv era, RatifyState era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RatifyEnv era
ratifyEnv, RatifyState era
ratifyState)

-- | Checks whether the governance action has enough DRep votes to be accepted in the next
-- epoch. (Note that no other checks except DRep votes are used)
isDRepAccepted ::
  (HasCallStack, ConwayEraGov era, ConwayEraPParams era, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era Bool
isDRepAccepted :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isDRepAccepted GovActionId
gaId = do
  (RatifyEnv era
ratifyEnv, RatifyState era
ratifyState) <- ImpTestM era (RatifyEnv era, RatifyState era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era, RatifyState era)
getRatifyEnvAndState
  GovActionState era
action <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  Bool -> ImpTestM era Bool
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ImpTestM era Bool) -> Bool -> ImpTestM era Bool
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted RatifyEnv era
ratifyEnv RatifyState era
ratifyState GovActionState era
action

isSpoAccepted ::
  (HasCallStack, ConwayEraGov era, ConwayEraPParams era, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era Bool
isSpoAccepted :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isSpoAccepted GovActionId
gaId = do
  (RatifyEnv era
ratifyEnv, RatifyState era
ratifyState) <- ImpTestM era (RatifyEnv era, RatifyState era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era, RatifyState era)
getRatifyEnvAndState
  GovActionState era
action <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  Bool -> ImpTestM era Bool
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ImpTestM era Bool) -> Bool -> ImpTestM era Bool
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted RatifyEnv era
ratifyEnv RatifyState era
ratifyState GovActionState era
action

isCommitteeAccepted ::
  (HasCallStack, ConwayEraGov era, ConwayEraPParams era, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era Bool
isCommitteeAccepted :: forall era.
(HasCallStack, ConwayEraGov era, ConwayEraPParams era,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era Bool
isCommitteeAccepted GovActionId
gaId = do
  (RatifyEnv era
ratifyEnv, RatifyState era
ratifyState) <- ImpTestM era (RatifyEnv era, RatifyState era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era, RatifyState era)
getRatifyEnvAndState
  GovActionState era
action <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  Bool -> ImpTestM era Bool
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ImpTestM era Bool) -> Bool -> ImpTestM era Bool
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv era
ratifyEnv RatifyState era
ratifyState GovActionState era
action

-- | Logs the results of each check required to make the governance action pass
logRatificationChecks ::
  (ConwayEraGov era, ConwayEraPParams era, HasCallStack, ConwayEraCertState era) =>
  GovActionId ->
  ImpTestM era ()
logRatificationChecks :: forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
gaId = do
  gas :: GovActionState era
gas@GovActionState {Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes, Map (Credential 'DRepRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasDRepVotes} <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
gaId
  let govAction :: GovAction era
govAction = GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas
  ens :: EnactState era
ens@EnactState {Map (Credential 'Staking) Coin
StrictMaybe (Committee era)
PParams era
Constitution era
GovRelation StrictMaybe
Coin
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential 'Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensConstitution :: forall era. EnactState era -> Constitution era
ensCurPParams :: forall era. EnactState era -> PParams era
ensPrevPParams :: forall era. EnactState era -> PParams era
ensTreasury :: forall era. EnactState era -> Coin
ensWithdrawals :: forall era. EnactState era -> Map (Credential 'Staking) Coin
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe
..} <- ImpTestM era (EnactState era)
forall era. ConwayEraGov era => ImpTestM era (EnactState era)
getEnactState
  StrictMaybe (Committee era)
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> EpochState era -> Const r (EpochState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  ratEnv :: RatifyEnv era
ratEnv@RatifyEnv {EpochNo
reCurrentEpoch :: forall era. RatifyEnv era -> EpochNo
reCurrentEpoch :: EpochNo
reCurrentEpoch} <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv
  let ratSt :: RatifyState era
ratSt = EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
forall era.
EnactState era
-> Seq (GovActionState era)
-> Set GovActionId
-> Bool
-> RatifyState era
RatifyState EnactState era
ens Seq (GovActionState era)
forall a. Monoid a => a
mempty Set GovActionId
forall a. Monoid a => a
mempty Bool
False
  Coin
curTreasury <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
  EpochNo
currentEpoch <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  ProtVer
pv <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  let
    members :: Map (Credential 'ColdCommitteeRole) EpochNo
members = (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee
    committeeState :: CommitteeState era
committeeState = RatifyEnv era -> CommitteeState era
forall era. RatifyEnv era -> CommitteeState era
reCommitteeState RatifyEnv era
ratEnv
  PParams era
curPParams <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((PParams era -> Const r (PParams era))
    -> GovState era -> Const r (GovState era))
-> (PParams era -> Const r (PParams era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> GovState era -> Const r (GovState era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL
  Doc AnsiStyle -> ImpTestM era ()
forall t. HasCallStack => Doc AnsiStyle -> ImpM t ()
logDoc (Doc AnsiStyle -> ImpTestM era ())
-> Doc AnsiStyle -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Maybe (Doc AnsiStyle) -> [(String, Doc AnsiStyle)] -> Doc AnsiStyle
tableDoc
      (Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just Doc AnsiStyle
"RATIFICATION CHECKS")
      [ (String
"prevActionAsExpected:", Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ GovActionState era -> GovRelation StrictMaybe -> Bool
forall era. GovActionState era -> GovRelation StrictMaybe -> Bool
prevActionAsExpected GovActionState era
gas GovRelation StrictMaybe
ensPrevGovActionIds)
      , (String
"validCommitteeTerm:", Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ GovAction era -> PParams era -> EpochNo -> Bool
forall era.
ConwayEraPParams era =>
GovAction era -> PParams era -> EpochNo -> Bool
validCommitteeTerm GovAction era
govAction PParams era
curPParams EpochNo
currentEpoch)
      , (String
"notDelayed:", Doc AnsiStyle
"??")
      , (String
"withdrawalCanWithdraw:", Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ GovAction era -> Coin -> Bool
forall era. GovAction era -> Coin -> Bool
withdrawalCanWithdraw GovAction era
govAction Coin
curTreasury)
      ,
        ( String
"committeeAccepted:"
        , [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep
            [ Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
committeeAccepted RatifyEnv era
ratEnv RatifyState era
ratSt GovActionState era
gas
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"["
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"To Pass:"
            , Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Rational -> Doc AnsiStyle) -> Rational -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'HotCommitteeRole) Vote
-> CommitteeState era
-> EpochNo
-> Rational
committeeAcceptedRatio Map (Credential 'ColdCommitteeRole) EpochNo
members Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes CommitteeState era
committeeState EpochNo
currentEpoch
            , Item [Doc AnsiStyle]
Doc AnsiStyle
">="
            , StrictMaybe UnitInterval -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (StrictMaybe UnitInterval -> Doc AnsiStyle)
-> StrictMaybe UnitInterval -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ EpochNo
-> RatifyState era
-> CommitteeState era
-> GovAction era
-> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
EpochNo
-> RatifyState era
-> CommitteeState era
-> GovAction era
-> StrictMaybe UnitInterval
votingCommitteeThreshold EpochNo
reCurrentEpoch RatifyState era
ratSt CommitteeState era
committeeState (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"]"
            ]
        )
      ,
        ( String
"spoAccepted:"
        , [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep
            [ Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
spoAccepted RatifyEnv era
ratEnv RatifyState era
ratSt GovActionState era
gas
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"["
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"To Pass:"
            , Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Rational -> Doc AnsiStyle) -> Rational -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> GovActionState era -> ProtVer -> Rational
forall era.
RatifyEnv era -> GovActionState era -> ProtVer -> Rational
spoAcceptedRatio RatifyEnv era
ratEnv GovActionState era
gas ProtVer
pv
            , Item [Doc AnsiStyle]
Doc AnsiStyle
">="
            , StrictMaybe UnitInterval -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (StrictMaybe UnitInterval -> Doc AnsiStyle)
-> StrictMaybe UnitInterval -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyState era -> GovAction era -> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingStakePoolThreshold RatifyState era
ratSt (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"]"
            ]
        )
      ,
        ( String
"dRepAccepted:"
        , [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep
            [ Bool -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Bool -> Doc AnsiStyle) -> Bool -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
forall era.
ConwayEraPParams era =>
RatifyEnv era -> RatifyState era -> GovActionState era -> Bool
dRepAccepted RatifyEnv era
ratEnv RatifyState era
ratSt GovActionState era
gas
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"["
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"To Pass:"
            , Rational -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Rational -> Doc AnsiStyle) -> Rational -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
forall era.
RatifyEnv era
-> Map (Credential 'DRepRole) Vote -> GovAction era -> Rational
dRepAcceptedRatio RatifyEnv era
ratEnv Map (Credential 'DRepRole) Vote
gasDRepVotes (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
            , Item [Doc AnsiStyle]
Doc AnsiStyle
">="
            , StrictMaybe UnitInterval -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (StrictMaybe UnitInterval -> Doc AnsiStyle)
-> StrictMaybe UnitInterval -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ RatifyState era -> GovAction era -> StrictMaybe UnitInterval
forall era.
ConwayEraPParams era =>
RatifyState era -> GovAction era -> StrictMaybe UnitInterval
votingDRepThreshold RatifyState era
ratSt (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
            , Item [Doc AnsiStyle]
Doc AnsiStyle
"]"
            ]
        )
      ]

-- | Submits a transaction that registers a hot key for the given cold key.
-- Returns the hot key hash.
registerCommitteeHotKey ::
  (ShelleyEraImp era, ConwayEraTxCert era) =>
  Credential 'ColdCommitteeRole ->
  ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
coldKey = do
  Credential 'HotCommitteeRole
hotKey NE.:| [] <- ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
-> ImpTestM era (Credential 'HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'HotCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash) (NonEmpty (Credential 'ColdCommitteeRole)
 -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole)))
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a b. (a -> b) -> a -> b
$ Credential 'ColdCommitteeRole
-> NonEmpty (Credential 'ColdCommitteeRole)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'ColdCommitteeRole
coldKey
  Credential 'HotCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'HotCommitteeRole
hotKey

registerCommitteeHotKeys ::
  (ShelleyEraImp era, ConwayEraTxCert era) =>
  -- | Hot Credential generator
  ImpTestM era (Credential 'HotCommitteeRole) ->
  NonEmpty (Credential 'ColdCommitteeRole) ->
  ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
ImpTestM era (Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'ColdCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerCommitteeHotKeys ImpTestM era (Credential 'HotCommitteeRole)
genHotCred NonEmpty (Credential 'ColdCommitteeRole)
coldKeys = do
  NonEmpty
  (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
keys <- NonEmpty (Credential 'ColdCommitteeRole)
-> (Credential 'ColdCommitteeRole
    -> ImpM
         (LedgerSpec era)
         (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole))
-> ImpM
     (LedgerSpec era)
     (NonEmpty
        (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (Credential 'ColdCommitteeRole)
coldKeys (\Credential 'ColdCommitteeRole
coldKey -> (,) Credential 'ColdCommitteeRole
coldKey (Credential 'HotCommitteeRole
 -> (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole))
-> ImpTestM era (Credential 'HotCommitteeRole)
-> ImpM
     (LedgerSpec era)
     (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpTestM era (Credential 'HotCommitteeRole)
genHotCred)
  String -> Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Registering Committee Hot keys" (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList (((Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
 -> TxCert era)
-> [(Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)]
-> [TxCert era]
forall a b. (a -> b) -> [a] -> [b]
map ((Credential 'ColdCommitteeRole
 -> Credential 'HotCommitteeRole -> TxCert era)
-> (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
-> TxCert era
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert) (NonEmpty
  (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
-> [(Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty
  (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
keys))
  NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (Credential 'HotCommitteeRole)
 -> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole)))
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall a b. (a -> b) -> a -> b
$ ((Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
 -> Credential 'HotCommitteeRole)
-> NonEmpty
     (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
-> NonEmpty (Credential 'HotCommitteeRole)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
-> Credential 'HotCommitteeRole
forall a b. (a, b) -> b
snd NonEmpty
  (Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)
keys

-- | Submits a transaction that resigns the cold key. Prior to resignation if there was
-- hot credential authorization for this committee member it will be returned.
resignCommitteeColdKey ::
  (ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
  Credential 'ColdCommitteeRole ->
  StrictMaybe Anchor ->
  ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey :: forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
coldKey StrictMaybe Anchor
anchor = do
  Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeAuthorizations <-
    SimpleGetter
  (NewEpochState era)
  (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era)
   (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
 -> ImpTestM
      era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> SimpleGetter
     (NewEpochState era)
     (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> ImpTestM
     era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
forall a b. (a -> b) -> a -> b
$
      (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL
        ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL
        ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL
        ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
        ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era -> Const r (CommitteeState era))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL
        ((CommitteeState era -> Const r (CommitteeState era))
 -> VState era -> Const r (VState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Const
          r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CommitteeState era -> Const r (CommitteeState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Const
         r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> VState era
-> Const r (VState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> Const
      r (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> Const r (CommitteeState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> f (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> f (CommitteeState era)
csCommitteeCredsL
  String -> Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx era -> ImpTestM era ()
submitTxAnn_ String
"Resigning Committee Cold key" (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
        ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton (Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
coldKey StrictMaybe Anchor
anchor)
  Maybe (Credential 'HotCommitteeRole)
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Credential 'HotCommitteeRole)
 -> ImpTestM era (Maybe (Credential 'HotCommitteeRole)))
-> Maybe (Credential 'HotCommitteeRole)
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall a b. (a -> b) -> a -> b
$ do
    CommitteeHotCredential Credential 'HotCommitteeRole
hotCred <- Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldKey Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
committeAuthorizations
    Credential 'HotCommitteeRole
-> Maybe (Credential 'HotCommitteeRole)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential 'HotCommitteeRole
hotCred

electCommittee ::
  forall era.
  ( HasCallStack
  , ConwayEraImp era
  ) =>
  StrictMaybe (GovPurposeId 'CommitteePurpose) ->
  Credential 'DRepRole ->
  Set.Set (Credential 'ColdCommitteeRole) ->
  Map.Map (Credential 'ColdCommitteeRole) EpochNo ->
  ImpTestM era (GovPurposeId 'CommitteePurpose)
electCommittee :: forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose)
electCommittee StrictMaybe (GovPurposeId 'CommitteePurpose)
prevGovId Credential 'DRepRole
drep Set (Credential 'ColdCommitteeRole)
toRemove Map (Credential 'ColdCommitteeRole) EpochNo
toAdd = String
-> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
-> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Electing committee" (ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
 -> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose))
-> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
-> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
forall a b. (a -> b) -> a -> b
$ do
  let
    committeeAction :: GovAction era
committeeAction =
      StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
        StrictMaybe (GovPurposeId 'CommitteePurpose)
prevGovId
        Set (Credential 'ColdCommitteeRole)
toRemove
        Map (Credential 'ColdCommitteeRole) EpochNo
toAdd
        (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
  GovActionId
gaidCommitteeProp <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
committeeAction
  Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaidCommitteeProp
  GovPurposeId 'CommitteePurpose
-> ImpM (LedgerSpec era) (GovPurposeId 'CommitteePurpose)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId -> GovPurposeId 'CommitteePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
gaidCommitteeProp)

electBasicCommittee ::
  forall era.
  ( HasCallStack
  , ConwayEraImp era
  ) =>
  ImpTestM
    era
    ( Credential 'DRepRole
    , Credential 'HotCommitteeRole
    , GovPurposeId 'CommitteePurpose
    )
electBasicCommittee :: forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
  era
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
   GovPurposeId 'CommitteePurpose)
electBasicCommittee = do
  String -> ImpM (LedgerSpec era) ()
forall t. HasCallStack => String -> ImpM t ()
logString String
"Setting up a DRep"
  (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
  (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000

  String -> ImpM (LedgerSpec era) ()
forall t. HasCallStack => String -> ImpM t ()
logString String
"Registering committee member"
  Credential 'ColdCommitteeRole
coldCommitteeC <- KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  EpochNo
startEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  let
    committeeAction :: GovAction era
committeeAction =
      StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
        StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. StrictMaybe a
SNothing
        Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
        (Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
coldCommitteeC (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
startEpochNo (Word32 -> EpochInterval
EpochInterval Word32
10)))
        (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
  (GovActionId
gaidCommitteeProp NE.:| [GovActionId]
_) <-
    NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
NonEmpty (GovAction era) -> ImpTestM era (NonEmpty GovActionId)
submitGovActions
      [ Item (NonEmpty (GovAction era))
GovAction era
committeeAction
      , StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) EpochNo
forall a. Monoid a => a
mempty (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
10)
      ]
  Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drep) GovActionId
gaidCommitteeProp
  Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaidCommitteeProp
  Nat -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Nat -> ImpTestM era ()
passNEpochs Nat
2
  Set (Credential 'ColdCommitteeRole)
committeeMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
  String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"The committee should be enacted" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
    Set (Credential 'ColdCommitteeRole)
committeeMembers Set (Credential 'ColdCommitteeRole)
-> (Set (Credential 'ColdCommitteeRole) -> Bool)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Credential 'ColdCommitteeRole
coldCommitteeC
  Credential 'HotCommitteeRole
hotCommitteeC <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
coldCommitteeC
  (Credential 'DRepRole, Credential 'HotCommitteeRole,
 GovPurposeId 'CommitteePurpose)
-> ImpTestM
     era
     (Credential 'DRepRole, Credential 'HotCommitteeRole,
      GovPurposeId 'CommitteePurpose)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole
drep, Credential 'HotCommitteeRole
hotCommitteeC, GovActionId -> GovPurposeId 'CommitteePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
gaidCommitteeProp)

logCurPParams ::
  ( EraGov era
  , ToExpr (PParamsHKD Identity era)
  , HasCallStack
  ) =>
  ImpTestM era ()
logCurPParams :: forall era.
(EraGov era, ToExpr (PParamsHKD Identity era), HasCallStack) =>
ImpTestM era ()
logCurPParams = do
  PParams era
pp <- SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (PParams era)
 -> ImpTestM era (PParams era))
-> SimpleGetter (NewEpochState era) (PParams era)
-> ImpTestM era (PParams era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PParams era -> Const r (PParams era))
    -> EpochState era -> Const r (EpochState era))
-> (PParams era -> Const r (PParams era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
  Doc AnsiStyle -> ImpTestM era ()
forall t. HasCallStack => Doc AnsiStyle -> ImpM t ()
logDoc (Doc AnsiStyle -> ImpTestM era ())
-> Doc AnsiStyle -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
      [ Item [Doc AnsiStyle]
Doc AnsiStyle
""
      , Item [Doc AnsiStyle]
Doc AnsiStyle
"----- Current PParams -----"
      , PParams era -> Doc AnsiStyle
forall a. ToExpr a => a -> Doc AnsiStyle
ansiExpr PParams era
pp
      , Item [Doc AnsiStyle]
Doc AnsiStyle
"---------------------------"
      , Item [Doc AnsiStyle]
Doc AnsiStyle
""
      ]

proposalsShowDebug :: Proposals era -> Bool -> Doc AnsiStyle
proposalsShowDebug :: forall era. Proposals era -> Bool -> Doc AnsiStyle
proposalsShowDebug Proposals era
ps Bool
showRoots =
  Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
align (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
    [ Item [Doc AnsiStyle]
Doc AnsiStyle
""
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"----- Proposals -----"
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"Size"
    , Int -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Int -> Doc AnsiStyle) -> Int -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era -> Int
forall era. Proposals era -> Int
proposalsSize Proposals era
ps
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"OMap"
    , StrictSeq GovActionId -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (StrictSeq GovActionId -> Doc AnsiStyle)
-> StrictSeq GovActionId -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era -> StrictSeq GovActionId
forall era. Proposals era -> StrictSeq GovActionId
proposalsIds Proposals era
ps
    , Item [Doc AnsiStyle]
Doc AnsiStyle
""
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"Roots"
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"> PParamUpdate"
    , PRoot (GovPurposeId 'PParamUpdatePurpose) -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (PRoot (GovPurposeId 'PParamUpdatePurpose) -> Doc AnsiStyle)
-> PRoot (GovPurposeId 'PParamUpdatePurpose) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (PRoot (GovPurposeId 'PParamUpdatePurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'PParamUpdatePurpose))
-> PRoot (GovPurposeId 'PParamUpdatePurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (PRoot (GovPurposeId 'PParamUpdatePurpose)) (GovRelation PRoot))
-> Proposals era
-> Const
     (PRoot (GovPurposeId 'PParamUpdatePurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (PRoot (GovPurposeId 'PParamUpdatePurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const
      (PRoot (GovPurposeId 'PParamUpdatePurpose)) (Proposals era))
-> ((PRoot (GovPurposeId 'PParamUpdatePurpose)
     -> Const
          (PRoot (GovPurposeId 'PParamUpdatePurpose))
          (PRoot (GovPurposeId 'PParamUpdatePurpose)))
    -> GovRelation PRoot
    -> Const
         (PRoot (GovPurposeId 'PParamUpdatePurpose)) (GovRelation PRoot))
-> Getting
     (PRoot (GovPurposeId 'PParamUpdatePurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'PParamUpdatePurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'PParamUpdatePurpose)
 -> Const
      (PRoot (GovPurposeId 'PParamUpdatePurpose))
      (PRoot (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PRoot
-> Const
     (PRoot (GovPurposeId 'PParamUpdatePurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"> HardFork"
    , PRoot (GovPurposeId 'HardForkPurpose) -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (PRoot (GovPurposeId 'HardForkPurpose) -> Doc AnsiStyle)
-> PRoot (GovPurposeId 'HardForkPurpose) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (PRoot (GovPurposeId 'HardForkPurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'HardForkPurpose))
-> PRoot (GovPurposeId 'HardForkPurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (PRoot (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
-> Proposals era
-> Const (PRoot (GovPurposeId 'HardForkPurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (PRoot (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const (PRoot (GovPurposeId 'HardForkPurpose)) (Proposals era))
-> ((PRoot (GovPurposeId 'HardForkPurpose)
     -> Const
          (PRoot (GovPurposeId 'HardForkPurpose))
          (PRoot (GovPurposeId 'HardForkPurpose)))
    -> GovRelation PRoot
    -> Const
         (PRoot (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot))
-> Getting
     (PRoot (GovPurposeId 'HardForkPurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'HardForkPurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'HardForkPurpose)
 -> Const
      (PRoot (GovPurposeId 'HardForkPurpose))
      (PRoot (GovPurposeId 'HardForkPurpose)))
-> GovRelation PRoot
-> Const
     (PRoot (GovPurposeId 'HardForkPurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"> Committee"
    , PRoot (GovPurposeId 'CommitteePurpose) -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (PRoot (GovPurposeId 'CommitteePurpose) -> Doc AnsiStyle)
-> PRoot (GovPurposeId 'CommitteePurpose) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (PRoot (GovPurposeId 'CommitteePurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'CommitteePurpose))
-> PRoot (GovPurposeId 'CommitteePurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> Proposals era
-> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era))
-> ((PRoot (GovPurposeId 'CommitteePurpose)
     -> Const
          (PRoot (GovPurposeId 'CommitteePurpose))
          (PRoot (GovPurposeId 'CommitteePurpose)))
    -> GovRelation PRoot
    -> Const
         (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> Getting
     (PRoot (GovPurposeId 'CommitteePurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'CommitteePurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'CommitteePurpose)
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose))
      (PRoot (GovPurposeId 'CommitteePurpose)))
-> GovRelation PRoot
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL
    , Item [Doc AnsiStyle]
Doc AnsiStyle
"> Constitution"
    , PRoot (GovPurposeId 'ConstitutionPurpose) -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (PRoot (GovPurposeId 'ConstitutionPurpose) -> Doc AnsiStyle)
-> PRoot (GovPurposeId 'ConstitutionPurpose) -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (PRoot (GovPurposeId 'ConstitutionPurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'ConstitutionPurpose))
-> PRoot (GovPurposeId 'ConstitutionPurpose)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const
      (PRoot (GovPurposeId 'ConstitutionPurpose)) (GovRelation PRoot))
-> Proposals era
-> Const
     (PRoot (GovPurposeId 'ConstitutionPurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (PRoot (GovPurposeId 'ConstitutionPurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const
      (PRoot (GovPurposeId 'ConstitutionPurpose)) (Proposals era))
-> ((PRoot (GovPurposeId 'ConstitutionPurpose)
     -> Const
          (PRoot (GovPurposeId 'ConstitutionPurpose))
          (PRoot (GovPurposeId 'ConstitutionPurpose)))
    -> GovRelation PRoot
    -> Const
         (PRoot (GovPurposeId 'ConstitutionPurpose)) (GovRelation PRoot))
-> Getting
     (PRoot (GovPurposeId 'ConstitutionPurpose))
     (Proposals era)
     (PRoot (GovPurposeId 'ConstitutionPurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'ConstitutionPurpose)
 -> Const
      (PRoot (GovPurposeId 'ConstitutionPurpose))
      (PRoot (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PRoot
-> Const
     (PRoot (GovPurposeId 'ConstitutionPurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL
    ]
      [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. Semigroup a => a -> a -> a
<> ( if Bool
showRoots
             then
               [ Item [Doc AnsiStyle]
Doc AnsiStyle
"Hierarchy"
               , Item [Doc AnsiStyle]
Doc AnsiStyle
">> PParamUpdate"
               , Map
  (GovPurposeId 'PParamUpdatePurpose)
  (PEdges (GovPurposeId 'PParamUpdatePurpose))
-> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Map
   (GovPurposeId 'PParamUpdatePurpose)
   (PEdges (GovPurposeId 'PParamUpdatePurpose))
 -> Doc AnsiStyle)
-> Map
     (GovPurposeId 'PParamUpdatePurpose)
     (PEdges (GovPurposeId 'PParamUpdatePurpose))
-> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
-> Map
     (GovPurposeId 'PParamUpdatePurpose)
     (PEdges (GovPurposeId 'PParamUpdatePurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'PParamUpdatePurpose)
          (PEdges (GovPurposeId 'PParamUpdatePurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'PParamUpdatePurpose)
       (PEdges (GovPurposeId 'PParamUpdatePurpose))
     -> Const
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose)))
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'PParamUpdatePurpose)
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (PGraph (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL ((PGraph (GovPurposeId 'PParamUpdatePurpose)
  -> Const
       (Map
          (GovPurposeId 'PParamUpdatePurpose)
          (PEdges (GovPurposeId 'PParamUpdatePurpose)))
       (PGraph (GovPurposeId 'PParamUpdatePurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'PParamUpdatePurpose)
       (PEdges (GovPurposeId 'PParamUpdatePurpose))
     -> Const
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose)))
          (Map
             (GovPurposeId 'PParamUpdatePurpose)
             (PEdges (GovPurposeId 'PParamUpdatePurpose))))
    -> PGraph (GovPurposeId 'PParamUpdatePurpose)
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (PGraph (GovPurposeId 'PParamUpdatePurpose)))
-> (Map
      (GovPurposeId 'PParamUpdatePurpose)
      (PEdges (GovPurposeId 'PParamUpdatePurpose))
    -> Const
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose)))
         (Map
            (GovPurposeId 'PParamUpdatePurpose)
            (PEdges (GovPurposeId 'PParamUpdatePurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'PParamUpdatePurpose)
   (PEdges (GovPurposeId 'PParamUpdatePurpose))
 -> Const
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose)))
      (Map
         (GovPurposeId 'PParamUpdatePurpose)
         (PEdges (GovPurposeId 'PParamUpdatePurpose))))
-> PGraph (GovPurposeId 'PParamUpdatePurpose)
-> Const
     (Map
        (GovPurposeId 'PParamUpdatePurpose)
        (PEdges (GovPurposeId 'PParamUpdatePurpose)))
     (PGraph (GovPurposeId 'PParamUpdatePurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL
               , Item [Doc AnsiStyle]
Doc AnsiStyle
">> HardFork"
               , Map
  (GovPurposeId 'HardForkPurpose)
  (PEdges (GovPurposeId 'HardForkPurpose))
-> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Map
   (GovPurposeId 'HardForkPurpose)
   (PEdges (GovPurposeId 'HardForkPurpose))
 -> Doc AnsiStyle)
-> Map
     (GovPurposeId 'HardForkPurpose)
     (PEdges (GovPurposeId 'HardForkPurpose))
-> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
-> Map
     (GovPurposeId 'HardForkPurpose)
     (PEdges (GovPurposeId 'HardForkPurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'HardForkPurpose)
          (PEdges (GovPurposeId 'HardForkPurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'HardForkPurpose)
       (PEdges (GovPurposeId 'HardForkPurpose))
     -> Const
          (Map
             (GovPurposeId 'HardForkPurpose)
             (PEdges (GovPurposeId 'HardForkPurpose)))
          (Map
             (GovPurposeId 'HardForkPurpose)
             (PEdges (GovPurposeId 'HardForkPurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'HardForkPurpose)
            (PEdges (GovPurposeId 'HardForkPurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'HardForkPurpose)
 -> Const
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose)))
      (PGraph (GovPurposeId 'HardForkPurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL ((PGraph (GovPurposeId 'HardForkPurpose)
  -> Const
       (Map
          (GovPurposeId 'HardForkPurpose)
          (PEdges (GovPurposeId 'HardForkPurpose)))
       (PGraph (GovPurposeId 'HardForkPurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'HardForkPurpose)
       (PEdges (GovPurposeId 'HardForkPurpose))
     -> Const
          (Map
             (GovPurposeId 'HardForkPurpose)
             (PEdges (GovPurposeId 'HardForkPurpose)))
          (Map
             (GovPurposeId 'HardForkPurpose)
             (PEdges (GovPurposeId 'HardForkPurpose))))
    -> PGraph (GovPurposeId 'HardForkPurpose)
    -> Const
         (Map
            (GovPurposeId 'HardForkPurpose)
            (PEdges (GovPurposeId 'HardForkPurpose)))
         (PGraph (GovPurposeId 'HardForkPurpose)))
-> (Map
      (GovPurposeId 'HardForkPurpose)
      (PEdges (GovPurposeId 'HardForkPurpose))
    -> Const
         (Map
            (GovPurposeId 'HardForkPurpose)
            (PEdges (GovPurposeId 'HardForkPurpose)))
         (Map
            (GovPurposeId 'HardForkPurpose)
            (PEdges (GovPurposeId 'HardForkPurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'HardForkPurpose)
   (PEdges (GovPurposeId 'HardForkPurpose))
 -> Const
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose)))
      (Map
         (GovPurposeId 'HardForkPurpose)
         (PEdges (GovPurposeId 'HardForkPurpose))))
-> PGraph (GovPurposeId 'HardForkPurpose)
-> Const
     (Map
        (GovPurposeId 'HardForkPurpose)
        (PEdges (GovPurposeId 'HardForkPurpose)))
     (PGraph (GovPurposeId 'HardForkPurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL
               , Item [Doc AnsiStyle]
Doc AnsiStyle
">> Committee"
               , Map
  (GovPurposeId 'CommitteePurpose)
  (PEdges (GovPurposeId 'CommitteePurpose))
-> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Map
   (GovPurposeId 'CommitteePurpose)
   (PEdges (GovPurposeId 'CommitteePurpose))
 -> Doc AnsiStyle)
-> Map
     (GovPurposeId 'CommitteePurpose)
     (PEdges (GovPurposeId 'CommitteePurpose))
-> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
-> Map
     (GovPurposeId 'CommitteePurpose)
     (PEdges (GovPurposeId 'CommitteePurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'CommitteePurpose)
          (PEdges (GovPurposeId 'CommitteePurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'CommitteePurpose)
       (PEdges (GovPurposeId 'CommitteePurpose))
     -> Const
          (Map
             (GovPurposeId 'CommitteePurpose)
             (PEdges (GovPurposeId 'CommitteePurpose)))
          (Map
             (GovPurposeId 'CommitteePurpose)
             (PEdges (GovPurposeId 'CommitteePurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'CommitteePurpose)
            (PEdges (GovPurposeId 'CommitteePurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'CommitteePurpose)
 -> Const
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose)))
      (PGraph (GovPurposeId 'CommitteePurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL ((PGraph (GovPurposeId 'CommitteePurpose)
  -> Const
       (Map
          (GovPurposeId 'CommitteePurpose)
          (PEdges (GovPurposeId 'CommitteePurpose)))
       (PGraph (GovPurposeId 'CommitteePurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'CommitteePurpose)
       (PEdges (GovPurposeId 'CommitteePurpose))
     -> Const
          (Map
             (GovPurposeId 'CommitteePurpose)
             (PEdges (GovPurposeId 'CommitteePurpose)))
          (Map
             (GovPurposeId 'CommitteePurpose)
             (PEdges (GovPurposeId 'CommitteePurpose))))
    -> PGraph (GovPurposeId 'CommitteePurpose)
    -> Const
         (Map
            (GovPurposeId 'CommitteePurpose)
            (PEdges (GovPurposeId 'CommitteePurpose)))
         (PGraph (GovPurposeId 'CommitteePurpose)))
-> (Map
      (GovPurposeId 'CommitteePurpose)
      (PEdges (GovPurposeId 'CommitteePurpose))
    -> Const
         (Map
            (GovPurposeId 'CommitteePurpose)
            (PEdges (GovPurposeId 'CommitteePurpose)))
         (Map
            (GovPurposeId 'CommitteePurpose)
            (PEdges (GovPurposeId 'CommitteePurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'CommitteePurpose)
   (PEdges (GovPurposeId 'CommitteePurpose))
 -> Const
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose)))
      (Map
         (GovPurposeId 'CommitteePurpose)
         (PEdges (GovPurposeId 'CommitteePurpose))))
-> PGraph (GovPurposeId 'CommitteePurpose)
-> Const
     (Map
        (GovPurposeId 'CommitteePurpose)
        (PEdges (GovPurposeId 'CommitteePurpose)))
     (PGraph (GovPurposeId 'CommitteePurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL
               , Item [Doc AnsiStyle]
Doc AnsiStyle
">> Constitution"
               , Map
  (GovPurposeId 'ConstitutionPurpose)
  (PEdges (GovPurposeId 'ConstitutionPurpose))
-> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow (Map
   (GovPurposeId 'ConstitutionPurpose)
   (PEdges (GovPurposeId 'ConstitutionPurpose))
 -> Doc AnsiStyle)
-> Map
     (GovPurposeId 'ConstitutionPurpose)
     (PEdges (GovPurposeId 'ConstitutionPurpose))
-> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
-> Map
     (GovPurposeId 'ConstitutionPurpose)
     (PEdges (GovPurposeId 'ConstitutionPurpose))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map
          (GovPurposeId 'ConstitutionPurpose)
          (PEdges (GovPurposeId 'ConstitutionPurpose)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (Proposals era))
-> ((Map
       (GovPurposeId 'ConstitutionPurpose)
       (PEdges (GovPurposeId 'ConstitutionPurpose))
     -> Const
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose)))
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose))))
    -> GovRelation PGraph
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (GovRelation PGraph))
-> Getting
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (Proposals era)
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId 'ConstitutionPurpose)
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (PGraph (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (GovRelation PGraph)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL ((PGraph (GovPurposeId 'ConstitutionPurpose)
  -> Const
       (Map
          (GovPurposeId 'ConstitutionPurpose)
          (PEdges (GovPurposeId 'ConstitutionPurpose)))
       (PGraph (GovPurposeId 'ConstitutionPurpose)))
 -> GovRelation PGraph
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (GovRelation PGraph))
-> ((Map
       (GovPurposeId 'ConstitutionPurpose)
       (PEdges (GovPurposeId 'ConstitutionPurpose))
     -> Const
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose)))
          (Map
             (GovPurposeId 'ConstitutionPurpose)
             (PEdges (GovPurposeId 'ConstitutionPurpose))))
    -> PGraph (GovPurposeId 'ConstitutionPurpose)
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (PGraph (GovPurposeId 'ConstitutionPurpose)))
-> (Map
      (GovPurposeId 'ConstitutionPurpose)
      (PEdges (GovPurposeId 'ConstitutionPurpose))
    -> Const
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose)))
         (Map
            (GovPurposeId 'ConstitutionPurpose)
            (PEdges (GovPurposeId 'ConstitutionPurpose))))
-> GovRelation PGraph
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   (GovPurposeId 'ConstitutionPurpose)
   (PEdges (GovPurposeId 'ConstitutionPurpose))
 -> Const
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose)))
      (Map
         (GovPurposeId 'ConstitutionPurpose)
         (PEdges (GovPurposeId 'ConstitutionPurpose))))
-> PGraph (GovPurposeId 'ConstitutionPurpose)
-> Const
     (Map
        (GovPurposeId 'ConstitutionPurpose)
        (PEdges (GovPurposeId 'ConstitutionPurpose)))
     (PGraph (GovPurposeId 'ConstitutionPurpose))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL
               ]
             else [Doc AnsiStyle]
forall a. Monoid a => a
mempty
         )
      [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. Semigroup a => a -> a -> a
<> [Item [Doc AnsiStyle]
Doc AnsiStyle
"----- Proposals End -----"]

getProposalsForest ::
  ConwayEraGov era =>
  ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest :: forall era.
ConwayEraGov era =>
ImpTestM era (Forest (StrictMaybe GovActionId))
getProposalsForest = do
  Proposals era
ps <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  Forest (StrictMaybe GovActionId)
-> ImpTestM era (Forest (StrictMaybe GovActionId))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    [ StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (Lens'
  (GovRelation PRoot) (PRoot (GovPurposeId 'PParamUpdatePurpose))
-> Proposals era -> StrictMaybe GovActionId
forall (p :: GovActionPurpose) era.
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
-> Proposals era -> StrictMaybe GovActionId
mkRoot (PRoot (GovPurposeId 'PParamUpdatePurpose)
 -> f (PRoot (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation PRoot -> f (GovRelation PRoot)
Lens'
  (GovRelation PRoot) (PRoot (GovPurposeId 'PParamUpdatePurpose))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL Proposals era
ps) (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> a -> b
$ (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'PParamUpdatePurpose)
  -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era -> Forest (StrictMaybe GovActionId)
forall (p :: GovActionPurpose) era.
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p) -> f (f (GovPurposeId p)))
 -> GovRelation f -> f (GovRelation f))
-> Proposals era -> Forest (StrictMaybe GovActionId)
mkForest (f (GovPurposeId 'PParamUpdatePurpose)
 -> f (f (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f -> f (GovRelation f)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'PParamUpdatePurpose)
 -> f2 (f1 (GovPurposeId 'PParamUpdatePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grPParamUpdateL Proposals era
ps
    , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (Lens' (GovRelation PRoot) (PRoot (GovPurposeId 'HardForkPurpose))
-> Proposals era -> StrictMaybe GovActionId
forall (p :: GovActionPurpose) era.
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
-> Proposals era -> StrictMaybe GovActionId
mkRoot (PRoot (GovPurposeId 'HardForkPurpose)
 -> f (PRoot (GovPurposeId 'HardForkPurpose)))
-> GovRelation PRoot -> f (GovRelation PRoot)
Lens' (GovRelation PRoot) (PRoot (GovPurposeId 'HardForkPurpose))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL Proposals era
ps) (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> a -> b
$ (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'HardForkPurpose)
  -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era -> Forest (StrictMaybe GovActionId)
forall (p :: GovActionPurpose) era.
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p) -> f (f (GovPurposeId p)))
 -> GovRelation f -> f (GovRelation f))
-> Proposals era -> Forest (StrictMaybe GovActionId)
mkForest (f (GovPurposeId 'HardForkPurpose)
 -> f (f (GovPurposeId 'HardForkPurpose)))
-> GovRelation f -> f (GovRelation f)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL Proposals era
ps
    , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (Lens' (GovRelation PRoot) (PRoot (GovPurposeId 'CommitteePurpose))
-> Proposals era -> StrictMaybe GovActionId
forall (p :: GovActionPurpose) era.
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
-> Proposals era -> StrictMaybe GovActionId
mkRoot (PRoot (GovPurposeId 'CommitteePurpose)
 -> f (PRoot (GovPurposeId 'CommitteePurpose)))
-> GovRelation PRoot -> f (GovRelation PRoot)
Lens' (GovRelation PRoot) (PRoot (GovPurposeId 'CommitteePurpose))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL Proposals era
ps) (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> a -> b
$ (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'CommitteePurpose)
  -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era -> Forest (StrictMaybe GovActionId)
forall (p :: GovActionPurpose) era.
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p) -> f (f (GovPurposeId p)))
 -> GovRelation f -> f (GovRelation f))
-> Proposals era -> Forest (StrictMaybe GovActionId)
mkForest (f (GovPurposeId 'CommitteePurpose)
 -> f (f (GovPurposeId 'CommitteePurpose)))
-> GovRelation f -> f (GovRelation f)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL Proposals era
ps
    , StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (Lens'
  (GovRelation PRoot) (PRoot (GovPurposeId 'ConstitutionPurpose))
-> Proposals era -> StrictMaybe GovActionId
forall (p :: GovActionPurpose) era.
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
-> Proposals era -> StrictMaybe GovActionId
mkRoot (PRoot (GovPurposeId 'ConstitutionPurpose)
 -> f (PRoot (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation PRoot -> f (GovRelation PRoot)
Lens'
  (GovRelation PRoot) (PRoot (GovPurposeId 'ConstitutionPurpose))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL Proposals era
ps) (Forest (StrictMaybe GovActionId)
 -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> a -> b
$ (forall (f1 :: * -> *) (f2 :: * -> *).
 Functor f2 =>
 (f1 (GovPurposeId 'ConstitutionPurpose)
  -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
 -> GovRelation f1 -> f2 (GovRelation f1))
-> Proposals era -> Forest (StrictMaybe GovActionId)
forall (p :: GovActionPurpose) era.
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p) -> f (f (GovPurposeId p)))
 -> GovRelation f -> f (GovRelation f))
-> Proposals era -> Forest (StrictMaybe GovActionId)
mkForest (f (GovPurposeId 'ConstitutionPurpose)
 -> f (f (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f -> f (GovRelation f)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'ConstitutionPurpose)
 -> f2 (f1 (GovPurposeId 'ConstitutionPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grConstitutionL Proposals era
ps
    ]
  where
    mkRoot ::
      Lens' (GovRelation PRoot) (PRoot (GovPurposeId p)) ->
      Proposals era ->
      StrictMaybe GovActionId
    mkRoot :: forall (p :: GovActionPurpose) era.
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
-> Proposals era -> StrictMaybe GovActionId
mkRoot Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
rootL Proposals era
ps = (GovPurposeId p -> GovActionId)
-> StrictMaybe (GovPurposeId p) -> StrictMaybe GovActionId
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GovPurposeId p -> GovActionId
forall (p :: GovActionPurpose). GovPurposeId p -> GovActionId
unGovPurposeId (StrictMaybe (GovPurposeId p) -> StrictMaybe GovActionId)
-> StrictMaybe (GovPurposeId p) -> StrictMaybe GovActionId
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (StrictMaybe (GovPurposeId p))
     (Proposals era)
     (StrictMaybe (GovPurposeId p))
-> StrictMaybe (GovPurposeId p)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot))
-> Proposals era
-> Const (StrictMaybe (GovPurposeId p)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot))
 -> Proposals era
 -> Const (StrictMaybe (GovPurposeId p)) (Proposals era))
-> ((StrictMaybe (GovPurposeId p)
     -> Const
          (StrictMaybe (GovPurposeId p)) (StrictMaybe (GovPurposeId p)))
    -> GovRelation PRoot
    -> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot))
-> Getting
     (StrictMaybe (GovPurposeId p))
     (Proposals era)
     (StrictMaybe (GovPurposeId p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId p)
 -> Const (StrictMaybe (GovPurposeId p)) (PRoot (GovPurposeId p)))
-> GovRelation PRoot
-> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot)
Lens' (GovRelation PRoot) (PRoot (GovPurposeId p))
rootL ((PRoot (GovPurposeId p)
  -> Const (StrictMaybe (GovPurposeId p)) (PRoot (GovPurposeId p)))
 -> GovRelation PRoot
 -> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot))
-> ((StrictMaybe (GovPurposeId p)
     -> Const
          (StrictMaybe (GovPurposeId p)) (StrictMaybe (GovPurposeId p)))
    -> PRoot (GovPurposeId p)
    -> Const (StrictMaybe (GovPurposeId p)) (PRoot (GovPurposeId p)))
-> (StrictMaybe (GovPurposeId p)
    -> Const
         (StrictMaybe (GovPurposeId p)) (StrictMaybe (GovPurposeId p)))
-> GovRelation PRoot
-> Const (StrictMaybe (GovPurposeId p)) (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (GovPurposeId p)
 -> Const
      (StrictMaybe (GovPurposeId p)) (StrictMaybe (GovPurposeId p)))
-> PRoot (GovPurposeId p)
-> Const (StrictMaybe (GovPurposeId p)) (PRoot (GovPurposeId p))
forall a (f :: * -> *).
Functor f =>
(StrictMaybe a -> f (StrictMaybe a)) -> PRoot a -> f (PRoot a)
prRootL
    mkForest ::
      (forall f. Lens' (GovRelation f) (f (GovPurposeId p))) ->
      Proposals era ->
      Forest (StrictMaybe GovActionId)
    mkForest :: forall (p :: GovActionPurpose) era.
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p) -> f (f (GovPurposeId p)))
 -> GovRelation f -> f (GovRelation f))
-> Proposals era -> Forest (StrictMaybe GovActionId)
mkForest forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId p) -> f (f (GovPurposeId p)))
-> GovRelation f -> f (GovRelation f)
forestL Proposals era
ps =
      let h :: Map (GovPurposeId p) (PEdges (GovPurposeId p))
h = Proposals era
ps Proposals era
-> Getting
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
     (Proposals era)
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
-> Map (GovPurposeId p) (PEdges (GovPurposeId p))
forall s a. s -> Getting a s a -> a
^. (GovRelation PGraph
 -> Const
      (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
      (GovRelation PGraph))
-> Proposals era
-> Const
     (Map (GovPurposeId p) (PEdges (GovPurposeId p))) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PGraph -> f (GovRelation PGraph))
-> Proposals era -> f (Proposals era)
pGraphL ((GovRelation PGraph
  -> Const
       (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
       (GovRelation PGraph))
 -> Proposals era
 -> Const
      (Map (GovPurposeId p) (PEdges (GovPurposeId p))) (Proposals era))
-> ((Map (GovPurposeId p) (PEdges (GovPurposeId p))
     -> Const
          (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
          (Map (GovPurposeId p) (PEdges (GovPurposeId p))))
    -> GovRelation PGraph
    -> Const
         (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
         (GovRelation PGraph))
-> Getting
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
     (Proposals era)
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGraph (GovPurposeId p)
 -> Const
      (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
      (PGraph (GovPurposeId p)))
-> GovRelation PGraph
-> Const
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
     (GovRelation PGraph)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId p) -> f (f (GovPurposeId p)))
-> GovRelation f -> f (GovRelation f)
forestL ((PGraph (GovPurposeId p)
  -> Const
       (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
       (PGraph (GovPurposeId p)))
 -> GovRelation PGraph
 -> Const
      (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
      (GovRelation PGraph))
-> ((Map (GovPurposeId p) (PEdges (GovPurposeId p))
     -> Const
          (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
          (Map (GovPurposeId p) (PEdges (GovPurposeId p))))
    -> PGraph (GovPurposeId p)
    -> Const
         (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
         (PGraph (GovPurposeId p)))
-> (Map (GovPurposeId p) (PEdges (GovPurposeId p))
    -> Const
         (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
         (Map (GovPurposeId p) (PEdges (GovPurposeId p))))
-> GovRelation PGraph
-> Const
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
     (GovRelation PGraph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (GovPurposeId p) (PEdges (GovPurposeId p))
 -> Const
      (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
      (Map (GovPurposeId p) (PEdges (GovPurposeId p))))
-> PGraph (GovPurposeId p)
-> Const
     (Map (GovPurposeId p) (PEdges (GovPurposeId p)))
     (PGraph (GovPurposeId p))
forall a (f :: * -> *).
Functor f =>
(Map a (PEdges a) -> f (Map a (PEdges a)))
-> PGraph a -> f (PGraph a)
pGraphNodesL
          s :: [GovActionId]
s = StrictSeq GovActionId -> [GovActionId]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq GovActionId -> [GovActionId])
-> StrictSeq GovActionId -> [GovActionId]
forall a b. (a -> b) -> a -> b
$ Proposals era -> StrictSeq GovActionId
forall era. Proposals era -> StrictSeq GovActionId
proposalsIds Proposals era
ps
          getOrderedChildren :: Set (GovPurposeId p) -> [GovActionId]
getOrderedChildren Set (GovPurposeId p)
cs = (GovActionId -> Bool) -> [GovActionId] -> [GovActionId]
forall a. (a -> Bool) -> [a] -> [a]
filter (GovActionId -> Set GovActionId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (GovPurposeId p -> GovActionId)
-> Set (GovPurposeId p) -> Set GovActionId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map GovPurposeId p -> GovActionId
forall (p :: GovActionPurpose). GovPurposeId p -> GovActionId
unGovPurposeId Set (GovPurposeId p)
cs) [GovActionId]
s
          go :: GovActionId -> (StrictMaybe GovActionId, [GovActionId])
go GovActionId
c = (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
c, Set (GovPurposeId p) -> [GovActionId]
getOrderedChildren (Set (GovPurposeId p) -> [GovActionId])
-> Set (GovPurposeId p) -> [GovActionId]
forall a b. (a -> b) -> a -> b
$ Map (GovPurposeId p) (PEdges (GovPurposeId p))
h Map (GovPurposeId p) (PEdges (GovPurposeId p))
-> GovPurposeId p -> PEdges (GovPurposeId p)
forall k a. Ord k => Map k a -> k -> a
Map.! GovActionId -> GovPurposeId p
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
c PEdges (GovPurposeId p)
-> Getting
     (Set (GovPurposeId p))
     (PEdges (GovPurposeId p))
     (Set (GovPurposeId p))
-> Set (GovPurposeId p)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (GovPurposeId p))
  (PEdges (GovPurposeId p))
  (Set (GovPurposeId p))
forall a (f :: * -> *).
Functor f =>
(Set a -> f (Set a)) -> PEdges a -> f (PEdges a)
peChildrenL)
       in (GovActionId -> (StrictMaybe GovActionId, [GovActionId]))
-> [GovActionId] -> Forest (StrictMaybe GovActionId)
forall b a. (b -> (a, [b])) -> [b] -> [Tree a]
unfoldForest GovActionId -> (StrictMaybe GovActionId, [GovActionId])
go (Set (GovPurposeId p) -> [GovActionId]
getOrderedChildren (Set (GovPurposeId p) -> [GovActionId])
-> Set (GovPurposeId p) -> [GovActionId]
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (Set (GovPurposeId p)) (Proposals era) (Set (GovPurposeId p))
-> Set (GovPurposeId p)
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const (Set (GovPurposeId p)) (GovRelation PRoot))
-> Proposals era -> Const (Set (GovPurposeId p)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const (Set (GovPurposeId p)) (GovRelation PRoot))
 -> Proposals era -> Const (Set (GovPurposeId p)) (Proposals era))
-> ((Set (GovPurposeId p)
     -> Const (Set (GovPurposeId p)) (Set (GovPurposeId p)))
    -> GovRelation PRoot
    -> Const (Set (GovPurposeId p)) (GovRelation PRoot))
-> Getting
     (Set (GovPurposeId p)) (Proposals era) (Set (GovPurposeId p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId p)
 -> Const (Set (GovPurposeId p)) (PRoot (GovPurposeId p)))
-> GovRelation PRoot
-> Const (Set (GovPurposeId p)) (GovRelation PRoot)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId p) -> f (f (GovPurposeId p)))
-> GovRelation f -> f (GovRelation f)
forestL ((PRoot (GovPurposeId p)
  -> Const (Set (GovPurposeId p)) (PRoot (GovPurposeId p)))
 -> GovRelation PRoot
 -> Const (Set (GovPurposeId p)) (GovRelation PRoot))
-> ((Set (GovPurposeId p)
     -> Const (Set (GovPurposeId p)) (Set (GovPurposeId p)))
    -> PRoot (GovPurposeId p)
    -> Const (Set (GovPurposeId p)) (PRoot (GovPurposeId p)))
-> (Set (GovPurposeId p)
    -> Const (Set (GovPurposeId p)) (Set (GovPurposeId p)))
-> GovRelation PRoot
-> Const (Set (GovPurposeId p)) (GovRelation PRoot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (GovPurposeId p)
 -> Const (Set (GovPurposeId p)) (Set (GovPurposeId p)))
-> PRoot (GovPurposeId p)
-> Const (Set (GovPurposeId p)) (PRoot (GovPurposeId p))
forall a (f :: * -> *).
Functor f =>
(Set a -> f (Set a)) -> PRoot a -> f (PRoot a)
prChildrenL)

submitGovActionTree ::
  (StrictMaybe GovActionId -> ImpTestM era GovActionId) ->
  StrictMaybe GovActionId ->
  Tree () ->
  ImpTestM era (Tree GovActionId)
submitGovActionTree :: forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Tree ()
-> ImpTestM era (Tree GovActionId)
submitGovActionTree StrictMaybe GovActionId -> ImpTestM era GovActionId
submitAction StrictMaybe GovActionId
p Tree ()
tree =
  (Tree (StrictMaybe GovActionId)
 -> ImpM
      (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId)))
-> Tree (StrictMaybe GovActionId)
-> ImpM (LedgerSpec era) (Tree GovActionId)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> b -> m (Tree a)
unfoldTreeM Tree (StrictMaybe GovActionId)
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
go (Tree (StrictMaybe GovActionId)
 -> ImpM (LedgerSpec era) (Tree GovActionId))
-> Tree (StrictMaybe GovActionId)
-> ImpM (LedgerSpec era) (Tree GovActionId)
forall a b. (a -> b) -> a -> b
$ (() -> StrictMaybe GovActionId)
-> Tree () -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StrictMaybe GovActionId -> () -> StrictMaybe GovActionId
forall a b. a -> b -> a
const StrictMaybe GovActionId
p) Tree ()
tree
  where
    go :: Tree (StrictMaybe GovActionId)
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
go (Node StrictMaybe GovActionId
parent Forest (StrictMaybe GovActionId)
children) = do
      GovActionId
n <- StrictMaybe GovActionId -> ImpTestM era GovActionId
submitAction StrictMaybe GovActionId
parent
      (GovActionId, Forest (StrictMaybe GovActionId))
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId
n, (Tree (StrictMaybe GovActionId) -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Forest (StrictMaybe GovActionId)
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Node StrictMaybe GovActionId
_child Forest (StrictMaybe GovActionId)
subtree) -> StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
n) Forest (StrictMaybe GovActionId)
subtree) Forest (StrictMaybe GovActionId)
children)

submitGovActionForest ::
  (StrictMaybe GovActionId -> ImpTestM era GovActionId) ->
  StrictMaybe GovActionId ->
  Forest () ->
  ImpTestM era (Forest GovActionId)
submitGovActionForest :: forall era.
(StrictMaybe GovActionId -> ImpTestM era GovActionId)
-> StrictMaybe GovActionId
-> Forest ()
-> ImpTestM era (Forest GovActionId)
submitGovActionForest StrictMaybe GovActionId -> ImpTestM era GovActionId
submitAction StrictMaybe GovActionId
p Forest ()
forest =
  (Tree (StrictMaybe GovActionId)
 -> ImpM
      (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId)))
-> Forest (StrictMaybe GovActionId)
-> ImpM (LedgerSpec era) (Forest GovActionId)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM Tree (StrictMaybe GovActionId)
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
go (Forest (StrictMaybe GovActionId)
 -> ImpM (LedgerSpec era) (Forest GovActionId))
-> Forest (StrictMaybe GovActionId)
-> ImpM (LedgerSpec era) (Forest GovActionId)
forall a b. (a -> b) -> a -> b
$ (Tree () -> Tree (StrictMaybe GovActionId))
-> Forest () -> Forest (StrictMaybe GovActionId)
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> StrictMaybe GovActionId)
-> Tree () -> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> StrictMaybe GovActionId)
 -> Tree () -> Tree (StrictMaybe GovActionId))
-> (() -> StrictMaybe GovActionId)
-> Tree ()
-> Tree (StrictMaybe GovActionId)
forall a b. (a -> b) -> a -> b
$ StrictMaybe GovActionId -> () -> StrictMaybe GovActionId
forall a b. a -> b -> a
const StrictMaybe GovActionId
p) Forest ()
forest
  where
    go :: Tree (StrictMaybe GovActionId)
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
go (Node StrictMaybe GovActionId
parent Forest (StrictMaybe GovActionId)
children) = do
      GovActionId
n <- StrictMaybe GovActionId -> ImpTestM era GovActionId
submitAction StrictMaybe GovActionId
parent
      (GovActionId, Forest (StrictMaybe GovActionId))
-> ImpM
     (LedgerSpec era) (GovActionId, Forest (StrictMaybe GovActionId))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionId
n, (Tree (StrictMaybe GovActionId) -> Tree (StrictMaybe GovActionId))
-> Forest (StrictMaybe GovActionId)
-> Forest (StrictMaybe GovActionId)
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Node StrictMaybe GovActionId
_child Forest (StrictMaybe GovActionId)
subtree) -> StrictMaybe GovActionId
-> Forest (StrictMaybe GovActionId)
-> Tree (StrictMaybe GovActionId)
forall a. a -> [Tree a] -> Tree a
Node (GovActionId -> StrictMaybe GovActionId
forall a. a -> StrictMaybe a
SJust GovActionId
n) Forest (StrictMaybe GovActionId)
subtree) Forest (StrictMaybe GovActionId)
children)

enactConstitution ::
  forall era.
  ( ConwayEraImp era
  , HasCallStack
  ) =>
  StrictMaybe (GovPurposeId 'ConstitutionPurpose) ->
  Constitution era ->
  Credential 'DRepRole ->
  NonEmpty (Credential 'HotCommitteeRole) ->
  ImpTestM era GovActionId
enactConstitution :: forall era.
(ConwayEraImp era, HasCallStack) =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Constitution era
-> Credential 'DRepRole
-> NonEmpty (Credential 'HotCommitteeRole)
-> ImpTestM era GovActionId
enactConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId Constitution era
constitution Credential 'DRepRole
dRep NonEmpty (Credential 'HotCommitteeRole)
committeeMembers = String
-> ImpM (LedgerSpec era) GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Enacting constitution" (ImpM (LedgerSpec era) GovActionId
 -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
-> ImpM (LedgerSpec era) GovActionId
forall a b. (a -> b) -> a -> b
$ do
  let action :: GovAction era
action = StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Constitution era -> GovAction era
NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId Constitution era
constitution
  GovActionId
govId <- GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
action
  Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
dRep) GovActionId
govId
  NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpTestM era ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
committeeMembers GovActionId
govId
  GovActionId -> ImpTestM era ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
 ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
govId
  Nat -> ImpTestM era ()
forall era. ShelleyEraImp era => Nat -> ImpTestM era ()
passNEpochs Nat
2
  Constitution era
enactedConstitution <- SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Constitution era)
 -> ImpTestM era (Constitution era))
-> SimpleGetter (NewEpochState era) (Constitution era)
-> ImpTestM era (Constitution era)
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
(ConwayGovState era -> Const r (ConwayGovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era -> Const r (ConwayGovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Constitution era -> Const r (Constitution era))
    -> ConwayGovState era -> Const r (ConwayGovState era))
-> (Constitution era -> Const r (Constitution era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constitution era -> Const r (Constitution era))
-> GovState era -> Const r (GovState era)
(Constitution era -> Const r (Constitution era))
-> ConwayGovState era -> Const r (ConwayGovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
  Constitution era
enactedConstitution Constitution era -> Constitution era -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Constitution era
constitution
  GovActionId -> ImpM (LedgerSpec era) GovActionId
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
govId

expectNumDormantEpochs :: (HasCallStack, ConwayEraCertState era) => EpochNo -> ImpTestM era ()
expectNumDormantEpochs :: forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs EpochNo
expected = do
  EpochNo
nd <-
    SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo)
-> SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall a b. (a -> b) -> a -> b
$
      (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((EpochNo -> Const r EpochNo)
    -> EpochState era -> Const r (EpochState era))
-> (EpochNo -> Const r EpochNo)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((EpochNo -> Const r EpochNo)
    -> LedgerState era -> Const r (LedgerState era))
-> (EpochNo -> Const r EpochNo)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((EpochNo -> Const r EpochNo)
    -> CertState era -> Const r (CertState era))
-> (EpochNo -> Const r EpochNo)
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((EpochNo -> Const r EpochNo)
    -> VState era -> Const r (VState era))
-> (EpochNo -> Const r EpochNo)
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochNo -> Const r EpochNo) -> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL
  EpochNo
nd EpochNo -> EpochNo -> ImpTestM era ()
forall a (m :: * -> *).
(HasCallStack, ToExpr a, Eq a, MonadIO m) =>
a -> a -> m ()
`shouldBeExpr` EpochNo
expected

mkConstitutionProposal ::
  ConwayEraImp era =>
  StrictMaybe (GovPurposeId 'ConstitutionPurpose) ->
  ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal :: forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId = do
  Constitution era
constitution <- ImpM (LedgerSpec era) (Constitution era)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
  (,Constitution era
constitution) (ProposalProcedure era
 -> (ProposalProcedure era, Constitution era))
-> ImpM (LedgerSpec era) (ProposalProcedure era)
-> ImpTestM era (ProposalProcedure era, Constitution era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovAction era -> ImpM (LedgerSpec era) (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Constitution era -> GovAction era
NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId Constitution era
constitution)

submitConstitution ::
  forall era.
  ConwayEraImp era =>
  StrictMaybe (GovPurposeId 'ConstitutionPurpose) ->
  ImpTestM era GovActionId
submitConstitution :: forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era GovActionId
submitConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId = do
  (ProposalProcedure era
proposal, Constitution era
_) <- StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (ProposalProcedure era, Constitution era)
forall era.
ConwayEraImp era =>
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> ImpTestM era (ProposalProcedure era, Constitution era)
mkConstitutionProposal StrictMaybe (GovPurposeId 'ConstitutionPurpose)
prevGovId
  ProposalProcedure era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal

expectDRepNotRegistered ::
  (HasCallStack, ConwayEraCertState era) =>
  Credential 'DRepRole ->
  ImpTestM era ()
expectDRepNotRegistered :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
expectDRepNotRegistered Credential 'DRepRole
drep = do
  Map (Credential 'DRepRole) DRepState
dsMap <- SimpleGetter
  (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const r (Map (Credential 'DRepRole) DRepState))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL)
  Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
drep Map (Credential 'DRepRole) DRepState
dsMap Maybe DRepState -> Maybe DRepState -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Maybe DRepState
forall a. Maybe a
Nothing

isDRepExpired ::
  (HasCallStack, ConwayEraCertState era) =>
  Credential 'DRepRole ->
  ImpTestM era Bool
isDRepExpired :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep = do
  VState era
vState <- SimpleGetter (NewEpochState era) (VState era)
-> ImpTestM era (VState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (VState era)
 -> ImpTestM era (VState era))
-> SimpleGetter (NewEpochState era) (VState era)
-> ImpTestM era (VState era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((VState era -> Const r (VState era))
    -> EpochState era -> Const r (EpochState era))
-> (VState era -> Const r (VState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((VState era -> Const r (VState era))
    -> LedgerState era -> Const r (LedgerState era))
-> (VState era -> Const r (VState era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((VState era -> Const r (VState era))
    -> CertState era -> Const r (CertState era))
-> (VState era -> Const r (VState era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
  EpochNo
currentEpoch <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
  case Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
drep (Map (Credential 'DRepRole) DRepState -> Maybe DRepState)
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall a b. (a -> b) -> a -> b
$ VState era
vState VState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (VState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'DRepRole) DRepState)
  (VState era)
  (Map (Credential 'DRepRole) DRepState)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL of
    Maybe DRepState
Nothing -> String -> ImpTestM era Bool
forall a. HasCallStack => String -> a
error (String -> ImpTestM era Bool) -> String -> ImpTestM era Bool
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
Item [String]
"DRep not found", Credential 'DRepRole -> String
forall a. Show a => a -> String
show Credential 'DRepRole
drep]
    Just DRepState
drep' ->
      Bool -> ImpTestM era Bool
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ImpTestM era Bool) -> Bool -> ImpTestM era Bool
forall a b. (a -> b) -> a -> b
$
        (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) (VState era
vState VState era -> Getting EpochNo (VState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo (VState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL) (DRepState
drep' DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL)
          EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
currentEpoch

expectDRepExpiry ::
  (HasCallStack, ConwayEraCertState era) =>
  Credential 'DRepRole ->
  EpochNo ->
  ImpTestM era ()
expectDRepExpiry :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep EpochNo
expected = do
  Map (Credential 'DRepRole) DRepState
dsMap <- SimpleGetter
  (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
   (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
 -> ImpTestM era (Map (Credential 'DRepRole) DRepState))
-> SimpleGetter
     (NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> LedgerState era -> Const r (LedgerState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> CertState era -> Const r (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const r (VState era))
 -> CertState era -> Const r (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const r (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Const r (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Const r (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const r (Map (Credential 'DRepRole) DRepState))
-> VState era -> Const r (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
  let ds :: DRepState
ds = Maybe DRepState -> DRepState
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DRepState -> DRepState) -> Maybe DRepState -> DRepState
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
drep Map (Credential 'DRepRole) DRepState
dsMap
  DRepState -> EpochNo
drepExpiry DRepState
ds EpochNo -> EpochNo -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo
expected

expectActualDRepExpiry ::
  (HasCallStack, ConwayEraCertState era) =>
  Credential 'DRepRole ->
  EpochNo ->
  ImpTestM era ()
expectActualDRepExpiry :: forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep EpochNo
expected = do
  VState era
vState <- SimpleGetter (NewEpochState era) (VState era)
-> ImpTestM era (VState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (VState era)
 -> ImpTestM era (VState era))
-> SimpleGetter (NewEpochState era) (VState era)
-> ImpTestM era (VState era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((VState era -> Const r (VState era))
    -> EpochState era -> Const r (EpochState era))
-> (VState era -> Const r (VState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((VState era -> Const r (VState era))
    -> LedgerState era -> Const r (LedgerState era))
-> (VState era -> Const r (VState era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((VState era -> Const r (VState era))
    -> CertState era -> Const r (CertState era))
-> (VState era -> Const r (VState era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const r (VState era))
-> CertState era -> Const r (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
  let actualDRepExpiry :: EpochNo
actualDRepExpiry = Maybe EpochNo -> EpochNo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe EpochNo -> EpochNo) -> Maybe EpochNo -> EpochNo
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> VState era -> Maybe EpochNo
forall era. Credential 'DRepRole -> VState era -> Maybe EpochNo
vsActualDRepExpiry Credential 'DRepRole
drep VState era
vState
  EpochNo
actualDRepExpiry EpochNo -> EpochNo -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo
expected

currentProposalsShouldContain ::
  ( HasCallStack
  , ConwayEraGov era
  ) =>
  GovActionId ->
  ImpTestM era ()
currentProposalsShouldContain :: forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era ()
currentProposalsShouldContain GovActionId
gai =
  ImpTestM era (StrictSeq GovActionId)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
currentProposalIds ImpTestM era (StrictSeq GovActionId)
-> (StrictSeq GovActionId -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([GovActionId] -> [GovActionId] -> ImpM (LedgerSpec era) ())
-> [GovActionId] -> [GovActionId] -> ImpM (LedgerSpec era) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [GovActionId] -> [GovActionId] -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
[a] -> [a] -> m ()
shouldContain [Item [GovActionId]
GovActionId
gai] ([GovActionId] -> ImpM (LedgerSpec era) ())
-> (StrictSeq GovActionId -> [GovActionId])
-> StrictSeq GovActionId
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq GovActionId -> [GovActionId]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

expectCurrentProposals :: (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectCurrentProposals :: forall era. (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectCurrentProposals = do
  StrictSeq GovActionId
props <- ImpTestM era (StrictSeq GovActionId)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
currentProposalIds
  String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Expected proposals in current gov state" (Bool -> Bool
not (StrictSeq GovActionId -> Bool
forall a. StrictSeq a -> Bool
SSeq.null StrictSeq GovActionId
props))

expectNoCurrentProposals :: (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals :: forall era. (HasCallStack, ConwayEraImp era) => ImpTestM era ()
expectNoCurrentProposals = do
  Proposals era
proposals <- ImpTestM era (Proposals era)
forall era. ConwayEraGov era => ImpTestM era (Proposals era)
getProposals
  case Proposals era -> StrictSeq (GovActionState era)
forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions Proposals era
proposals of
    StrictSeq (GovActionState era)
Empty -> () -> ImpTestM era ()
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    StrictSeq (GovActionState era)
xs -> String -> ImpTestM era ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure (String -> ImpTestM era ()) -> String -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ String
"Expected no active proposals, but got:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Expr -> String
forall a. Show a => a -> String
show (StrictSeq (GovActionState era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (GovActionState era)
xs)

expectPulserProposals :: (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectPulserProposals :: forall era. (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectPulserProposals = do
  StrictSeq GovActionId
props <- ImpTestM era (StrictSeq GovActionId)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
lastEpochProposals
  String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Expected proposals in the pulser" (Bool -> Bool
not (StrictSeq GovActionId -> Bool
forall a. StrictSeq a -> Bool
SSeq.null StrictSeq GovActionId
props))

expectNoPulserProposals :: (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectNoPulserProposals :: forall era. (HasCallStack, ConwayEraGov era) => ImpTestM era ()
expectNoPulserProposals = do
  StrictSeq GovActionId
props <- ImpTestM era (StrictSeq GovActionId)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
lastEpochProposals
  String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
"Expected no proposals in the pulser" (StrictSeq GovActionId -> Bool
forall a. StrictSeq a -> Bool
SSeq.null StrictSeq GovActionId
props)

currentProposalIds ::
  ConwayEraGov era => ImpTestM era (SSeq.StrictSeq GovActionId)
currentProposalIds :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
currentProposalIds = Proposals era -> StrictSeq GovActionId
forall era. Proposals era -> StrictSeq GovActionId
proposalsIds (Proposals era -> StrictSeq GovActionId)
-> ImpM (LedgerSpec era) (Proposals era)
-> ImpM (LedgerSpec era) (StrictSeq GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleGetter (NewEpochState era) (Proposals era)
-> ImpM (LedgerSpec era) (Proposals era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES ((GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Const r (GovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((Proposals era -> Const r (Proposals era))
    -> GovState era -> Const r (GovState era))
-> (Proposals era -> Const r (Proposals era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Const r (Proposals era))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL)

lastEpochProposals ::
  forall era.
  ConwayEraGov era =>
  ImpTestM era (SSeq.StrictSeq GovActionId)
lastEpochProposals :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictSeq GovActionId)
lastEpochProposals =
  (GovActionState era -> GovActionId)
-> StrictSeq (GovActionState era) -> StrictSeq GovActionId
forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. GovActionState era -> GovActionId
gasId @era) (StrictSeq (GovActionState era) -> StrictSeq GovActionId)
-> (PulsingSnapshot era -> StrictSeq (GovActionState era))
-> PulsingSnapshot era
-> StrictSeq GovActionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingSnapshot era -> StrictSeq (GovActionState era)
forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
psProposals
    (PulsingSnapshot era -> StrictSeq GovActionId)
-> ImpM (LedgerSpec era) (PulsingSnapshot era)
-> ImpM (LedgerSpec era) (StrictSeq GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleGetter (NewEpochState era) (PulsingSnapshot era)
-> ImpM (LedgerSpec era) (PulsingSnapshot era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES
      ( (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL
          ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PulsingSnapshot era -> Const r (PulsingSnapshot era))
    -> EpochState era -> Const r (EpochState era))
-> (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL
          ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((PulsingSnapshot era -> Const r (PulsingSnapshot era))
    -> LedgerState era -> Const r (LedgerState era))
-> (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Const r (UTxOState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL
          ((UTxOState era -> Const r (UTxOState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((PulsingSnapshot era -> Const r (PulsingSnapshot era))
    -> UTxOState era -> Const r (UTxOState era))
-> (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> UTxOState era -> Const r (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL
          ((GovState era -> Const r (GovState era))
 -> UTxOState era -> Const r (UTxOState era))
-> ((PulsingSnapshot era -> Const r (PulsingSnapshot era))
    -> GovState era -> Const r (GovState era))
-> (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> UTxOState era
-> Const r (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> Const r (DRepPulsingState era))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL
          ((DRepPulsingState era -> Const r (DRepPulsingState era))
 -> GovState era -> Const r (GovState era))
-> ((PulsingSnapshot era -> Const r (PulsingSnapshot era))
    -> DRepPulsingState era -> Const r (DRepPulsingState era))
-> (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> GovState era
-> Const r (GovState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PulsingSnapshot era -> Const r (PulsingSnapshot era))
-> DRepPulsingState era -> Const r (DRepPulsingState era)
forall era.
EraStake era =>
Lens' (DRepPulsingState era) (PulsingSnapshot era)
Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingStateSnapshotL
      )

pulsingStateSnapshotL :: EraStake era => Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingStateSnapshotL :: forall era.
EraStake era =>
Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingStateSnapshotL = (DRepPulsingState era -> PulsingSnapshot era)
-> (DRepPulsingState era
    -> PulsingSnapshot era -> DRepPulsingState era)
-> Lens
     (DRepPulsingState era)
     (DRepPulsingState era)
     (PulsingSnapshot era)
     (PulsingSnapshot era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DRepPulsingState era -> PulsingSnapshot era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraStake era) =>
DRepPulsingState era -> PulsingSnapshot era
getter DRepPulsingState era -> PulsingSnapshot era -> DRepPulsingState era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraStake era) =>
DRepPulsingState era -> PulsingSnapshot era -> DRepPulsingState era
setter
  where
    getter :: DRepPulsingState era -> PulsingSnapshot era
getter (DRComplete PulsingSnapshot era
x RatifyState era
_) = PulsingSnapshot era
x
    getter DRepPulsingState era
state = (PulsingSnapshot era, RatifyState era) -> PulsingSnapshot era
forall a b. (a, b) -> a
fst (DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
state)
    setter :: DRepPulsingState era -> PulsingSnapshot era -> DRepPulsingState era
setter (DRComplete PulsingSnapshot era
_ RatifyState era
y) PulsingSnapshot era
snap = PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snap RatifyState era
y
    setter DRepPulsingState era
state PulsingSnapshot era
snap = PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snap (RatifyState era -> DRepPulsingState era)
-> RatifyState era -> DRepPulsingState era
forall a b. (a -> b) -> a -> b
$ (PulsingSnapshot era, RatifyState era) -> RatifyState era
forall a b. (a, b) -> b
snd ((PulsingSnapshot era, RatifyState era) -> RatifyState era)
-> (PulsingSnapshot era, RatifyState era) -> RatifyState era
forall a b. (a -> b) -> a -> b
$ DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
state

whenBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
whenBootstrap :: forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenBootstrap = forall (v :: Nat) era.
(EraGov era, KnownNat v, 0 <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersion @9

whenPostBootstrap :: EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap :: forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap = forall (v :: Nat) era.
(EraGov era, KnownNat v, 0 <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtLeast @10

ifBootstrap :: EraGov era => ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap :: forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap ImpTestM era a
inBootstrap ImpTestM era a
outOfBootstrap = do
  ProtVer
pv <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
  if ProtVer -> Bool
HardForks.bootstrapPhase ProtVer
pv then ImpTestM era a
inBootstrap else ImpTestM era a
outOfBootstrap

submitYesVoteCCs_ ::
  forall era f.
  (ConwayEraImp era, Foldable f) =>
  f (Credential 'HotCommitteeRole) ->
  GovActionId ->
  ImpTestM era ()
submitYesVoteCCs_ :: forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ f (Credential 'HotCommitteeRole)
committeeMembers GovActionId
govId =
  (Credential 'HotCommitteeRole -> ImpM (LedgerSpec era) ())
-> f (Credential 'HotCommitteeRole) -> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Credential 'HotCommitteeRole
c -> Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
c) GovActionId
govId) f (Credential 'HotCommitteeRole)
committeeMembers

mkUpdateCommitteeProposal ::
  ConwayEraImp era =>
  -- | Set the parent. When Nothing is supplied latest parent will be used.
  Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose)) ->
  -- | CC members to remove
  Set.Set (Credential 'ColdCommitteeRole) ->
  -- | CC members to add
  [(Credential 'ColdCommitteeRole, EpochInterval)] ->
  UnitInterval ->
  ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal :: forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
mParent Set (Credential 'ColdCommitteeRole)
ccsToRemove [(Credential 'ColdCommitteeRole, EpochInterval)]
ccsToAdd UnitInterval
threshold = do
  NewEpochState era
nes <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
  let
    curEpochNo :: EpochNo
curEpochNo = NewEpochState era
nes NewEpochState era
-> Getting EpochNo (NewEpochState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
    rootCommittee :: PRoot (GovPurposeId 'CommitteePurpose)
rootCommittee = NewEpochState era
nes NewEpochState era
-> Getting
     (PRoot (GovPurposeId 'CommitteePurpose))
     (NewEpochState era)
     (PRoot (GovPurposeId 'CommitteePurpose))
-> PRoot (GovPurposeId 'CommitteePurpose)
forall s a. s -> Getting a s a -> a
^. (GovState era
 -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (GovState era))
-> NewEpochState era
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (NewEpochState era)
(ConwayGovState era
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era))
-> NewEpochState era
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((ConwayGovState era
  -> Const
       (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era))
 -> NewEpochState era
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose)) (NewEpochState era))
-> ((PRoot (GovPurposeId 'CommitteePurpose)
     -> Const
          (PRoot (GovPurposeId 'CommitteePurpose))
          (PRoot (GovPurposeId 'CommitteePurpose)))
    -> ConwayGovState era
    -> Const
         (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era))
-> Getting
     (PRoot (GovPurposeId 'CommitteePurpose))
     (NewEpochState era)
     (PRoot (GovPurposeId 'CommitteePurpose))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era
 -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era))
-> ConwayGovState era
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL ((Proposals era
  -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era))
 -> ConwayGovState era
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era))
-> ((PRoot (GovPurposeId 'CommitteePurpose)
     -> Const
          (PRoot (GovPurposeId 'CommitteePurpose))
          (PRoot (GovPurposeId 'CommitteePurpose)))
    -> Proposals era
    -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era))
-> (PRoot (GovPurposeId 'CommitteePurpose)
    -> Const
         (PRoot (GovPurposeId 'CommitteePurpose))
         (PRoot (GovPurposeId 'CommitteePurpose)))
-> ConwayGovState era
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (ConwayGovState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovRelation PRoot
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> Proposals era
-> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const
       (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
 -> Proposals era
 -> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era))
-> ((PRoot (GovPurposeId 'CommitteePurpose)
     -> Const
          (PRoot (GovPurposeId 'CommitteePurpose))
          (PRoot (GovPurposeId 'CommitteePurpose)))
    -> GovRelation PRoot
    -> Const
         (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot))
-> (PRoot (GovPurposeId 'CommitteePurpose)
    -> Const
         (PRoot (GovPurposeId 'CommitteePurpose))
         (PRoot (GovPurposeId 'CommitteePurpose)))
-> Proposals era
-> Const (PRoot (GovPurposeId 'CommitteePurpose)) (Proposals era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PRoot (GovPurposeId 'CommitteePurpose)
 -> Const
      (PRoot (GovPurposeId 'CommitteePurpose))
      (PRoot (GovPurposeId 'CommitteePurpose)))
-> GovRelation PRoot
-> Const
     (PRoot (GovPurposeId 'CommitteePurpose)) (GovRelation PRoot)
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'CommitteePurpose)
 -> f2 (f1 (GovPurposeId 'CommitteePurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grCommitteeL
    parent :: StrictMaybe (GovPurposeId 'CommitteePurpose)
parent = StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. a -> Maybe a -> a
fromMaybe (PRoot (GovPurposeId 'CommitteePurpose)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. PRoot a -> StrictMaybe a
prRoot PRoot (GovPurposeId 'CommitteePurpose)
rootCommittee) Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
mParent
    newCommitteMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers =
      [(Credential 'ColdCommitteeRole, EpochNo)]
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'ColdCommitteeRole
cc, EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo EpochInterval
lifetime) | (Credential 'ColdCommitteeRole
cc, EpochInterval
lifetime) <- [(Credential 'ColdCommitteeRole, EpochInterval)]
ccsToAdd]
  GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
(ShelleyEraImp era, ConwayEraTxBody era) =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal (GovAction era -> ImpTestM era (ProposalProcedure era))
-> GovAction era -> ImpTestM era (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose)
parent Set (Credential 'ColdCommitteeRole)
ccsToRemove Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteMembers UnitInterval
threshold

submitUpdateCommittee ::
  ConwayEraImp era =>
  -- | Set the parent. When Nothing is supplied latest parent will be used.
  Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose)) ->
  -- | CC members to remove
  Set.Set (Credential 'ColdCommitteeRole) ->
  -- | CC members to add
  [(Credential 'ColdCommitteeRole, EpochInterval)] ->
  UnitInterval ->
  ImpTestM era GovActionId
submitUpdateCommittee :: forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era GovActionId
submitUpdateCommittee Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
mParent Set (Credential 'ColdCommitteeRole)
ccsToRemove [(Credential 'ColdCommitteeRole, EpochInterval)]
ccsToAdd UnitInterval
threshold =
  Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose))
mParent Set (Credential 'ColdCommitteeRole)
ccsToRemove [(Credential 'ColdCommitteeRole, EpochInterval)]
ccsToAdd UnitInterval
threshold ImpTestM era (ProposalProcedure era)
-> (ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId)
-> ImpM (LedgerSpec era) GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal

expectCommitteeMemberPresence ::
  (HasCallStack, ConwayEraGov era) => Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberPresence :: forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberPresence Credential 'ColdCommitteeRole
cc = do
  SJust Committee era
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Const r (GovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool (String
"Expected Committee Member: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Credential 'ColdCommitteeRole -> String
forall a. Show a => a -> String
show Credential 'ColdCommitteeRole
cc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be present in the committee") (Bool -> ImpTestM era ()) -> Bool -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole
cc (Committee era
committee Committee era
-> Getting
     (Map (Credential 'ColdCommitteeRole) EpochNo)
     (Committee era)
     (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'ColdCommitteeRole) EpochNo)
  (Committee era)
  (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) EpochNo
 -> f (Map (Credential 'ColdCommitteeRole) EpochNo))
-> Committee era -> f (Committee era)
committeeMembersL)

expectCommitteeMemberAbsence ::
  (HasCallStack, ConwayEraGov era) => Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence :: forall era.
(HasCallStack, ConwayEraGov era) =>
Credential 'ColdCommitteeRole -> ImpTestM era ()
expectCommitteeMemberAbsence Credential 'ColdCommitteeRole
cc = do
  SJust Committee era
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Const r (GovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  String -> Bool -> ImpTestM era ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool (String
"Expected Committee Member: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Credential 'ColdCommitteeRole -> String
forall a. Show a => a -> String
show Credential 'ColdCommitteeRole
cc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be absent from the committee") (Bool -> ImpTestM era ()) -> Bool -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'ColdCommitteeRole
cc (Committee era
committee Committee era
-> Getting
     (Map (Credential 'ColdCommitteeRole) EpochNo)
     (Committee era)
     (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'ColdCommitteeRole) EpochNo)
  (Committee era)
  (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) EpochNo
 -> f (Map (Credential 'ColdCommitteeRole) EpochNo))
-> Committee era -> f (Committee era)
committeeMembersL)

donateToTreasury :: ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury :: forall era. ConwayEraImp era => Coin -> ImpTestM era ()
donateToTreasury Coin
amount =
  String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (String
"Donation to treasury in the amount of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show Coin
amount) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
    Coin
treasuryStart <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
    Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era)
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL ((Coin -> Identity Coin) -> TxBody era -> Identity (TxBody era))
-> Coin -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
amount)
    Coin
treasuryEndEpoch0 <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
    -- Actual donation happens on the epoch boundary
    Coin
treasuryStart Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
treasuryEndEpoch0
    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
    Coin
treasuryEndEpoch1 <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (Coin -> Const r Coin)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) Coin
Lens' (NewEpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
    Coin
treasuryEndEpoch1 Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
treasuryStart Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Coin
amount

expectMembers ::
  (HasCallStack, ConwayEraGov era) =>
  Set.Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers :: forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers Set (Credential 'ColdCommitteeRole)
expKhs = do
  StrictMaybe (Committee era)
committee <- SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const r (GovState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> Const r (GovState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
  let members :: Set (Credential 'ColdCommitteeRole)
members = Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall k a. Map k a -> Set k
Map.keysSet (Map (Credential 'ColdCommitteeRole) EpochNo
 -> Set (Credential 'ColdCommitteeRole))
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall a b. (a -> b) -> a -> b
$ (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee
  String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Expecting committee members" (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
members Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Set (Credential 'ColdCommitteeRole)
expKhs

showConwayTxBalance ::
  ( EraUTxO era
  , ConwayEraTxBody era
  , Tx era ~ AlonzoTx era
  , ConwayEraCertState era
  ) =>
  PParams era ->
  CertState era ->
  UTxO era ->
  AlonzoTx era ->
  String
showConwayTxBalance :: forall era.
(EraUTxO era, ConwayEraTxBody era, Tx era ~ AlonzoTx era,
 ConwayEraCertState era) =>
PParams era -> CertState era -> UTxO era -> AlonzoTx era -> String
showConwayTxBalance PParams era
pp CertState era
certState UTxO era
utxo AlonzoTx era
tx =
  [String] -> String
unlines
    [ String
Item [String]
"Consumed:"
    , String
"\tInputs:     \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show (Value era -> Coin
forall t. Val t => t -> Coin
coin Value era
inputs)
    , String
"\tRefunds:    \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show Coin
refunds
    , String
"\tWithdrawals \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show Coin
withdrawals
    , String
"\tTotal:      \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Coin -> String
forall a. Show a => a -> String
show (Coin -> String) -> (Value era -> Coin) -> Value era -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value era -> Coin
forall t. Val t => t -> Coin
coin (Value era -> String) -> Value era -> String
forall a b. (a -> b) -> a -> b
$ PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
forall era.
EraUTxO era =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
consumed PParams era
pp CertState era
certState UTxO era
utxo TxBody era
txBody)
    , String
Item [String]
""
    , String
Item [String]
"Produced:"
    , String
"\tOutputs:   \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show (Value era -> Coin
forall t. Val t => t -> Coin
coin (Value era -> Coin) -> Value era -> Coin
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxOut era) -> Value era
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Value era
sumAllValue (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL))
    , String
"\tDonations: \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show (TxBody era
txBody TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL)
    , String
"\tDeposits:  \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show (PParams era -> (KeyHash 'StakePool -> Bool) -> TxBody era -> Coin
forall era.
EraTxBody era =>
PParams era -> (KeyHash 'StakePool -> Bool) -> TxBody era -> Coin
getTotalDepositsTxBody PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolId TxBody era
txBody)
    , String
"\tFees:      \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Coin -> String
forall a. Show a => a -> String
show (TxBody era
txBody TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL)
    , String
"\tTotal:     \t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Coin -> String
forall a. Show a => a -> String
show (Coin -> String) -> (Value era -> Coin) -> Value era -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value era -> Coin
forall t. Val t => t -> Coin
coin (Value era -> String) -> Value era -> String
forall a b. (a -> b) -> a -> b
$ PParams era -> CertState era -> TxBody era -> Value era
forall era.
(EraUTxO era, EraCertState era) =>
PParams era -> CertState era -> TxBody era -> Value era
produced PParams era
pp CertState era
certState TxBody era
txBody)
    ]
  where
    txBody :: TxBody era
txBody = AlonzoTx era
tx AlonzoTx era
-> Getting (TxBody era) (AlonzoTx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (TxBody era) (TxBody era))
-> Tx era -> Const (TxBody era) (Tx era)
Getting (TxBody era) (AlonzoTx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
    inputs :: Value era
inputs = UTxO era -> Value era
forall era. EraTxOut era => UTxO era -> Value era
sumUTxO (UTxO era -> Set TxIn -> UTxO era
forall era. UTxO era -> Set TxIn -> UTxO era
txInsFilter UTxO era
utxo (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL))
    refunds :: Coin
refunds =
      PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> TxBody era
-> Coin
forall era.
EraTxBody era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> TxBody era
-> Coin
getTotalRefundsTxBody
        PParams era
pp
        (DState era -> Credential 'Staking -> Maybe Coin
forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState (DState era -> Credential 'Staking -> Maybe Coin)
-> DState era -> Credential 'Staking -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL)
        (VState era -> Credential 'DRepRole -> Maybe Coin
forall era. VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState (VState era -> Credential 'DRepRole -> Maybe Coin)
-> VState era -> Credential 'DRepRole -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ CertState era
certState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL)
        TxBody era
txBody
    isRegPoolId :: KeyHash 'StakePool -> Bool
isRegPoolId = (KeyHash 'StakePool -> Map (KeyHash 'StakePool) PoolParams -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` (CertState era
certState CertState era
-> Getting
     (Map (KeyHash 'StakePool) PoolParams)
     (CertState era)
     (Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s a. s -> Getting a s a -> a
^. (PState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> CertState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era
  -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
 -> CertState era
 -> Const (Map (KeyHash 'StakePool) PoolParams) (CertState era))
-> ((Map (KeyHash 'StakePool) PoolParams
     -> Const
          (Map (KeyHash 'StakePool) PoolParams)
          (Map (KeyHash 'StakePool) PoolParams))
    -> PState era
    -> Const (Map (KeyHash 'StakePool) PoolParams) (PState era))
-> Getting
     (Map (KeyHash 'StakePool) PoolParams)
     (CertState era)
     (Map (KeyHash 'StakePool) PoolParams)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) PoolParams
 -> Const
      (Map (KeyHash 'StakePool) PoolParams)
      (Map (KeyHash 'StakePool) PoolParams))
-> PState era
-> Const (Map (KeyHash 'StakePool) PoolParams) (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) PoolParams
 -> f (Map (KeyHash 'StakePool) PoolParams))
-> PState era -> f (PState era)
psStakePoolParamsL))
    withdrawals :: Coin
withdrawals = Map RewardAccount Coin -> Coin
forall m. Monoid m => Map RewardAccount m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map RewardAccount Coin -> Coin)
-> (Withdrawals -> Map RewardAccount Coin) -> Withdrawals -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals (Withdrawals -> Coin) -> Withdrawals -> Coin
forall a b. (a -> b) -> a -> b
$ TxBody era
txBody TxBody era
-> Getting Withdrawals (TxBody era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody era) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL

logConwayTxBalance ::
  ( EraUTxO era
  , EraGov era
  , ConwayEraTxBody era
  , Tx era ~ AlonzoTx era
  , ConwayEraCertState era
  ) =>
  AlonzoTx era ->
  ImpTestM era ()
logConwayTxBalance :: forall era.
(EraUTxO era, EraGov era, ConwayEraTxBody era,
 Tx era ~ AlonzoTx era, ConwayEraCertState era) =>
AlonzoTx era -> ImpTestM era ()
logConwayTxBalance AlonzoTx era
tx = do
  PParams era
pp <- Lens' (PParams era) (PParams era) -> ImpTestM era (PParams era)
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PParams era -> f (PParams era)) -> PParams era -> f (PParams era)
forall a. a -> a
Lens' (PParams era) (PParams era)
id
  CertState era
certState <- SimpleGetter (NewEpochState era) (CertState era)
-> ImpTestM era (CertState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (CertState era)
 -> ImpTestM era (CertState era))
-> SimpleGetter (NewEpochState era) (CertState era)
-> ImpTestM era (CertState era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((CertState era -> Const r (CertState era))
    -> EpochState era -> Const r (EpochState era))
-> (CertState era -> Const r (CertState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((CertState era -> Const r (CertState era))
    -> LedgerState era -> Const r (LedgerState era))
-> (CertState era -> Const r (CertState era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL
  UTxO era
utxo <- SimpleGetter (NewEpochState era) (UTxO era)
-> ImpTestM era (UTxO era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (UTxO era -> Const r (UTxO era))
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) (UTxO era)
forall era. Lens' (NewEpochState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
utxoL
  String -> ImpTestM era ()
forall t. HasCallStack => String -> ImpM t ()
logString (String -> ImpTestM era ()) -> String -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ PParams era -> CertState era -> UTxO era -> AlonzoTx era -> String
forall era.
(EraUTxO era, ConwayEraTxBody era, Tx era ~ AlonzoTx era,
 ConwayEraCertState era) =>
PParams era -> CertState era -> UTxO era -> AlonzoTx era -> String
showConwayTxBalance PParams era
pp CertState era
certState UTxO era
utxo AlonzoTx era
tx

submitBootstrapAwareFailingVote ::
  ConwayEraImp era =>
  Vote ->
  Voter ->
  GovActionId ->
  SubmitFailureExpectation era ->
  ImpTestM era ()
submitBootstrapAwareFailingVote :: forall era.
ConwayEraImp era =>
Vote
-> Voter
-> GovActionId
-> SubmitFailureExpectation era
-> ImpTestM era ()
submitBootstrapAwareFailingVote Vote
vote Voter
voter GovActionId
gaId =
  ImpTestM era ()
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpTestM era ())
-> SubmitFailureExpectation era
-> ImpTestM era ()
forall era a.
EraGov era =>
ImpTestM era a
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpTestM era a)
-> SubmitFailureExpectation era
-> ImpTestM era a
submitBootstrapAware
    (Vote -> Voter -> GovActionId -> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
vote Voter
voter GovActionId
gaId)
    (Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter
-> GovActionId
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingVote Voter
voter GovActionId
gaId)

submitBootstrapAwareFailingProposal ::
  ConwayEraImp era =>
  ProposalProcedure era ->
  SubmitFailureExpectation era ->
  ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal :: forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal =
  ImpTestM era (Maybe GovActionId)
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpTestM era (Maybe GovActionId))
-> SubmitFailureExpectation era
-> ImpTestM era (Maybe GovActionId)
forall era a.
EraGov era =>
ImpTestM era a
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpTestM era a)
-> SubmitFailureExpectation era
-> ImpTestM era a
submitBootstrapAware
    (GovActionId -> Maybe GovActionId
forall a. a -> Maybe a
Just (GovActionId -> Maybe GovActionId)
-> ImpM (LedgerSpec era) GovActionId
-> ImpTestM era (Maybe GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProposalProcedure era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era -> ImpTestM era GovActionId
submitProposal ProposalProcedure era
proposal)
    ((Maybe GovActionId
forall a. Maybe a
Nothing Maybe GovActionId
-> ImpM (LedgerSpec era) () -> ImpTestM era (Maybe GovActionId)
forall a b. a -> ImpM (LedgerSpec era) b -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ImpM (LedgerSpec era) () -> ImpTestM era (Maybe GovActionId))
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpM (LedgerSpec era) ())
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era (Maybe GovActionId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
ProposalProcedure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingProposal ProposalProcedure era
proposal)

submitBootstrapAwareFailingProposal_ ::
  ConwayEraImp era =>
  ProposalProcedure era ->
  SubmitFailureExpectation era ->
  ImpTestM era ()
submitBootstrapAwareFailingProposal_ :: forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era ()
submitBootstrapAwareFailingProposal_ ProposalProcedure era
p = ImpM (LedgerSpec era) (Maybe GovActionId)
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (Maybe GovActionId)
 -> ImpM (LedgerSpec era) ())
-> (SubmitFailureExpectation era
    -> ImpM (LedgerSpec era) (Maybe GovActionId))
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era
-> SubmitFailureExpectation era
-> ImpM (LedgerSpec era) (Maybe GovActionId)
forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
p

data SubmitFailureExpectation era
  = FailBootstrap (NE.NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  | FailPostBootstrap (NE.NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
  | FailBootstrapAndPostBootstrap (FailBoth era)

data FailBoth era = FailBoth
  { forall era.
FailBoth era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bootstrapFailures :: NE.NonEmpty (PredicateFailure (EraRule "LEDGER" era))
  , forall era.
FailBoth era -> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
postBootstrapFailures :: NE.NonEmpty (PredicateFailure (EraRule "LEDGER" era))
  }

submitBootstrapAware ::
  EraGov era =>
  ImpTestM era a ->
  (NE.NonEmpty (PredicateFailure (EraRule "LEDGER" era)) -> ImpTestM era a) ->
  SubmitFailureExpectation era ->
  ImpTestM era a
submitBootstrapAware :: forall era a.
EraGov era =>
ImpTestM era a
-> (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
    -> ImpTestM era a)
-> SubmitFailureExpectation era
-> ImpTestM era a
submitBootstrapAware ImpTestM era a
action NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era a
failAction =
  \case
    FailBootstrap NonEmpty (PredicateFailure (EraRule "LEDGER" era))
failures ->
      ImpTestM era a -> ImpTestM era a -> ImpTestM era a
forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era a
failAction NonEmpty (PredicateFailure (EraRule "LEDGER" era))
failures)
        ImpTestM era a
action
    FailPostBootstrap NonEmpty (PredicateFailure (EraRule "LEDGER" era))
failures ->
      ImpTestM era a -> ImpTestM era a -> ImpTestM era a
forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap
        ImpTestM era a
action
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era a
failAction NonEmpty (PredicateFailure (EraRule "LEDGER" era))
failures)
    FailBootstrapAndPostBootstrap (FailBoth NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bFailures NonEmpty (PredicateFailure (EraRule "LEDGER" era))
pBFailures) ->
      ImpTestM era a -> ImpTestM era a -> ImpTestM era a
forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era a
failAction NonEmpty (PredicateFailure (EraRule "LEDGER" era))
bFailures)
        (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era a
failAction NonEmpty (PredicateFailure (EraRule "LEDGER" era))
pBFailures)

delegateSPORewardAddressToDRep_ ::
  ConwayEraImp era =>
  KeyHash 'StakePool ->
  Coin ->
  DRep ->
  ImpTestM era ()
delegateSPORewardAddressToDRep_ :: forall era.
ConwayEraImp era =>
KeyHash 'StakePool -> Coin -> DRep -> ImpTestM era ()
delegateSPORewardAddressToDRep_ KeyHash 'StakePool
kh Coin
stake DRep
drep = do
  PoolParams
pp <- ImpTestM era (RatifyEnv era)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
ImpTestM era (RatifyEnv era)
getRatifyEnv ImpTestM era (RatifyEnv era)
-> (RatifyEnv era -> ImpM (LedgerSpec era) PoolParams)
-> ImpM (LedgerSpec era) PoolParams
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe PoolParams -> ImpM (LedgerSpec era) PoolParams
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Maybe PoolParams -> ImpM (LedgerSpec era) PoolParams)
-> (RatifyEnv era -> Maybe PoolParams)
-> RatifyEnv era
-> ImpM (LedgerSpec era) PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool
-> Map (KeyHash 'StakePool) PoolParams -> Maybe PoolParams
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
kh (Map (KeyHash 'StakePool) PoolParams -> Maybe PoolParams)
-> (RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams)
-> RatifyEnv era
-> Maybe PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
forall era. RatifyEnv era -> Map (KeyHash 'StakePool) PoolParams
rePoolParams
  ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpTestM era ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpTestM era ())
-> ImpM (LedgerSpec era) (KeyPair 'Payment) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$
    Credential 'Staking
-> Coin -> DRep -> ImpM (LedgerSpec era) (KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Credential 'Staking
-> Coin -> DRep -> ImpTestM era (KeyPair 'Payment)
delegateToDRep
      (RewardAccount -> Credential 'Staking
raCredential (RewardAccount -> Credential 'Staking)
-> (PoolParams -> RewardAccount)
-> PoolParams
-> Credential 'Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> RewardAccount
ppRewardAccount (PoolParams -> Credential 'Staking)
-> PoolParams -> Credential 'Staking
forall a b. (a -> b) -> a -> b
$ PoolParams
pp)
      Coin
stake
      DRep
drep

-- Partial implementation used for checking predicate failures
instance InjectRuleFailure "LEDGER" ShelleyDelegPredFailure ConwayEra where
  injectFailure :: ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "LEDGER" ConwayEra
injectFailure = PredicateFailure (EraRule "CERTS" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
ConwayCertsPredFailure ConwayEra
-> ConwayLedgerPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERTS" era)
-> ConwayLedgerPredFailure era
ConwayCertsFailure (ConwayCertsPredFailure ConwayEra
 -> ConwayLedgerPredFailure ConwayEra)
-> (ShelleyDelegPredFailure ConwayEra
    -> ConwayCertsPredFailure ConwayEra)
-> ShelleyDelegPredFailure ConwayEra
-> ConwayLedgerPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "CERTS" ConwayEra
ShelleyDelegPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "CERTS" ShelleyDelegPredFailure ConwayEra where
  injectFailure :: ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "CERTS" ConwayEra
injectFailure = PredicateFailure (EraRule "CERT" ConwayEra)
-> ConwayCertsPredFailure ConwayEra
ConwayCertPredFailure ConwayEra -> ConwayCertsPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
CertFailure (ConwayCertPredFailure ConwayEra
 -> ConwayCertsPredFailure ConwayEra)
-> (ShelleyDelegPredFailure ConwayEra
    -> ConwayCertPredFailure ConwayEra)
-> ShelleyDelegPredFailure ConwayEra
-> ConwayCertsPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "CERT" ConwayEra
ShelleyDelegPredFailure ConwayEra
-> ConwayCertPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "CERT" ShelleyDelegPredFailure ConwayEra where
  injectFailure :: ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "CERT" ConwayEra
injectFailure = PredicateFailure (EraRule "DELEG" ConwayEra)
-> ConwayCertPredFailure ConwayEra
ConwayDelegPredFailure ConwayEra -> ConwayCertPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure (ConwayDelegPredFailure ConwayEra
 -> ConwayCertPredFailure ConwayEra)
-> (ShelleyDelegPredFailure ConwayEra
    -> ConwayDelegPredFailure ConwayEra)
-> ShelleyDelegPredFailure ConwayEra
-> ConwayCertPredFailure ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "DELEG" ConwayEra
ShelleyDelegPredFailure ConwayEra
-> ConwayDelegPredFailure ConwayEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure

instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ConwayEra where
  injectFailure :: ShelleyDelegPredFailure ConwayEra
-> EraRuleFailure "DELEG" ConwayEra
injectFailure (Shelley.StakeKeyAlreadyRegisteredDELEG Credential 'Staking
c) = Credential 'Staking -> ConwayDelegPredFailure ConwayEra
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG Credential 'Staking
c
  injectFailure (Shelley.StakeKeyNotRegisteredDELEG Credential 'Staking
c) = Credential 'Staking -> ConwayDelegPredFailure ConwayEra
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
c
  injectFailure (Shelley.StakeKeyNonZeroAccountBalanceDELEG Coin
c) = Coin -> ConwayDelegPredFailure ConwayEra
forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
c
  injectFailure ShelleyDelegPredFailure ConwayEra
_ = String -> ConwayDelegPredFailure ConwayEra
forall a. HasCallStack => String -> a
error String
"Cannot inject ShelleyDelegPredFailure into ConwayEra"

getCommittee :: ConwayEraGov era => ImpTestM era (StrictMaybe (Committee era))
getCommittee :: forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (Committee era))
getCommittee = SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
 -> ImpTestM era (StrictMaybe (Committee era)))
-> SimpleGetter (NewEpochState era) (StrictMaybe (Committee era))
-> ImpTestM era (StrictMaybe (Committee era))
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> EpochState era -> Const r (EpochState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const r (GovState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> Const r (GovState era))
 -> EpochState era -> Const r (EpochState era))
-> ((StrictMaybe (Committee era)
     -> Const r (StrictMaybe (Committee era)))
    -> GovState era -> Const r (GovState era))
-> (StrictMaybe (Committee era)
    -> Const r (StrictMaybe (Committee era)))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const r (StrictMaybe (Committee era)))
-> GovState era -> Const r (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL