cardano-ledger-test-9.9.9.9: Testing harness, tests and benchmarks for Shelley style cardano ledgers
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.Cardano.Ledger.Constrained.Vars

Synopsis

Documentation

fieldEra era ⇒ Rep era s → Term era t → AnyF era s Source #

Used in Component constraints to turn a Var Term into a component (AnyF era s) E.g. (Component foo [ field fooRep fooPart1, field fooRep fooPart2]) Where fooPart1 :: Term era a, and fooPart2 :: Term era b And fooPart1 has an (Access foo a) And fooPart2 has an (Access foo b)

getNameTerm era t → Name era Source #

type NELens era t = Lens' (NewEpochState era) t Source #

mockPoolDistrEra era ⇒ Term era (Map (KeyHash 'StakePool) Rational) Source #

For tests only, Like PoolDistr but has a Rational (rather than a IndividualPoolStake).

ptrsEra era ⇒ Term era (Map Ptr (Credential 'Staking)) Source #

utxoEra era ⇒ Proof era → Term era (Map TxIn (TxOutF era)) Source #

utxoLProof era → NELens era (Map TxIn (TxOutF era)) Source #

unUtxoLProof era → Lens' (UTxO era) (Map TxIn (TxOutF era)) Source #

depositsEra era ⇒ Term era Coin Source #

feesEra era ⇒ Term era Coin Source #

donationEra era ⇒ Term era Coin Source #

ppupEra era ⇒ Proof era → Term era (ShelleyGovState era) Source #

ppupsLProof era → NELens era (ShelleyGovState era) Source #

pparamProposalsEra era ⇒ Proof era → Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era)) Source #

currPParamsEra era ⇒ Proof era → Term era (PParamsF era) Source #

futurePParamsEra era ⇒ Proof era → Term era (FuturePParams era) Source #

prevPParamsEraGov era ⇒ Proof era → Term era (PParamsF era) Source #

ppupStateT ∷ ∀ era. (GovState era ~ ShelleyGovState era, EraGov era) ⇒ Proof era → RootTarget era (ShelleyGovState era) (ShelleyGovState era) Source #

govStateT ∷ ∀ era. Era era ⇒ Proof era → RootTarget era (GovState era) (GovState era) Source #

isPtrMapTEra era ⇒ Term era (Map Ptr Coin) Source #

incrementalStakeEra era ⇒ Term era (Map (Credential 'Staking) Coin) Source #

This variable is computed from the UTxO and the PParams, It represents the incremental stake that is computed by smartUTxO in the UTxOState Target UTxOStateT The domain of this map is the complete set of credentials used to delegate Coin in the TxOuts in the UTxO.

treasuryEra era ⇒ Term era Coin Source #

reservesEra era ⇒ Term era Coin Source #

mirAvailTreasuryEra era ⇒ Term era Coin Source #

The Coin availabe for a MIR transfer to/from the Treasury Computed from treasury + deltaTreasury - sum(instanTreasury)

mirAvailReservesEra era ⇒ Term era Coin Source #

The Coin availabe for a MIR transfer to/from the Reserves Computed from reserves + deltaReserves - sum(instanReserves)

ppFLProof era → Lens' (PParams era) (PParamsF era) Source #

Lens' from the Core PParams to the Model PParamsF which embeds a (Proof era)

pparamsVarEraGov era ⇒ Proof era → V era (PParamsF era) Source #

pparamsEraGov era ⇒ Proof era → Term era (PParamsF era) Source #

nmRewardPotTEra era ⇒ Term era Coin Source #

stakeLLens' Stake (Map (Credential 'Staking) Coin) Source #

Helper lens that deals with the Stake newtype, and the shift from Map to VMap

vmapLLens' (VMap VB VB k v) (Map k v) Source #

Helper lens that deals with the shift from Map to VMap

snapShotFeeEra era ⇒ Term era Coin Source #

deltaTEra era ⇒ Term era (Maybe DeltaCoin) Source #

deltaREra era ⇒ Term era (Maybe DeltaCoin) Source #

deltaFEra era ⇒ Term era (Maybe DeltaCoin) Source #

totalAdaEra era ⇒ Term era Coin Source #

utxoCoinEra era ⇒ Term era Coin Source #

credsUnivEra era ⇒ Term era (Set (Credential 'Staking)) Source #

The universe of Staking Credentials. A credential is either KeyHash of a ScriptHash Any Plutus scripts in this Universe are NOT Spending scripts, so they do not need a Redeemer

spendCredsUnivEra era ⇒ Term era (Set (Credential 'Payment)) Source #

The universe of Staking Credentials. A credential is either KeyHash of a ScriptHash All Plutus scripts in this Universe are SPENDING scripts, so they will need a Redeemer Use this ONLY in the Pay-part of an Address (Do not use this in the Stake-part of an Address)

voteUnivEra era ⇒ Term era (Set (Credential 'DRepRole)) Source #

The universe of Voting Credentials. A credential is either KeyHash of a ScriptHash

drepUnivEra era ⇒ Term era (Set DRep) Source #

The universe of DReps

hotCommitteeCredsUnivEra era ⇒ Term era (Set (Credential 'HotCommitteeRole)) Source #

The universe of Credentials used in voting for constitutional committee changes.

coldCommitteeCredsUnivEra era ⇒ Term era (Set (Credential 'ColdCommitteeRole)) Source #

The universe of Credentials used in voting for constitutional committee changes.

payUnivEra era ⇒ Term era (Set (Credential 'Payment)) Source #

The universe of Payment Credentials. A credential is either KeyHash of a ScriptHash We only find payment credentials in the Payment part of an Addr.

spendscriptUnivEra era ⇒ Proof era → Term era (Map ScriptHash (ScriptF era)) Source #

The universe of Scripts (and their hashes) useable in spending contexts That means if they are Plutus scripts then they will be passed an additional argument (the TxInfo context)

nonSpendScriptUnivEra era ⇒ Proof era → Term era (Map ScriptHash (ScriptF era)) Source #

The universe of Scripts (and their hashes) useable in contexts other than Spending

allScriptUnivEra era ⇒ Proof era → Term era (Map ScriptHash (ScriptF era)) Source #

The union of spendscriptUniv and nonSpendScriptUniv. All possible scripts in any context

dataUnivEra era ⇒ Term era (Map DataHash (Data era)) Source #

The universe of Data (and their hashes)

poolHashUnivEra era ⇒ Term era (Set (KeyHash 'StakePool)) Source #

The universe of StakePool key hashes. These hashes hash the cold key of the Pool operators.

stakeHashUnivEra era ⇒ Term era (Set (KeyHash 'Staking)) Source #

The universe of StakePool key hashes. These hashes hash are hashes of the Owners of a PoolParam

drepHashUnivEra era ⇒ Term era (Set (KeyHash 'DRepRole)) Source #

The universe of DRep key hashes. These hashes hash are hashes of the DReps

genesisHashUnivEra era ⇒ Term era (Map (KeyHash 'Genesis) GenDelegPair) Source #

The universe of the Genesis key hashes and their signing and validating GenDelegPairs

txinUnivEra era ⇒ Term era (Set TxIn) Source #

The universe of TxIns. Pairs of TxId: hashes of previously run transaction bodies, and TxIx: indexes of one of the bodies outputs.

govActionIdUnivEra era ⇒ Term era (Set GovActionId) Source #

The universe of GovActionId. Pairs of TxId: hashes of previously run transaction bodies, and GovActionIx: indexes of one of the bodies Proposals .

txoutUnivEra era ⇒ Proof era → Term era (Set (TxOutF era)) Source #

The universe of TxOuts. It contains colTxoutUniv as a sublist and feeOutput as an element See also feeOutput which is defined by the universes, and is related.

colTxoutUnivEra era ⇒ Proof era → Term era (Set (TxOutF era)) Source #

The universe of TxOuts useable for collateral The collateral TxOuts consists only of VKey addresses and The collateral TxOuts do not contain any non-ADA part

feeTxOutReflect era ⇒ Term era (TxOutF era) Source #

A TxOut, guaranteed to have 1) no scripts in its Addr, and 2) It's Addr is in the addrUniv 3) bigCoin is stored in the Addr Value, and 4) the Addr Value has empty MutiAssets 5) be a member of the txoutUniv

feeTxInEra era ⇒ Term era TxIn Source #

A TxIn, guaranteed to have 1) be a member of the txinUniv

bigCoinEra era ⇒ Term era Coin Source #

A Coin large enough to pay almost any fee. See also feeOutput which is related.

datumsUnivEra era ⇒ Term era [Datum era] Source #

keymapUnivEra era ⇒ Term era (Map (KeyHash 'Witness) (KeyPair 'Witness)) Source #

The universe of key hashes, and the signing and validating key pairs they represent.

currentSlotEra era ⇒ Term era SlotNo Source #

networkEra era ⇒ Term era Network Source #

From Globals

quorumConstantWord64 Source #

This not really a variable, But a constant that is set by the testGlobals we reflect this into a Term, so we can refer to it in the Preds.

quorumEra era ⇒ Term era Int Source #

From Globals. Reflected here at type Int, This is set to quorumConstant in CertState. because is is used to compare the Size of things, which are computed as Int

addrUnivEra era ⇒ Term era (Set Addr) Source #

ptrUnivEra era ⇒ Term era (Set Ptr) Source #

byronAddrUnivEra era ⇒ Term era (Map (KeyHash 'Payment) (Addr, SigningKey)) Source #

The universe of all Byron addresses. In Eras, Babbage, Conway we avoid these Adresses, as they do not play well with Plutus Scripts.

newEpochStateConstrProof era → EpochNoMap (KeyHash 'StakePool) NaturalMap (KeyHash 'StakePool) NaturalEpochState era → Map (KeyHash 'StakePool) IndividualPoolStakeNewEpochState era Source #

Abstract constuctor function for NewEpochState

newEpochStateT ∷ ∀ era. EraGov era ⇒ Proof era → RootTarget era (NewEpochState era) (NewEpochState era) Source #

Target for NewEpochState

epochStateT ∷ ∀ era. EraGov era ⇒ Proof era → RootTarget era (EpochState era) (EpochState era) Source #

Target for EpochState

accountStateTEra era ⇒ RootTarget era AccountState AccountState Source #

Target for AccountState

ledgerStateT ∷ ∀ era. EraGov era ⇒ Proof era → RootTarget era (LedgerState era) (LedgerState era) Source #

Target for LedgerState

ledgerStateReflect era ⇒ Term era (LedgerState era) Source #

utxoStateT ∷ ∀ era. EraGov era ⇒ Proof era → RootTarget era (UTxOState era) (UTxOState era) Source #

Target for UTxOState

unGovLProof era → Lens' (GovState era) (GovState era) Source #

justProtocolVersion ∷ ∀ era. Reflect era ⇒ Proof era → PParams era Source #

certstateT ∷ ∀ era. Era era ⇒ RootTarget era (CertState era) (CertState era) Source #

Target for CertState

vstateT ∷ ∀ era. Era era ⇒ RootTarget era (VState era) (VState era) Source #

Target for VState

pstateT ∷ ∀ era. Era era ⇒ RootTarget era (PState era) (PState era) Source #

Target for PState

dstateT ∷ ∀ era. Era era ⇒ RootTarget era (DState era) (DState era) Source #

Target for DState

allvarsString Source #

A String that pretty prints the complete set of variables of the NewEpochState

printTargetRootTarget era root t → IO () Source #

protVerEra era ⇒ Proof era → Term era ProtVer Source #

ProtVer in pparams

prevProtVerEra era ⇒ Proof era → Term era ProtVer Source #

ProtVer in prevPParams

minFeeAEra era ⇒ Proof era → Term era Coin Source #

minFeeBEra era ⇒ Proof era → Term era Coin Source #

maxBBSizeEra era ⇒ Proof era → Term era Natural Source #

Max Block Body Size

maxTxSizeEra era ⇒ Proof era → Term era Natural Source #

Max Tx Size

fromIntegralBounded ∷ ∀ a b. (HasCallStack, Integral a, Show a, Integral b, Bounded b, Show b) ⇒ String → a → b Source #

maxBHSizeEra era ⇒ Proof era → Term era Natural Source #

Max Block Header Size

poolDepAmtEra era ⇒ Proof era → Term era Coin Source #

keyDepAmtEra era ⇒ Proof era → Term era Coin Source #

maxEpochEra era ⇒ Proof era → Term era EpochInterval Source #

txbodytermReflect era ⇒ Term era (TxBodyF era) Source #

inputsEra era ⇒ Term era (Set TxIn) Source #

collateralEra era ⇒ Term era (Set TxIn) Source #

refInputsEra era ⇒ Term era (Set TxIn) Source #

outputsEra era ⇒ Proof era → Term era [TxOutF era] Source #

collateralReturnEra era ⇒ Proof era → Term era (TxOutF era) Source #

totalColEra era ⇒ Term era Coin Source #

The sum of all the collateral inputs. The Tx is constucted by SNothing or wrapping SJust around this value.

certsReflect era ⇒ Term era [TxCertF era] Source #

withdrawals ∷ ∀ era. Era era ⇒ Term era (Map RewardAccount Coin) Source #

txfeeEra era ⇒ Term era Coin Source #

ttlEra era ⇒ Term era SlotNo Source #

networkIDEra era ⇒ Term era (Maybe Network) Source #

txDonationEra era ⇒ Term era Coin Source #

liftMultiAssetMap ScriptHash (Map AssetName Integer) → MultiAsset Source #

lift the model type of mint into a MultiAsset

extraColEra era ⇒ Term era Coin Source #

A Coin that needs to be added to the range of the colInputs in the UtxO that will make sure the collateral is large enough to pay the fees if needed

sumColEra era ⇒ Term era Coin Source #

The sum of all the collateral inputs, total colateral of the Tx is computed by adding (SJust _) to this value.

colRetAddrEra era ⇒ Term era Addr Source #

colRetCoinEra era ⇒ Term era Coin Source #

The Coin in the collateralReturn TxOut

owedEra era ⇒ Term era Coin Source #

The amount that the collateral must cover if there is a two phase error. This is roughly the collateralPercentage * txfee . The calculation deals with rounding, but you don't need those details to understand what is going on.

txbodyReflect era ⇒ Term era (TxBodyF era) Source #

txwitsReflect era ⇒ Term era (TxWitsF era) Source #

txauxdataReflect era ⇒ Term era (Maybe (TxAuxDataF era)) Source #

txisvalidEra era ⇒ Term era IsValid Source #

validsEra era ⇒ Term era [IsValid] Source #

txtermReflect era ⇒ Term era (TxF era) Source #

txOutFLLens' (TxOutF era) (TxOut era) Source #

valueFLReflect era ⇒ Lens' (Value era) (ValueF era) Source #

lensVCVal t ⇒ Lens' t Coin Source #

valCoinF ∷ (HasCallStack, Reflect era) ⇒ Field era (ValueF era) Coin Source #

a Field from (ValueF era) to Coin

valueFMultiAssetFReflect era ⇒ Field era (ValueF era) MultiAsset Source #

a Field from (ValueF era) to MultiAsset

txoutAddressFReflect era ⇒ Field era (TxOutF era) Addr Source #

a Field from (TxOut era) to (Addr era)

txoutCoinF ∷ (HasCallStack, Reflect era) ⇒ Field era (TxOutF era) Coin Source #

a Field from (TxOutF era) to Coin

txoutAmountFReflect era ⇒ Field era (TxOutF era) (ValueF era) Source #

a Field from (TxOutF era) to (ValueF era)

txoutAmountReflect era ⇒ Term era (ValueF era) Source #

redeemersReflect era ⇒ Term era (Map (PlutusPointerF era) (Data era, ExUnits)) Source #

bootWits ∷ ∀ era. Reflect era ⇒ Term era (Set BootstrapWitness) Source #

dataWitsReflect era ⇒ Term era (Map DataHash (Data era)) Source #

keyWitsReflect era ⇒ Term era (Set (WitVKey 'Witness)) Source #

witsTargetReflect era ⇒ Term era (Set BootstrapWitness) → Term era (Set (WitVKey 'Witness)) → Target era (TxWits era) Source #

txTargetReflect era ⇒ Term era (TxBodyF era) → Term era (Set BootstrapWitness) → Term era (Set (WitVKey 'Witness)) → Target era (TxF era) Source #

txbodyTargetReflect era ⇒ Term era CoinTerm era (Maybe ScriptIntegrityHash) → Term era CoinTarget era (TxBodyF era) Source #

Need to build the TxBody with different terms that control the fee and wppHash so we parameterise this target over those two terms

constitutionEra era ⇒ Term era (Constitution era) Source #

enactTreasuryEra era ⇒ Term era Coin Source #

enactWithdrawals ∷ ∀ era. Era era ⇒ Term era (Map (Credential 'Staking) Coin) Source #

committeeVarEra era ⇒ Term era (Maybe (Committee era)) Source #

type UtxoPulse era = (Map TxIn (TxOutF era), DRepPulser era Identity (RatifyState era)) Source #

There are 2 forms of DRepPulsingState. This is part of the first one where the pulsing is not complete, and the snapshots are stored as fields in the datatype DRepPulser. Note that the function part of Invert : initPulser makes many transformations from the types used in the Model, and the types stored in the implementation types. In order to construct a valid DRepPulser we need the UTxO (to compute the IncrementalStake) But we cannot find a Lens that can recover the UTxO from a DRepPulser. So we introduce this type ' UtxoPulse' that pairs the two (which makes the recovery possible). W

utxoPulse ∷ (RunConwayRatify era, Reflect era) ⇒ Proof era → Term era (UtxoPulse era) Source #

We also introduce an intermediate variable utxoPulse which can constrain this value by using the predicate [ utxoPulse p :<-: pulsingPair p ]

pulsingPairT ∷ ∀ era. (RunConwayRatify era, Reflect era) ⇒ Proof era → RootTarget era (UtxoPulse era) (UtxoPulse era) Source #

an invertable RootTarget to compute a (UtxoPulse era)

justPulser ∷ ∀ era. (Reflect era, RunConwayRatify era) ⇒ Proof era → RootTarget era (DRepPulser era Identity (RatifyState era)) (DRepPulser era Identity (RatifyState era)) Source #

drepPulser ∷ (RunConwayRatify era, Reflect era) ⇒ Term era (DRepPulser era Identity (RatifyState era)) Source #

Variable used to constrain the DRepPulser

prevPulsingPreds ∷ (RunConwayRatify era, Reflect era) ⇒ Proof era → [Pred era] Source #

Predicates that constrain the DRepPuser and all its prevXXX snapshots These ensure we generate state just passing the epoch boundary

pulsingPulsingStateT ∷ ∀ era. (RunConwayRatify era, Reflect era) ⇒ RootTarget era (DRepPulsingState era) (DRepPulsingState era) Source #

Target for assembling DRPulsing form of (DRepPulsingState era) from drepPulser :: forall era. Term era (DRepPulser era Identity (RatifyState era))

pulsingStatePulserLLens' (DRepPulsingState era) (DRepPulser era Identity (RatifyState era)) Source #

The Lens' used in pulsingPulsingStateT

initPulser ∷ ∀ era. (Reflect era, RunConwayRatify era) ⇒ Proof era → Map TxIn (TxOutF era) → Map (Credential 'Staking) DRepMap (KeyHash 'StakePool) IndividualPoolStakeMap (Credential 'DRepRole) DRepStateEpochNoMap (Credential 'ColdCommitteeRole) CommitteeAuthorizationEnactState era → [GovActionState era] → Map (KeyHash 'StakePool) PoolParamsDRepPulser era Identity (RatifyState era) Source #

The abstract form of DRepPulser that transforms from the Model types used in the inputs, and the concrete types actually stored in DRepPulser

proposalsT ∷ ∀ era. Era era ⇒ Proof era → RootTarget era (Proposals era) (Proposals era) Source #

pulsingSnapshotT ∷ ∀ era. Era era ⇒ RootTarget era (PulsingSnapshot era) (PulsingSnapshot era) Source #

The snapshot dedicated datatype (PulsingSnapshot era) stored inside DRComplete Note this is used in dRepPulsingStateT, the second DRepPulsingState form.

completePulsingStateT ∷ ∀ era. Reflect era ⇒ Proof era → RootTarget era (DRepPulsingState era) (DRepPulsingState era) Source #

There are 2 forms of DRepPulsingState. This is the second one where the pulsing is complete

ratifyStateReflect era ⇒ Term era (RatifyState era) Source #

prevProposalsEra era ⇒ Proof era → Term era (Proposals era) Source #

partialDRepDistrEra era ⇒ Term era (Map DRep Coin) Source #

Partially computed DRepDistr inside the pulser

prevDRepStateEra era ⇒ Term era (Map (Credential 'DRepRole) DRepState) Source #

Snapshot of dreps from the start of the current epoch

prevPoolDistrEra era ⇒ Term era (Map (KeyHash 'StakePool) IndividualPoolStake) Source #

snapshot of poolDistr from the start of the current epoch

prevDRepDelegationsEra era ⇒ Term era (Map (Credential 'Staking) DRep) Source #

Snapshot of the drepDelegation from he start of the current epoch.

prevDRepDelegationsLLens' (DRepPulser era Identity (RatifyState era)) (Map (Credential 'Staking) DRep) Source #

Snapshot of drepDelegation from the start of the current epoch

prevCommitteeStateEra era ⇒ Term era (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization) Source #

Snapshot of committeeState from the start of the current epoch

prevEnactStateReflect era ⇒ Term era (EnactState era) Source #

Snapshot of the enactState built by enactStateT assembled from data at the start the current epoch

prevEpochEra era ⇒ Term era EpochNo Source #

Snapshot of currentEpoch just before the start of the current epoch. (currenEpoch - 1)

prevTreasuryEra era ⇒ Term era Coin Source #

conwayGovStateT ∷ ∀ era. (RunConwayRatify era, Reflect era) ⇒ Proof era → RootTarget era (ConwayGovState era) (ConwayGovState era) Source #

proposalDepositsEra era ⇒ Term era Coin Source #

The sum of all the gasDeposit fields of currProposals

drepDepositsViewEra era ⇒ Term era (Map (Credential 'DRepRole) Coin) Source #

A view of currentDRepState (sum of the drepDeposit field of in the range of currentDRepState)

currProposalsEra era ⇒ Proof era → Term era (Proposals era) Source #

The current set of proposals. Proposals has a serious set of invariants. We do not attempt to state these proposals (Yes I know that is cheating) We get random Proposals (that meets its invariants) by using (genSizedRep n (ProposalsR p))

prevGovActionIds ∷ ∀ era. Reflect era ⇒ Term era (GovRelation StrictMaybe era) Source #

Part of the EnactState, it is computed by selecting from currProposals

currGovStatesEra era ⇒ Term era [GovActionState era] Source #

This is a view of currProposals, so will compute it once once currProposals is defined

enactStateT ∷ ∀ era. Reflect era ⇒ RootTarget era (EnactState era) (EnactState era) Source #

committeeT ∷ ∀ era. Era era ⇒ RootTarget era (Committee era) (Committee era) Source #

One can use this Target, to make a constraint for committeeVar from the vars commMembers and commQuorum

pparamsFLProof era → Lens' (PParams era) (PParamsF era) Source #

pair1Era era ⇒ Rep era a → Term era a Source #

pair2Era era ⇒ Rep era b → Term era b Source #

pairT ∷ ∀ era a b. (Typeable a, Typeable b, Era era) ⇒ Rep era a → Rep era b → RootTarget era (a, b) (a, b) Source #

idVEra era ⇒ Term era GovActionId Source #

depositVEra era ⇒ Term era Coin Source #

actionVEra era ⇒ Term era (GovAction era) Source #

anchorVEra era ⇒ Term era Anchor Source #

liftIdMaybe GovActionIdStrictMaybe (GovPurposeId p era) Source #

Lift the Model to the real type

dropIdStrictMaybe (GovPurposeId p era) → Maybe GovActionId Source #

Drop the real type back to the Model

constitutionT ∷ ∀ era. Reflect era ⇒ RootTarget era (Constitution era) (Constitution era) Source #

parameterChangeT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

hardForkInitiationT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

treasuryWithdrawalsT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

noConfidenceT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

updateCommitteeT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

newConstitutionT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #

infoActionT ∷ ∀ era. Reflect era ⇒ RootTarget era (GovAction era) (GovAction era) Source #