{-# LANGUAGE NamedFieldPuns #-}
module Cardano.Node.Protocol
( mkConsensusProtocol
, SomeConsensusProtocol(..)
, ProtocolInstantiationError(..)
, renderProtocolInstantiationError
) where
import Cardano.Prelude
import Control.Monad.Trans.Except.Extra (firstExceptT)
import Cardano.Node.Configuration.POM (NodeConfiguration (..))
import Cardano.Node.Types
import Cardano.Node.Protocol.Byron
import Cardano.Node.Protocol.Cardano
import Cardano.Node.Protocol.Shelley
import Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
mkConsensusProtocol
:: NodeConfiguration
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
mkConsensusProtocol :: NodeConfiguration
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
mkConsensusProtocol NodeConfiguration{NodeProtocolConfiguration
ncProtocolConfig :: NodeConfiguration -> NodeProtocolConfiguration
ncProtocolConfig :: NodeProtocolConfiguration
ncProtocolConfig, ProtocolFilepaths
ncProtocolFiles :: NodeConfiguration -> ProtocolFilepaths
ncProtocolFiles :: ProtocolFilepaths
ncProtocolFiles} =
case NodeProtocolConfiguration
ncProtocolConfig of
NodeProtocolConfigurationByron NodeByronProtocolConfiguration
config ->
(ByronProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronProtocolInstantiationError -> ProtocolInstantiationError
ByronProtocolInstantiationError (ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
NodeByronProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolByron NodeByronProtocolConfiguration
config (ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)
NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration
config ->
(ShelleyProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT
ShelleyProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyProtocolInstantiationError -> ProtocolInstantiationError
ShelleyProtocolInstantiationError (ExceptT ShelleyProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT
ShelleyProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
NodeShelleyProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
ShelleyProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolShelley NodeShelleyProtocolConfiguration
config (ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)
NodeProtocolConfigurationCardano NodeByronProtocolConfiguration
byronConfig
NodeShelleyProtocolConfiguration
shelleyConfig
NodeHardForkProtocolConfiguration
hardForkConfig ->
(CardanoProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT
CardanoProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CardanoProtocolInstantiationError -> ProtocolInstantiationError
CardanoProtocolInstantiationError (ExceptT CardanoProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT
CardanoProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
CardanoProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCardano
NodeByronProtocolConfiguration
byronConfig
NodeShelleyProtocolConfiguration
shelleyConfig
NodeHardForkProtocolConfiguration
hardForkConfig
(ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)
data ProtocolInstantiationError =
ByronProtocolInstantiationError ByronProtocolInstantiationError
| ShelleyProtocolInstantiationError ShelleyProtocolInstantiationError
| CardanoProtocolInstantiationError CardanoProtocolInstantiationError
deriving Int -> ProtocolInstantiationError -> ShowS
[ProtocolInstantiationError] -> ShowS
ProtocolInstantiationError -> String
(Int -> ProtocolInstantiationError -> ShowS)
-> (ProtocolInstantiationError -> String)
-> ([ProtocolInstantiationError] -> ShowS)
-> Show ProtocolInstantiationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolInstantiationError] -> ShowS
$cshowList :: [ProtocolInstantiationError] -> ShowS
show :: ProtocolInstantiationError -> String
$cshow :: ProtocolInstantiationError -> String
showsPrec :: Int -> ProtocolInstantiationError -> ShowS
$cshowsPrec :: Int -> ProtocolInstantiationError -> ShowS
Show
renderProtocolInstantiationError :: ProtocolInstantiationError -> Text
renderProtocolInstantiationError :: ProtocolInstantiationError -> Text
renderProtocolInstantiationError ProtocolInstantiationError
pie =
case ProtocolInstantiationError
pie of
ByronProtocolInstantiationError ByronProtocolInstantiationError
bpie ->
ByronProtocolInstantiationError -> Text
renderByronProtocolInstantiationError ByronProtocolInstantiationError
bpie
ShelleyProtocolInstantiationError ShelleyProtocolInstantiationError
spie ->
ShelleyProtocolInstantiationError -> Text
renderShelleyProtocolInstantiationError ShelleyProtocolInstantiationError
spie
CardanoProtocolInstantiationError CardanoProtocolInstantiationError
cpie ->
CardanoProtocolInstantiationError -> Text
renderCardanoProtocolInstantiationError CardanoProtocolInstantiationError
cpie