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

Ouroboros.Consensus.Ledger.Basics

Description

Definition is IsLedger

Normally this is imported from Ouroboros.Consensus.Ledger.Abstract. We pull this out to avoid circular module dependencies.

Synopsis

The LedgerState definition

type family LedgerCfg (l ∷ LedgerStateKind) Source #

Static environment required for the ledger

Types that inhabit this family will come from the Ledger code.

data family LedgerState blk (mk ∷ MapKind) Source #

Ledger state associated with a block

This is the Consensus notion of a Ledger ledger state. Each block type is associated with one of the Ledger types for the ledger state. Virtually every concept in this codebase revolves around this type, or the referenced blk. Whenever we use the type variable l we intend to signal that the expected instantiation is either a LedgerState or some wrapper over it (like the ExtLedgerState).

This type is parametrized over mk :: MapKind to express the LedgerTables contained in such a LedgerState. See LedgerTables for a more thorough description.

The main operations we can do with a LedgerState are ticking (defined in IsLedger), and applying a block (defined in ApplyBlock).

Instances

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

Methods

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

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

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

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

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

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

Defined in Ouroboros.Consensus.Ledger.Dual

Associated Types

type LedgerErr (LedgerState (DualBlock m a)) 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

type AuxLedgerEvent (LedgerState (DualBlock m a)) 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanStowLedgerTables (LedgerState m) ⇒ CanStowLedgerTables (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

(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

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 (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

projectLedgerTables ∷ ∀ (mk ∷ MapKind). (CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) ⇒ LedgerState (DualBlock m a) mk → LedgerTables (LedgerState (DualBlock m a)) mk Source #

withLedgerTables ∷ ∀ (mk ∷ MapKind) (any ∷ MapKind). (CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) ⇒ LedgerState (DualBlock m a) any → LedgerTables (LedgerState (DualBlock m a)) mk → LedgerState (DualBlock m a) mk Source #

(Ord (TxIn (LedgerState m)), MemPack (TxIn (LedgerState m)), MemPack (TxOut (LedgerState m))) ⇒ SerializeTablesWithHint (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

CanUpgradeLedgerTables (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

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

Defined in Ouroboros.Consensus.Ledger.Dual

SerialiseHFC xs ⇒ DecodeDisk (HardForkBlock xs) (LedgerState (HardForkBlock xs) EmptyMK) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk

SerialiseHFC xs ⇒ EncodeDisk (HardForkBlock xs) (LedgerState (HardForkBlock xs) EmptyMK) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk

(ShowMK mk, CanHardFork xs) ⇒ Show (LedgerState (HardForkBlock xs) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Basics

(Bridge m a, ShowMK mk) ⇒ Show (LedgerState (DualBlock m a) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

showsPrecIntLedgerState (DualBlock m a) mk → ShowS #

showLedgerState (DualBlock m a) mk → String #

showList ∷ [LedgerState (DualBlock m a) mk] → ShowS #

(EqMK mk, CanHardFork xs) ⇒ Eq (LedgerState (HardForkBlock xs) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Basics

(Bridge m a, EqMK mk) ⇒ Eq (LedgerState (DualBlock m a) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

(==)LedgerState (DualBlock m a) mk → LedgerState (DualBlock m a) mk → Bool #

(/=)LedgerState (DualBlock m a) mk → LedgerState (DualBlock m a) mk → Bool #

(NoThunksMK mk, CanHardFork xs) ⇒ NoThunks (LedgerState (HardForkBlock xs) mk) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Basics

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

Defined in Ouroboros.Consensus.Ledger.Dual

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 #

(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

(txout ~ TxOut (LedgerState m), IndexedMemPack (LedgerState m EmptyMK) txout) ⇒ IndexedMemPack (LedgerState (DualBlock m a) EmptyMK) txout Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

StandardHash blk ⇒ StandardHash (LedgerState blk ∷ MapKindType) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

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

Defined in Ouroboros.Consensus.Ledger.Dual

Inject (Flip LedgerState mk) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Nary

Methods

inject ∷ ∀ x (xs ∷ [Type]). (CanHardFork xs, HasCanonicalTxIn xs, HasHardForkTxOut xs) ⇒ InjectionIndex xs x → Flip LedgerState mk x → Flip LedgerState mk (HardForkBlock xs) Source #

Isomorphic (Flip LedgerState mk) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Unary

Methods

projectNoHardForks blk ⇒ Flip LedgerState mk (HardForkBlock '[blk]) → Flip LedgerState mk blk Source #

injectNoHardForks blk ⇒ Flip LedgerState mk blk → Flip LedgerState mk (HardForkBlock '[blk]) Source #

type AuxLedgerEvent (LedgerState (HardForkBlock xs)) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type AuxLedgerEvent (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

type LedgerCfg (LedgerState (HardForkBlock xs)) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Basics

type LedgerCfg (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

type LedgerErr (LedgerState (HardForkBlock xs)) Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type LedgerErr (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

newtype LedgerState (HardForkBlock xs) mk Source # 
Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Basics

type TxIn (LedgerState (HardForkBlock xs)) Source #

Must be the CannonicalTxIn type, but this will probably change in the future to NS WrapTxIn xs. See HasCanonicalTxIn.

Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type TxIn (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

type TxOut (LedgerState (HardForkBlock xs)) Source #

Must be the HardForkTxOut type

Instance details

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

type TxOut (LedgerState (DualBlock m a)) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

data LedgerState (DualBlock m a) mk Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

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

type HeaderHash (LedgerState blk ∷ MapKindType) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

type HeaderHash (LedgerState blk ∷ MapKindType) = HeaderHash blk

Definition of a ledger independent of a choice of block

data ComputeLedgerEvents Source #

Whether we tell the ledger layer to compute ledger events

At the moment events are not emitted in any case in the consensus layer (i.e. there is no handler for those events, nor are they traced), so they are not really forced, we always discard them. This behavior does not incur big costs thanks to laziness.

By passing OmitLedgerEvents we tell the Ledger layer to not even allocate thunks for those events, as we explicitly don't want them.

Instances

Instances details
Generic ComputeLedgerEvents Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

Associated Types

type Rep ComputeLedgerEvents 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

type Rep ComputeLedgerEvents = D1 ('MetaData "ComputeLedgerEvents" "Ouroboros.Consensus.Ledger.Basics" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "ComputeLedgerEvents" 'PrefixI 'False) (U1TypeType) :+: C1 ('MetaCons "OmitLedgerEvents" 'PrefixI 'False) (U1TypeType))
Show ComputeLedgerEvents Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

Eq ComputeLedgerEvents Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

NoThunks ComputeLedgerEvents Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

type Rep ComputeLedgerEvents Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

type Rep ComputeLedgerEvents = D1 ('MetaData "ComputeLedgerEvents" "Ouroboros.Consensus.Ledger.Basics" "ouroboros-consensus-0.26.0.0-inplace" 'False) (C1 ('MetaCons "ComputeLedgerEvents" 'PrefixI 'False) (U1TypeType) :+: C1 ('MetaCons "OmitLedgerEvents" 'PrefixI 'False) (U1TypeType))

class (∀ (mk ∷ MapKind). EqMK mk ⇒ Eq (l mk), ∀ (mk ∷ MapKind). NoThunksMK mk ⇒ NoThunks (l mk), ∀ (mk ∷ MapKind). ShowMK mk ⇒ Show (l mk), NoThunks (LedgerCfg l), Show (LedgerErr l), Eq (LedgerErr l), NoThunks (LedgerErr l), GetTip l, GetTip (Ticked l)) ⇒ IsLedger (l ∷ LedgerStateKind) where Source #

Associated Types

type LedgerErr (l ∷ LedgerStateKind) Source #

Errors that can arise when updating the ledger

This is defined here rather than in ApplyBlock, since the type of these errors does not depend on the type of the block.

type AuxLedgerEvent (l ∷ LedgerStateKind) Source #

Event emitted by the ledger

TODO we call this AuxLedgerEvent to differentiate from LedgerEvent in InspectLedger. When that module is rewritten to make use of ledger derived events, we may rename this type.

Methods

applyChainTickLedgerResultComputeLedgerEventsLedgerCfg l → SlotNo → l EmptyMKLedgerResult l (Ticked l DiffMK) Source #

Apply "slot based" state transformations

When a block is applied to the ledger state, a number of things happen purely based on the slot number of that block. For example:

  • In Byron, scheduled updates are applied, and the update system state is updated.
  • In Shelley, delegation state is updated (on epoch boundaries).

The consensus layer must be able to apply such a "chain tick" function, primarily when validating transactions in the mempool (which, conceptually, live in "some block in the future") or when extracting valid transactions from the mempool to insert into a new block to be produced.

This is not allowed to throw any errors. After all, if this could fail, it would mean a previous block set up the ledger state in such a way that as soon as a certain slot was reached, any block would be invalid.

Ticking a ledger state may not use any data from the LedgerTables, however it might produce differences in the tables, in particular because era transitions happen when ticking a ledger state.

PRECONDITION: The slot number must be strictly greater than the slot at the tip of the ledger (except for EBBs, obviously..).

NOTE: applyChainTickLedgerResult should not change the tip of the underlying ledger state, which should still refer to the most recent applied block. In other words, we should have:

ledgerTipPoint (applyChainTick cfg slot st) == ledgerTipPoint st

Instances

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

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

Defined in Ouroboros.Consensus.Ledger.Dual

Associated Types

type LedgerErr (LedgerState (DualBlock m a)) 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

type AuxLedgerEvent (LedgerState (DualBlock m a)) 
Instance details

Defined in Ouroboros.Consensus.Ledger.Dual

LedgerSupportsProtocol blk ⇒ IsLedger (ExtLedgerState blk) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Extended

Ledger Events

data LedgerResult (l ∷ LedgerStateKind) a Source #

The result of invoke a ledger function that does validation

Note: we do not instantiate Applicative or Monad for this type because those interfaces would typically incur space leaks. We encourage you to process the events each time you invoke a ledger function.

Constructors

LedgerResult 

Fields

Instances

Instances details
Functor (LedgerResult l) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

Methods

fmap ∷ (a → b) → LedgerResult l a → LedgerResult l b #

(<$) ∷ a → LedgerResult l b → LedgerResult l a #

Foldable (LedgerResult l) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

Methods

foldMonoid m ⇒ LedgerResult l m → m #

foldMapMonoid m ⇒ (a → m) → LedgerResult l a → m #

foldMap'Monoid m ⇒ (a → m) → LedgerResult l a → m #

foldr ∷ (a → b → b) → b → LedgerResult l a → b #

foldr' ∷ (a → b → b) → b → LedgerResult l a → b #

foldl ∷ (b → a → b) → b → LedgerResult l a → b #

foldl' ∷ (b → a → b) → b → LedgerResult l a → b #

foldr1 ∷ (a → a → a) → LedgerResult l a → a #

foldl1 ∷ (a → a → a) → LedgerResult l a → a #

toListLedgerResult l a → [a] #

nullLedgerResult l a → Bool #

lengthLedgerResult l a → Int #

elemEq a ⇒ a → LedgerResult l a → Bool #

maximumOrd a ⇒ LedgerResult l a → a #

minimumOrd a ⇒ LedgerResult l a → a #

sumNum a ⇒ LedgerResult l a → a #

productNum a ⇒ LedgerResult l a → a #

Traversable (LedgerResult l) Source # 
Instance details

Defined in Ouroboros.Consensus.Ledger.Basics

Methods

traverseApplicative f ⇒ (a → f b) → LedgerResult l a → f (LedgerResult l b) #

sequenceAApplicative f ⇒ LedgerResult l (f a) → f (LedgerResult l a) #

mapMMonad m ⇒ (a → m b) → LedgerResult l a → m (LedgerResult l b) #

sequenceMonad m ⇒ LedgerResult l (m a) → m (LedgerResult l a) #

data VoidLedgerEvent (l ∷ LedgerStateKind) Source #

A Void isomorph for explicitly declaring that some ledger has no events

GetTip

class GetTip (l ∷ LedgerStateKind) where Source #

Methods

getTip ∷ ∀ (mk ∷ MapKind). l mk → Point l Source #

Point of the most recently applied block

Should be GenesisPoint when no blocks have been applied yet

Instances

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

Defined in Ouroboros.Consensus.HardFork.Combinator.Ledger

Methods

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

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

Defined in Ouroboros.Consensus.Ledger.Dual

Methods

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

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

Defined in Ouroboros.Consensus.Ledger.Extended

Methods

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

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 #

IsLedger l ⇒ GetTip (K (DbChangelog l) ∷ MapKindType) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V1.DbChangelog

Methods

getTip ∷ ∀ (mk ∷ MapKind). K (DbChangelog l) mk → Point (K (DbChangelog l) ∷ MapKindType) Source #

class GetTipSTM (m ∷ TypeType) l where Source #

Methods

getTipSTM ∷ l → STM m (Point l) Source #

Instances

Instances details
(GetTip l, HeaderHash l ~ HeaderHash blk, MonadSTM m) ⇒ GetTipSTM m (Forker m l blk) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.Forker

Methods

getTipSTMForker m l blk → STM m (Point (Forker m l blk)) Source #

getTipHash ∷ ∀ l (mk ∷ MapKind). GetTip l ⇒ l mk → ChainHash l Source #

getTipM ∷ (GetTipSTM m l, MonadSTM m) ⇒ l → m (Point l) Source #

getTipSlot ∷ ∀ l (mk ∷ MapKind). GetTip l ⇒ l mk → WithOrigin SlotNo Source #

Associated types by block type

Re-exports