Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Cardano.Ledger.Shelley.Core
Synopsis
- class (ShelleyEraTxCert era, EraTxBody era, ProtVerAtMost era 8) ⇒ ShelleyEraTxBody era where
- ttlTxBodyL ∷ ExactEra ShelleyEra era ⇒ Lens' (TxBody era) SlotNo
- updateTxBodyL ∷ Lens' (TxBody era) (StrictMaybe (Update era))
- newtype Withdrawals = Withdrawals {}
- class EraTxCert era ⇒ ShelleyEraTxCert era where
- mkRegTxCert ∷ StakeCredential → TxCert era
- getRegTxCert ∷ TxCert era → Maybe StakeCredential
- mkUnRegTxCert ∷ StakeCredential → TxCert era
- getUnRegTxCert ∷ TxCert era → Maybe StakeCredential
- mkDelegStakeTxCert ∷ StakeCredential → KeyHash 'StakePool → TxCert era
- getDelegStakeTxCert ∷ TxCert era → Maybe (StakeCredential, KeyHash 'StakePool)
- mkGenesisDelegTxCert ∷ ProtVerAtMost era 8 ⇒ GenesisDelegCert → TxCert era
- getGenesisDelegTxCert ∷ ProtVerAtMost era 8 ⇒ TxCert era → Maybe GenesisDelegCert
- mkMirTxCert ∷ ProtVerAtMost era 8 ⇒ MIRCert → TxCert era
- getMirTxCert ∷ ProtVerAtMost era 8 ⇒ TxCert era → Maybe MIRCert
- pattern MirTxCert ∷ (ShelleyEraTxCert era, ProtVerAtMost era 8) ⇒ MIRCert → TxCert era
- data MIRCert = MIRCert {
- mirPot ∷ !MIRPot
- mirRewards ∷ !MIRTarget
- data MIRPot
- data MIRTarget
- pattern GenesisDelegTxCert ∷ (ShelleyEraTxCert era, ProtVerAtMost era 8) ⇒ KeyHash 'Genesis → KeyHash 'GenesisDelegate → VRFVerKeyHash 'GenDelegVRF → TxCert era
- pattern RegTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → TxCert era
- pattern UnRegTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → TxCert era
- pattern DelegStakeTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → KeyHash 'StakePool → TxCert era
- type family Value era
- data Hash h a
- class (KnownNat (SizeHash h), Typeable h) ⇒ HashAlgorithm h
- newtype KeyHash (r ∷ KeyRole) = KeyHash {}
- class (Val (Value era), ToJSON (TxOut era), DecCBOR (Value era), DecCBOR (CompactForm (Value era)), MemPack (CompactForm (Value era)), EncCBOR (Value era), ToCBOR (TxOut era), EncCBOR (TxOut era), DecCBOR (TxOut era), DecShareCBOR (TxOut era), Share (TxOut era) ~ Interns (Credential 'Staking), NoThunks (TxOut era), NFData (TxOut era), Show (TxOut era), Eq (TxOut era), MemPack (TxOut era), EraPParams era) ⇒ EraTxOut era where
- type TxOut era = (r ∷ Type) | r → era
- mkBasicTxOut ∷ Addr → Value era → TxOut era
- upgradeTxOut ∷ TxOut (PreviousEra era) → TxOut era
- valueTxOutL ∷ Lens' (TxOut era) (Value era)
- compactValueTxOutL ∷ Lens' (TxOut era) (CompactForm (Value era))
- valueEitherTxOutL ∷ Lens' (TxOut era) (Either (Value era) (CompactForm (Value era)))
- addrTxOutL ∷ Lens' (TxOut era) Addr
- compactAddrTxOutL ∷ Lens' (TxOut era) CompactAddr
- addrEitherTxOutL ∷ Lens' (TxOut era) (Either Addr CompactAddr)
- getMinCoinSizedTxOut ∷ PParams era → Sized (TxOut era) → Coin
- getMinCoinTxOut ∷ PParams era → TxOut era → Coin
- type family TxOut era = (r ∷ Type) | r → era
- class (EraTxBody era, EraTxWits era, EraTxAuxData era, EraPParams era, NFData (Tx era), NoThunks (Tx era), DecCBOR (Tx era), EncCBOR (Tx era), ToCBOR (Tx era), Show (Tx era), Eq (Tx era), EqRaw (Tx era)) ⇒ EraTx era where
- type Tx era = (r ∷ Type) | r → era
- type TxUpgradeError era
- mkBasicTx ∷ TxBody era → Tx era
- bodyTxL ∷ Lens' (Tx era) (TxBody era)
- witsTxL ∷ Lens' (Tx era) (TxWits era)
- auxDataTxL ∷ Lens' (Tx era) (StrictMaybe (TxAuxData era))
- sizeTxF ∷ SimpleGetter (Tx era) Integer
- wireSizeTxF ∷ SimpleGetter (Tx era) Word32
- sizeTxForFeeCalculation ∷ Tx era → Integer
- validateNativeScript ∷ Tx era → NativeScript era → Bool
- getMinFeeTx ∷ PParams era → Tx era → Int → Coin
- upgradeTx ∷ Tx (PreviousEra era) → Either (TxUpgradeError era) (Tx era)
- type family Tx era = (r ∷ Type) | r → era
- type AtMostEra eraMostEra era = ProtVerAtMost era (ProtVerHigh eraMostEra)
- type AtLeastEra atLeastEra era = ProtVerAtLeast era (ProtVerLow atLeastEra)
- type ExactEra inEra era = ProtVerInBounds era (ProtVerLow inEra) (ProtVerHigh inEra)
- type ProtVerInBounds era (l ∷ Nat) (h ∷ Nat) = (ProtVerAtLeast era l, ProtVerAtMost era h)
- type family ProtVerAtMost era (h ∷ Nat) where ...
- type family ProtVerAtLeast era (l ∷ Nat) where ...
- class EraRuleEvent rule era ~ Event (EraRule rule era) ⇒ InjectRuleEvent (rule ∷ Symbol) (t ∷ Type → Type) era where
- injectEvent ∷ t era → EraRuleEvent rule era
- class EraRuleFailure rule era ~ PredicateFailure (EraRule rule era) ⇒ InjectRuleFailure (rule ∷ Symbol) (t ∷ Type → Type) era where
- injectFailure ∷ t era → EraRuleFailure rule era
- data VoidEraRule (rule ∷ Symbol) era
- type family EraRuleEvent (rule ∷ Symbol) era = (r ∷ Type) | r → rule era
- type family EraRuleFailure (rule ∷ Symbol) era = (r ∷ Type) | r → rule era
- type family EraRule (rule ∷ Symbol) era = (r ∷ Type) | r → rule
- data ByronEra
- class (Typeable era, KnownNat (ProtVerLow era), KnownNat (ProtVerHigh era), ProtVerLow era <= ProtVerHigh era, MinVersion <= ProtVerLow era, MinVersion <= ProtVerHigh era, CmpNat (ProtVerLow era) MaxVersion ~ 'LT, CmpNat (ProtVerHigh era) MaxVersion ~ 'LT, ProtVerLow era <= MaxVersion, ProtVerHigh era <= MaxVersion) ⇒ Era era where
- type PreviousEra era = (r ∷ Type) | r → era
- type ProtVerLow era ∷ Nat
- type ProtVerHigh era ∷ Nat
- eraName ∷ String
- type family PreviousEra era = (r ∷ Type) | r → era
- type family ProtVerLow era ∷ Nat
- type family ProtVerHigh era ∷ Nat
- class (Era era, Era (PreviousEra era)) ⇒ TranslateEra era (f ∷ Type → Type) where
- type TranslationError era (f ∷ Type → Type)
- translateEra ∷ TranslationContext era → f (PreviousEra era) → Except (TranslationError era f) (f era)
- type family TranslationError era (f ∷ Type → Type)
- type family TranslationContext era
- data KeyRole
- class SafeToHash x ⇒ HashAnnotated x i | x → i where
- hashAnnotated ∷ x → SafeHash i
- class SafeToHash t where
- originalBytes ∷ t → ByteString
- originalBytesSize ∷ t → Int
- makeHashWithExplicitProxys ∷ Proxy i → t → SafeHash i
- data SafeHash i
- newtype TxAuxDataHash = TxAuxDataHash {}
- newtype VRFVerKeyHash (r ∷ KeyRoleVRF) = VRFVerKeyHash {}
- data KeyRoleVRF
- newtype ScriptHash = ScriptHash (Hash ADDRHASH EraIndependentScript)
- data EraIndependentScriptIntegrity
- data EraIndependentPParamView
- data EraIndependentScriptData
- type DataHash = SafeHash EraIndependentData
- data EraIndependentData
- data EraIndependentScript
- data EraIndependentTxAuxData
- data EraIndependentMetadata
- data EraIndependentBlockBody
- data EraIndependentBlockHeader
- data EraIndependentTxBody
- type ADDRHASH = Blake2b_224
- type HASH = Blake2b_256
- data PParamUpdate era t = PParamUpdate {
- ppuTag ∷ Word
- ppuLens ∷ Lens' (PParamsUpdate era) (StrictMaybe t)
- data PParam era where
- class (Era era, Eq (PParamsHKD Identity era), Ord (PParamsHKD Identity era), Show (PParamsHKD Identity era), NFData (PParamsHKD Identity era), NoThunks (PParamsHKD Identity era), Eq (PParamsHKD StrictMaybe era), Ord (PParamsHKD StrictMaybe era), Show (PParamsHKD StrictMaybe era), NFData (PParamsHKD StrictMaybe era), NoThunks (PParamsHKD StrictMaybe era)) ⇒ EraPParams era where
- type PParamsHKD (f ∷ Type → Type) era = (r ∷ Type) | r → era
- type UpgradePParams (f ∷ Type → Type) era
- type DowngradePParams (f ∷ Type → Type) era
- applyPPUpdates ∷ PParams era → PParamsUpdate era → PParams era
- ppDG ∷ SimpleGetter (PParams era) UnitInterval
- ppProtocolVersionL ∷ Lens' (PParams era) ProtVer
- ppuProtocolVersionL ∷ Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
- type family PParamsHKD (f ∷ Type → Type) era = (r ∷ Type) | r → era
- type family UpgradePParams (f ∷ Type → Type) era
- type family DowngradePParams (f ∷ Type → Type) era
- newtype PParamsUpdate era = PParamsUpdate (PParamsHKD StrictMaybe era)
- newtype PParams era = PParams (PParamsHKD Identity era)
- data Reward = Reward {
- rewardType ∷ !RewardType
- rewardPool ∷ !(KeyHash 'StakePool)
- rewardAmount ∷ !Coin
- data RewardType
- data PoolCert
- = RegPool !PoolParams
- | RetirePool !(KeyHash 'StakePool) !EpochNo
- class (Era era, ToJSON (TxCert era), DecCBOR (TxCert era), EncCBOR (TxCert era), ToCBOR (TxCert era), FromCBOR (TxCert era), NoThunks (TxCert era), NFData (TxCert era), Show (TxCert era), Ord (TxCert era), Eq (TxCert era)) ⇒ EraTxCert era where
- type TxCert era = (r ∷ Type) | r → era
- type TxCertUpgradeError era
- upgradeTxCert ∷ TxCert (PreviousEra era) → Either (TxCertUpgradeError era) (TxCert era)
- getVKeyWitnessTxCert ∷ TxCert era → Maybe (KeyHash 'Witness)
- getScriptWitnessTxCert ∷ TxCert era → Maybe ScriptHash
- mkRegPoolTxCert ∷ PoolParams → TxCert era
- getRegPoolTxCert ∷ TxCert era → Maybe PoolParams
- mkRetirePoolTxCert ∷ KeyHash 'StakePool → EpochNo → TxCert era
- getRetirePoolTxCert ∷ TxCert era → Maybe (KeyHash 'StakePool, EpochNo)
- lookupRegStakeTxCert ∷ TxCert era → Maybe (Credential 'Staking)
- lookupUnRegStakeTxCert ∷ TxCert era → Maybe (Credential 'Staking)
- getTotalDepositsTxCerts ∷ Foldable f ⇒ PParams era → (KeyHash 'StakePool → Bool) → f (TxCert era) → Coin
- getTotalRefundsTxCerts ∷ Foldable f ⇒ PParams era → (Credential 'Staking → Maybe Coin) → (Credential 'DRepRole → Maybe Coin) → f (TxCert era) → Coin
- type family TxCert era = (r ∷ Type) | r → era
- type family TxCertUpgradeError era
- class (EraTx era, Eq (TxSeq era), Show (TxSeq era), EncCBORGroup (TxSeq era), DecCBOR (TxSeq era)) ⇒ EraSegWits era where
- type family TxSeq era = (r ∷ Type) | r → era
- class (Era era, Show (Script era), Eq (Script era), EqRaw (Script era), ToCBOR (Script era), EncCBOR (Script era), DecCBOR (Script era), NoThunks (Script era), SafeToHash (Script era), Eq (NativeScript era), Show (NativeScript era), NFData (NativeScript era), NoThunks (NativeScript era), EncCBOR (NativeScript era), DecCBOR (NativeScript era)) ⇒ EraScript era where
- type Script era = (r ∷ Type) | r → era
- type NativeScript era = (r ∷ Type) | r → era
- upgradeScript ∷ Script (PreviousEra era) → Script era
- scriptPrefixTag ∷ Script era → ByteString
- getNativeScript ∷ Script era → Maybe (NativeScript era)
- fromNativeScript ∷ NativeScript era → Script era
- type family Script era = (r ∷ Type) | r → era
- type family NativeScript era = (r ∷ Type) | r → era
- class (EraScript era, Eq (TxWits era), EqRaw (TxWits era), Show (TxWits era), Monoid (TxWits era), NoThunks (TxWits era), ToCBOR (TxWits era), EncCBOR (TxWits era), DecCBOR (TxWits era)) ⇒ EraTxWits era where
- type TxWits era = (r ∷ Type) | r → era
- mkBasicTxWits ∷ TxWits era
- addrTxWitsL ∷ Lens' (TxWits era) (Set (WitVKey 'Witness))
- bootAddrTxWitsL ∷ Lens' (TxWits era) (Set BootstrapWitness)
- scriptTxWitsL ∷ Lens' (TxWits era) (Map ScriptHash (Script era))
- upgradeTxWits ∷ TxWits (PreviousEra era) → TxWits era
- type family TxWits era = (r ∷ Type) | r → era
- class (Era era, Eq (TxAuxData era), EqRaw (TxAuxData era), Show (TxAuxData era), NoThunks (TxAuxData era), ToCBOR (TxAuxData era), EncCBOR (TxAuxData era), DecCBOR (TxAuxData era), HashAnnotated (TxAuxData era) EraIndependentTxAuxData) ⇒ EraTxAuxData era where
- type TxAuxData era = (r ∷ Type) | r → era
- mkBasicTxAuxData ∷ TxAuxData era
- metadataTxAuxDataL ∷ Lens' (TxAuxData era) (Map Word64 Metadatum)
- upgradeTxAuxData ∷ TxAuxData (PreviousEra era) → TxAuxData era
- validateTxAuxData ∷ ProtVer → TxAuxData era → Bool
- type family TxAuxData era = (r ∷ Type) | r → era
- class (EraTxOut era, EraTxCert era, EraPParams era, HashAnnotated (TxBody era) EraIndependentTxBody, DecCBOR (TxBody era), EncCBOR (TxBody era), ToCBOR (TxBody era), NoThunks (TxBody era), NFData (TxBody era), Show (TxBody era), Eq (TxBody era), EqRaw (TxBody era)) ⇒ EraTxBody era where
- data TxBody era
- type TxBodyUpgradeError era
- mkBasicTxBody ∷ TxBody era
- inputsTxBodyL ∷ Lens' (TxBody era) (Set TxIn)
- outputsTxBodyL ∷ Lens' (TxBody era) (StrictSeq (TxOut era))
- feeTxBodyL ∷ Lens' (TxBody era) Coin
- withdrawalsTxBodyL ∷ Lens' (TxBody era) Withdrawals
- auxDataHashTxBodyL ∷ Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
- spendableInputsTxBodyF ∷ SimpleGetter (TxBody era) (Set TxIn)
- allInputsTxBodyF ∷ SimpleGetter (TxBody era) (Set TxIn)
- certsTxBodyL ∷ Lens' (TxBody era) (StrictSeq (TxCert era))
- getTotalDepositsTxBody ∷ PParams era → (KeyHash 'StakePool → Bool) → TxBody era → Coin
- getTotalRefundsTxBody ∷ PParams era → (Credential 'Staking → Maybe Coin) → (Credential 'DRepRole → Maybe Coin) → TxBody era → Coin
- getGenesisKeyHashCountTxBody ∷ TxBody era → Int
- upgradeTxBody ∷ TxBody (PreviousEra era) → Either (TxBodyUpgradeError era) (TxBody era)
- data family TxBody era
- type family TxBodyUpgradeError era
- type family TxUpgradeError era
- pattern RetirePoolTxCert ∷ EraTxCert era ⇒ KeyHash 'StakePool → EpochNo → TxCert era
- pattern RegPoolTxCert ∷ EraTxCert era ⇒ PoolParams → TxCert era
- hashKey ∷ ∀ (kd ∷ KeyRole). VKey kd → KeyHash kd
- hashScript ∷ EraScript era ⇒ Script era → ScriptHash
- absurdEraRule ∷ ∀ (rule ∷ Symbol) era a. VoidEraRule rule era → a
- eraProtVerLow ∷ Era era ⇒ Version
- eraProtVerHigh ∷ Era era ⇒ Version
- eraProtVersions ∷ Era era ⇒ [Version]
- atLeastEra ∷ AtLeastEra eraName era ⇒ ()
- atMostEra ∷ AtMostEra eraName era ⇒ ()
- notSupportedInThisEra ∷ HasCallStack ⇒ a
- notSupportedInThisEraL ∷ HasCallStack ⇒ Lens' a b
- toEraCBOR ∷ (Era era, EncCBOR t) ⇒ t → Encoding
- fromEraCBOR ∷ (Era era, DecCBOR t) ⇒ Decoder s t
- fromEraShareCBOR ∷ (Era era, DecShareCBOR t) ⇒ Decoder s t
- eraDecoder ∷ ∀ era t s. Era era ⇒ Decoder s t → Decoder s t
- eraDecoderWithBytes ∷ ∀ era t s. Era era ⇒ ByteString → Decoder s t → Decoder s t
- translateEra' ∷ (TranslateEra era f, TranslationError era f ~ Void) ⇒ TranslationContext era → f (PreviousEra era) → f era
- translateEraMaybe ∷ (TranslateEra era f, TranslationError era f ~ ()) ⇒ TranslationContext era → f (PreviousEra era) → Maybe (f era)
- translateEraThroughCBOR ∷ (Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) ⇒ ti (PreviousEra era) → Except DecoderError (to era)
- hashTxBodySignature ∷ SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) → Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
- toVRFVerKeyHash ∷ ∀ v (r ∷ KeyRoleVRF). Hash HASH (VerKeyVRF v) → VRFVerKeyHash r
- fromVRFVerKeyHash ∷ ∀ (r ∷ KeyRoleVRF) v. VRFVerKeyHash r → Hash HASH (VerKeyVRF v)
- extractHash ∷ SafeHash i → Hash HASH i
- castSafeHash ∷ SafeHash i → SafeHash j
- genericApplyPPUpdates ∷ (Generic (PParamsHKD Identity era), Generic (PParamsHKD StrictMaybe era), Updatable (Rep (PParamsHKD Identity era) a) (Rep (PParamsHKD StrictMaybe era) u)) ⇒ PParams era → PParamsUpdate era → PParams era
- emptyPParams ∷ EraPParams era ⇒ PParams era
- emptyPParamsUpdate ∷ EraPParams era ⇒ PParamsUpdate era
- ppLensHKD ∷ ∀ era f. Functor f ⇒ (PParamsHKD Identity era → f (PParamsHKD Identity era)) → PParams era → f (PParams era)
- ppuLensHKD ∷ ∀ era f. Functor f ⇒ (PParamsHKD StrictMaybe era → f (PParamsHKD StrictMaybe era)) → PParamsUpdate era → f (PParamsUpdate era)
- ppMinFeeAL ∷ EraPParams era ⇒ Lens' (PParams era) Coin
- ppMinFeeBL ∷ EraPParams era ⇒ Lens' (PParams era) Coin
- ppMaxBBSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word32
- ppMaxTxSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word32
- ppMaxBHSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word16
- ppKeyDepositL ∷ EraPParams era ⇒ Lens' (PParams era) Coin
- ppPoolDepositL ∷ EraPParams era ⇒ Lens' (PParams era) Coin
- ppEMaxL ∷ EraPParams era ⇒ Lens' (PParams era) EpochInterval
- ppNOptL ∷ EraPParams era ⇒ Lens' (PParams era) Word16
- ppA0L ∷ EraPParams era ⇒ Lens' (PParams era) NonNegativeInterval
- ppRhoL ∷ EraPParams era ⇒ Lens' (PParams era) UnitInterval
- ppTauL ∷ EraPParams era ⇒ Lens' (PParams era) UnitInterval
- ppDL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParams era) UnitInterval
- ppExtraEntropyL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParams era) Nonce
- ppMinUTxOValueL ∷ (EraPParams era, ProtVerAtMost era 4) ⇒ Lens' (PParams era) Coin
- ppMinPoolCostL ∷ EraPParams era ⇒ Lens' (PParams era) Coin
- ppuMinFeeAL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- ppuMinFeeBL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- ppuMaxBBSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word32)
- ppuMaxTxSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word32)
- ppuMaxBHSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word16)
- ppuKeyDepositL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- ppuPoolDepositL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- ppuEMaxL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
- ppuNOptL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word16)
- ppuA0L ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
- ppuRhoL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
- ppuTauL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
- ppuDL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
- ppuExtraEntropyL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParamsUpdate era) (StrictMaybe Nonce)
- ppuMinUTxOValueL ∷ (EraPParams era, ProtVerAtMost era 4) ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- ppuMinPoolCostL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin)
- mapPParams ∷ (PParamsHKD Identity era1 → PParamsHKD Identity era2) → PParams era1 → PParams era2
- mapPParamsUpdate ∷ (PParamsHKD StrictMaybe era1 → PParamsHKD StrictMaybe era2) → PParamsUpdate era1 → PParamsUpdate era2
- upgradePParams ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ UpgradePParams Identity era → PParams (PreviousEra era) → PParams era
- downgradePParams ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ DowngradePParams Identity era → PParams era → PParams (PreviousEra era)
- upgradePParamsUpdate ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ UpgradePParams StrictMaybe era → PParamsUpdate (PreviousEra era) → PParamsUpdate era
- downgradePParamsUpdate ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ DowngradePParams StrictMaybe era → PParamsUpdate era → PParamsUpdate (PreviousEra era)
- getPoolCertTxCert ∷ EraTxCert era ⇒ TxCert era → Maybe PoolCert
- poolCertKeyHashWitness ∷ PoolCert → KeyHash 'Witness
- isRegStakeTxCert ∷ EraTxCert era ⇒ TxCert era → Bool
- isUnRegStakeTxCert ∷ EraTxCert era ⇒ TxCert era → Bool
- bootAddrTxOutF ∷ EraTxOut era ⇒ SimpleGetter (TxOut era) (Maybe BootstrapAddress)
- coinTxOutL ∷ (HasCallStack, EraTxOut era) ⇒ Lens' (TxOut era) Coin
- compactCoinTxOutL ∷ (HasCallStack, EraTxOut era) ⇒ Lens' (TxOut era) (CompactForm Coin)
- isAdaOnlyTxOutF ∷ EraTxOut era ⇒ SimpleGetter (TxOut era) Bool
- mkCoinTxOut ∷ EraTxOut era ⇒ Addr → Coin → TxOut era
- hashTxAuxData ∷ EraTxAuxData era ⇒ TxAuxData era → TxAuxDataHash
- hashScriptTxWitsL ∷ EraTxWits era ⇒ Lens (TxWits era) (TxWits era) (Map ScriptHash (Script era)) [Script era]
- keyHashWitnessesTxWits ∷ EraTxWits era ⇒ TxWits era → Set (KeyHash 'Witness)
- isNativeScript ∷ EraScript era ⇒ Script era → Bool
- bBodySize ∷ EraSegWits era ⇒ ProtVer → TxSeq era → Int
- txIdTx ∷ EraTx era ⇒ Tx era → TxId
- txIdTxBody ∷ EraTxBody era ⇒ TxBody era → TxId
- module Cardano.Ledger.Shelley.Governance
Documentation
class (ShelleyEraTxCert era, EraTxBody era, ProtVerAtMost era 8) ⇒ ShelleyEraTxBody era where Source #
Methods
ttlTxBodyL ∷ ExactEra ShelleyEra era ⇒ Lens' (TxBody era) SlotNo Source #
updateTxBodyL ∷ Lens' (TxBody era) (StrictMaybe (Update era)) Source #
Instances
ShelleyEraTxBody ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxBody Methods ttlTxBodyL ∷ Lens' (TxBody ShelleyEra) SlotNo Source # updateTxBodyL ∷ Lens' (TxBody ShelleyEra) (StrictMaybe (Update ShelleyEra)) Source # |
newtype Withdrawals Source #
This is called wdrl
in the spec.
Constructors
Withdrawals | |
Fields |
Instances
class EraTxCert era ⇒ ShelleyEraTxCert era where Source #
Methods
mkRegTxCert ∷ StakeCredential → TxCert era Source #
getRegTxCert ∷ TxCert era → Maybe StakeCredential Source #
mkUnRegTxCert ∷ StakeCredential → TxCert era Source #
getUnRegTxCert ∷ TxCert era → Maybe StakeCredential Source #
mkDelegStakeTxCert ∷ StakeCredential → KeyHash 'StakePool → TxCert era Source #
getDelegStakeTxCert ∷ TxCert era → Maybe (StakeCredential, KeyHash 'StakePool) Source #
mkGenesisDelegTxCert ∷ ProtVerAtMost era 8 ⇒ GenesisDelegCert → TxCert era Source #
getGenesisDelegTxCert ∷ ProtVerAtMost era 8 ⇒ TxCert era → Maybe GenesisDelegCert Source #
mkMirTxCert ∷ ProtVerAtMost era 8 ⇒ MIRCert → TxCert era Source #
getMirTxCert ∷ ProtVerAtMost era 8 ⇒ TxCert era → Maybe MIRCert Source #
Instances
pattern MirTxCert ∷ (ShelleyEraTxCert era, ProtVerAtMost era 8) ⇒ MIRCert → TxCert era Source #
Move instantaneous rewards certificate
Constructors
MIRCert | |
Fields
|
Instances
ToJSON MIRCert Source # | |
Generic MIRCert Source # | |
Show MIRCert Source # | |
DecCBOR MIRCert Source # | |
EncCBOR MIRCert Source # | |
NFData MIRCert Source # | |
Defined in Cardano.Ledger.Shelley.TxCert | |
Eq MIRCert Source # | |
Ord MIRCert Source # | |
NoThunks MIRCert Source # | |
type Rep MIRCert Source # | |
Defined in Cardano.Ledger.Shelley.TxCert type Rep MIRCert = D1 ('MetaData "MIRCert" "Cardano.Ledger.Shelley.TxCert" "cardano-ledger-shelley-1.17.0.0-inplace" 'False) (C1 ('MetaCons "MIRCert" 'PrefixI 'True) (S1 ('MetaSel ('Just "mirPot") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 MIRPot) :*: S1 ('MetaSel ('Just "mirRewards") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 MIRTarget))) |
Constructors
ReservesMIR | |
TreasuryMIR |
Instances
ToJSON MIRPot Source # | |
Bounded MIRPot Source # | |
Enum MIRPot Source # | |
Defined in Cardano.Ledger.Shelley.TxCert | |
Generic MIRPot Source # | |
Show MIRPot Source # | |
DecCBOR MIRPot Source # | |
EncCBOR MIRPot Source # | |
NFData MIRPot Source # | |
Defined in Cardano.Ledger.Shelley.TxCert | |
Eq MIRPot Source # | |
Ord MIRPot Source # | |
NoThunks MIRPot Source # | |
type Rep MIRPot Source # | |
MIRTarget specifies if funds from either the reserves or the treasury are to be handed out to a collection of reward accounts or instead transfered to the opposite pot.
Constructors
StakeAddressesMIR !(Map (Credential 'Staking) DeltaCoin) | |
SendToOppositePotMIR !Coin |
Instances
ToJSON MIRTarget Source # | |
Generic MIRTarget Source # | |
Show MIRTarget Source # | |
DecCBOR MIRTarget Source # | |
EncCBOR MIRTarget Source # | |
NFData MIRTarget Source # | |
Defined in Cardano.Ledger.Shelley.TxCert | |
Eq MIRTarget Source # | |
Ord MIRTarget Source # | |
Defined in Cardano.Ledger.Shelley.TxCert | |
NoThunks MIRTarget Source # | |
type Rep MIRTarget Source # | |
Defined in Cardano.Ledger.Shelley.TxCert type Rep MIRTarget = D1 ('MetaData "MIRTarget" "Cardano.Ledger.Shelley.TxCert" "cardano-ledger-shelley-1.17.0.0-inplace" 'False) (C1 ('MetaCons "StakeAddressesMIR" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map (Credential 'Staking) DeltaCoin))) :+: C1 ('MetaCons "SendToOppositePotMIR" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Coin))) |
pattern GenesisDelegTxCert ∷ (ShelleyEraTxCert era, ProtVerAtMost era 8) ⇒ KeyHash 'Genesis → KeyHash 'GenesisDelegate → VRFVerKeyHash 'GenDelegVRF → TxCert era Source #
pattern RegTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → TxCert era Source #
pattern UnRegTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → TxCert era Source #
pattern DelegStakeTxCert ∷ ShelleyEraTxCert era ⇒ StakeCredential → KeyHash 'StakePool → TxCert era Source #
type family Value era Source #
A value is something which quantifies a transaction output.
Instances
type Value ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Era |
Instances
HashAlgorithm h ⇒ IsString (Q (TExp (Hash h a))) | This instance is meant to be used with
|
Defined in Cardano.Crypto.Hash.Class | |
HashAlgorithm h ⇒ FromJSON (Hash h a) | |
HashAlgorithm h ⇒ FromJSONKey (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class Methods fromJSONKey ∷ FromJSONKeyFunction (Hash h a) Source # fromJSONKeyList ∷ FromJSONKeyFunction [Hash h a] Source # | |
HashAlgorithm h ⇒ ToJSON (Hash h a) | |
HashAlgorithm h ⇒ ToJSONKey (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class Methods toJSONKey ∷ ToJSONKeyFunction (Hash h a) Source # toJSONKeyList ∷ ToJSONKeyFunction [Hash h a] Source # | |
HashAlgorithm h ⇒ IsString (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class Methods fromString ∷ String → Hash h a # | |
Generic (Hash h a) | |
HashAlgorithm h ⇒ Read (Hash h a) | |
Show (Hash h a) | |
(HashAlgorithm h, Typeable a) ⇒ FromCBOR (Hash h a) | |
(HashAlgorithm h, Typeable a) ⇒ ToCBOR (Hash h a) | |
(HashAlgorithm h, Typeable a) ⇒ DecCBOR (Hash h a) | |
(HashAlgorithm h, Typeable a) ⇒ EncCBOR (Hash h a) | |
HashAlgorithm h ⇒ SafeToHash (Hash h i) | Hash of a hash. Hash is always safe to hash. Do you even hash? |
Defined in Cardano.Ledger.Hashes Methods originalBytes ∷ Hash h i → ByteString Source # originalBytesSize ∷ Hash h i → Int Source # makeHashWithExplicitProxys ∷ Proxy i0 → Hash h i → SafeHash i0 Source # | |
NFData (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class | |
Eq (Hash h a) | |
Ord (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class | |
HeapWords (Hash h a) | |
HashAlgorithm h ⇒ MemPack (Hash h a) | |
NoThunks (Hash h a) | |
HashAlgorithm h ⇒ IsString (Code Q (Hash h a)) | |
Defined in Cardano.Crypto.Hash.Class | |
type Rep (Hash h a) | |
Defined in Cardano.Crypto.Hash.Class type Rep (Hash h a) = D1 ('MetaData "Hash" "Cardano.Crypto.Hash.Class" "cardano-crypto-class-2.2.1.0-319b3ff27e2497eb2cedb84a3b8aeefbb6d7ca20646e71e44bcc1020e99988d6" 'True) (C1 ('MetaCons "UnsafeHashRep" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (PackedBytes (SizeHash h))))) |
class (KnownNat (SizeHash h), Typeable h) ⇒ HashAlgorithm h Source #
Minimal complete definition
Instances
newtype KeyHash (r ∷ KeyRole) Source #
Discriminated hash of public Key
Instances
HasKeyRole KeyHash | |
Defined in Cardano.Ledger.Hashes | |
FromJSON (KeyHash r) | |
FromJSONKey (KeyHash r) | |
Defined in Cardano.Ledger.Hashes Methods | |
ToJSON (KeyHash r) | |
ToJSONKey (KeyHash r) | |
Defined in Cardano.Ledger.Hashes Methods toJSONKey ∷ ToJSONKeyFunction (KeyHash r) Source # | |
Generic (KeyHash r) | |
Show (KeyHash r) | |
Typeable r ⇒ FromCBOR (KeyHash r) | |
Typeable r ⇒ ToCBOR (KeyHash r) | |
Typeable r ⇒ DecCBOR (KeyHash r) | |
Typeable r ⇒ EncCBOR (KeyHash r) | |
Default (KeyHash r) | |
Defined in Cardano.Ledger.Hashes | |
NFData (KeyHash r) | |
Defined in Cardano.Ledger.Hashes | |
Eq (KeyHash r) | |
Ord (KeyHash r) | |
Defined in Cardano.Ledger.Hashes | |
MemPack (KeyHash r) | |
NoThunks (KeyHash r) | |
type Rep (KeyHash r) | |
Defined in Cardano.Ledger.Hashes |
class (Val (Value era), ToJSON (TxOut era), DecCBOR (Value era), DecCBOR (CompactForm (Value era)), MemPack (CompactForm (Value era)), EncCBOR (Value era), ToCBOR (TxOut era), EncCBOR (TxOut era), DecCBOR (TxOut era), DecShareCBOR (TxOut era), Share (TxOut era) ~ Interns (Credential 'Staking), NoThunks (TxOut era), NFData (TxOut era), Show (TxOut era), Eq (TxOut era), MemPack (TxOut era), EraPParams era) ⇒ EraTxOut era where Source #
Abstract interface into specific fields of a TxOut
Minimal complete definition
mkBasicTxOut, upgradeTxOut, valueEitherTxOutL, addrEitherTxOutL, (getMinCoinSizedTxOut | getMinCoinTxOut)
Associated Types
type TxOut era = (r ∷ Type) | r → era Source #
The output of a UTxO for a particular era
Methods
mkBasicTxOut ∷ Addr → Value era → TxOut era Source #
upgradeTxOut ∷ TxOut (PreviousEra era) → TxOut era Source #
Every era, except Shelley, must be able to upgrade a TxOut
from a previous era.
valueTxOutL ∷ Lens' (TxOut era) (Value era) Source #
compactValueTxOutL ∷ Lens' (TxOut era) (CompactForm (Value era)) Source #
valueEitherTxOutL ∷ Lens' (TxOut era) (Either (Value era) (CompactForm (Value era))) Source #
Lens for getting and setting in TxOut either an address or its compact version by doing the least amount of work.
addrTxOutL ∷ Lens' (TxOut era) Addr Source #
compactAddrTxOutL ∷ Lens' (TxOut era) CompactAddr Source #
addrEitherTxOutL ∷ Lens' (TxOut era) (Either Addr CompactAddr) Source #
Lens for getting and setting in TxOut either an address or its compact version by doing the least amount of work.
The utility of this function comes from the fact that TxOut usually stores
the address in either one of two forms: compacted or unpacked. In order to
avoid extroneous conversions in getTxOutAddr
and getTxOutCompactAddr
we
can define just this functionality. Also sometimes it is crucial to know at
the callsite which form of address we have readily available without any
conversions (eg. searching millions of TxOuts for a particular address)
getMinCoinSizedTxOut ∷ PParams era → Sized (TxOut era) → Coin Source #
Produce the minimum lovelace that a given transaction output must
contain. Information about the size of the TxOut is required in some eras.
Use getMinCoinTxOut
if you don't have the size readily available to you.
getMinCoinTxOut ∷ PParams era → TxOut era → Coin Source #
Same as getMinCoinSizedTxOut
, except information about the size of
TxOut will be computed by serializing the TxOut. If the size turns out to
be not needed, then serialization will have no overhead, since it is
computed lazily.
Instances
EraTxOut ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxOut Associated Types type TxOut ShelleyEra = (r ∷ Type) Source # Methods mkBasicTxOut ∷ Addr → Value ShelleyEra → TxOut ShelleyEra Source # upgradeTxOut ∷ TxOut (PreviousEra ShelleyEra) → TxOut ShelleyEra Source # valueTxOutL ∷ Lens' (TxOut ShelleyEra) (Value ShelleyEra) Source # compactValueTxOutL ∷ Lens' (TxOut ShelleyEra) (CompactForm (Value ShelleyEra)) Source # valueEitherTxOutL ∷ Lens' (TxOut ShelleyEra) (Either (Value ShelleyEra) (CompactForm (Value ShelleyEra))) Source # addrTxOutL ∷ Lens' (TxOut ShelleyEra) Addr Source # compactAddrTxOutL ∷ Lens' (TxOut ShelleyEra) CompactAddr Source # addrEitherTxOutL ∷ Lens' (TxOut ShelleyEra) (Either Addr CompactAddr) Source # getMinCoinSizedTxOut ∷ PParams ShelleyEra → Sized (TxOut ShelleyEra) → Coin Source # getMinCoinTxOut ∷ PParams ShelleyEra → TxOut ShelleyEra → Coin Source # |
type family TxOut era = (r ∷ Type) | r → era Source #
The output of a UTxO for a particular era
Instances
type TxOut ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxOut |
class (EraTxBody era, EraTxWits era, EraTxAuxData era, EraPParams era, NFData (Tx era), NoThunks (Tx era), DecCBOR (Tx era), EncCBOR (Tx era), ToCBOR (Tx era), Show (Tx era), Eq (Tx era), EqRaw (Tx era)) ⇒ EraTx era where Source #
A transaction.
Minimal complete definition
mkBasicTx, bodyTxL, witsTxL, auxDataTxL, sizeTxF, wireSizeTxF, validateNativeScript, getMinFeeTx, upgradeTx
Associated Types
type Tx era = (r ∷ Type) | r → era Source #
type TxUpgradeError era Source #
type TxUpgradeError era = Void
Methods
mkBasicTx ∷ TxBody era → Tx era Source #
bodyTxL ∷ Lens' (Tx era) (TxBody era) Source #
witsTxL ∷ Lens' (Tx era) (TxWits era) Source #
auxDataTxL ∷ Lens' (Tx era) (StrictMaybe (TxAuxData era)) Source #
sizeTxF ∷ SimpleGetter (Tx era) Integer Source #
For fee calculation and estimations of impact on block space
wireSizeTxF ∷ SimpleGetter (Tx era) Word32 Source #
For end use by eg. diffusion layer in transaction submission protocol
sizeTxForFeeCalculation ∷ Tx era → Integer Source #
For fee calculation and estimations of impact on block space
To replace sizeTxF
after it has been proved equivalent to it .
validateNativeScript ∷ Tx era → NativeScript era → Bool Source #
Using information from the transaction validate the supplied native script.
Arguments
∷ PParams era | |
→ Tx era | |
→ Int | Size in bytes of reference scripts present in this transaction |
→ Coin |
Minimum fee calculation excluding witnesses
upgradeTx ∷ Tx (PreviousEra era) → Either (TxUpgradeError era) (Tx era) Source #
Instances
EraTx ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Tx.Internal Methods mkBasicTx ∷ TxBody ShelleyEra → Tx ShelleyEra Source # bodyTxL ∷ Lens' (Tx ShelleyEra) (TxBody ShelleyEra) Source # witsTxL ∷ Lens' (Tx ShelleyEra) (TxWits ShelleyEra) Source # auxDataTxL ∷ Lens' (Tx ShelleyEra) (StrictMaybe (TxAuxData ShelleyEra)) Source # sizeTxF ∷ SimpleGetter (Tx ShelleyEra) Integer Source # wireSizeTxF ∷ SimpleGetter (Tx ShelleyEra) Word32 Source # sizeTxForFeeCalculation ∷ Tx ShelleyEra → Integer Source # validateNativeScript ∷ Tx ShelleyEra → NativeScript ShelleyEra → Bool Source # getMinFeeTx ∷ PParams ShelleyEra → Tx ShelleyEra → Int → Coin Source # upgradeTx ∷ Tx (PreviousEra ShelleyEra) → Either (TxUpgradeError ShelleyEra) (Tx ShelleyEra) Source # |
type family Tx era = (r ∷ Type) | r → era Source #
Instances
type Tx ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Tx.Internal |
type AtMostEra eraMostEra era = ProtVerAtMost era (ProtVerHigh eraMostEra) Source #
Restrict the era
to equal to eraName
or come before it.
type AtLeastEra atLeastEra era = ProtVerAtLeast era (ProtVerLow atLeastEra) Source #
Restrict the era
to equal to atLeastEra
or come after it
type ExactEra inEra era = ProtVerInBounds era (ProtVerLow inEra) (ProtVerHigh inEra) Source #
Restrict an era to the specific era through the protocol version. This is
equivalent to (inEra (Crypto era) ~ era)
type ProtVerInBounds era (l ∷ Nat) (h ∷ Nat) = (ProtVerAtLeast era l, ProtVerAtMost era h) Source #
Restrict a lower and upper bounds of the protocol version for the particular era
type family ProtVerAtMost era (h ∷ Nat) where ... Source #
Requirement for the era's lowest protocol version to be lower or equal to the supplied value
Equations
ProtVerAtMost era h = ProtVerIsInBounds "at most" era h (ProtVerLow era <=? h) |
type family ProtVerAtLeast era (l ∷ Nat) where ... Source #
Requirement for the era's highest protocol version to be higher or equal to the supplied value
Equations
ProtVerAtLeast era l = ProtVerIsInBounds "at least" era l (l <=? ProtVerHigh era) |
class EraRuleEvent rule era ~ Event (EraRule rule era) ⇒ InjectRuleEvent (rule ∷ Symbol) (t ∷ Type → Type) era where Source #
Minimal complete definition
Nothing
Methods
injectEvent ∷ t era → EraRuleEvent rule era Source #
class EraRuleFailure rule era ~ PredicateFailure (EraRule rule era) ⇒ InjectRuleFailure (rule ∷ Symbol) (t ∷ Type → Type) era where Source #
Minimal complete definition
Nothing
Methods
injectFailure ∷ t era → EraRuleFailure rule era Source #
Instances
data VoidEraRule (rule ∷ Symbol) era Source #
This is a type with no inhabitans for the rules. It is used to indicate that a rule does not have a predicate failure as well as marking rules that have been disabled when comparing to prior eras.
Instances
type family EraRuleEvent (rule ∷ Symbol) era = (r ∷ Type) | r → rule era Source #
Instances
type EraRuleEvent "LEDGER" ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Ledger | |
type EraRuleEvent "LEDGERS" ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Ledgers | |
type EraRuleEvent "NEWEPOCH" ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Rules.NewEpoch | |
type EraRuleEvent "POOLREAP" ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Rules.PoolReap | |
type EraRuleEvent "TICK" ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Rules.Tick |
type family EraRuleFailure (rule ∷ Symbol) era = (r ∷ Type) | r → rule era Source #
EraRuleFailure
type family is needed for injectivity, which STS' PredicateFailure
does not provide for us unfortunately.
Instances
type family EraRule (rule ∷ Symbol) era = (r ∷ Type) | r → rule Source #
Era STS map
Instances
This is the era that preceded Shelley era. It cannot have any other class instances,
except for Era
type class.
Instances
Era ByronEra | |
Defined in Cardano.Ledger.Core.Era Associated Types type PreviousEra ByronEra = (r ∷ Type) Source # type ProtVerLow ByronEra ∷ Nat Source # type ProtVerHigh ByronEra ∷ Nat Source # | |
type PreviousEra ByronEra | |
Defined in Cardano.Ledger.Core.Era | |
type ProtVerHigh ByronEra | |
Defined in Cardano.Ledger.Core.Era | |
type ProtVerLow ByronEra | |
Defined in Cardano.Ledger.Core.Era |
class (Typeable era, KnownNat (ProtVerLow era), KnownNat (ProtVerHigh era), ProtVerLow era <= ProtVerHigh era, MinVersion <= ProtVerLow era, MinVersion <= ProtVerHigh era, CmpNat (ProtVerLow era) MaxVersion ~ 'LT, CmpNat (ProtVerHigh era) MaxVersion ~ 'LT, ProtVerLow era <= MaxVersion, ProtVerHigh era <= MaxVersion) ⇒ Era era where Source #
Associated Types
type PreviousEra era = (r ∷ Type) | r → era Source #
Map an era to its predecessor.
For example:
type instance PreviousEra (AllegraEra c) = ShelleyEra c
type ProtVerLow era ∷ Nat Source #
Lowest major protocol version for this era
type ProtVerHigh era ∷ Nat Source #
Highest major protocol version for this era. By default se to ProtVerLow
type ProtVerHigh era = ProtVerLow era
Methods
Textual name of the current era.
Designed to be used with TypeApplications
:
>>>
eraName @ByronEra
Byron
Instances
Era ByronEra | |
Defined in Cardano.Ledger.Core.Era Associated Types type PreviousEra ByronEra = (r ∷ Type) Source # type ProtVerLow ByronEra ∷ Nat Source # type ProtVerHigh ByronEra ∷ Nat Source # | |
Era ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Era Associated Types type PreviousEra ShelleyEra = (r ∷ Type) Source # type ProtVerLow ShelleyEra ∷ Nat Source # type ProtVerHigh ShelleyEra ∷ Nat Source # |
type family PreviousEra era = (r ∷ Type) | r → era Source #
Map an era to its predecessor.
For example:
type instance PreviousEra (AllegraEra c) = ShelleyEra c
Instances
type PreviousEra ByronEra | |
Defined in Cardano.Ledger.Core.Era | |
type PreviousEra ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Era |
type family ProtVerLow era ∷ Nat Source #
Lowest major protocol version for this era
Instances
type ProtVerLow ByronEra | |
Defined in Cardano.Ledger.Core.Era | |
type ProtVerLow ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Era |
type family ProtVerHigh era ∷ Nat Source #
Highest major protocol version for this era. By default se to ProtVerLow
Instances
type ProtVerHigh ByronEra | |
Defined in Cardano.Ledger.Core.Era | |
type ProtVerHigh ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Era |
class (Era era, Era (PreviousEra era)) ⇒ TranslateEra era (f ∷ Type → Type) where Source #
Translation of types between eras, e.g., from Shelley to Allegra.
When era
is just a phantom type parameter, an empty standalone deriving can be used:
newtype Foo era = Foo Int instance TranslateEra AllegraEra Foo
Note that one could use DerivingAnyClass
(deriving (TranslateEra (Allegra
c))
), but this would introduce an undesired coupling between the
era-parametric type and (a) particular era(s). The intention is to have a
module with orphan instances per era.
In most cases, the era
parameter won't be phantom, and a manual instance
will have to be written:
newtype Bar era = Bar (TxBody era) instance TranslateEra AllegraEra Bar where translateEra ctxt = Bar <$> translateEra ctxt -- With the following instance being in scope: instance TranslatEra AllegraEra TxBody
Note: we use PreviousEra
instead of NextEra
as an era definitely knows
its predecessor, but not necessarily its successor. Moreover, one could argue
that it makes more sense to define the translation from era A to era B where
era B is defined, than where era A is defined.
Minimal complete definition
Nothing
Associated Types
type TranslationError era (f ∷ Type → Type) Source #
Most translations should be infallible (default instance), but we leave the door open for partial translations.
For a partial translation, override the default type to be ()
or a
concrete error type.
type TranslationError era (f ∷ Type → Type) = Void
Methods
translateEra ∷ TranslationContext era → f (PreviousEra era) → Except (TranslationError era f) (f era) Source #
Translate a type f
parameterised by the era from an era to the era
after it.
The translation is a given the translation context of era
.
A default instance is provided for when the two types are Coercible
.
type family TranslationError era (f ∷ Type → Type) Source #
Most translations should be infallible (default instance), but we leave the door open for partial translations.
For a partial translation, override the default type to be ()
or a
concrete error type.
type family TranslationContext era Source #
Per-era context used for TranslateEra
.
This context will be passed to the translation instances of all types of that particular era. In practice, most instances won't need the context, but this approach makes the translation composable (as opposed to having a separate context per type).
Instances
The role of a key.
All key roles are fixed and unique, except for the Witness
role. In particular,
keys can be cast to a Witness
role with the help of asWitness
, because same witness
can be valid for many roles.
In fact, it is perfectly allowable for a key to be used in many roles by the end user; there is nothing prohibiting somebody using the same underlying key or a script as their payment and staking credential, as well as the key for their stake pool. However, in the ledger code mixing up keys with different roles could be catastrophic, that is why we have this separation.
class SafeToHash x ⇒ HashAnnotated x i | x → i where Source #
Types that are SafeToHash
AND have the type uniquely determines the index
type
tag of SafeHash
index
The SafeToHash
and the HashAnnotated
classes are designed so that their instances
can be easily derived (because their methods have default methods when the type is a
newtype around a type that is SafeToHash
). For example,
Minimal complete definition
Nothing
Methods
hashAnnotated ∷ x → SafeHash i Source #
Create a (
, given SafeHash
i)(
instance.HashAnnotated
x i)
Instances
HashAnnotated AnchorData AnchorData | |
Defined in Cardano.Ledger.BaseTypes Methods | |
HashAnnotated (TxBody ShelleyEra) EraIndependentTxBody Source # | |
Defined in Cardano.Ledger.Shelley.TxBody Methods hashAnnotated ∷ TxBody ShelleyEra → SafeHash EraIndependentTxBody Source # | |
HashAnnotated (ShelleyTxAuxData era) EraIndependentTxAuxData Source # | |
Defined in Cardano.Ledger.Shelley.TxAuxData Methods hashAnnotated ∷ ShelleyTxAuxData era → SafeHash EraIndependentTxAuxData Source # |
class SafeToHash t where Source #
Only Types that preserve their serialisation bytes are members of the
class SafeToHash
. There are only a limited number of primitive direct
instances of SafeToHash
, all but two of them are present in this file. Instead
of making explicit instances, we almost always use a newtype (around a type S
)
where their is already an instance (SafeToHash S)
. In that case the newtype
has its SafeToHash instance derived using newtype deriving. The prime example of s
is MemoBytes
.
The only exceptions are the legacy Shelley types: Metadata
and ShelleyTx
, that
preserve their serialization bytes
using a different mechanism than the use of MemoBytes
. SafeToHash
is a superclass
requirement of the classes HashAnnotated
which
provide more convenient ways to construct SafeHashes than using makeHashWithExplicitProxys
.
Minimal complete definition
Methods
originalBytes ∷ t → ByteString Source #
Extract the original bytes from t
originalBytesSize ∷ t → Int Source #
makeHashWithExplicitProxys ∷ Proxy i → t → SafeHash i Source #
Instances
A SafeHash
is a hash of something that is safe to hash. Such types store their own
serialisation bytes. The prime example is (
, but other examples are
things that consist of only ByteStrings (i.e. they are their own serialization) or for
some other reason store their original bytes.MemoBytes
t)
We do NOT export the constructor SafeHash
, but instead export other functions such as
hashAnnotated
and extractHash
which have constraints that limit their application
to types which preserve their original serialization bytes.
Instances
FromJSON (SafeHash i) | |
ToJSON (SafeHash i) | |
Show (SafeHash i) | |
Typeable i ⇒ FromCBOR (SafeHash i) | |
Typeable i ⇒ ToCBOR (SafeHash i) | |
Typeable i ⇒ DecCBOR (SafeHash i) | |
Typeable i ⇒ EncCBOR (SafeHash i) | |
SafeToHash (SafeHash i) | |
Defined in Cardano.Ledger.Hashes Methods originalBytes ∷ SafeHash i → ByteString Source # originalBytesSize ∷ SafeHash i → Int Source # makeHashWithExplicitProxys ∷ Proxy i0 → SafeHash i → SafeHash i0 Source # | |
Default (SafeHash i) | |
Defined in Cardano.Ledger.Hashes | |
NFData (SafeHash i) | |
Defined in Cardano.Ledger.Hashes | |
Eq (SafeHash i) | |
Ord (SafeHash i) | |
Defined in Cardano.Ledger.Hashes | |
MemPack (SafeHash i) | |
NoThunks (SafeHash i) | |
newtype TxAuxDataHash Source #
Constructors
TxAuxDataHash | |
Instances
newtype VRFVerKeyHash (r ∷ KeyRoleVRF) Source #
Discriminated hash of VRF Verification Key
Constructors
VRFVerKeyHash | |
Fields |
Instances
data KeyRoleVRF Source #
Constructors
StakePoolVRF | |
GenDelegVRF | |
BlockIssuerVRF |
newtype ScriptHash Source #
Constructors
ScriptHash (Hash ADDRHASH EraIndependentScript) |
Instances
type DataHash = SafeHash EraIndependentData Source #
data EraIndependentData Source #
data EraIndependentScript Source #
data EraIndependentTxAuxData Source #
Instances
HashAnnotated (ShelleyTxAuxData era) EraIndependentTxAuxData Source # | |
Defined in Cardano.Ledger.Shelley.TxAuxData Methods hashAnnotated ∷ ShelleyTxAuxData era → SafeHash EraIndependentTxAuxData Source # |
data EraIndependentTxBody Source #
Instances
type ADDRHASH = Blake2b_224 Source #
Hashing algorithm used for hashing cryptographic keys and scripts. As the type synonym name alludes, this is the hashing algorithm used for addresses.
type HASH = Blake2b_256 Source #
Hashing algorithm used for hashing everything, except addresses, for which ADDRHASH
is used.
data PParamUpdate era t Source #
Constructors
PParamUpdate | |
Fields
|
data PParam era where Source #
Represents a single protocol parameter and the data required to serialize it.
class (Era era, Eq (PParamsHKD Identity era), Ord (PParamsHKD Identity era), Show (PParamsHKD Identity era), NFData (PParamsHKD Identity era), NoThunks (PParamsHKD Identity era), Eq (PParamsHKD StrictMaybe era), Ord (PParamsHKD StrictMaybe era), Show (PParamsHKD StrictMaybe era), NFData (PParamsHKD StrictMaybe era), NoThunks (PParamsHKD StrictMaybe era)) ⇒ EraPParams era where Source #
Minimal complete definition
emptyPParamsIdentity, emptyPParamsStrictMaybe, upgradePParamsHKD, downgradePParamsHKD, hkdMinFeeAL, hkdMinFeeBL, hkdMaxBBSizeL, hkdMaxTxSizeL, hkdMaxBHSizeL, hkdKeyDepositL, hkdPoolDepositL, hkdEMaxL, hkdNOptL, hkdA0L, hkdRhoL, hkdTauL, hkdDL, hkdExtraEntropyL, hkdProtocolVersionL, hkdMinUTxOValueL, hkdMinPoolCostL, eraPParams
Associated Types
type PParamsHKD (f ∷ Type → Type) era = (r ∷ Type) | r → era Source #
Protocol parameters where the fields are represented with a HKD
type UpgradePParams (f ∷ Type → Type) era Source #
type DowngradePParams (f ∷ Type → Type) era Source #
Methods
applyPPUpdates ∷ PParams era → PParamsUpdate era → PParams era Source #
Applies a protocol parameters update
ppDG ∷ SimpleGetter (PParams era) UnitInterval Source #
Decentralization parameter getter
ppProtocolVersionL ∷ Lens' (PParams era) ProtVer Source #
ppuProtocolVersionL ∷ Lens' (PParamsUpdate era) (StrictMaybe ProtVer) Source #
PParamsUpdate Protocol version
Instances
type family PParamsHKD (f ∷ Type → Type) era = (r ∷ Type) | r → era Source #
Protocol parameters where the fields are represented with a HKD
Instances
type PParamsHKD f ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.PParams |
type family UpgradePParams (f ∷ Type → Type) era Source #
Instances
type UpgradePParams f ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.PParams |
type family DowngradePParams (f ∷ Type → Type) era Source #
Instances
type DowngradePParams f ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.PParams |
newtype PParamsUpdate era Source #
The type of updates to Protocol parameters
Constructors
PParamsUpdate (PParamsHKD StrictMaybe era) |
Instances
Protocol parameters
Constructors
PParams (PParamsHKD Identity era) |
Instances
The Reward
type captures:
- if the reward is a member or leader reward
- the stake pool ID associated with the reward
- the number of Lovelace in the reward
Constructors
Reward | |
Fields
|
Instances
ToJSON Reward | |
Generic Reward | |
Show Reward | |
DecCBOR Reward | |
EncCBOR Reward | |
NFData Reward | |
Defined in Cardano.Ledger.Rewards | |
Eq Reward | |
Ord Reward | Note that this Ord instance is chosen to align precisely
with the Allegra reward aggregation, as given by the
function |
NoThunks Reward | |
type Rep Reward | |
Defined in Cardano.Ledger.Rewards type Rep Reward = D1 ('MetaData "Reward" "Cardano.Ledger.Rewards" "cardano-ledger-core-1.18.0.0-inplace" 'False) (C1 ('MetaCons "Reward" 'PrefixI 'True) (S1 ('MetaSel ('Just "rewardType") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RewardType) :*: (S1 ('MetaSel ('Just "rewardPool") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (KeyHash 'StakePool)) :*: S1 ('MetaSel ('Just "rewardAmount") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Coin)))) |
data RewardType Source #
The staking rewards in Cardano are all either:
- member rewards - rewards given to a registered stake credential which has delegated to a stake pool, or
- leader rewards - rewards given to a registered stake pool (in particular, given to the stake credential in the stake pool registration certificate).
See Figure 47, "Functions used in the Reward Splitting", of the formal specification for more details.
Constructors
MemberReward | |
LeaderReward |
Instances
Constructors
RegPool !PoolParams | A stake pool registration certificate. |
RetirePool !(KeyHash 'StakePool) !EpochNo | A stake pool retirement certificate. |
Instances
ToJSON PoolCert | |
Generic PoolCert | |
Show PoolCert | |
EncCBOR PoolCert | |
NFData PoolCert | |
Defined in Cardano.Ledger.Core.TxCert | |
Eq PoolCert | |
Ord PoolCert | |
Defined in Cardano.Ledger.Core.TxCert | |
NoThunks PoolCert | |
type Rep PoolCert | |
Defined in Cardano.Ledger.Core.TxCert type Rep PoolCert = D1 ('MetaData "PoolCert" "Cardano.Ledger.Core.TxCert" "cardano-ledger-core-1.18.0.0-inplace" 'False) (C1 ('MetaCons "RegPool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PoolParams)) :+: C1 ('MetaCons "RetirePool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (KeyHash 'StakePool)) :*: S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 EpochNo))) |
class (Era era, ToJSON (TxCert era), DecCBOR (TxCert era), EncCBOR (TxCert era), ToCBOR (TxCert era), FromCBOR (TxCert era), NoThunks (TxCert era), NFData (TxCert era), Show (TxCert era), Ord (TxCert era), Eq (TxCert era)) ⇒ EraTxCert era where Source #
Associated Types
type TxCert era = (r ∷ Type) | r → era Source #
type TxCertUpgradeError era Source #
type TxCertUpgradeError era = Void
Methods
upgradeTxCert ∷ TxCert (PreviousEra era) → Either (TxCertUpgradeError era) (TxCert era) Source #
Every era, except Shelley, must be able to upgrade a TxCert
from a previous
era. However, not all certificates can be upgraded, because some eras lose some of
the certificates, thus return type is an Either
. Eg. from Babbage to Conway: MIR
and Genesis certificates were removed.
getVKeyWitnessTxCert ∷ TxCert era → Maybe (KeyHash 'Witness) Source #
Return a witness key whenever a certificate requires one
getScriptWitnessTxCert ∷ TxCert era → Maybe ScriptHash Source #
Return a ScriptHash for certificate types that require a witness
mkRegPoolTxCert ∷ PoolParams → TxCert era Source #
getRegPoolTxCert ∷ TxCert era → Maybe PoolParams Source #
mkRetirePoolTxCert ∷ KeyHash 'StakePool → EpochNo → TxCert era Source #
getRetirePoolTxCert ∷ TxCert era → Maybe (KeyHash 'StakePool, EpochNo) Source #
lookupRegStakeTxCert ∷ TxCert era → Maybe (Credential 'Staking) Source #
Extract staking credential from any certificate that can register such credential
lookupUnRegStakeTxCert ∷ TxCert era → Maybe (Credential 'Staking) Source #
Extract staking credential from any certificate that can unregister such credential
getTotalDepositsTxCerts Source #
Arguments
∷ Foldable f | |
⇒ PParams era | |
→ (KeyHash 'StakePool → Bool) | Check whether stake pool is registered or not |
→ f (TxCert era) | |
→ Coin |
Compute the total deposits from a list of certificates.
getTotalRefundsTxCerts Source #
Arguments
∷ Foldable f | |
⇒ PParams era | |
→ (Credential 'Staking → Maybe Coin) | Lookup current deposit for Staking credential if one is registered |
→ (Credential 'DRepRole → Maybe Coin) | Lookup current deposit for DRep credential if one is registered |
→ f (TxCert era) | |
→ Coin |
Compute the total refunds from a list of certificates.
Instances
type family TxCert era = (r ∷ Type) | r → era Source #
Instances
type TxCert ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxCert |
type family TxCertUpgradeError era Source #
Instances
type TxCertUpgradeError ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxCert |
class (EraTx era, Eq (TxSeq era), Show (TxSeq era), EncCBORGroup (TxSeq era), DecCBOR (TxSeq era)) ⇒ EraSegWits era where Source #
Indicates that an era supports segregated witnessing.
This class embodies an isomorphism between 'TxSeq era' and 'StrictSeq
(Tx era)', witnessed by fromTxSeq
and toTxSeq
.
Methods
fromTxSeq ∷ TxSeq era → StrictSeq (Tx era) Source #
toTxSeq ∷ StrictSeq (Tx era) → TxSeq era Source #
hashTxSeq ∷ TxSeq era → Hash HASH EraIndependentBlockBody Source #
Get the block body hash from the TxSeq. Note that this is not a regular "hash the stored bytes" function since the block body hash forms a small Merkle tree.
numSegComponents ∷ Word64 Source #
The number of segregated components
Instances
EraSegWits ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.BlockChain Associated Types type TxSeq ShelleyEra = (r ∷ Type) Source # Methods fromTxSeq ∷ TxSeq ShelleyEra → StrictSeq (Tx ShelleyEra) Source # toTxSeq ∷ StrictSeq (Tx ShelleyEra) → TxSeq ShelleyEra Source # hashTxSeq ∷ TxSeq ShelleyEra → Hash HASH EraIndependentBlockBody Source # |
type family TxSeq era = (r ∷ Type) | r → era Source #
Instances
type TxSeq ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.BlockChain |
class (Era era, Show (Script era), Eq (Script era), EqRaw (Script era), ToCBOR (Script era), EncCBOR (Script era), DecCBOR (Script era), NoThunks (Script era), SafeToHash (Script era), Eq (NativeScript era), Show (NativeScript era), NFData (NativeScript era), NoThunks (NativeScript era), EncCBOR (NativeScript era), DecCBOR (NativeScript era)) ⇒ EraScript era where Source #
Typeclass for script data types. Allows for script validation and hashing.
You must understand the role of SafeToHash and scriptPrefixTag to make new
instances. scriptPrefixTag
is a magic number representing the tag of the
script language. For each new script language defined, a new tag is chosen
and the tag is included in the script hash for a script. The safeToHash
constraint ensures that Scripts are never reserialised.
Associated Types
type Script era = (r ∷ Type) | r → era Source #
Scripts which may lock transaction outputs in this era
type NativeScript era = (r ∷ Type) | r → era Source #
Methods
upgradeScript ∷ Script (PreviousEra era) → Script era Source #
Every era, except Shelley, must be able to upgrade a Script
from a previous era.
Warning - Important to note that any memoized binary representation will not be
preserved, you need to retain underlying bytes you can use translateEraThroughCBOR
scriptPrefixTag ∷ Script era → ByteString Source #
getNativeScript ∷ Script era → Maybe (NativeScript era) Source #
fromNativeScript ∷ NativeScript era → Script era Source #
Instances
EraScript ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Scripts Associated Types type Script ShelleyEra = (r ∷ Type) Source # type NativeScript ShelleyEra = (r ∷ Type) Source # |
type family Script era = (r ∷ Type) | r → era Source #
Scripts which may lock transaction outputs in this era
Instances
type Script ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Scripts |
type family NativeScript era = (r ∷ Type) | r → era Source #
Instances
type NativeScript ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Scripts |
class (EraScript era, Eq (TxWits era), EqRaw (TxWits era), Show (TxWits era), Monoid (TxWits era), NoThunks (TxWits era), ToCBOR (TxWits era), EncCBOR (TxWits era), DecCBOR (TxWits era)) ⇒ EraTxWits era where Source #
A collection of witnesses in a Tx
Minimal complete definition
Methods
mkBasicTxWits ∷ TxWits era Source #
addrTxWitsL ∷ Lens' (TxWits era) (Set (WitVKey 'Witness)) Source #
bootAddrTxWitsL ∷ Lens' (TxWits era) (Set BootstrapWitness) Source #
scriptTxWitsL ∷ Lens' (TxWits era) (Map ScriptHash (Script era)) Source #
upgradeTxWits ∷ TxWits (PreviousEra era) → TxWits era Source #
Instances
EraTxWits ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxWits Associated Types type TxWits ShelleyEra = (r ∷ Type) Source # Methods mkBasicTxWits ∷ TxWits ShelleyEra Source # addrTxWitsL ∷ Lens' (TxWits ShelleyEra) (Set (WitVKey 'Witness)) Source # bootAddrTxWitsL ∷ Lens' (TxWits ShelleyEra) (Set BootstrapWitness) Source # scriptTxWitsL ∷ Lens' (TxWits ShelleyEra) (Map ScriptHash (Script ShelleyEra)) Source # upgradeTxWits ∷ TxWits (PreviousEra ShelleyEra) → TxWits ShelleyEra Source # |
type family TxWits era = (r ∷ Type) | r → era Source #
Instances
type TxWits ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxWits |
class (Era era, Eq (TxAuxData era), EqRaw (TxAuxData era), Show (TxAuxData era), NoThunks (TxAuxData era), ToCBOR (TxAuxData era), EncCBOR (TxAuxData era), DecCBOR (TxAuxData era), HashAnnotated (TxAuxData era) EraIndependentTxAuxData) ⇒ EraTxAuxData era where Source #
TxAuxData which may be attached to a transaction
Methods
mkBasicTxAuxData ∷ TxAuxData era Source #
metadataTxAuxDataL ∷ Lens' (TxAuxData era) (Map Word64 Metadatum) Source #
upgradeTxAuxData ∷ TxAuxData (PreviousEra era) → TxAuxData era Source #
Every era, except Shelley, must be able to upgrade a TxAuxData
from a previous
era.
Warning - Important to note that any memoized binary representation will not be
preserved. If you need to retain underlying bytes you can use translateEraThroughCBOR
Instances
EraTxAuxData ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxAuxData Associated Types type TxAuxData ShelleyEra = (r ∷ Type) Source # |
type family TxAuxData era = (r ∷ Type) | r → era Source #
Instances
type TxAuxData ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxAuxData |
class (EraTxOut era, EraTxCert era, EraPParams era, HashAnnotated (TxBody era) EraIndependentTxBody, DecCBOR (TxBody era), EncCBOR (TxBody era), ToCBOR (TxBody era), NoThunks (TxBody era), NFData (TxBody era), Show (TxBody era), Eq (TxBody era), EqRaw (TxBody era)) ⇒ EraTxBody era where Source #
Minimal complete definition
mkBasicTxBody, inputsTxBodyL, outputsTxBodyL, feeTxBodyL, withdrawalsTxBodyL, auxDataHashTxBodyL, spendableInputsTxBodyF, allInputsTxBodyF, certsTxBodyL, upgradeTxBody
Associated Types
The body of a transaction.
type TxBodyUpgradeError era Source #
type TxBodyUpgradeError era = Void
Methods
mkBasicTxBody ∷ TxBody era Source #
inputsTxBodyL ∷ Lens' (TxBody era) (Set TxIn) Source #
outputsTxBodyL ∷ Lens' (TxBody era) (StrictSeq (TxOut era)) Source #
feeTxBodyL ∷ Lens' (TxBody era) Coin Source #
withdrawalsTxBodyL ∷ Lens' (TxBody era) Withdrawals Source #
auxDataHashTxBodyL ∷ Lens' (TxBody era) (StrictMaybe TxAuxDataHash) Source #
spendableInputsTxBodyF ∷ SimpleGetter (TxBody era) (Set TxIn) Source #
This getter will produce all inputs from the UTxO map that this transaction might spend, which ones will depend on the validity of the transaction itself. Starting in Alonzo this will include collateral inputs.
allInputsTxBodyF ∷ SimpleGetter (TxBody era) (Set TxIn) Source #
This getter will produce all inputs from the UTxO map that this transaction is referencing, even if some of them cannot be spent by the transaction. For example starting with Babbage era it will also include reference inputs.
certsTxBodyL ∷ Lens' (TxBody era) (StrictSeq (TxCert era)) Source #
getTotalDepositsTxBody Source #
Arguments
∷ PParams era | |
→ (KeyHash 'StakePool → Bool) | Check whether stake pool is registered or not |
→ TxBody era | |
→ Coin |
Compute the total deposits from the certificates in a TxBody.
This is the contribution of a TxBody towards the consumed amount by the transaction
getTotalRefundsTxBody Source #
Arguments
∷ PParams era | |
→ (Credential 'Staking → Maybe Coin) | Lookup current deposit for Staking credential if one is registered |
→ (Credential 'DRepRole → Maybe Coin) | Lookup current deposit for DRep credential if one is registered |
→ TxBody era | |
→ Coin |
Compute the total refunds from the Certs of a TxBody.
This is the contribution of a TxBody towards produced amount by the transaction
getGenesisKeyHashCountTxBody ∷ TxBody era → Int Source #
This function is not used in the ledger rules. It is only used by the downstream tooling to figure out how many witnesses should be supplied for Genesis keys.
upgradeTxBody ∷ TxBody (PreviousEra era) → Either (TxBodyUpgradeError era) (TxBody era) Source #
Upgrade the transaction body from the previous era.
This can fail where elements of the transaction body are deprecated.
Compare this to translateEraThroughCBOR
:
- upgradeTxBody
will use the Haskell representation, but will not
preserve the serialised form. However, it will be suitable for iterated
translation through eras.
- translateEraThroughCBOR
will preserve the binary representation, but is
not guaranteed to work through multiple eras - that is, the serialised
representation from era n is guaranteed valid in era n + 1, but not
necessarily in era n + 2.
Instances
data family TxBody era Source #
The body of a transaction.
Instances
type family TxBodyUpgradeError era Source #
Instances
type TxBodyUpgradeError ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.TxBody |
type family TxUpgradeError era Source #
Instances
type TxUpgradeError ShelleyEra Source # | |
Defined in Cardano.Ledger.Shelley.Tx.Internal |
pattern RegPoolTxCert ∷ EraTxCert era ⇒ PoolParams → TxCert era Source #
hashScript ∷ EraScript era ⇒ Script era → ScriptHash Source #
Compute ScriptHash
of a Script
for a particular era.
absurdEraRule ∷ ∀ (rule ∷ Symbol) era a. VoidEraRule rule era → a Source #
eraProtVerLow ∷ Era era ⇒ Version Source #
Get the value level Version
of the lowest major protocol version for the supplied era
.
eraProtVerHigh ∷ Era era ⇒ Version Source #
Get the value level Version
of the highest major protocol version for the supplied era
.
eraProtVersions ∷ Era era ⇒ [Version] Source #
List with all major versions that are used in the particular era.
atLeastEra ∷ AtLeastEra eraName era ⇒ () Source #
Enforce era to be at least the specified era at the type level. In other words compiler will produce type error when applied to eras prior to the specified era. This function should be used in order to avoid redundant constraints warning.
For example these will type check
>>>
atLeastEra @BabbageEra @ConwayEra
>>>
atLeastEra @BabbageEra @BabbageEra
However this will result in a type error
>>>
atLeastEra @BabbageEra @AlonzoEra
atMostEra ∷ AtMostEra eraName era ⇒ () Source #
Enforce era to be at most the specified era at the type level. In other words compiler will produce type error when applied to eras prior to the specified era. This function should be used in order to avoid redundant constraints warning.
For example these will type check
>>>
atMostEra @BabbageEra @ShelleyEra
>>>
atMostEra @AlonzoEra @MaryEra
However this will result in a type error
>>>
atMostEra @BabbageEra @ConwayEra
notSupportedInThisEraL ∷ HasCallStack ⇒ Lens' a b Source #
fromEraCBOR ∷ (Era era, DecCBOR t) ⇒ Decoder s t Source #
Convert a type that implements DecCBOR
to plain Decoder
using the lowest
protocol version for the supplied era
This action should not be used for decoders that require access to original bytes, use
toPlainDecoder
instead.
fromEraShareCBOR ∷ (Era era, DecShareCBOR t) ⇒ Decoder s t Source #
Convert a type that implements DecShareCBOR
to plain Decoder
using the lowest
protocol version for the supplied era
This action should not be used for decoders that require access to original bytes, use
toPlainDecoder
instead.
eraDecoder ∷ ∀ era t s. Era era ⇒ Decoder s t → Decoder s t Source #
Convert a versioned Decoder
to plain a Decoder
using the lowest protocol
version for the supplied era
This action should not be used for decoders that require access to original bytes, use
eraDecoderWithBytes
instead.
eraDecoderWithBytes ∷ ∀ era t s. Era era ⇒ ByteString → Decoder s t → Decoder s t Source #
Just like eraDecoder
, but for decoders that rely on access for underlying bytes
translateEra' ∷ (TranslateEra era f, TranslationError era f ~ Void) ⇒ TranslationContext era → f (PreviousEra era) → f era Source #
Variant of translateEra
for when TranslationError
is Void
and the
translation thus cannot fail.
translateEraMaybe ∷ (TranslateEra era f, TranslationError era f ~ ()) ⇒ TranslationContext era → f (PreviousEra era) → Maybe (f era) Source #
Variant of translateEra
for when TranslationError
is ()
, converting
the result to a Maybe
.
translateEraThroughCBOR ∷ (Era era, ToCBOR (ti (PreviousEra era)), DecCBOR (to era)) ⇒ ti (PreviousEra era) → Except DecoderError (to era) Source #
Translate a type through its binary representation from previous era to the current one.
hashTxBodySignature ∷ SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) → Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)) Source #
Hash a given signature
toVRFVerKeyHash ∷ ∀ v (r ∷ KeyRoleVRF). Hash HASH (VerKeyVRF v) → VRFVerKeyHash r Source #
fromVRFVerKeyHash ∷ ∀ (r ∷ KeyRoleVRF) v. VRFVerKeyHash r → Hash HASH (VerKeyVRF v) Source #
castSafeHash ∷ SafeHash i → SafeHash j Source #
To change the index parameter of SafeHash (which is a phantom type) use castSafeHash
genericApplyPPUpdates ∷ (Generic (PParamsHKD Identity era), Generic (PParamsHKD StrictMaybe era), Updatable (Rep (PParamsHKD Identity era) a) (Rep (PParamsHKD StrictMaybe era) u)) ⇒ PParams era → PParamsUpdate era → PParams era Source #
emptyPParams ∷ EraPParams era ⇒ PParams era Source #
emptyPParamsUpdate ∷ EraPParams era ⇒ PParamsUpdate era Source #
ppLensHKD ∷ ∀ era f. Functor f ⇒ (PParamsHKD Identity era → f (PParamsHKD Identity era)) → PParams era → f (PParams era) Source #
ppuLensHKD ∷ ∀ era f. Functor f ⇒ (PParamsHKD StrictMaybe era → f (PParamsHKD StrictMaybe era)) → PParamsUpdate era → f (PParamsUpdate era) Source #
ppMinFeeAL ∷ EraPParams era ⇒ Lens' (PParams era) Coin Source #
The linear factor for the minimum fee calculation
ppMinFeeBL ∷ EraPParams era ⇒ Lens' (PParams era) Coin Source #
The constant factor for the minimum fee calculation
ppMaxBBSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word32 Source #
Maximal block body size
ppMaxTxSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word32 Source #
Maximal transaction size
ppMaxBHSizeL ∷ EraPParams era ⇒ Lens' (PParams era) Word16 Source #
Maximal block header size
ppKeyDepositL ∷ EraPParams era ⇒ Lens' (PParams era) Coin Source #
The amount of a key registration deposit
ppPoolDepositL ∷ EraPParams era ⇒ Lens' (PParams era) Coin Source #
The amount of a pool registration deposit
ppEMaxL ∷ EraPParams era ⇒ Lens' (PParams era) EpochInterval Source #
epoch bound on pool retirement
ppA0L ∷ EraPParams era ⇒ Lens' (PParams era) NonNegativeInterval Source #
Pool influence
ppRhoL ∷ EraPParams era ⇒ Lens' (PParams era) UnitInterval Source #
Monetary expansion
ppTauL ∷ EraPParams era ⇒ Lens' (PParams era) UnitInterval Source #
Treasury expansion
ppDL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParams era) UnitInterval Source #
Decentralization parameter
ppExtraEntropyL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParams era) Nonce Source #
Extra entropy
ppMinUTxOValueL ∷ (EraPParams era, ProtVerAtMost era 4) ⇒ Lens' (PParams era) Coin Source #
Minimum UTxO value
ppMinPoolCostL ∷ EraPParams era ⇒ Lens' (PParams era) Coin Source #
Minimum Stake Pool Cost
ppuMinFeeAL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
The linear factor for the minimum fee calculation
ppuMinFeeBL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
The constant factor for the minimum fee calculation
ppuMaxBBSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word32) Source #
Maximal block body size
ppuMaxTxSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word32) Source #
Maximal transaction size
ppuMaxBHSizeL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word16) Source #
Maximal block header size
ppuKeyDepositL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
The amount of a key registration deposit
ppuPoolDepositL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
The amount of a pool registration deposit
ppuEMaxL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe EpochInterval) Source #
epoch bound on pool retirement
ppuNOptL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Word16) Source #
Desired number of pools
ppuA0L ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval) Source #
Pool influence
ppuRhoL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval) Source #
Monetary expansion
ppuTauL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval) Source #
Treasury expansion
ppuDL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParamsUpdate era) (StrictMaybe UnitInterval) Source #
Decentralization parameter
ppuExtraEntropyL ∷ (EraPParams era, ProtVerAtMost era 6) ⇒ Lens' (PParamsUpdate era) (StrictMaybe Nonce) Source #
Extra entropy
ppuMinUTxOValueL ∷ (EraPParams era, ProtVerAtMost era 4) ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
Minimum UTxO value
ppuMinPoolCostL ∷ EraPParams era ⇒ Lens' (PParamsUpdate era) (StrictMaybe Coin) Source #
Minimum Stake Pool Cost
mapPParams ∷ (PParamsHKD Identity era1 → PParamsHKD Identity era2) → PParams era1 → PParams era2 Source #
mapPParamsUpdate ∷ (PParamsHKD StrictMaybe era1 → PParamsHKD StrictMaybe era2) → PParamsUpdate era1 → PParamsUpdate era2 Source #
upgradePParams ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ UpgradePParams Identity era → PParams (PreviousEra era) → PParams era Source #
downgradePParams ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ DowngradePParams Identity era → PParams era → PParams (PreviousEra era) Source #
upgradePParamsUpdate ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ UpgradePParams StrictMaybe era → PParamsUpdate (PreviousEra era) → PParamsUpdate era Source #
downgradePParamsUpdate ∷ (EraPParams era, EraPParams (PreviousEra era)) ⇒ DowngradePParams StrictMaybe era → PParamsUpdate era → PParamsUpdate (PreviousEra era) Source #
isRegStakeTxCert ∷ EraTxCert era ⇒ TxCert era → Bool Source #
Check if supplied TxCert is a stake registering certificate
isUnRegStakeTxCert ∷ EraTxCert era ⇒ TxCert era → Bool Source #
Check if supplied TxCert is a stake un-registering certificate
bootAddrTxOutF ∷ EraTxOut era ⇒ SimpleGetter (TxOut era) (Maybe BootstrapAddress) Source #
coinTxOutL ∷ (HasCallStack, EraTxOut era) ⇒ Lens' (TxOut era) Coin Source #
compactCoinTxOutL ∷ (HasCallStack, EraTxOut era) ⇒ Lens' (TxOut era) (CompactForm Coin) Source #
isAdaOnlyTxOutF ∷ EraTxOut era ⇒ SimpleGetter (TxOut era) Bool Source #
This is a getter that implements an efficient way to check whether TxOut
contains ADA only.
hashTxAuxData ∷ EraTxAuxData era ⇒ TxAuxData era → TxAuxDataHash Source #
Compute a hash of TxAuxData
hashScriptTxWitsL ∷ EraTxWits era ⇒ Lens (TxWits era) (TxWits era) (Map ScriptHash (Script era)) [Script era] Source #
This is a helper lens that will hash the scripts when adding as witnesses.