Skip to content

Commit

Permalink
Merge #2498
Browse files Browse the repository at this point in the history
2498: Adapt packages to use Protocol type class r=Jimbo4350 a=jhartzell42

This PR depends on IntersectMBO/ouroboros-network#2978

In that PR, the `Protocol` type that the cardano-node packages use is removed. This is so that ouroboros-network does not need to enumerate all the consensus modes it implements. The majority of changes in this PR are in reaction to that, creating a type class to replace it.

We found that it would take a significant increase in code complexity to remove the explicit enumeration of supported consensus modes in two places: 
- cardano-node/src/Cardano/Node/Configuration/Logging.hs:nodeBasicInfo
- cardano-node/src/Cardano/Node/Query.hs

For that purpose, we have written the GADT `BlockType` which provides the little bit of type discovery these places need. 

In addition, we have removed the `Enum` instance for `AnyCardanoEra`. The motivation is that we anticipate the inclusion of experimental eras and consensus modes in the code base which cannot reasonably be said to be enumerable among the mainnet eras. This instance does not appear to be used anywhere. If it needs to be preserved then we will need an answer on how to handle eras we don't expect to be part of mainnet (at least when they are first implemented).

Co-authored-by: Madeline Haraj <madeline.haraj@obsidian.systems>
  • Loading branch information
iohk-bors[bot] and madeline-os authored Apr 22, 2021
2 parents 324c2d8 + 7402029 commit a593cec
Show file tree
Hide file tree
Showing 21 changed files with 264 additions and 247 deletions.
4 changes: 2 additions & 2 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -174,8 +174,8 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/input-output-hk/ouroboros-network
tag: 7f90c8c59ffc7d61a4e161e886d8962a9c26787a
--sha256: 0hnw6hvbyny3wniaqw8d37l4ysgp8xrq5d84fapxfm525a4hfs0x
tag: 66dd5eb0f4bf20272e30a8c5c0a0c9d3992de039
--sha256: 1z23l4l81afdzmsh0bgs4ivg0nv58l4mp7g25qa4nfsczl6j07cf
subdir:
io-sim
io-sim-classes
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/src/Cardano/Api/Block.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,9 +58,9 @@ import qualified Ouroboros.Consensus.Block as Consensus
import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
import qualified Ouroboros.Consensus.Cardano.Block as Consensus
import qualified Ouroboros.Consensus.Cardano.ByronHFC as Consensus
import qualified Ouroboros.Consensus.Cardano.ShelleyHFC as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus

import qualified Cardano.Chain.Block as Byron
Expand Down
16 changes: 0 additions & 16 deletions cardano-api/src/Cardano/Api/Eras.hs
Original file line number Diff line number Diff line change
Expand Up @@ -185,22 +185,6 @@ instance Eq AnyCardanoEra where
Nothing -> False
Just Refl -> True -- since no constructors share types

instance Enum AnyCardanoEra where
toEnum 0 = AnyCardanoEra ByronEra
toEnum 1 = AnyCardanoEra ShelleyEra
toEnum 2 = AnyCardanoEra AllegraEra
toEnum 3 = AnyCardanoEra MaryEra
toEnum _ = error "AnyCardanoEra.toEnum: bad argument"

fromEnum (AnyCardanoEra ByronEra) = 0
fromEnum (AnyCardanoEra ShelleyEra) = 1
fromEnum (AnyCardanoEra AllegraEra) = 2
fromEnum (AnyCardanoEra MaryEra) = 3

instance Bounded AnyCardanoEra where
minBound = AnyCardanoEra ByronEra
maxBound = AnyCardanoEra MaryEra

instance ToJSON AnyCardanoEra where
toJSON (AnyCardanoEra era) = toJSON era

Expand Down
31 changes: 14 additions & 17 deletions cardano-api/src/Cardano/Api/IPC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,6 @@ import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx
import Ouroboros.Network.Util.ShowProxy (ShowProxy (..))

import qualified Ouroboros.Consensus.Block as Consensus
import qualified Ouroboros.Consensus.Cardano as Consensus
import qualified Ouroboros.Consensus.Ledger.Query as Consensus
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Consensus
import qualified Ouroboros.Consensus.Network.NodeToClient as Consensus
Expand All @@ -105,6 +104,7 @@ import Cardano.Api.Block
import Cardano.Api.HasTypeProxy
import Cardano.Api.Modes
import Cardano.Api.NetworkId
import Cardano.Api.Protocol.Types
import Cardano.Api.Query
import Cardano.Api.TxInMode

Expand Down Expand Up @@ -201,16 +201,11 @@ connectToLocalNode LocalNodeConnectInfo {


mkVersionedProtocols :: forall block.
(Consensus.SerialiseNodeToClientConstraints block,
Consensus.SupportedNetworkProtocolVersion block,
ShowProxy block,
ShowProxy (Consensus.ApplyTxErr block),
ShowProxy (Consensus.GenTx block),
ShowProxy (Consensus.Query block),
Consensus.ShowQuery (Consensus.Query block))
( Consensus.ShowQuery (Consensus.Query block),
ProtocolClient block
)
=> NetworkId
-> Consensus.ProtocolClient block
(Consensus.BlockProtocol block)
-> ProtocolClientInfoArgs block
-> LocalNodeClientProtocolsForBlock block
-> Net.Versions
Net.NodeToClientVersion
Expand Down Expand Up @@ -288,7 +283,7 @@ mkVersionedProtocols networkid ptcl

codecConfig :: Consensus.CodecConfig block
codecConfig = Consensus.pClientInfoCodecConfig
(Consensus.protocolClientInfo ptcl)
(protocolClientInfo ptcl)


-- | This type defines the boundary between the mode-parametrised style used in
Expand All @@ -308,8 +303,10 @@ data LocalNodeClientParams where
Consensus.SupportedNetworkProtocolVersion block,
ShowProxy block, ShowProxy (Consensus.ApplyTxErr block),
ShowProxy (Consensus.GenTx block), ShowProxy (Consensus.Query block),
Consensus.ShowQuery (Consensus.Query block))
=> Consensus.ProtocolClient block (Consensus.BlockProtocol block)
Consensus.ShowQuery (Consensus.Query block),
ProtocolClient block
)
=> ProtocolClientInfoArgs block
-> LocalNodeClientProtocolsForBlock block
-> LocalNodeClientParams

Expand Down Expand Up @@ -343,7 +340,7 @@ mkLocalNodeClientParams :: forall mode block.
-> LocalNodeClientParams
mkLocalNodeClientParams modeparams clients =
-- For each of the possible consensus modes we pick the concrete block type
-- (by picking the appropriate 'Consensus.ProtocolClient' value).
-- (by picking the appropriate 'ProtocolClient' value).
--
-- Though it is not immediately visible, this point where we use
-- 'LocalNodeClientParams' is also where we pick up the necessary class
Expand All @@ -356,17 +353,17 @@ mkLocalNodeClientParams modeparams clients =
case modeparams of
ByronModeParams epochSlots ->
LocalNodeClientParams
(Consensus.ProtocolClientByron epochSlots)
(ProtocolClientInfoArgsByron epochSlots)
(convLocalNodeClientProtocols ByronMode clients)

ShelleyModeParams ->
LocalNodeClientParams
Consensus.ProtocolClientShelley
ProtocolClientInfoArgsShelley
(convLocalNodeClientProtocols ShelleyMode clients)

CardanoModeParams epochSlots ->
LocalNodeClientParams
(Consensus.ProtocolClientCardano epochSlots)
(ProtocolClientInfoArgsCardano epochSlots)
(convLocalNodeClientProtocols CardanoMode clients)


Expand Down
2 changes: 1 addition & 1 deletion cardano-api/src/Cardano/Api/Modes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,10 +43,10 @@ import Data.SOP.Strict (K (K), NS (S, Z))
import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
import qualified Ouroboros.Consensus.Cardano.Block as Consensus
import qualified Ouroboros.Consensus.Cardano.ByronHFC as Consensus (ByronBlockHFC)
import qualified Ouroboros.Consensus.Cardano.ShelleyHFC as Consensus (ShelleyBlockHFC)
import Ouroboros.Consensus.HardFork.Combinator as Consensus (EraIndex (..), eraIndexSucc,
eraIndexZero)
import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)
import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus (ShelleyBlockHFC)
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
import Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)

Expand Down
9 changes: 5 additions & 4 deletions cardano-api/src/Cardano/Api/Protocol/Byron.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,15 @@ module Cardano.Api.Protocol.Byron
, mkSomeNodeClientProtocolByron
) where

import Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
import Cardano.Api.Protocol.Types (ProtocolClient(..),
ProtocolClientInfoArgs(ProtocolClientInfoArgsByron),
SomeNodeClientProtocol(..))
import Cardano.Chain.Slotting (EpochSlots)
import Ouroboros.Consensus.Cardano (ProtocolByron, ProtocolClient (ProtocolClientByron))
import Ouroboros.Consensus.Cardano.ByronHFC

mkNodeClientProtocolByron :: EpochSlots
-> ProtocolClient ByronBlockHFC ProtocolByron
mkNodeClientProtocolByron = ProtocolClientByron
-> ProtocolClientInfoArgs ByronBlockHFC
mkNodeClientProtocolByron = ProtocolClientInfoArgsByron

mkSomeNodeClientProtocolByron :: EpochSlots
-> SomeNodeClientProtocol
Expand Down
11 changes: 5 additions & 6 deletions cardano-api/src/Cardano/Api/Protocol/Cardano.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,17 +6,16 @@ module Cardano.Api.Protocol.Cardano
, mkSomeNodeClientProtocolCardano
) where

import Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
import Cardano.Api.Protocol.Types (ProtocolClient(..),
ProtocolClientInfoArgs(ProtocolClientInfoArgsCardano),
SomeNodeClientProtocol (..))
import Cardano.Chain.Slotting (EpochSlots)
import Ouroboros.Consensus.Cardano (ProtocolCardano,
ProtocolClient (ProtocolClientCardano))
import Ouroboros.Consensus.Cardano.Block (CardanoBlock)
import Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)

mkNodeClientProtocolCardano :: EpochSlots
-> ProtocolClient (CardanoBlock StandardCrypto)
ProtocolCardano
mkNodeClientProtocolCardano = ProtocolClientCardano
-> ProtocolClientInfoArgs (CardanoBlock StandardCrypto)
mkNodeClientProtocolCardano = ProtocolClientInfoArgsCardano

mkSomeNodeClientProtocolCardano :: EpochSlots
-> SomeNodeClientProtocol
Expand Down
12 changes: 4 additions & 8 deletions cardano-api/src/Cardano/Api/Protocol/Shelley.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,19 +7,15 @@ module Cardano.Api.Protocol.Shelley
) where


import Ouroboros.Consensus.Cardano (ProtocolClient (ProtocolClientShelley),
ProtocolShelley)
import Ouroboros.Consensus.Cardano.ShelleyHFC
import Ouroboros.Consensus.Shelley.ShelleyHFC

import Ouroboros.Consensus.Shelley.Eras (StandardShelley)

import Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
import Cardano.Api.Protocol.Types


mkNodeClientProtocolShelley :: ProtocolClient
(ShelleyBlockHFC StandardShelley)
ProtocolShelley
mkNodeClientProtocolShelley = ProtocolClientShelley
mkNodeClientProtocolShelley :: ProtocolClientInfoArgs (ShelleyBlockHFC StandardShelley)
mkNodeClientProtocolShelley = ProtocolClientInfoArgsShelley


mkSomeNodeClientProtocolShelley :: SomeNodeClientProtocol
Expand Down
114 changes: 109 additions & 5 deletions cardano-api/src/Cardano/Api/Protocol/Types.hs
Original file line number Diff line number Diff line change
@@ -1,17 +1,121 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Protocol.Types
( SomeNodeClientProtocol(..)
( BlockType(..)
, Protocol(..)
, ProtocolInfoArgs(..)
, ProtocolClient(..)
, ProtocolClientInfoArgs(..)
, SomeNodeClientProtocol(..)
) where

import Ouroboros.Consensus.Block (BlockProtocol)
import Cardano.Prelude

import Cardano.Chain.Slotting (EpochSlots)

import Ouroboros.Consensus.Byron.Ledger (ByronBlock)
import Ouroboros.Consensus.Cardano
import Ouroboros.Consensus.Cardano.Node
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.ByronHFC (ByronBlockHFC)
import Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo(..), ProtocolInfo(..))
import Ouroboros.Consensus.Node.Run (RunNode)
import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
import Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
import Ouroboros.Consensus.Util.IOLike (IOLike)

class (RunNode blk, IOLike m) => Protocol m blk where
data ProtocolInfoArgs m blk
protocolInfo :: ProtocolInfoArgs m blk -> ProtocolInfo m blk

-- | 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.
--
class (RunNode blk) => ProtocolClient blk where
data ProtocolClientInfoArgs blk
protocolClientInfo :: ProtocolClientInfoArgs blk -> ProtocolClientInfo blk


-- | Run PBFT against the Byron ledger
instance IOLike m => Protocol m ByronBlockHFC where
data ProtocolInfoArgs m ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
protocolInfo (ProtocolInfoArgsByron params) = inject $ protocolInfoByron params

instance IOLike m => Protocol m (CardanoBlock StandardCrypto) where
data ProtocolInfoArgs m (CardanoBlock StandardCrypto) = ProtocolInfoArgsCardano
ProtocolParamsByron
(ProtocolParamsShelleyBased StandardShelley)
ProtocolParamsShelley
ProtocolParamsAllegra
ProtocolParamsMary
(ProtocolParamsTransition ByronBlock (ShelleyBlock StandardShelley))
(ProtocolParamsTransition (ShelleyBlock StandardShelley) (ShelleyBlock StandardAllegra))
(ProtocolParamsTransition (ShelleyBlock StandardAllegra) (ShelleyBlock StandardMary))
protocolInfo (ProtocolInfoArgsCardano
paramsByron
paramsShelleyBased
paramsShelley
paramsAllegra
paramsMary
paramsByronShelley
paramsShelleyAllegra
paramsAllegraMary) =
protocolInfoCardano
paramsByron
paramsShelleyBased
paramsShelley
paramsAllegra
paramsMary
paramsByronShelley
paramsShelleyAllegra
paramsAllegraMary

instance ProtocolClient ByronBlockHFC where
data ProtocolClientInfoArgs ByronBlockHFC =
ProtocolClientInfoArgsByron EpochSlots
protocolClientInfo (ProtocolClientInfoArgsByron epochSlots) =
inject $ protocolClientInfoByron epochSlots

instance ProtocolClient (CardanoBlock StandardCrypto) where
data ProtocolClientInfoArgs (CardanoBlock StandardCrypto) =
ProtocolClientInfoArgsCardano EpochSlots
protocolClientInfo (ProtocolClientInfoArgsCardano epochSlots) =
protocolClientInfoCardano epochSlots

instance IOLike m => Protocol m (ShelleyBlockHFC StandardShelley) where
data ProtocolInfoArgs m (ShelleyBlockHFC StandardShelley) = ProtocolInfoArgsShelley
(ProtocolParamsShelleyBased StandardShelley)
ProtocolParamsShelley
protocolInfo (ProtocolInfoArgsShelley paramsShelleyBased paramsShelley) =
inject $ protocolInfoShelley paramsShelleyBased paramsShelley

instance ProtocolClient (ShelleyBlockHFC StandardShelley) where
data ProtocolClientInfoArgs (ShelleyBlockHFC StandardShelley) =
ProtocolClientInfoArgsShelley
protocolClientInfo ProtocolClientInfoArgsShelley =
inject protocolClientInfoShelley

data BlockType blk where
ByronBlockType :: BlockType ByronBlockHFC
ShelleyBlockType :: BlockType (ShelleyBlockHFC StandardShelley)
CardanoBlockType :: BlockType (CardanoBlock StandardCrypto)

deriving instance Eq (BlockType blk)
deriving instance Show (BlockType blk)

data SomeNodeClientProtocol where

SomeNodeClientProtocol
:: RunNode blk
=> ProtocolClient blk (BlockProtocol blk)
:: (RunNode blk, ProtocolClient blk)
=> ProtocolClientInfoArgs blk
-> SomeNodeClientProtocol
8 changes: 4 additions & 4 deletions cardano-node-chairman/app/Cardano/Chairman.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
module Cardano.Chairman (chairmanTest) where


import Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
import Cardano.Api.Protocol.Types
import Cardano.Node.Types (SocketPath (..))
import Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show, throwIO)
import Control.Monad.Class.MonadAsync
Expand All @@ -23,8 +23,8 @@ import Control.Monad.Class.MonadTimer
import Control.Tracer
import Data.ByteString.Lazy (ByteString)
import Data.Coerce (coerce)
import Ouroboros.Consensus.Block (BlockProtocol, CodecConfig, GetHeader (..), Header)
import Ouroboros.Consensus.Cardano
import Ouroboros.Consensus.Block (CodecConfig, GetHeader (..), Header)
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx)
import Ouroboros.Consensus.Network.NodeToClient
import Ouroboros.Consensus.Node.NetworkProtocolVersion (HasNetworkProtocolVersion (..),
Expand Down Expand Up @@ -72,7 +72,7 @@ chairmanTest tracer protocol nw securityParam runningTime progressThreshold sock
traceWith tracer ("Will observe nodes for " ++ show runningTime)
traceWith tracer ("Will require chain growth of " ++ show progressThreshold)

SomeNodeClientProtocol (ptcl :: ProtocolClient blk (BlockProtocol blk)) <- return protocol
SomeNodeClientProtocol (ptcl :: ProtocolClientInfoArgs blk) <- return protocol

-- Run the chairman and get the final snapshot of the chain from each node.
chainsSnapshot <- runChairman
Expand Down
2 changes: 1 addition & 1 deletion cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ import Cardano.Prelude hiding (option)
import Control.Monad.Class.MonadTime (DiffTime)
import Control.Tracer (Tracer (..), stdoutTracer)
import Options.Applicative
import Ouroboros.Consensus.Cardano (SecurityParam (..))
import Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..))

import qualified Data.Time.Clock as DTC
import qualified Options.Applicative as Opt
Expand Down
1 change: 0 additions & 1 deletion cardano-node-chairman/cardano-node-chairman.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,6 @@ executable cardano-node-chairman
, network-mux
, optparse-applicative
, ouroboros-consensus
, ouroboros-consensus-cardano
, ouroboros-network
, ouroboros-network-framework
, process
Expand Down
Loading

0 comments on commit a593cec

Please sign in to comment.