ouroboros-consensus-0.26.0.0: Consensus layer for the Ouroboros blockchain protocol
Safe HaskellNone
LanguageHaskell2010

Ouroboros.Consensus.HardFork.Combinator.Ledger

Synopsis

Documentation

data HardForkEnvelopeErr (xs ∷ [Type]) Source #

Constructors

HardForkEnvelopeErrFromEra (OneEraEnvelopeErr xs)

Validation error from one of the eras

HardForkEnvelopeErrWrongEra (MismatchEraInfo xs)

We tried to apply a block from the wrong era

Instances

Instances details
Generic (HardForkEnvelopeErr xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

Associated Types

type Rep (HardForkEnvelopeErr xs) 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkEnvelopeErr xs) = D1 ('MetaData "HardForkEnvelopeErr" "Ouroboros.Consensus.HardFork.Combinator.Ledger" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "HardForkEnvelopeErrFromEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OneEraEnvelopeErr xs))) :+: C1 ('MetaCons "HardForkEnvelopeErrWrongEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (MismatchEraInfo xs))))
CanHardFork xs ⇒ Show (HardForkEnvelopeErr xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanHardFork xs ⇒ Eq (HardForkEnvelopeErr xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanHardFork xs ⇒ NoThunks (HardForkEnvelopeErr xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkEnvelopeErr xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkEnvelopeErr xs) = D1 ('MetaData "HardForkEnvelopeErr" "Ouroboros.Consensus.HardFork.Combinator.Ledger" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "HardForkEnvelopeErrFromEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OneEraEnvelopeErr xs))) :+: C1 ('MetaCons "HardForkEnvelopeErrWrongEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (MismatchEraInfo xs))))

data HardForkLedgerError (xs ∷ [Type]) Source #

Constructors

HardForkLedgerErrorFromEra (OneEraLedgerError xs)

Validation error from one of the eras

HardForkLedgerErrorWrongEra (MismatchEraInfo xs)

We tried to apply a block from the wrong era

Instances

Instances details
Generic (HardForkLedgerError xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

Associated Types

type Rep (HardForkLedgerError xs) 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkLedgerError xs) = D1 ('MetaData "HardForkLedgerError" "Ouroboros.Consensus.HardFork.Combinator.Ledger" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "HardForkLedgerErrorFromEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OneEraLedgerError xs))) :+: C1 ('MetaCons "HardForkLedgerErrorWrongEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (MismatchEraInfo xs))))
CanHardFork xs ⇒ Show (HardForkLedgerError xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanHardFork xs ⇒ Eq (HardForkLedgerError xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanHardFork xs ⇒ NoThunks (HardForkLedgerError xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkLedgerError xs) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type Rep (HardForkLedgerError xs) = D1 ('MetaData "HardForkLedgerError" "Ouroboros.Consensus.HardFork.Combinator.Ledger" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "HardForkLedgerErrorFromEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OneEraLedgerError xs))) :+: C1 ('MetaCons "HardForkLedgerErrorWrongEra" 'PrefixI 'False) (S1 ('MetaSel ('NothingMaybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (MismatchEraInfo xs))))

data HardForkLedgerUpdate (xs ∷ [Type]) Source #

Constructors

HardForkUpdateInEra (OneEraLedgerUpdate xs) 
HardForkUpdateTransitionConfirmed (EraIndex xs) (EraIndex xs) EpochNo

Hard fork transition got confirmed

HardForkUpdateTransitionDone (EraIndex xs) (EraIndex xs) EpochNo

Hard fork transition happened

We record the EpochNo at the start of the era after the transition

HardForkUpdateTransitionRolledBack (EraIndex xs) (EraIndex xs)

The hard fork transition rolled back

data HardForkLedgerWarning (xs ∷ [Type]) Source #

Constructors

HardForkWarningInEra (OneEraLedgerWarning xs)

Warning from the underlying era

HardForkWarningTransitionMismatch (EraIndex xs) EraParams EpochNo

The transition to the next era does not match the EraParams

The EraParams can specify a lower bound on when the transition to the next era will happen. If the actual transition, when confirmed, is before this lower bound, the node is misconfigured and will likely not work correctly. This should be taken care of as soon as possible (before the transition happens).

HardForkWarningTransitionInFinalEra (EraIndex xs) EpochNo

Transition in the final era

The final era should never confirm any transitions. For clarity, we also record the index of that final era.

HardForkWarningTransitionUnconfirmed (EraIndex xs)

An already-confirmed transition got un-confirmed

HardForkWarningTransitionReconfirmed (EraIndex xs) (EraIndex xs) EpochNo EpochNo

An already-confirmed transition got changed

We record the indices of the era we are transitioning from and to, as well as the old and new EpochNo of that transition, in that order.

Type family instances

data family Ticked (st ∷ k) ∷ k Source #

" Ticked " piece of state, either LedgerState or ChainDepState

Ticking refers to the passage of time (the ticking of the clock). When a piece of state is marked as ticked, it means that time-related changes have been applied to the state. There are exactly two methods in the interface that do that: tickChainDepState and applyChainTickLedgerResult.

Also note that a successful forecast forecastFor (ledgerViewForecastAt cfg st) slot must equal protocolLedgerView cfg (applyChainTick cfg slot st). Thus a LedgerView can only be projected from a Ticked state, but cannot itself be ticked.

Some examples of time related changes:

  • Scheduled delegations might have been applied in Byron
  • New leader schedule computed for Shelley
  • Transition from Byron to Shelley activated in the hard fork combinator.
  • Nonces switched out at the start of a new epoch.

Instances

Instances details
Show (Ticked ()) Source # 
Instance details

Defined in Ouroboros.Consensus.Ticked

Methods

showsPrecIntTicked () → ShowS #

showTicked () → String #

showList ∷ [Ticked ()] → ShowS #

CanHardFork xs ⇒ GetTip (Ticked (LedgerState (HardForkBlock xs))) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

Methods

getTip ∷ ∀ (mk ∷ MapKind). Ticked (LedgerState (HardForkBlock xs)) mk → Point (Ticked (LedgerState (HardForkBlock xs))) Source #

Bridge m a ⇒ GetTip (Ticked (LedgerState (DualBlock m a))) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

getTip ∷ ∀ (mk ∷ MapKind). Ticked (LedgerState (DualBlock m a)) mk → Point (Ticked (LedgerState (DualBlock m a))) Source #

IsLedger (LedgerState blk) ⇒ GetTip (Ticked (ExtLedgerState blk)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Extended

Methods

getTip ∷ ∀ (mk ∷ MapKind). Ticked (ExtLedgerState blk) mk → Point (Ticked (ExtLedgerState blk)) Source #

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ HasLedgerTables (Ticked (LedgerState (HardForkBlock xs))) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

(Bridge m a, NoThunks (TxOut (LedgerState m)), NoThunks (TxIn (LedgerState m)), Show (TxOut (LedgerState m)), Show (TxIn (LedgerState m)), Eq (TxOut (LedgerState m)), Ord (TxIn (LedgerState m)), MemPack (TxIn (LedgerState m))) ⇒ HasLedgerTables (Ticked (LedgerState (DualBlock m a))) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

(HasLedgerTables (Ticked (LedgerState blk)), NoThunks (TxOut (LedgerState blk)), NoThunks (TxIn (LedgerState blk)), Show (TxOut (LedgerState blk)), Show (TxIn (LedgerState blk)), Eq (TxOut (LedgerState blk)), Ord (TxIn (LedgerState blk)), MemPack (TxIn (LedgerState blk))) ⇒ HasLedgerTables (Ticked (ExtLedgerState blk)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Extended

Methods

projectLedgerTables ∷ ∀ (mk ∷ MapKind). (CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) ⇒ Ticked (ExtLedgerState blk) mk → LedgerTables (Ticked (ExtLedgerState blk)) mk Source #

withLedgerTables ∷ ∀ (mk ∷ MapKind) (any ∷ MapKind). (CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) ⇒ Ticked (ExtLedgerState blk) any → LedgerTables (Ticked (ExtLedgerState blk)) mk → Ticked (ExtLedgerState blk) mk Source #

LedgerTablesAreTrivial (Ticked (LedgerState blk)) ⇒ LedgerTablesAreTrivial (Ticked (ExtLedgerState blk)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Extended

Methods

convertMapKind ∷ ∀ (mk ∷ MapKind) (mk' ∷ MapKind). Ticked (ExtLedgerState blk) mk → Ticked (ExtLedgerState blk) mk' Source #

NoThunks (Ticked (LedgerState (DualBlock m a)) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

Show (Ticked (f a)) ⇒ Show (((TickedTypeType) :.: f) a) Source # 
Instance details

Defined in Ouroboros.Consensus.Ticked

Methods

showsPrecInt → ((TickedTypeType) :.: f) a → ShowS #

show ∷ ((TickedTypeType) :.: f) a → String #

showList ∷ [((TickedTypeType) :.: f) a] → ShowS #

NoThunks (Ticked (f a)) ⇒ NoThunks (((TickedTypeType) :.: f) a) Source # 
Instance details

Defined in Ouroboros.Consensus.Ticked

Methods

noThunksContext → ((TickedTypeType) :.: f) a → IO (Maybe ThunkInfo) Source #

wNoThunksContext → ((TickedTypeType) :.: f) a → IO (Maybe ThunkInfo) Source #

showTypeOfProxy (((TickedTypeType) :.: f) a) → String Source #

data Ticked () Source # 
Instance details

Defined in Ouroboros.Consensus.Ticked

data Ticked (HardForkChainDepState xs ∷ Type) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Protocol

data Ticked (HeaderState blk ∷ Type) Source # 
Instance details

Defined in Ouroboros.Consensus.HeaderValidation

data Ticked (PBftState c ∷ Type) Source # 
Instance details

Defined in Ouroboros.Consensus.Protocol.PBFT

newtype Ticked (WrapChainDepState blk ∷ Type) Source # 
Instance details

Defined in Ouroboros.Consensus.TypeFamilyWrappers

type HeaderHash (Ticked l ∷ k) Source # 
Instance details

Defined in Ouroboros.Consensus.Ticked

type HeaderHash (Ticked l ∷ k) = HeaderHash l
type TxIn (Ticked l) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Tables.Basics

type TxIn (Ticked l) = TxIn l
type TxOut (Ticked l) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Tables.Basics

type TxOut (Ticked l) = TxOut l
data Ticked (LedgerState (HardForkBlock xs) ∷ MapKindType) (mk ∷ MapKind) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

data Ticked (LedgerState (DualBlock m a) ∷ MapKindType) (mk ∷ MapKind) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

data Ticked (ExtLedgerState blk ∷ MapKindType) (mk ∷ MapKind) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Extended

Low-level API (exported for the benefit of testing)

data AnnForecast (state ∷ Type → (TypeTypeType) → Type) (view ∷ TypeType) blk Source #

Forecast annotated with details about the ledger it was derived from

mkHardForkForecast ∷ ∀ (state ∷ Type → (TypeTypeType) → Type) (view ∷ TypeType) (xs ∷ [Type]). SListI xs ⇒ InPairs (CrossEraForecaster state view) xs → HardForkState (AnnForecast state view) xs → Forecast (HardForkLedgerView_ view xs) Source #

Change a telescope of a forecast into a forecast of a telescope

Ledger tables

HardForkTxIn

class (Show (CanonicalTxIn xs), Ord (CanonicalTxIn xs), NoThunks (CanonicalTxIn xs), MemPack (CanonicalTxIn xs)) ⇒ HasCanonicalTxIn (xs ∷ [Type]) where Source #

Canonical TxIn

The Ledger and Consensus team discussed the fact that we need to be able to reach the TxIn key for an entry from any era, regardless of the era in which it was created, therefore we need to have a "canonical" serialization that doesn't change between eras. For now we are requiring that a HardForkBlock has only one associated TxIn type as a stop-gap, but Ledger will provide a serialization function into something more efficient.

Associated Types

data CanonicalTxIn (xs ∷ [Type]) Source #

Methods

injectCanonicalTxInIndex xs x → TxIn (LedgerState x) → CanonicalTxIn xs Source #

Inject an era-specific TxIn into a TxIn for a HardForkBlock.

ejectCanonicalTxInIndex xs x → CanonicalTxIn xs → TxIn (LedgerState x) Source #

Distribute a TxIn for a HardForkBlock to an era-specific TxIn.

HardForkTxOut

type DefaultHardForkTxOut (xs ∷ [Type]) = NS WrapTxOut xs Source #

This choice for HardForkTxOut imposes some complications on the code.

We deliberately chose not to have all values in the tables be TxOut era because this would require us to traverse and translate the whole UTxO set on era boundaries. To avoid this, we are holding a NS WrapTxOut xs instead.

Whenever we are carrying a LedgerState (HardForkBlock xs) mk (or ExtLedgerState), the tables are the ones inside the particular ledger state in the Telescope of the HardForkState.

However, when we are carrying LedgerTables (HardForkBlock xs) mk we are instead carrying these tables, where the TxOut is an NS. This means that whenever we are extracting these tables, we are effectively duplicating the UTxO set (Map) inside, to create an identical one where every element has been translated to the most recent era and unwrapped from the NS.

To prevent memory explosion, try to only perform one of this transformations, for example:

  • when applying blocks, inject the tables for the transactions only once, and extract them only once.
  • when performing queries on the tables (that use QFTraverseTables), operate with the tables at the hard fork level until the very end, when you have to promote them to some specific era.

(image code)

Expand
>>> :{
>>> either (error . show) pure =<<
>>> renderToFile "docs/haddocks/hard-fork-tables.svg" defaultEnv (tikz ["positioning", "arrows"]) "\\node at (4.5,4.8) {\\small{LedgerTables (LedgerState (HardForkBlock xs))}};\
>>> \ \\draw (0,0) rectangle (9,5);\
>>> \ \\node (rect) at (1.5,4) [draw,minimum width=1cm,minimum height=0.5cm] {TxIn};\
>>> \ \\node (oneOf) at (3.5,4) [draw=none] {NS};\
>>> \ \\draw (rect) -> (oneOf);\
>>> \ \\node (sh) at (6.5,4) [draw,minimum width=1cm,minimum height=0.5cm] {BlockATxOut};\
>>> \ \\node (al) at (6.5,3) [draw,minimum width=1cm,minimum height=0.5cm] {BlockBTxOut};\
>>> \ \\node (my) at (6.5,2) [draw=none,minimum width=1cm,minimum height=0.5cm] {...};\
>>> \ \\node (ba) at (6.5,1) [draw,minimum width=1cm,minimum height=0.5cm] {BlockNTxOut};\
>>> \ \\draw (oneOf) -> (sh);\
>>> \ \\draw (oneOf) -> (al);\
>>> \ \\draw (oneOf) -> (ba);\
>>> \ \\draw (3,0.5) rectangle (8,4.5);"
>>> :}
>>> :{
>>> either (error . show) pure =<<
>>> renderToFile "docs/haddocks/hard-fork-tables-per-block.svg" defaultEnv (tikz ["positioning", "arrows"]) "\\node at (5,4.8) {\\small{LedgerState (HardForkBlock xs)}};\
>>> \ \\draw (0,0) rectangle (10,5);\
>>> \ \\node (oneOf2) at (2,4) [draw=none] {HardForkState};\
>>> \ \\node (bb) at (5,4) [draw,minimum width=1cm,minimum height=0.5cm] {BlockAState};\
>>> \ \\node (bt) at (8,4) [draw,minimum width=1cm,minimum height=0.5cm] {BlockATables};\
>>> \ \\node (sb) at (5,3) [draw,minimum width=1cm,minimum height=0.5cm] {BlockBState};\
>>> \ \\node (st) at (8,3) [draw,minimum width=1cm,minimum height=0.5cm] {BlockBTables};\
>>> \ \\node (db) at (5,2) [draw=none,minimum width=1cm,minimum height=0.5cm] {...};\
>>> \ \\node (dt) at (8,2) [draw=none,minimum width=1cm,minimum height=0.5cm] {...};\
>>> \ \\node (bab) at (5,1) [draw,minimum width=1cm,minimum height=0.5cm] {BlockNState};\
>>> \ \\node (bat) at (8,1) [draw,minimum width=1cm,minimum height=0.5cm] {BlockNTables};\
>>> \ \\draw (oneOf2) -> (bb);\
>>> \ \\draw (bb) -> (bt);\
>>> \ \\draw (oneOf2) -> (sb);\
>>> \ \\draw (sb) -> (st);\
>>> \ \\draw (oneOf2) -> (bab);\
>>> \ \\draw (bab) -> (bat);"
>>> :}

class (Show (HardForkTxOut xs), Eq (HardForkTxOut xs), NoThunks (HardForkTxOut xs), IndexedMemPack (LedgerState (HardForkBlock xs) EmptyMK) (HardForkTxOut xs), SerializeTablesWithHint (LedgerState (HardForkBlock xs))) ⇒ HasHardForkTxOut (xs ∷ [Type]) where Source #

Minimal complete definition

injectHardForkTxOut, ejectHardForkTxOut

Associated Types

type HardForkTxOut (xs ∷ [Type]) Source #

Methods

injectHardForkTxOutIndex xs x → TxOut (LedgerState x) → HardForkTxOut xs Source #

ejectHardForkTxOutIndex xs x → HardForkTxOut xs → TxOut (LedgerState x) Source #

txOutEjectionsNP ((K (NS WrapTxOut xs) ∷ TypeType) -.-> WrapTxOut) xs Source #

This method is a null-arity method in a typeclass to make it a CAF, such that we only compute it once, then it is cached for the duration of the program, as we will use it very often when converting from the HardForkBlock to the particular blk.

This particular method is useful when our HardForkBlock uses DefaultHardForkTxOut, so that we can implement inject and project.

default txOutEjectionsCanHardFork xs ⇒ NP ((K (NS WrapTxOut xs) ∷ TypeType) -.-> WrapTxOut) xs Source #

txOutTranslationsTails (Fn2 WrapTxOut) xs Source #

This method is a null-arity method in a typeclass to make it a CAF, such that we only compute it once, then it is cached for the duration of the program, as we will use it very often when converting from the HardForkBlock to the particular blk.

class MemPack (TxOut (LedgerState x)) ⇒ MemPackTxOut x Source #

Instances

Instances details
MemPack (TxOut (LedgerState x)) ⇒ MemPackTxOut x Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

injectHardForkTxOutDefault ∷ ∀ (xs ∷ [Type]) x. SListI xs ⇒ Index xs x → TxOut (LedgerState x) → DefaultHardForkTxOut xs Source #

Orphan instances

(All MemPackTxOut xs, Typeable xs) ⇒ MemPack (DefaultHardForkTxOut xs) Source # 
Instance details

All SingleEraBlock xs ⇒ HasHardForkHistory (HardForkBlock xs) Source # 
Instance details

Associated Types

type HardForkIndices (HardForkBlock xs) 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanHardFork xs ⇒ ValidateEnvelope (HardForkBlock xs) Source # 
Instance details

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ UpdateLedger (HardForkBlock xs) Source # 
Instance details

CanHardFork xs ⇒ GetTip (LedgerState (HardForkBlock xs)) Source # 
Instance details

Methods

getTip ∷ ∀ (mk ∷ MapKind). LedgerState (HardForkBlock xs) mk → Point (LedgerState (HardForkBlock xs)) Source #

CanHardFork xs ⇒ IsLedger (LedgerState (HardForkBlock xs)) Source # 
Instance details

CanHardFork xs ⇒ InspectLedger (HardForkBlock xs) Source # 
Instance details

Methods

inspectLedger ∷ ∀ (mk1 ∷ MapKind) (mk2 ∷ MapKind). TopLevelConfig (HardForkBlock xs) → LedgerState (HardForkBlock xs) mk1 → LedgerState (HardForkBlock xs) mk2 → [LedgerEvent (HardForkBlock xs)] Source #

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ LedgerSupportsProtocol (HardForkBlock xs) Source # 
Instance details

All (Compose CanStowLedgerTables LedgerState) xs ⇒ CanStowLedgerTables (LedgerState (HardForkBlock xs)) Source # 
Instance details

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ HasLedgerTables (LedgerState (HardForkBlock xs)) Source #

Warning: projectLedgerTables and withLedgerTables are prohibitively expensive when using big tables or when used multiple times. See the TxOut instance for the HardForkBlock for more information.

Instance details

(CanHardFork xs, HasHardForkTxOut xs) ⇒ CanUpgradeLedgerTables (LedgerState (HardForkBlock xs)) Source # 
Instance details

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ ApplyBlock (LedgerState (HardForkBlock xs)) (HardForkBlock xs) Source # 
Instance details

CanHardFork xs ⇒ GetTip (Ticked (LedgerState (HardForkBlock xs))) Source # 
Instance details

Methods

getTip ∷ ∀ (mk ∷ MapKind). Ticked (LedgerState (HardForkBlock xs)) mk → Point (Ticked (LedgerState (HardForkBlock xs))) Source #

(CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ HasLedgerTables (Ticked (LedgerState (HardForkBlock xs))) Source # 
Instance details