{-# LANGUAGE NamedFieldPuns #-}

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

import           Bcc.Prelude

import           Control.Monad.Trans.Except.Extra (firstExceptT)

import           Bcc.Api

import           Bcc.Node.Configuration.POM (NodeConfiguration (..))
import           Bcc.Node.Types

import           Bcc.Node.Orphans ()
import           Bcc.Node.Protocol.Cole
import           Bcc.Node.Protocol.Bcc
import           Bcc.Node.Protocol.Sophie
import           Bcc.Node.Protocol.Types (SomeConsensusProtocol (..))


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

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

      NodeProtocolConfigurationCole NodeColeProtocolConfiguration
config ->
        (ColeProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeProtocolInstantiationError -> ProtocolInstantiationError
ColeProtocolInstantiationError (ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
 -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
          NodeColeProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT ColeProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolCole NodeColeProtocolConfiguration
config (ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)

      NodeProtocolConfigurationSophie NodeSophieProtocolConfiguration
config ->
        (SophieProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieProtocolInstantiationError -> ProtocolInstantiationError
SophieProtocolInstantiationError (ExceptT SophieProtocolInstantiationError IO SomeConsensusProtocol
 -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
          NodeSophieProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT
     SophieProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolSophie NodeSophieProtocolConfiguration
config (ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)

      NodeProtocolConfigurationBcc NodeColeProtocolConfiguration
coleConfig
                                       NodeSophieProtocolConfiguration
sophieConfig
                                       NodeAurumProtocolConfiguration
aurumConfig
                                       NodeHardForkProtocolConfiguration
hardForkConfig ->
        (BccProtocolInstantiationError -> ProtocolInstantiationError)
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT BccProtocolInstantiationError -> ProtocolInstantiationError
BccProtocolInstantiationError (ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
 -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol)
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
-> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$
          NodeColeProtocolConfiguration
-> NodeSophieProtocolConfiguration
-> NodeAurumProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolBcc
            NodeColeProtocolConfiguration
coleConfig
            NodeSophieProtocolConfiguration
sophieConfig
            NodeAurumProtocolConfiguration
aurumConfig
            NodeHardForkProtocolConfiguration
hardForkConfig
            (ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths
ncProtocolFiles)

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

data ProtocolInstantiationError =
    ColeProtocolInstantiationError   ColeProtocolInstantiationError
  | SophieProtocolInstantiationError SophieProtocolInstantiationError
  | BccProtocolInstantiationError BccProtocolInstantiationError
  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


instance Error ProtocolInstantiationError where
  displayError :: ProtocolInstantiationError -> String
displayError (ColeProtocolInstantiationError   ColeProtocolInstantiationError
err) = ColeProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError ColeProtocolInstantiationError
err
  displayError (SophieProtocolInstantiationError SophieProtocolInstantiationError
err) = SophieProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError SophieProtocolInstantiationError
err
  displayError (BccProtocolInstantiationError BccProtocolInstantiationError
err) = BccProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError BccProtocolInstantiationError
err