-
Notifications
You must be signed in to change notification settings - Fork 720
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
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
Showing
21 changed files
with
264 additions
and
247 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.