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

Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Description

The data structure that holds the cached ledger states.

Synopsis

LedgerHandles

data LedgerTablesHandle (m ∷ TypeType) (l ∷ (TypeTypeType) → Type) Source #

The interface fulfilled by handles on both the InMemory and LSM handles.

Constructors

LedgerTablesHandle 

Fields

  • close ∷ !(m ())
     
  • duplicate ∷ !(m (LedgerTablesHandle m l))

    Create a copy of the handle.

    A duplicated handle must provide access to all the data that was there in the original handle while being able to mutate in ways different than the original handle.

    When applying diffs to a table, we will first duplicate the handle, then apply the diffs in the copy. It is expected that duplicating the handle takes constant time.

  • read ∷ !(l EmptyMKLedgerTables l KeysMK → m (LedgerTables l ValuesMK))

    Read values for the given keys from the tables, and deserialize them as if they were from the same era as the given ledger state.

  • readRange ∷ !(l EmptyMK → (Maybe (TxIn l), Int) → m (LedgerTables l ValuesMK, Maybe (TxIn l)))

    Read the requested number of values, possibly starting from the given key, from the tables, and deserialize them as if they were from the same era as the given ledger state.

    The returned value contains both the read values as well as the last key retrieved. This is necessary in case the backend uses a serialization format such that the order in the store (which will be used when reading) might not match the order in a Haskell Map (induced by Ord), so the backend must tell which key it read last (if any).

    The last key retrieved is part of the map too. It is intended to be fed back into the next iteration of the range read. If the function returns Nothing, it means the read returned no results, or in other words, we reached the end of the ledger tables.

  • readAll ∷ !(l EmptyMK → m (LedgerTables l ValuesMK))

    Costly read all operation, not to be used in Consensus but only in snapshot-converter executable. The values will be read as if they were from the same era as the given ledger state.

  • pushDiffs ∷ !(∀ (mk ∷ TypeTypeType). l mk → l DiffMK → m ())

    Push some diffs into the ledger tables handle.

    The first argument has to be the ledger state before applying the block, the second argument should be the ledger state after applying a block. See CanUpgradeLedgerTables.

    Note CanUpgradeLedgerTables is only used in the InMemory backend.

  • takeHandleSnapshot ∷ !(l EmptyMKString → m (Maybe CRC))

    Take a snapshot of a handle. The given ledger state is used to decide the encoding of the values based on the current era.

    It returns a CRC only on backends that support it, as the InMemory backend.

  • tablesSize ∷ !(m (Maybe Int))

    Consult the size of the ledger tables in the database. This will return Nothing in backends that do not support this operation.

The ledger seq

newtype LedgerSeq (m ∷ TypeType) (l ∷ (TypeTypeType) → Type) Source #

Constructors

LedgerSeq 

Instances

Instances details
Generic (LedgerSeq m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Associated Types

type Rep (LedgerSeq m l) 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (LedgerSeq m l) = D1 ('MetaData "LedgerSeq" "Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq" "ouroboros-consensus-0.28.0.0-inplace" 'True) (C1 ('MetaCons "LedgerSeq" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLedgerSeq") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AnchoredSeq (WithOrigin SlotNo) (StateRef m l) (StateRef m l)))))

Methods

fromLedgerSeq m l → Rep (LedgerSeq m l) x #

toRep (LedgerSeq m l) x → LedgerSeq m l #

Show (l EmptyMK) ⇒ Show (LedgerSeq m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Methods

showsPrecIntLedgerSeq m l → ShowS #

showLedgerSeq m l → String #

showList ∷ [LedgerSeq m l] → ShowS #

Eq (l EmptyMK) ⇒ Eq (LedgerSeq m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Methods

(==)LedgerSeq m l → LedgerSeq m l → Bool #

(/=)LedgerSeq m l → LedgerSeq m l → Bool #

(IOLike m, NoThunks (l EmptyMK)) ⇒ NoThunks (LedgerSeq m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (LedgerSeq m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (LedgerSeq m l) = D1 ('MetaData "LedgerSeq" "Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq" "ouroboros-consensus-0.28.0.0-inplace" 'True) (C1 ('MetaCons "LedgerSeq" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLedgerSeq") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AnchoredSeq (WithOrigin SlotNo) (StateRef m l) (StateRef m l)))))

type LedgerSeq' (m ∷ TypeType) blk = LedgerSeq m (ExtLedgerState blk) Source #

data StateRef (m ∷ TypeType) (l ∷ (TypeTypeType) → Type) Source #

For single era blocks, it would be the same to hold a stowed ledger state (LedgerTables (LedgerState blk) EmptyMK), an unstowed one (LedgerTables (LedgerState blk) ValuesMK) or a tuple with the state and the tables (LedgerState blk EmptyMK, LedgerTables (LedgerState blk) ValuesMK), however, for a hard fork block, these are not equivalent.

If we were to hold a sequence of type LedgerState blk EmptyMK with stowed values, we would have to translate the entirety of the tables on epoch boundaries.

If we were to hold a sequence of type LedgerState blk ValuesMK we would have the same problem as the mk in the state actually refers to the mk in the HardForkState'ed state.

Therefore it sounds reasonable to hold a LedgerState blk EmptyMK with no values, and a LedgerTables blk ValuesMK next to it, that will live its entire lifetime as LedgerTables of the HardForkBlock.

Constructors

StateRef 

Fields

Instances

Instances details
GetTip l ⇒ Anchorable (WithOrigin SlotNo) (StateRef m l) (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Generic (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Associated Types

type Rep (StateRef m l) 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (StateRef m l) = D1 ('MetaData "StateRef" "Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq" "ouroboros-consensus-0.28.0.0-inplace" 'False) (C1 ('MetaCons "StateRef" 'PrefixI 'True) (S1 ('MetaSel ('Just "state") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (l EmptyMK)) :*: S1 ('MetaSel ('Just "tables") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LedgerTablesHandle m l))))

Methods

fromStateRef m l → Rep (StateRef m l) x #

toRep (StateRef m l) x → StateRef m l #

Show (l EmptyMK) ⇒ Show (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Methods

showsPrecIntStateRef m l → ShowS #

showStateRef m l → String #

showList ∷ [StateRef m l] → ShowS #

Eq (l EmptyMK) ⇒ Eq (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

Methods

(==)StateRef m l → StateRef m l → Bool #

(/=)StateRef m l → StateRef m l → Bool #

(IOLike m, NoThunks (l EmptyMK)) ⇒ NoThunks (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (StateRef m l) Source # 
Instance details

Defined in Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq

type Rep (StateRef m l) = D1 ('MetaData "StateRef" "Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq" "ouroboros-consensus-0.28.0.0-inplace" 'False) (C1 ('MetaCons "StateRef" 'PrefixI 'True) (S1 ('MetaSel ('Just "state") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (l EmptyMK)) :*: S1 ('MetaSel ('Just "tables") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LedgerTablesHandle m l))))

closeLedgerSeq ∷ ∀ m (l ∷ (TypeTypeType) → Type). Monad m ⇒ LedgerSeq m l → m () Source #

Close all LedgerTablesHandle in this LedgerSeq, in particular that on the anchor.

empty ∷ (GetTip l, IOLike m) ⇒ l EmptyMK → init → (init → m (LedgerTablesHandle m l)) → m (LedgerSeq m l) Source #

Creates an empty LedgerSeq

empty' ∷ (GetTip l, IOLike m, HasLedgerTables l) ⇒ l ValuesMK → (l ValuesMK → m (LedgerTablesHandle m l)) → m (LedgerSeq m l) Source #

Creates an empty LedgerSeq

Apply Blocks

extend ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ StateRef m l → LedgerSeq m l → LedgerSeq m l Source #

Extending the LedgerDB with a valid ledger state.

>>> ldb            = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> LedgerSeq ldb' = extend l4 ldb
>>> AS.toOldestFirst ldb' == [l1, l2, l3, l4]
True

prune ∷ ∀ m (l ∷ LedgerStateKind). (Monad m, GetTip l) ⇒ LedgerDbPruneLedgerSeq m l → (m (), LedgerSeq m l) Source #

Prune older ledger states according to the given LedgerDbPrune strategy.

The fst component of the returned value is an action closing the pruned ledger states.

>>> ldb  = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> ldb' = LedgerSeq $ AS.fromOldestFirst     l1 [l2, l3]
>>> snd (prune (LedgerDbPruneBeforeSlot 1) ldb) == ldb'
True

where lX is a ledger state from slot X-1 (or Origin for l0).

pruneToImmTipOnly ∷ ∀ m (l ∷ LedgerStateKind). (Monad m, GetTip l) ⇒ LedgerSeq m l → (m (), LedgerSeq m l) Source #

Set the volatile tip as the immutable tip and prune all older states.

>>> ldb  = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> LedgerSeq ldb' = snd $ pruneToImmTipOnly ldb
>>> AS.anchor ldb' == l3 && AS.toOldestFirst ldb' == []
True

reapplyBlock ∷ ∀ m (l ∷ LedgerStateKind) blk. (ApplyBlock l blk, IOLike m) ⇒ ComputeLedgerEventsLedgerCfg l → blk → ResourceRegistry m → LedgerSeq m l → m (StateRef m l) Source #

reapplyThenPush ∷ ∀ m (l ∷ LedgerStateKind) blk. (IOLike m, ApplyBlock l blk) ⇒ ResourceRegistry m → LedgerDbCfg l → blk → LedgerSeq m l → m (m (), LedgerSeq m l) Source #

Apply a block on top of the ledger state and extend the LedgerSeq with the result ledger state.

The fst component of the result should be run to close the pruned states.

Queries

anchor ∷ ∀ (m ∷ TypeType) l. LedgerSeq m l → l EmptyMK Source #

The ledger state at the anchor of the Volatile chain (i.e. the immutable tip).

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> l0s == anchor ldb
True

anchorHandle ∷ ∀ (m ∷ TypeType) (l ∷ (TypeTypeType) → Type). LedgerSeq m l → StateRef m l Source #

current ∷ ∀ l (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → l EmptyMK Source #

The ledger state at the tip of the chain

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> l3s == current ldb
True

currentHandle ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → StateRef m l Source #

getPastLedgerAt ∷ ∀ blk l (m ∷ TypeType). (HasHeader blk, GetTip l, HeaderHash l ~ HeaderHash blk, StandardHash l) ⇒ Point blk → LedgerSeq m l → Maybe (l EmptyMK) Source #

Get a past ledger state

\( O(\log(\min(i,n-i)) \)

When no ledger state (or anchor) has the given Point, Nothing is returned.

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> getPastLedgerAt (Point (At (Block 4 4)) :: Point B) ldb == Nothing
True
>>> getPastLedgerAt (Point (At (Block 1 1)) :: Point B) ldb == Just l2s
True

immutableTipSlot ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → WithOrigin SlotNo Source #

isSaturated ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ SecurityParamLedgerSeq m l → Bool Source #

Have we seen at least k blocks?

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> isSaturated (SecurityParam (unsafeNonZero 3)) ldb
True
>>> isSaturated (SecurityParam (unsafeNonZero 4)) ldb
False

maxRollback ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → Word64 Source #

How many blocks can we currently roll back?

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> maxRollback ldb
3

rollback ∷ ∀ blk (l ∷ LedgerStateKind) (m ∷ TypeType). (HasHeader blk, GetTip l, HeaderHash l ~ HeaderHash blk, StandardHash l) ⇒ Point blk → LedgerSeq m l → Maybe (LedgerSeq m l) Source #

Get a prefix of the LedgerDB that ends at the given point

\( O(\log(\min(i,n-i)) \)

When no ledger state (or anchor) has the given Point, Nothing is returned.

rollbackN ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ Word64LedgerSeq m l → Maybe (LedgerSeq m l) Source #

Rollback n ledger states.

Returns Nothing if maximum rollback (usually k, but can be less on startup or under corruption) is exceeded.

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> fmap (([l1] ==) . AS.toOldestFirst . getLedgerSeq) (rollbackN 2 ldb)
Just True

rollbackToAnchor ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → LedgerSeq m l Source #

Rollback the volatile states up to the volatile anchor.

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> LedgerSeq ldb' = rollbackToAnchor ldb
>>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == []
True

rollbackToPoint ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). (StandardHash l, GetTip l) ⇒ Point l → LedgerSeq m l → Maybe (LedgerSeq m l) Source #

Roll back the volatile states up to the specified point.

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> Just (LedgerSeq ldb') = rollbackToPoint (Point Origin) ldb
>>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == []
True
>>> rollbackToPoint (Point (At (Block 1 2))) ldb == Nothing
True
>>> Just (LedgerSeq ldb') = rollbackToPoint (Point (At (Block 1 1))) ldb
>>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == [l1, l2]
True

snapshots ∷ ∀ (m ∷ TypeType) l. LedgerSeq m l → [(Word64, l EmptyMK)] Source #

All snapshots currently stored by the ledger DB (new to old)

This also includes the snapshot at the anchor. For each snapshot we also return the distance from the tip.

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> [(0, l3s), (1, l2s), (2, l1s)] == snapshots ldb
True

tip ∷ ∀ (l ∷ LedgerStateKind) (m ∷ TypeType). GetTip l ⇒ LedgerSeq m l → Point l Source #

Reference to the block at the tip of the chain

>>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
>>> tip ldb == getTip l3s
True

volatileStatesBimap ∷ ∀ a b l (m ∷ TypeType). Anchorable (WithOrigin SlotNo) a b ⇒ (l EmptyMK → a) → (l EmptyMK → b) → LedgerSeq m l → AnchoredSeq (WithOrigin SlotNo) a b Source #

Transform the underlying volatile AnchoredSeq using the given functions.