-- DUPLICATE -- adapted from: cardano-node/src/Cardano/Node/Protocol.hs

module Cardano.Node.Protocol (
    ProtocolInstantiationError (..)
  , SomeConsensusProtocol (..)
  , mkConsensusProtocol
  ) where

import           Cardano.Api.Any
import           Cardano.Node.Protocol.Byron
import           Cardano.Node.Protocol.Cardano
import           Cardano.Node.Protocol.Shelley
import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
import           Cardano.Node.Types
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT)


------------------------------------------------------------------------------
-- Conversions from configuration into specific protocols and their params
--

mkConsensusProtocol ::
     NodeProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
mkConsensusProtocol :: NodeProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
mkConsensusProtocol NodeProtocolConfiguration
ncProtocolConfig Maybe ProtocolFilepaths
mProtocolFiles =
    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 Maybe ProtocolFilepaths
mProtocolFiles

      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 Maybe ProtocolFilepaths
mProtocolFiles

      NodeProtocolConfigurationCardano NodeByronProtocolConfiguration
byronConfig
                                       NodeShelleyProtocolConfiguration
shelleyConfig
                                       NodeAlonzoProtocolConfiguration
alonzoConfig
                                       NodeConwayProtocolConfiguration
conwayConfig
                                       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
-> NodeAlonzoProtocolConfiguration
-> NodeConwayProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     CardanoProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCardano
            NodeByronProtocolConfiguration
byronConfig
            NodeShelleyProtocolConfiguration
shelleyConfig
            NodeAlonzoProtocolConfiguration
alonzoConfig
            NodeConwayProtocolConfiguration
conwayConfig
            NodeHardForkProtocolConfiguration
hardForkConfig
            Maybe ProtocolFilepaths
mProtocolFiles

------------------------------------------------------------------------------
-- Errors
--

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
$cshowsPrec :: Int -> ProtocolInstantiationError -> ShowS
showsPrec :: Int -> ProtocolInstantiationError -> ShowS
$cshow :: ProtocolInstantiationError -> String
show :: ProtocolInstantiationError -> String
$cshowList :: [ProtocolInstantiationError] -> ShowS
showList :: [ProtocolInstantiationError] -> ShowS
Show


instance Error ProtocolInstantiationError where
  displayError :: ProtocolInstantiationError -> String
displayError (ByronProtocolInstantiationError   ByronProtocolInstantiationError
err) = ByronProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError ByronProtocolInstantiationError
err
  displayError (ShelleyProtocolInstantiationError ShelleyProtocolInstantiationError
err) = ShelleyProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError ShelleyProtocolInstantiationError
err
  displayError (CardanoProtocolInstantiationError CardanoProtocolInstantiationError
err) = CardanoProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError CardanoProtocolInstantiationError
err