{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE StandaloneDeriving #-}
module Cardano.Node.Protocol.Types
( Protocol(..)
, SomeConsensusProtocol(..)
, SomeConsensusProtocolConstraints
) where
import Cardano.Prelude
import Control.Monad.Fail (fail)
import Data.Aeson
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block (BlockProtocol)
import qualified Ouroboros.Consensus.Cardano as Consensus (Protocol)
import Ouroboros.Consensus.Node.Run (RunNode)
import Cardano.Tracing.Constraints (TraceConstraints)
import Cardano.Tracing.Metrics (HasKESMetricsData)
data Protocol = ByronProtocol
| ShelleyProtocol
| CardanoProtocol
deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq, Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show, (forall x. Protocol -> Rep Protocol x)
-> (forall x. Rep Protocol x -> Protocol) -> Generic Protocol
forall x. Rep Protocol x -> Protocol
forall x. Protocol -> Rep Protocol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Protocol x -> Protocol
$cfrom :: forall x. Protocol -> Rep Protocol x
Generic)
deriving instance NFData Protocol
deriving instance NoThunks Protocol
instance FromJSON Protocol where
parseJSON :: Value -> Parser Protocol
parseJSON =
String -> (Text -> Parser Protocol) -> Value -> Parser Protocol
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Protocol" ((Text -> Parser Protocol) -> Value -> Parser Protocol)
-> (Text -> Parser Protocol) -> Value -> Parser Protocol
forall a b. (a -> b) -> a -> b
$ \Text
str -> case Text
str of
Text
"Byron" -> Protocol -> Parser Protocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ByronProtocol
Text
"Shelley" -> Protocol -> Parser Protocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ShelleyProtocol
Text
"Cardano" -> Protocol -> Parser Protocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
CardanoProtocol
Text
"RealPBFT" -> Protocol -> Parser Protocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ByronProtocol
Text
"TPraos" -> Protocol -> Parser Protocol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ShelleyProtocol
Text
_ -> String -> Parser Protocol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Protocol) -> String -> Parser Protocol
forall a b. (a -> b) -> a -> b
$ String
"Parsing of Protocol failed. "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Text
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a valid protocol"
type SomeConsensusProtocolConstraints blk =
( HasKESMetricsData blk
, RunNode blk
, TraceConstraints blk
)
data SomeConsensusProtocol where
SomeConsensusProtocol :: SomeConsensusProtocolConstraints blk
=> Consensus.Protocol IO blk (BlockProtocol blk)
-> SomeConsensusProtocol