Merge pull request #4302 from input-output-hk/jasagredo/reenable-tutorials
Reenable consensus tutorials
Reenable consensus tutorials
% Example: Implementing a Simple Protocol Using `ouroborus-consensus`
% Example: Implementing a Simple Protocol Using `ouroboros-consensus`
Generating Documentation From This File
=======================================
This example uses several extensions:
> {-# OPTIONS_GHC -Wno-unused-top-binds #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE DerivingVia #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE DeriveAnyClass #-}
> {-# LANGUAGE DeriveGeneric #-}
> {-# LANGUAGE DerivingVia #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE DeriveAnyClass #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE RecordWildCards #-}
> {-# LANGUAGE StandaloneDeriving #-}
> {-# LANGUAGE TypeFamilies #-}
> module Ouroboros.Consensus.Tutorial.Simple () where
> HeaderHash, Point, StandardHash)
> import Ouroboros.Consensus.Protocol.Abstract
> (SecurityParam(..), ConsensusConfig, ConsensusProtocol(..) )
> import Ouroboros.Consensus.Ticked ( Ticked(TickedTrivial) )
> import Ouroboros.Consensus.Ticked ( Ticked1, Ticked(TickedTrivial) )
> import Ouroboros.Consensus.Block
> (BlockSupportsProtocol (selectView, validateView))
> import Ouroboros.Consensus.Ledger.Tables
> import Ouroboros.Consensus.Ledger.Abstract
> (GetTip(..), IsLedger(..), LedgerCfg,
> LedgerResult(LedgerResult, lrEvents, lrResult),
valid. Computing this value is the responsibility of the **ledger** and the
**ledger state** is the computed value.
`ouroborus-consensus` combines features of much of this infrastructure taking
`ouroboros-consensus` combines features of much of this infrastructure taking
(possibly simplified) views of blocks and the ledger and using them to decide
between different proposed chains to implement eventual consistency across the
nodes.
The `ConsensusProtocol` typeclass
=================================
The central abstraction of `ouroborus-consensus` is the `ConsensusProtocol`
The central abstraction of `ouroboros-consensus` is the `ConsensusProtocol`
typeclass. This class captures the relationship between consensus and the rest
of the system (in particular the ledger) as a set of type families.
Below we'll define a group of typeclasses that together implement a simple
ledger that uses `BlockC` and that is suitable for our consensus protocol `SP`.
For this tutorial we will be ignoring the definitions related to UTxO-HD. In
particular one can ignore type variables named `mk`, types of the form `*MK`,
and anything mentioning to tables or `KeySets`. There is an appendix at the end
of this document that briefly outlines UTxO-HD.
`LedgerCfg` - Ledger Static Configuration
-----------------------------------------
number, we materialize that number in the `LedgerState`. We'll also need to
keep track of some information about the most recent block we have seen.
> data instance LedgerState BlockC =
>
> data instance LedgerState BlockC mk =
> LedgerC
> -- the hash and slot number of the most recent block
> { lsbc_tip :: Point BlockC
---------------------------------------
Again, the slot abstraction defines a logical clock - and instances of the
`Ticked` family describe values that evolve with respect to this logical clock.
As such, we will also need to define an instance of `Ticked` for our ledger
`Ticked1` family describe values that evolve with respect to this logical clock.
As such, we will also need to define an instance of `Ticked1` for our ledger
state. In our example, this is essentially an `Identity` functor:
> newtype instance Ticked (LedgerState BlockC) =
> newtype instance Ticked1 (LedgerState BlockC) mk =
> TickedLedgerStateC
> { unTickedLedgerStateC :: LedgerState BlockC }
> { unTickedLedgerStateC :: LedgerState BlockC mk }
> deriving (Show, Eq, Generic, Serialise)
`IsLedger`
----------
>
> applyChainTickLedgerResult _cfg _slot ldgrSt =
> LedgerResult { lrEvents = []
> , lrResult = TickedLedgerStateC ldgrSt
> , lrResult = TickedLedgerStateC $ convertMapKind ldgrSt
> }
The `LedgerErr` type is the type of errors associated with this ledger that can
The `applyChainTickLedgerResult` function 'ticks' the `LedgerState`, resulting
in an updated `LedgerState` that has witnessed a change in slot (which, again,
corresponds to a logical clock.) Note that this function _does allow failure._
If it did, that means the `LedgerState` is such that it is in a state that will
eventually fail due to the passage of time and such errors should have been
signalled earlier (for example, when applying blocks.)
corresponds to a logical clock.) Note that this function _does not allow
failure._ If it did, that means the `LedgerState` is such that it is in a state
that will eventually fail due to the passage of time and such errors should have
been signalled earlier (for example, when applying blocks.)
`ApplyBlock` - Applying Blocks to `LedgerState`
-----------------------------------------------
`LedgerState` is the result of having witnessed `b` at some point. We can
express this as a function:
> applyBlockTo :: BlockC -> Ticked (LedgerState BlockC) -> LedgerState BlockC
> applyBlockTo :: BlockC -> Ticked1 (LedgerState BlockC) ValuesMK -> LedgerState BlockC DiffMK
> applyBlockTo block tickedLedgerState =
> ledgerState { lsbc_tip = blockPoint block
> , lsbc_count = lsbc_count'
> Inc -> i + 1
> Dec -> i - 1
We use a `Ticked (LedgerState BlockC)` to enforce the invariant that we should
We use a `Ticked1 (LedgerState BlockC)` to enforce the invariant that we should
not apply two blocks in a row - at least one tick (aka slot) must have elapsed
between block applications.
> , lrResult = block `applyBlockTo` tickedLdgrSt
> }
>
>
> getBlockKeySets = const NoLedgerTables
`applyBlockLedgerResult` tries to apply a block to the ledger and fails with a
`LedgerErr` corresponding to the particular `LedgerState blk` if for whatever
the most recently applied block. We need to implement this both for
`LedgerState BlockC` as well as its ticked version:
> instance GetTip (Ticked (LedgerState BlockC)) where
> instance GetTip (Ticked1 (LedgerState BlockC) mk) where
> getTip = castPoint . lsbc_tip . unTickedLedgerStateC
> instance GetTip (LedgerState BlockC) where
> instance GetTip (LedgerState BlockC mk) where
> getTip = castPoint . lsbc_tip
Associating Ledgers to Protocols
> instance NoThunks BlockC
> deriving via OnlyCheckWhnfNamed "HdrBlockC" (Header BlockC)
> instance NoThunks (Header BlockC)
> deriving via OnlyCheckWhnfNamed "LedgerC" (LedgerState BlockC)
> instance NoThunks (LedgerState BlockC)
> deriving instance NoThunks (Ticked (LedgerState BlockC))
> deriving via OnlyCheckWhnfNamed "LedgerC" (LedgerState BlockC mk)
> instance NoThunks (LedgerState BlockC mk)
> deriving instance NoThunks (Ticked1 (LedgerState BlockC) mk)
Appendix: UTxO-HD features
==========================
The introduction of UTxO-HD is out of the scope of this tutorial but we will
describe here a few hints on how it would be defined. In broad terms, with the
introduction of UTxO-HD a part of the ledger state (the UTxO set) was moved to
the disk and now consensus:
- provides subsets of that data to the ledger rules (i.e. only the consumed
UTxOs on a block)
- stores a sequence of deltas (diffs) produced by the execution of the ledger
rules
These subsets are defined in terms of the `LedgerTables` and the `mk` type
variable that indicates if the collection is made of key-value pairs, only keys
or to keys-delta pairs.
The `TableStuff` class defines the basic operations that can be done with the
`LedgerTables`. For a Ledger state definition as simple as the one we are
defining there the tables are trivially empty so the operations are all trivial.
> instance TableStuff (LedgerState BlockC) where
> data instance LedgerTables (LedgerState BlockC) mk =
> NoLedgerTables
> deriving (Eq, Show, Generic, NoThunks)
>
As before, we require a few language extensions:
> {-# OPTIONS_GHC -Wno-unused-top-binds #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE DerivingVia #-}
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE DeriveAnyClass #-}
> {-# LANGUAGE DeriveGeneric #-}
> {-# LANGUAGE DerivingVia #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE GeneralizedNewtypeDeriving #-}
> {-# LANGUAGE DeriveAnyClass #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE RecordWildCards #-}
> {-# LANGUAGE StandaloneDeriving #-}
> {-# LANGUAGE TypeFamilies #-}
> module Ouroboros.Consensus.Tutorial.WithEpoch () where
> import Ouroboros.Consensus.Protocol.Abstract
> (ConsensusConfig, SecurityParam, ConsensusProtocol (..))
>
> import Ouroboros.Consensus.Ticked (Ticked)
> import Ouroboros.Consensus.Ticked (Ticked, Ticked1)
> import Ouroboros.Consensus.Ledger.Abstract
> (LedgerState, LedgerCfg, GetTip, LedgerResult (..), ApplyBlock (..),
> UpdateLedger, IsLedger (..))
> import Ouroboros.Consensus.Forecast
> (Forecast (..), OutsideForecastRange (..))
> import Ouroboros.Consensus.Ledger.Basics (GetTip(..))
> import Ouroboros.Consensus.Ledger.Tables
Epochs
epoch boundaries - this is the `lsbd_snapshot1` and `lsbd_snapshot2` fields
below:
> data instance LedgerState BlockD =
> data instance LedgerState BlockD mk =
> LedgerD
> { lsbd_tip :: Point BlockD -- ^ Point of the last applied block.
> -- (Point is header hash and slot no.)
Our `GetTip` implementation retrieves the tip from the `lsbd_tip` field:
> instance GetTip (Ticked (LedgerState BlockD)) where
> instance GetTip (Ticked1 (LedgerState BlockD) mk) where
> getTip = castPoint . lsbd_tip . unTickedLedgerStateD
> instance GetTip (LedgerState BlockD) where
> instance GetTip (LedgerState BlockD mk) where
> getTip = castPoint . lsbd_tip
Ticking
-------
`LedgerState BlockD` also needs a corresponding `Ticked` instance which is still
very simple:
`LedgerState BlockD` also needs a corresponding `Ticked1` instance which is
still very simple:
> newtype instance Ticked (LedgerState BlockD) =
> newtype instance Ticked1 (LedgerState BlockD) mk =
> TickedLedgerStateD {
> unTickedLedgerStateD :: LedgerState BlockD
> unTickedLedgerStateD :: LedgerState BlockD mk
> }
> deriving stock (Show, Eq, Generic)
> deriving newtype (NoThunks, Serialise)
Because the ledger now needs to track the snapshots in `lsbd_snapshot1` and
`lsbd_snapshot2` we can express this in terms of ticking a `LedgerState BlockD`.
We'll write a function (that we'll use later) to express this relationship
computing the `Ticked (LedgerState BlockD)` resulting from a starting
computing the `Ticked1 (LedgerState BlockD)` resulting from a starting
`LedgerState BlockD` being ticked to some slot in the future - assuming no
intervening blocks are applied:
> tickLedgerStateD ::
> SlotNo -> LedgerState BlockD -> Ticked (LedgerState BlockD)
> SlotNo -> LedgerState BlockD EmptyMK -> Ticked1 (LedgerState BlockD) DiffMK
> tickLedgerStateD newSlot ldgrSt =
> TickedLedgerStateD $
> TickedLedgerStateD $ convertMapKind $
> if isNewEpoch then
> ldgrSt{ lsbd_snapshot2 = lsbd_snapshot1 ldgrSt
> -- save previous epoch snapshot (assumes we do not
Applying a `BlockD` to a `Ticked (LedgerState BlockD)` is (again) the result of
applying each individual transaction - exactly as it was in for `BlockC`:
> applyBlockTo :: BlockD -> Ticked (LedgerState BlockD) -> LedgerState BlockD
> applyBlockTo :: BlockD -> Ticked1 (LedgerState BlockD) ValuesMK -> LedgerState BlockD DiffMK
> applyBlockTo block tickedLedgerState =
> ledgerState { lsbd_tip = blockPoint block
> , lsbd_count = lsbc_count'
> LedgerResult { lrResult = b `applyBlockTo` tickedLdgrSt
> , lrEvents = []
> }
>
> getBlockKeySets = const NoLedgerTables
Note that prior to `applyBlockLedgerResult` being invoked, the calling code will
have already established that the header is valid and that the header matches
While this is a large ecosystem of interrelated typeclasses and families, the
overall organization of things is such that Haskell's type checking can help
guide the implementation.
Appendix: UTxO-HD features
==========================
For reference on these instances and their meaning, please see the appendix in
[the Simple tutorial](./Simple.lhs).
> instance TableStuff (LedgerState BlockD) where
> data instance LedgerTables (LedgerState BlockD) mk =
> NoLedgerTables
> deriving (Eq, Show, Generic, NoThunks)
>
> projectLedgerTables _st = NoLedgerTables
> withLedgerTables st NoLedgerTables = convertMapKind st
>
> pureLedgerTables _f = NoLedgerTables
> mapLedgerTables _f NoLedgerTables = NoLedgerTables
> traverseLedgerTables _f NoLedgerTables = pure NoLedgerTables
> zipLedgerTables _f NoLedgerTables NoLedgerTables = NoLedgerTables
> zipLedgerTables2 _f NoLedgerTables NoLedgerTables NoLedgerTables = NoLedgerTables
> zipLedgerTablesA _f NoLedgerTables NoLedgerTables = pure NoLedgerTables
> zipLedgerTables2A _f NoLedgerTables NoLedgerTables NoLedgerTables = pure NoLedgerTables
> foldLedgerTables _f NoLedgerTables = mempty
> foldLedgerTables2 _f NoLedgerTables NoLedgerTables = mempty
>
> namesLedgerTables = NoLedgerTables
> instance TickedTableStuff (LedgerState BlockD) where
> projectLedgerTablesTicked _st = NoLedgerTables
> withLedgerTablesTicked st NoLedgerTables = convertMapKind st
> instance StowableLedgerTables (LedgerState BlockD) where
> stowLedgerTables = convertMapKind
> unstowLedgerTables = convertMapKind
> instance InMemory (LedgerState BlockD) where
> convertMapKind LedgerD{..} = LedgerD{..}
>
> instance InMemory (Ticked1 (LedgerState BlockD)) where
> convertMapKind = TickedLedgerStateD . convertMapKind . unTickedLedgerStateD
> instance ShowLedgerState (LedgerState BlockD) where
> showsLedgerState = shows
>
> instance ShowLedgerState (LedgerTables (LedgerState BlockD)) where
> showsLedgerState = shows
cpp-options: -DENABLE_ASSERTIONS
-- library tutorials
-- hs-source-dirs: docs/tutorials
-- other-modules: Ouroboros.Consensus.Tutorial.Simple
-- , Ouroboros.Consensus.Tutorial.WithEpoch
library tutorials
hs-source-dirs: docs/tutorials
other-modules: Ouroboros.Consensus.Tutorial.Simple
, Ouroboros.Consensus.Tutorial.WithEpoch
-- build-depends: base >=4.14 && <4.17
-- , containers
-- , hashable
-- , mtl
-- , nothunks
-- , serialise
-- , ouroboros-consensus
-- , ouroboros-network-api
build-depends: base >=4.14 && <4.17
, containers
, hashable
, mtl
, nothunks
, serialise
, ouroboros-consensus
, ouroboros-network-api
-- default-language: Haskell2010
-- ghc-options: -Wall
-- -Wcompat
-- -Wincomplete-uni-patterns
-- -Wincomplete-record-updates
-- -Wpartial-fields
-- -Widentities
-- -Wredundant-constraints
-- -Wmissing-export-lists
-- -fno-ignore-asserts
default-language: Haskell2010
ghc-options: -Wall
-Wcompat
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wpartial-fields
-Widentities
-Wredundant-constraints
-Wmissing-export-lists
-fno-ignore-asserts
tracing the un-hashed bytes of the script integrity
SCP-4880 GetTransaction Query
* Moved the JSON serialization of the types of the UtxoIndexer in `marconi-chain-index` instead of `marconi-mamba` * Updated README of `marconi-mamba` Co-authored-by: koslambrou <[email protected]>
3993: PLT-106: Add encoder and decoder for `LedgerState` r=zliu41 a=zliu41 One use case is for `foldBlocks` to checkpoint the ledger state to avoid having to start from Genisys. cc `@JaredCorduan` Co-authored-by: Ziyang Liu <[email protected]>
Co-authored-by: koslambrou <[email protected]>
This should get ahold of all the applied plutus scripts in a transaction to profile them externally. For now, this is a just a frankenstein evaluateTx.
Add links to ledger CDDL specs, and warn about lack of information about HFC.
- Renamed the module names from Marconi.JsonRpc to Network.JsonRpc - Renamed `marconi` to `marconi-chain-index` - Renamed `rewindable-index` package to `marconi-core` and changed corresponding module names accordingly - Renamed marconi-mamba module names to match those of corresponding package name Co-authored-by: koslambrou <[email protected]>