Skip to content

Commit

Permalink
Refactor to decouple consensus modes
Browse files Browse the repository at this point in the history
- Functionality that handles Shelley-based eras in a multi-era consensus
  is moved to ouroboros-consensus-shelley so that it can be shared
  between mainnet consensus (in ouroboros-consensus-cardano) and other
  consensus modes comprising multiple Shelley eras.
- The `Protocol` GADT that enumerates consensus modes and provides a
  wealth of information for clients is eliminated. It is an
  implementation detail only used by `cardano-node`. This way,
  `ouroboros-consensus-cardano` does not need to know about other
  consensus modes.
  • Loading branch information
Jimmy Hartzell committed Mar 30, 2021
1 parent 7e0269d commit 32285a5
Show file tree
Hide file tree
Showing 13 changed files with 412 additions and 513 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ import qualified Shelley.Spec.Ledger.UTxO as SL (makeWitnessVKey)
import Ouroboros.Consensus.Shelley.Ledger (GenTx, ShelleyBlock,
mkShelleyTx)
import Ouroboros.Consensus.Shelley.Ledger.Ledger
(tickedShelleyLedgerState)
(Ticked, tickedShelleyLedgerState)

import Ouroboros.Consensus.Cardano
import Ouroboros.Consensus.Cardano.Block (CardanoEras, GenTx (..),
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,6 @@ import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util (Dict (..))

import Ouroboros.Consensus.HardFork.Combinator (NestedCtxt_ (..))

import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node ()

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ library
Ouroboros.Consensus.Cardano
Ouroboros.Consensus.Cardano.Block
Ouroboros.Consensus.Cardano.ByronHFC
Ouroboros.Consensus.Cardano.ShelleyHFC
Ouroboros.Consensus.Cardano.Condense
Ouroboros.Consensus.Cardano.CanHardFork
Ouroboros.Consensus.Cardano.Node
Expand Down
170 changes: 2 additions & 168 deletions ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}

module Ouroboros.Consensus.Cardano (
-- * The block type of the Cardano block chain
Expand All @@ -17,47 +13,20 @@ module Ouroboros.Consensus.Cardano (
, ProtocolParamsAllegra(..)
, ProtocolParamsMary(..)
, ProtocolParamsTransition(..)
, Protocol(..)
, verifyProtocol
-- * Data required to run a protocol
, protocolInfo
-- * Evidence that we can run all the supported protocols
, runProtocol
, module X

-- * Client support for nodes running a protocol
, ProtocolClient(..)
, protocolClientInfo
, runProtocolClient
, verifyProtocolClient
) where

import Data.Kind (Type)
import Data.Type.Equality

import Cardano.Chain.Slotting (EpochSlots)

import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Protocol.Abstract as X
import Ouroboros.Consensus.Protocol.PBFT as X
import Ouroboros.Consensus.Util
import Ouroboros.Consensus.Util.IOLike

import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.Embed.Unary

import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node as X

import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Node as X
import Ouroboros.Consensus.Shelley.ShelleyHFC

import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.ByronHFC
import Ouroboros.Consensus.Cardano.Node
import Ouroboros.Consensus.Cardano.ShelleyHFC

{-------------------------------------------------------------------------------
Supported protocols
Expand All @@ -69,143 +38,8 @@ import Ouroboros.Consensus.Cardano.ShelleyHFC
-------------------------------------------------------------------------------}

type ProtocolByron = HardForkProtocol '[ ByronBlock ]
type ProtocolShelley = HardForkProtocol '[ ShelleyBlock StandardShelley ]
type ProtocolCardano = HardForkProtocol '[ ByronBlock
, ShelleyBlock StandardShelley
, ShelleyBlock StandardAllegra
, ShelleyBlock StandardMary
]

{-------------------------------------------------------------------------------
Abstract over the various protocols
-------------------------------------------------------------------------------}

-- | Consensus protocol to use
data Protocol (m :: Type -> Type) blk p where
-- | Run PBFT against the Byron ledger
ProtocolByron
:: ProtocolParamsByron
-> Protocol m ByronBlockHFC ProtocolByron

-- | Run TPraos against the Shelley ledger
ProtocolShelley
:: ProtocolParamsShelleyBased StandardShelley
-> ProtocolParamsShelley
-> Protocol m (ShelleyBlockHFC StandardShelley) ProtocolShelley

-- | Run the protocols of /the/ Cardano block
--
-- WARNING: only a single set of Shelley credentials is allowed when used for
-- mainnet. Testnets allow multiple Shelley credentials.
ProtocolCardano
:: ProtocolParamsByron
-> ProtocolParamsShelleyBased StandardShelley
-> ProtocolParamsShelley
-> ProtocolParamsAllegra
-> ProtocolParamsMary
-> ProtocolParamsTransition
ByronBlock
(ShelleyBlock StandardShelley)
-> ProtocolParamsTransition
(ShelleyBlock StandardShelley)
(ShelleyBlock StandardAllegra)
-> ProtocolParamsTransition
(ShelleyBlock StandardAllegra)
(ShelleyBlock StandardMary)
-> Protocol m (CardanoBlock StandardCrypto) ProtocolCardano

verifyProtocol :: Protocol m blk p -> (p :~: BlockProtocol blk)
verifyProtocol ProtocolByron{} = Refl
verifyProtocol ProtocolShelley{} = Refl
verifyProtocol ProtocolCardano{} = Refl

{-------------------------------------------------------------------------------
Data required to run a protocol
-------------------------------------------------------------------------------}

-- | Data required to run the selected protocol
protocolInfo :: forall m blk p. IOLike m
=> Protocol m blk p -> ProtocolInfo m blk
protocolInfo (ProtocolByron params) =
inject $ protocolInfoByron params

protocolInfo (ProtocolShelley paramsShelleyBased paramsShelley) =
inject $ protocolInfoShelley paramsShelleyBased paramsShelley

protocolInfo (ProtocolCardano
paramsByron
paramsShelleyBased
paramsShelley
paramsAllegra
paramsMary
paramsByronShelley
paramsShelleyAllegra
paramsAllegraMary) =
protocolInfoCardano
paramsByron
paramsShelleyBased
paramsShelley
paramsAllegra
paramsMary
paramsByronShelley
paramsShelleyAllegra
paramsAllegraMary

{-------------------------------------------------------------------------------
Evidence that we can run all the supported protocols
-------------------------------------------------------------------------------}

runProtocol :: Protocol m blk p -> Dict (RunNode blk)
runProtocol ProtocolByron{} = Dict
runProtocol ProtocolShelley{} = Dict
runProtocol ProtocolCardano{} = Dict

{-------------------------------------------------------------------------------
Client support for the protocols: what you need as a client of the node
-------------------------------------------------------------------------------}

-- | Node client support for each consensus protocol.
--
-- This is like 'Protocol' but for clients of the node, so with less onerous
-- requirements than to run a node.
--
data ProtocolClient blk p where
ProtocolClientByron
:: EpochSlots
-> ProtocolClient
ByronBlockHFC
ProtocolByron

ProtocolClientShelley
:: ProtocolClient
(ShelleyBlockHFC StandardShelley)
ProtocolShelley

ProtocolClientCardano
:: EpochSlots
-> ProtocolClient
(CardanoBlock StandardCrypto)
ProtocolCardano

-- | Sanity check that we have the right type combinations
verifyProtocolClient :: ProtocolClient blk p -> (p :~: BlockProtocol blk)
verifyProtocolClient ProtocolClientByron{} = Refl
verifyProtocolClient ProtocolClientShelley{} = Refl
verifyProtocolClient ProtocolClientCardano{} = Refl

-- | Sanity check that we have the right class instances available
runProtocolClient :: ProtocolClient blk p -> Dict (RunNode blk)
runProtocolClient ProtocolClientByron{} = Dict
runProtocolClient ProtocolClientShelley{} = Dict
runProtocolClient ProtocolClientCardano{} = Dict

-- | Data required by clients of a node running the specified protocol.
protocolClientInfo :: ProtocolClient blk p -> ProtocolClientInfo blk
protocolClientInfo (ProtocolClientByron epochSlots) =
inject $ protocolClientInfoByron epochSlots

protocolClientInfo ProtocolClientShelley =
inject $ protocolClientInfoShelley

protocolClientInfo (ProtocolClientCardano epochSlots) =
protocolClientInfoCardano epochSlots
Loading

0 comments on commit 32285a5

Please sign in to comment.