Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Cardano.Ledger.Shelley.Rules
Synopsis
- data ShelleyBBODY era
- data ShelleyBbodyState era = BbodyState !(State (EraRule "LEDGERS" era)) !BlocksMade
- data BbodyEnv era = BbodyEnv {
- bbodyPp ∷ PParams era
- bbodyAccount ∷ AccountState
- data ShelleyBbodyPredFailure era
- = WrongBlockBodySizeBBODY (Mismatch 'RelEQ Int)
- | InvalidBodyHashBBODY (Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody))
- | LedgersFailure (PredicateFailure (EraRule "LEDGERS" era))
- newtype ShelleyBbodyEvent era = LedgersEvent (Event (EraRule "LEDGERS" era))
- type family PredicateFailure a
- type family State a
- data ShelleyDELEG era
- data DelegEnv era = DelegEnv {
- slotNo ∷ SlotNo
- deCurEpochNo ∷ EpochNo
- ptr_ ∷ Ptr
- acnt_ ∷ AccountState
- ppDE ∷ PParams era
- type family PredicateFailure a
- data ShelleyDelegPredFailure era
- = StakeKeyAlreadyRegisteredDELEG (Credential 'Staking)
- | StakeKeyNotRegisteredDELEG (Credential 'Staking)
- | StakeKeyNonZeroAccountBalanceDELEG Coin
- | StakeDelegationImpossibleDELEG (Credential 'Staking)
- | WrongCertificateTypeDELEG
- | GenesisKeyNotInMappingDELEG (KeyHash 'Genesis)
- | DuplicateGenesisDelegateDELEG (KeyHash 'GenesisDelegate)
- | InsufficientForInstantaneousRewardsDELEG MIRPot (Mismatch 'RelLTEQ Coin)
- | MIRCertificateTooLateinEpochDELEG (Mismatch 'RelLT SlotNo)
- | DuplicateGenesisVRFDELEG (VRFVerKeyHash 'GenDelegVRF)
- | MIRTransferNotCurrentlyAllowed
- | MIRNegativesNotCurrentlyAllowed
- | InsufficientForTransferDELEG MIRPot (Mismatch 'RelLTEQ Coin)
- | MIRProducesNegativeUpdate
- | MIRNegativeTransfer MIRPot Coin
- newtype ShelleyDelegEvent era = DelegNewEpoch EpochNo
- data ShelleyDELEGS era
- data DelegsEnv era = DelegsEnv {
- delegsSlotNo ∷ SlotNo
- delegsEpochNo ∷ EpochNo
- delegsIx ∷ TxIx
- delegspp ∷ PParams era
- delegsTx ∷ Tx era
- delegsAccount ∷ AccountState
- data ShelleyDelegsPredFailure era
- = DelegateeNotRegisteredDELEG (KeyHash 'StakePool)
- | WithdrawalsNotInRewardsDELEGS (Map RewardAccount Coin)
- | DelplFailure (PredicateFailure (EraRule "DELPL" era))
- newtype ShelleyDelegsEvent era = DelplEvent (Event (EraRule "DELPL" era))
- type family PredicateFailure a
- validateZeroRewards ∷ ∀ era. DState era → Withdrawals → Network → Test (Map RewardAccount Coin)
- validateStakePoolDelegateeRegistered ∷ PState era → KeyHash 'StakePool → Test (KeyHash 'StakePool)
- drainWithdrawals ∷ DState era → Withdrawals → DState era
- data ShelleyDELPL era
- data DelplEnv era = DelplEnv {}
- data ShelleyDelplPredFailure era
- = PoolFailure (PredicateFailure (EraRule "POOL" era))
- | DelegFailure (PredicateFailure (EraRule "DELEG" era))
- data ShelleyDelplEvent era
- type family PredicateFailure a
- data ShelleyLEDGER era
- data LedgerEnv era = LedgerEnv {}
- ledgerSlotNoL ∷ Lens' (LedgerEnv era) SlotNo
- ledgerEpochNoL ∷ Lens' (LedgerEnv era) (Maybe EpochNo)
- ledgerIxL ∷ Lens' (LedgerEnv era) TxIx
- ledgerPpL ∷ Lens' (LedgerEnv era) (PParams era)
- ledgerAccountL ∷ Lens' (LedgerEnv era) AccountState
- data ShelleyLedgerPredFailure era
- = UtxowFailure (PredicateFailure (EraRule "UTXOW" era))
- | DelegsFailure (PredicateFailure (EraRule "DELEGS" era))
- data ShelleyLedgerEvent era
- = UtxowEvent (Event (EraRule "UTXOW" era))
- | DelegsEvent (Event (EraRule "DELEGS" era))
- type family Event a
- type family PredicateFailure a
- epochFromSlot ∷ SlotNo → Reader Globals EpochNo
- renderDepositEqualsObligationViolation ∷ (EraTx era, EraGov era, Environment t ~ LedgerEnv era, Signal t ~ Tx era, State t ~ LedgerState era) ⇒ AssertionViolation t → String
- shelleyLedgerAssertions ∷ (EraGov era, State (rule era) ~ LedgerState era) ⇒ [Assertion (rule era)]
- data ShelleyLEDGERS era
- data ShelleyLedgersEnv era = LedgersEnv {}
- newtype ShelleyLedgersPredFailure era = LedgerFailure (PredicateFailure (EraRule "LEDGER" era))
- newtype ShelleyLedgersEvent era = LedgerEvent (Event (EraRule "LEDGER" era))
- type family PredicateFailure a
- data ShelleyPOOL era
- data PoolEvent era
- data PoolEnv era = PoolEnv EpochNo (PParams era)
- type family PredicateFailure a
- data ShelleyPoolPredFailure era
- = StakePoolNotRegisteredOnKeyPOOL (KeyHash 'StakePool)
- | StakePoolRetirementWrongEpochPOOL (Mismatch 'RelGT EpochNo) (Mismatch 'RelLTEQ EpochNo)
- | StakePoolCostTooLowPOOL (Mismatch 'RelGTEQ Coin)
- | WrongNetworkPOOL (Mismatch 'RelEQ Network) (KeyHash 'StakePool)
- | PoolMedataHashTooBig (KeyHash 'StakePool) Int
- data ShelleyPPUP era
- data PpupEnv era = PPUPEnv SlotNo (PParams era) GenDelegs
- data ShelleyPpupPredFailure era
- data ShelleyGovState era = ShelleyGovState {
- sgsCurProposals ∷ !(ProposedPPUpdates era)
- sgsFutureProposals ∷ !(ProposedPPUpdates era)
- sgsCurPParams ∷ !(PParams era)
- sgsPrevPParams ∷ !(PParams era)
- sgsFuturePParams ∷ !(FuturePParams era)
- newtype PpupEvent era = PpupNewEpoch EpochNo
- type family PredicateFailure a
- data VotingPeriod
- votedFuturePParams ∷ ∀ era. EraPParams era ⇒ ProposedPPUpdates era → PParams era → Word64 → Maybe (PParams era)
- data ShelleyUTXO era
- data UtxoEnv era = UtxoEnv {}
- data ShelleyUtxoPredFailure era
- = BadInputsUTxO (Set TxIn)
- | ExpiredUTxO (Mismatch 'RelLTEQ SlotNo)
- | MaxTxSizeUTxO (Mismatch 'RelLTEQ Integer)
- | InputSetEmptyUTxO
- | FeeTooSmallUTxO (Mismatch 'RelGTEQ Coin)
- | ValueNotConservedUTxO (Mismatch 'RelEQ (Value era))
- | WrongNetwork Network (Set Addr)
- | WrongNetworkWithdrawal Network (Set RewardAccount)
- | OutputTooSmallUTxO [TxOut era]
- | UpdateFailure (EraRuleFailure "PPUP" era)
- | OutputBootAddrAttrsTooBig [TxOut era]
- data UtxoEvent era
- = TotalDeposits (SafeHash EraIndependentTxBody) Coin
- | UpdateEvent (Event (EraRule "PPUP" era))
- | TxUTxODiff (UTxO era) (UTxO era)
- type family PredicateFailure a
- updateUTxOState ∷ (EraTxBody era, Monad m) ⇒ PParams era → UTxOState era → TxBody era → CertState era → GovState era → (Coin → m ()) → (UTxO era → UTxO era → m ()) → m (UTxOState era)
- validateInputSetEmptyUTxO ∷ EraTxBody era ⇒ TxBody era → Test (ShelleyUtxoPredFailure era)
- validateFeeTooSmallUTxO ∷ EraUTxO era ⇒ PParams era → Tx era → UTxO era → Test (ShelleyUtxoPredFailure era)
- validateBadInputsUTxO ∷ UTxO era → Set TxIn → Test (ShelleyUtxoPredFailure era)
- validateWrongNetwork ∷ (EraTxOut era, Foldable f) ⇒ Network → f (TxOut era) → Test (ShelleyUtxoPredFailure era)
- validateWrongNetworkWithdrawal ∷ EraTxBody era ⇒ Network → TxBody era → Test (ShelleyUtxoPredFailure era)
- validateOutputBootAddrAttrsTooBig ∷ (EraTxOut era, Foldable f) ⇒ f (TxOut era) → Test (ShelleyUtxoPredFailure era)
- validateMaxTxSizeUTxO ∷ EraTx era ⇒ PParams era → Tx era → Test (ShelleyUtxoPredFailure era)
- validateValueNotConservedUTxO ∷ EraUTxO era ⇒ PParams era → UTxO era → CertState era → TxBody era → Test (ShelleyUtxoPredFailure era)
- utxoEnvSlotL ∷ Lens' (UtxoEnv era) SlotNo
- utxoEnvPParamsL ∷ Lens' (UtxoEnv era) (PParams era)
- utxoEnvCertStateL ∷ Lens' (UtxoEnv era) (CertState era)
- data ShelleyUTXOW era
- data ShelleyUtxowPredFailure era
- = InvalidWitnessesUTXOW [VKey 'Witness]
- | MissingVKeyWitnessesUTXOW (Set (KeyHash 'Witness))
- | MissingScriptWitnessesUTXOW (Set ScriptHash)
- | ScriptWitnessNotValidatingUTXOW (Set ScriptHash)
- | UtxoFailure (PredicateFailure (EraRule "UTXO" era))
- | MIRInsufficientGenesisSigsUTXOW (Set (KeyHash 'Witness))
- | MissingTxBodyMetadataHash TxAuxDataHash
- | MissingTxMetadata TxAuxDataHash
- | ConflictingMetadataHash (Mismatch 'RelEQ TxAuxDataHash)
- | InvalidMetadata
- | ExtraneousScriptWitnessesUTXOW (Set ScriptHash)
- newtype ShelleyUtxowEvent era = UtxoEvent (Event (EraRule "UTXO" era))
- type family PredicateFailure a
- transitionRulesUTXOW ∷ ∀ era. (EraUTxO era, ShelleyEraTxBody era, ScriptsNeeded era ~ ShelleyScriptsNeeded era, BaseM (EraRule "UTXOW" era) ~ ShelleyBase, Embed (EraRule "UTXO" era) (EraRule "UTXOW" era), Environment (EraRule "UTXO" era) ~ UtxoEnv era, State (EraRule "UTXO" era) ~ UTxOState era, Signal (EraRule "UTXO" era) ~ Tx era, Environment (EraRule "UTXOW" era) ~ UtxoEnv era, State (EraRule "UTXOW" era) ~ UTxOState era, Signal (EraRule "UTXOW" era) ~ Tx era, InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era, STS (EraRule "UTXOW" era)) ⇒ TransitionRule (EraRule "UTXOW" era)
- validateFailedNativeScripts ∷ EraTx era ⇒ ScriptsProvided era → Tx era → Test (ShelleyUtxowPredFailure era)
- validateMissingScripts ∷ ShelleyScriptsNeeded era → ScriptsProvided era → Test (ShelleyUtxowPredFailure era)
- validateVerifiedWits ∷ EraTx era ⇒ Tx era → Test (ShelleyUtxowPredFailure era)
- validateMetadata ∷ EraTx era ⇒ PParams era → Tx era → Test (ShelleyUtxowPredFailure era)
- validateMIRInsufficientGenesisSigs ∷ (EraTx era, ShelleyEraTxBody era) ⇒ GenDelegs → Word64 → Set (KeyHash 'Witness) → Tx era → Test (ShelleyUtxowPredFailure era)
- validateNeededWitnesses ∷ EraUTxO era ⇒ Set (KeyHash 'Witness) → CertState era → UTxO era → TxBody era → Test (ShelleyUtxowPredFailure era)
- data ShelleyEPOCH era
- data ShelleyEpochPredFailure era
- = PoolReapFailure (PredicateFailure (EraRule "POOLREAP" era))
- | SnapFailure (PredicateFailure (EraRule "SNAP" era))
- | UpecFailure (UpecPredFailure era)
- data ShelleyEpochEvent era
- type family PredicateFailure a
- type UpecPredFailure era = UpecPredFailurePV (ProtVerLow era) era
- data ShelleyNEWEPOCH era
- data ShelleyNewEpochPredFailure era
- = EpochFailure (PredicateFailure (EraRule "EPOCH" era))
- | CorruptRewardUpdate RewardUpdate
- | MirFailure (PredicateFailure (EraRule "MIR" era))
- data ShelleyNewEpochEvent era
- = DeltaRewardEvent (Event (EraRule "RUPD" era))
- | RestrainedRewards EpochNo (Map (Credential 'Staking) (Set Reward)) (Set (Credential 'Staking))
- | TotalRewardEvent EpochNo (Map (Credential 'Staking) (Set Reward))
- | EpochEvent (Event (EraRule "EPOCH" era))
- | MirEvent (Event (EraRule "MIR" era))
- | TotalAdaPotsEvent AdaPots
- type family PredicateFailure a
- updateRewards ∷ EraGov era ⇒ EpochState era → EpochNo → RewardUpdate → Rule (ShelleyNEWEPOCH era) 'Transition (EpochState era)
- calculatePoolDistr ∷ SnapShot → PoolDistr
- calculatePoolDistr' ∷ (KeyHash 'StakePool → Bool) → SnapShot → PoolDistr
- data ShelleyRUPD era
- data RupdEnv era = RupdEnv BlocksMade (EpochState era)
- type family PredicateFailure a
- data ShelleyRupdPredFailure era
- epochInfoRange ∷ Monad m ⇒ EpochInfo m → EpochNo → m (SlotNo, SlotNo)
- data PulsingRewUpdate
- startStep ∷ ∀ era. EraGov era ⇒ EpochSize → BlocksMade → EpochState era → Coin → ActiveSlotCoeff → NonZero Word64 → PulsingRewUpdate
- pulseStep ∷ PulsingRewUpdate → ShelleyBase (PulsingRewUpdate, RewardEvent)
- completeStep ∷ PulsingRewUpdate → ShelleyBase (PulsingRewUpdate, RewardEvent)
- lift ∷ (MonadTrans t, Monad m) ⇒ m a → t m a
- newtype Identity a = Identity {
- runIdentity ∷ a
- data RupdEvent = RupdEvent !EpochNo !(Map (Credential 'Staking) (Set Reward))
- data ShelleySNAP era
- type family PredicateFailure a
- data ShelleySnapPredFailure era
- newtype SnapEvent era = StakeDistEvent (Map (Credential 'Staking) (Coin, KeyHash 'StakePool))
- data SnapEnv era = SnapEnv (LedgerState era) (PParams era)
- data ShelleyTICK era
- type family State a
- data ShelleyTickPredFailure era
- = NewEpochFailure (PredicateFailure (EraRule "NEWEPOCH" era))
- | RupdFailure (PredicateFailure (EraRule "RUPD" era))
- data ShelleyTickEvent era
- = TickNewEpochEvent (Event (EraRule "NEWEPOCH" era))
- | TickRupdEvent (Event (EraRule "RUPD" era))
- type family PredicateFailure a
- adoptGenesisDelegs ∷ EpochState era → SlotNo → EpochState era
- data ShelleyTICKF era
- data ShelleyTickfPredFailure era
- validatingTickTransition ∷ ∀ tick era. (EraGov era, Embed (EraRule "NEWEPOCH" era) (tick era), STS (tick era), State (tick era) ~ NewEpochState era, BaseM (tick era) ~ ShelleyBase, Environment (EraRule "NEWEPOCH" era) ~ (), State (EraRule "NEWEPOCH" era) ~ NewEpochState era, Signal (EraRule "NEWEPOCH" era) ~ EpochNo) ⇒ NewEpochState era → SlotNo → TransitionRule (tick era)
- validatingTickTransitionFORECAST ∷ ∀ tick era. (State (tick era) ~ NewEpochState era, BaseM (tick era) ~ ShelleyBase, State (EraRule "UPEC" era) ~ UpecState era, Signal (EraRule "UPEC" era) ~ (), Environment (EraRule "UPEC" era) ~ LedgerState era, Embed (EraRule "UPEC" era) (tick era), STS (tick era), GovState era ~ ShelleyGovState era, EraGov era) ⇒ NewEpochState era → SlotNo → TransitionRule (tick era)
- solidifyNextEpochPParams ∷ EraGov era ⇒ NewEpochState era → SlotNo → ShelleyBase (EpochNo, NewEpochState era)
- data ShelleyUPEC era
- data UpecState era = UpecState {
- usCurPParams ∷ !(PParams era)
- usGovState ∷ !(ShelleyGovState era)
- newtype ShelleyUpecPredFailure era = NewPpFailure (PredicateFailure (ShelleyNEWPP era))
- data ShelleyMIR era
- type family PredicateFailure a
- data ShelleyMirPredFailure era
- data ShelleyMirEvent era
- emptyInstantaneousRewards ∷ InstantaneousRewards
- data ShelleyNEWPP era
- data ShelleyNewppState era = NewppState (PParams era) (ShelleyGovState era)
- data NewppEnv era = NewppEnv {
- neCertState ∷ CertState era
- neUTxOState ∷ UTxOState era
- type family PredicateFailure a
- data ShelleyPOOLREAP era
- data ShelleyPoolreapEvent era = RetiredPools {
- refundPools ∷ Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
- unclaimedPools ∷ Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
- epochNo ∷ EpochNo
- data ShelleyPoolreapState era = PoolreapState {
- prUTxOSt ∷ UTxOState era
- prAccountState ∷ AccountState
- prDState ∷ DState era
- prPState ∷ PState era
- newtype ShelleyPoolreapEnv era = ShelleyPoolreapEnv {}
- type family PredicateFailure a
- data ShelleyPoolreapPredFailure era
Block
data ShelleyBBODY era Source #
Instances
data ShelleyBbodyState era Source #
Constructors
BbodyState !(State (EraRule "LEDGERS" era)) !BlocksMade |
Instances
Show (State (EraRule "LEDGERS" era)) ⇒ Show (ShelleyBbodyState era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Bbody Methods showsPrec ∷ Int → ShelleyBbodyState era → ShowS # show ∷ ShelleyBbodyState era → String # showList ∷ [ShelleyBbodyState era] → ShowS # | |
Eq (State (EraRule "LEDGERS" era)) ⇒ Eq (ShelleyBbodyState era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Bbody Methods (==) ∷ ShelleyBbodyState era → ShelleyBbodyState era → Bool # (/=) ∷ ShelleyBbodyState era → ShelleyBbodyState era → Bool # |
Constructors
BbodyEnv | |
Fields
|
data ShelleyBbodyPredFailure era Source #
Constructors
WrongBlockBodySizeBBODY (Mismatch 'RelEQ Int) |
|
InvalidBodyHashBBODY (Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)) |
|
LedgersFailure (PredicateFailure (EraRule "LEDGERS" era)) |
Instances
newtype ShelleyBbodyEvent era Source #
Constructors
LedgersEvent (Event (EraRule "LEDGERS" era)) |
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
Type of the state which the system transitions between.
Instances
data ShelleyDELEG era Source #
Instances
Constructors
DelegEnv | |
Fields
|
Instances
Generic (DelegEnv era) Source # | |
Show (PParams era) ⇒ Show (DelegEnv era) Source # | |
NFData (PParams era) ⇒ NFData (DelegEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Deleg | |
Eq (PParams era) ⇒ Eq (DelegEnv era) Source # | |
type Rep (DelegEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Deleg type Rep (DelegEnv era) = D1 ('MetaData "DelegEnv" "Cardano.Ledger.Shelley.Rules.Deleg" "cardano-ledger-shelley-1.16.0.0-inplace" 'False) (C1 ('MetaCons "DelegEnv" 'PrefixI 'True) ((S1 ('MetaSel ('Just "slotNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SlotNo) :*: S1 ('MetaSel ('Just "deCurEpochNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 EpochNo)) :*: (S1 ('MetaSel ('Just "ptr_") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Ptr) :*: (S1 ('MetaSel ('Just "acnt_") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AccountState) :*: S1 ('MetaSel ('Just "ppDE") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (PParams era)))))) |
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
data ShelleyDelegPredFailure era Source #
Constructors
Instances
newtype ShelleyDelegEvent era Source #
Constructors
DelegNewEpoch EpochNo |
Instances
data ShelleyDELEGS era Source #
Instances
Constructors
DelegsEnv | |
Fields
|
data ShelleyDelegsPredFailure era Source #
Constructors
DelegateeNotRegisteredDELEG (KeyHash 'StakePool) | Target pool which is not registered |
WithdrawalsNotInRewardsDELEGS (Map RewardAccount Coin) | Withdrawals that are missing or do not withdrawal the entire amount |
DelplFailure (PredicateFailure (EraRule "DELPL" era)) | Subtransition Failures |
Instances
newtype ShelleyDelegsEvent era Source #
Constructors
DelplEvent (Event (EraRule "DELPL" era)) |
Instances
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
validateZeroRewards ∷ ∀ era. DState era → Withdrawals → Network → Test (Map RewardAccount Coin) Source #
validateStakePoolDelegateeRegistered ∷ PState era → KeyHash 'StakePool → Test (KeyHash 'StakePool) Source #
drainWithdrawals ∷ DState era → Withdrawals → DState era Source #
data ShelleyDELPL era Source #
Instances
Constructors
DelplEnv | |
Fields
|
data ShelleyDelplPredFailure era Source #
Constructors
PoolFailure (PredicateFailure (EraRule "POOL" era)) | |
DelegFailure (PredicateFailure (EraRule "DELEG" era)) |
Instances
data ShelleyDelplEvent era Source #
Instances
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
data ShelleyLEDGER era Source #
Instances
Constructors
LedgerEnv | |
Fields
|
Instances
Generic (LedgerEnv era) Source # | |
Show (PParams era) ⇒ Show (LedgerEnv era) Source # | |
EraPParams era ⇒ EncCBOR (LedgerEnv era) Source # | |
NFData (PParams era) ⇒ NFData (LedgerEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Ledger | |
Eq (PParams era) ⇒ Eq (LedgerEnv era) Source # | |
type Rep (LedgerEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Ledger type Rep (LedgerEnv era) = D1 ('MetaData "LedgerEnv" "Cardano.Ledger.Shelley.Rules.Ledger" "cardano-ledger-shelley-1.16.0.0-inplace" 'False) (C1 ('MetaCons "LedgerEnv" 'PrefixI 'True) ((S1 ('MetaSel ('Just "ledgerSlotNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SlotNo) :*: S1 ('MetaSel ('Just "ledgerEpochNo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe EpochNo))) :*: (S1 ('MetaSel ('Just "ledgerIx") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TxIx) :*: (S1 ('MetaSel ('Just "ledgerPp") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (PParams era)) :*: S1 ('MetaSel ('Just "ledgerAccount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AccountState))))) |
ledgerAccountL ∷ Lens' (LedgerEnv era) AccountState Source #
data ShelleyLedgerPredFailure era Source #
Constructors
UtxowFailure (PredicateFailure (EraRule "UTXOW" era)) | |
DelegsFailure (PredicateFailure (EraRule "DELEGS" era)) |
Instances
data ShelleyLedgerEvent era Source #
Constructors
UtxowEvent (Event (EraRule "UTXOW" era)) | |
DelegsEvent (Event (EraRule "DELEGS" era)) |
Instances
Event type.
Instances
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
renderDepositEqualsObligationViolation ∷ (EraTx era, EraGov era, Environment t ~ LedgerEnv era, Signal t ~ Tx era, State t ~ LedgerState era) ⇒ AssertionViolation t → String Source #
shelleyLedgerAssertions ∷ (EraGov era, State (rule era) ~ LedgerState era) ⇒ [Assertion (rule era)] Source #
data ShelleyLEDGERS era Source #
Instances
data ShelleyLedgersEnv era Source #
Constructors
LedgersEnv | |
Fields |
Instances
newtype ShelleyLedgersPredFailure era Source #
Constructors
LedgerFailure (PredicateFailure (EraRule "LEDGER" era)) |
Instances
newtype ShelleyLedgersEvent era Source #
Constructors
LedgerEvent (Event (EraRule "LEDGER" era)) |
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
data ShelleyPOOL era Source #
Instances
Constructors
RegisterPool (KeyHash 'StakePool) | |
ReregisterPool (KeyHash 'StakePool) |
Instances
Generic (PoolEvent era) Source # | |
NFData (PoolEvent era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Pool | |
Eq (PoolEvent era) Source # | |
type Rep (PoolEvent era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Pool type Rep (PoolEvent era) = D1 ('MetaData "PoolEvent" "Cardano.Ledger.Shelley.Rules.Pool" "cardano-ledger-shelley-1.16.0.0-inplace" 'False) (C1 ('MetaCons "RegisterPool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (KeyHash 'StakePool))) :+: C1 ('MetaCons "ReregisterPool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (KeyHash 'StakePool)))) |
Instances
Generic (PoolEnv era) Source # | |
Show (PParams era) ⇒ Show (PoolEnv era) Source # | |
EraPParams era ⇒ EncCBOR (PoolEnv era) Source # | |
NFData (PParams era) ⇒ NFData (PoolEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Pool | |
Eq (PParams era) ⇒ Eq (PoolEnv era) Source # | |
type Rep (PoolEnv era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Pool type Rep (PoolEnv era) = D1 ('MetaData "PoolEnv" "Cardano.Ledger.Shelley.Rules.Pool" "cardano-ledger-shelley-1.16.0.0-inplace" 'False) (C1 ('MetaCons "PoolEnv" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 EpochNo) :*: S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (PParams era)))) |
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
data ShelleyPoolPredFailure era Source #
Constructors
Instances
data ShelleyPPUP era Source #
Instances
data ShelleyPpupPredFailure era Source #
Constructors
NonGenesisUpdatePPUP (Mismatch 'RelSubset (Set (KeyHash 'Genesis))) | An update was proposed by a key hash that is not one of the genesis keys.
|
PPUpdateWrongEpoch EpochNo EpochNo VotingPeriod | An update was proposed for the wrong epoch.
The first |
PVCannotFollowPPUP ProtVer | An update was proposed which contains an invalid protocol version. New protocol versions must either increase the major number by exactly one and set the minor version to zero, or keep the major version the same and increase the minor version by exactly one. |
Instances
data ShelleyGovState era Source #
Constructors
ShelleyGovState | |
Fields
|
Instances
newtype PpupEvent era Source #
Constructors
PpupNewEpoch EpochNo |
type family PredicateFailure a Source #
Descriptive type for the possible failures which might cause a transition to fail.
As a convention, PredicateFailure
s which are "structural" (meaning that
they are not "throwable" in practice, and are used to pass control from
one transition rule to another) are prefixed with S_
.
Structural PredicateFailure
s represent conditions between rules where
the disjunction of all rules' preconditions is equal to True
. That is,
either one rule will throw a structural PredicateFailure
and the other
will succeed, or vice-versa.
Instances
type PredicateFailure (ShelleyBBODY era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Bbody | |
type PredicateFailure (ShelleyDELEG era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Deleg | |
type PredicateFailure (ShelleyDELEGS era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Delegs | |
type PredicateFailure (ShelleyDELPL era) Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Delpl | |