{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}

{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}

module Bcc.Node.Configuration.POM
  ( NodeConfiguration (..)
  , PartialNodeConfiguration(..)
  , defaultPartialNodeConfiguration
  , lastOption
  , makeNodeConfiguration
  , parseNodeConfigurationFP
  , pncProtocol
  , ncProtocol
  )
where

import           Bcc.Prelude
import           Prelude (String)

import           Control.Monad (fail)
import           Data.Aeson
import           Data.Yaml (decodeFileThrow)
import           Generic.Data (gmappend)
import           Generic.Data.Orphans ()
import           Options.Applicative
import           System.FilePath (takeDirectory, (</>))
import           System.Posix.Types (Fd (..))

import qualified Bcc.Chain.Update as Cole
import           Bcc.Crypto (RequiresNetworkMagic (..))
import           Bcc.Node.Protocol.Types (Protocol (..))
import           Bcc.Node.Types
import           Bcc.Tracing.Config
import           Shardagnostic.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
import           Shardagnostic.Network.Block (MaxSlotNo (..))
import           Shardagnostic.Network.NodeToNode (DiffusionMode (..))

data NodeConfiguration
  = NodeConfiguration
      {  NodeConfiguration -> Maybe NodeHostIPv4Address
ncNodeIPv4Addr    :: !(Maybe NodeHostIPv4Address)
      ,  NodeConfiguration -> Maybe NodeHostIPv6Address
ncNodeIPv6Addr    :: !(Maybe NodeHostIPv6Address)
      ,  NodeConfiguration -> Maybe PortNumber
ncNodePortNumber  :: !(Maybe PortNumber)
          -- | Filepath of the configuration yaml file. This file determines
          -- all the configuration settings required for the bcc node
          -- (logging, tracing, protocol, slot length etc)
       , NodeConfiguration -> ConfigYamlFilePath
ncConfigFile      :: !ConfigYamlFilePath
       , NodeConfiguration -> TopologyFile
ncTopologyFile    :: !TopologyFile
       , NodeConfiguration -> DbFile
ncDatabaseFile    :: !DbFile
       , NodeConfiguration -> ProtocolFilepaths
ncProtocolFiles   :: !ProtocolFilepaths
       , NodeConfiguration -> Bool
ncValidateDB      :: !Bool
       , NodeConfiguration -> Maybe Fd
ncShutdownIPC     :: !(Maybe Fd)
       , NodeConfiguration -> MaxSlotNo
ncShutdownOnSlotSynced :: !MaxSlotNo

        -- Protocol-specific parameters:
       , NodeConfiguration -> NodeProtocolConfiguration
ncProtocolConfig :: !NodeProtocolConfiguration

         -- Node parameters, not protocol-specific:
       , NodeConfiguration -> Maybe SocketPath
ncSocketPath       :: !(Maybe SocketPath)
       , NodeConfiguration -> DiffusionMode
ncDiffusionMode    :: !DiffusionMode
       , NodeConfiguration -> SnapshotInterval
ncSnapshotInterval :: !SnapshotInterval

         -- | During the development and integration of new network protocols
         -- (node-to-node and node-to-client) we wish to be able to test them
         -- but not have everybody use them by default on the mainnet. Avoiding
         -- enabling them by default makes it practical to include such
         -- not-yet-ready protocol versions into released versions of the node
         -- without the danger that node operators on the mainnet will start
         -- using them prematurely, before the testing is complete.
         --
         -- The flag defaults to 'False'
         --
         -- This flag should be set to 'True' when testing the new protocol
         -- versions.
       , NodeConfiguration -> Bool
ncTestEnableDevelopmentNetworkProtocols :: !Bool

         -- BlockFetch configuration
       , NodeConfiguration -> Maybe MaxConcurrencyBulkSync
ncMaxConcurrencyBulkSync :: !(Maybe MaxConcurrencyBulkSync)
       , NodeConfiguration -> Maybe MaxConcurrencyDeadline
ncMaxConcurrencyDeadline :: !(Maybe MaxConcurrencyDeadline)

         -- Logging parameters:
       , NodeConfiguration -> Bool
ncLoggingSwitch  :: !Bool
       , NodeConfiguration -> Bool
ncLogMetrics     :: !Bool
       , NodeConfiguration -> TraceOptions
ncTraceConfig    :: !TraceOptions
       } deriving (NodeConfiguration -> NodeConfiguration -> Bool
(NodeConfiguration -> NodeConfiguration -> Bool)
-> (NodeConfiguration -> NodeConfiguration -> Bool)
-> Eq NodeConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeConfiguration -> NodeConfiguration -> Bool
$c/= :: NodeConfiguration -> NodeConfiguration -> Bool
== :: NodeConfiguration -> NodeConfiguration -> Bool
$c== :: NodeConfiguration -> NodeConfiguration -> Bool
Eq, Int -> NodeConfiguration -> ShowS
[NodeConfiguration] -> ShowS
NodeConfiguration -> String
(Int -> NodeConfiguration -> ShowS)
-> (NodeConfiguration -> String)
-> ([NodeConfiguration] -> ShowS)
-> Show NodeConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeConfiguration] -> ShowS
$cshowList :: [NodeConfiguration] -> ShowS
show :: NodeConfiguration -> String
$cshow :: NodeConfiguration -> String
showsPrec :: Int -> NodeConfiguration -> ShowS
$cshowsPrec :: Int -> NodeConfiguration -> ShowS
Show)


data PartialNodeConfiguration
  = PartialNodeConfiguration
      {  PartialNodeConfiguration -> Last NodeHostIPv4Address
pncNodeIPv4Addr    :: !(Last NodeHostIPv4Address)
      ,  PartialNodeConfiguration -> Last NodeHostIPv6Address
pncNodeIPv6Addr    :: !(Last NodeHostIPv6Address)
      ,  PartialNodeConfiguration -> Last PortNumber
pncNodePortNumber  :: !(Last PortNumber)
         -- | Filepath of the configuration yaml file. This file determines
         -- all the configuration settings required for the bcc node
         -- (logging, tracing, protocol, slot length etc)
       , PartialNodeConfiguration -> Last ConfigYamlFilePath
pncConfigFile      :: !(Last ConfigYamlFilePath)
       , PartialNodeConfiguration -> Last TopologyFile
pncTopologyFile    :: !(Last TopologyFile)
       , PartialNodeConfiguration -> Last DbFile
pncDatabaseFile    :: !(Last DbFile)
       , PartialNodeConfiguration -> Last ProtocolFilepaths
pncProtocolFiles   :: !(Last ProtocolFilepaths)
       , PartialNodeConfiguration -> Last Bool
pncValidateDB      :: !(Last Bool)
       , PartialNodeConfiguration -> Last (Maybe Fd)
pncShutdownIPC     :: !(Last (Maybe Fd))
       , PartialNodeConfiguration -> Last MaxSlotNo
pncShutdownOnSlotSynced :: !(Last MaxSlotNo)

          -- Protocol-specific parameters:
       , PartialNodeConfiguration -> Last NodeProtocolConfiguration
pncProtocolConfig :: !(Last NodeProtocolConfiguration)

         -- Node parameters, not protocol-specific:
       , PartialNodeConfiguration -> Last SocketPath
pncSocketPath       :: !(Last SocketPath)
       , PartialNodeConfiguration -> Last DiffusionMode
pncDiffusionMode    :: !(Last DiffusionMode)
       , PartialNodeConfiguration -> Last SnapshotInterval
pncSnapshotInterval :: !(Last SnapshotInterval)
       , PartialNodeConfiguration -> Last Bool
pncTestEnableDevelopmentNetworkProtocols :: !(Last Bool)

         -- BlockFetch configuration
       , PartialNodeConfiguration -> Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync :: !(Last MaxConcurrencyBulkSync)
       , PartialNodeConfiguration -> Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline :: !(Last MaxConcurrencyDeadline)

         -- Logging parameters:
       , PartialNodeConfiguration -> Last Bool
pncLoggingSwitch  :: !(Last Bool)
       , PartialNodeConfiguration -> Last Bool
pncLogMetrics     :: !(Last Bool)
       , PartialNodeConfiguration -> Last TraceOptions
pncTraceConfig    :: !(Last TraceOptions)
       } deriving (PartialNodeConfiguration -> PartialNodeConfiguration -> Bool
(PartialNodeConfiguration -> PartialNodeConfiguration -> Bool)
-> (PartialNodeConfiguration -> PartialNodeConfiguration -> Bool)
-> Eq PartialNodeConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialNodeConfiguration -> PartialNodeConfiguration -> Bool
$c/= :: PartialNodeConfiguration -> PartialNodeConfiguration -> Bool
== :: PartialNodeConfiguration -> PartialNodeConfiguration -> Bool
$c== :: PartialNodeConfiguration -> PartialNodeConfiguration -> Bool
Eq, (forall x.
 PartialNodeConfiguration -> Rep PartialNodeConfiguration x)
-> (forall x.
    Rep PartialNodeConfiguration x -> PartialNodeConfiguration)
-> Generic PartialNodeConfiguration
forall x.
Rep PartialNodeConfiguration x -> PartialNodeConfiguration
forall x.
PartialNodeConfiguration -> Rep PartialNodeConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PartialNodeConfiguration x -> PartialNodeConfiguration
$cfrom :: forall x.
PartialNodeConfiguration -> Rep PartialNodeConfiguration x
Generic, Int -> PartialNodeConfiguration -> ShowS
[PartialNodeConfiguration] -> ShowS
PartialNodeConfiguration -> String
(Int -> PartialNodeConfiguration -> ShowS)
-> (PartialNodeConfiguration -> String)
-> ([PartialNodeConfiguration] -> ShowS)
-> Show PartialNodeConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialNodeConfiguration] -> ShowS
$cshowList :: [PartialNodeConfiguration] -> ShowS
show :: PartialNodeConfiguration -> String
$cshow :: PartialNodeConfiguration -> String
showsPrec :: Int -> PartialNodeConfiguration -> ShowS
$cshowsPrec :: Int -> PartialNodeConfiguration -> ShowS
Show)

instance AdjustFilePaths PartialNodeConfiguration where
  adjustFilePaths :: ShowS -> PartialNodeConfiguration -> PartialNodeConfiguration
adjustFilePaths ShowS
f PartialNodeConfiguration
x =
    PartialNodeConfiguration
x { pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig = ShowS
-> Last NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f (PartialNodeConfiguration -> Last NodeProtocolConfiguration
pncProtocolConfig PartialNodeConfiguration
x)
      , pncSocketPath :: Last SocketPath
pncSocketPath     = ShowS -> Last SocketPath -> Last SocketPath
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths ShowS
f (PartialNodeConfiguration -> Last SocketPath
pncSocketPath PartialNodeConfiguration
x)
      }

instance Semigroup PartialNodeConfiguration where
  <> :: PartialNodeConfiguration
-> PartialNodeConfiguration -> PartialNodeConfiguration
(<>) = PartialNodeConfiguration
-> PartialNodeConfiguration -> PartialNodeConfiguration
forall a. (Generic a, Semigroup (Rep a ())) => a -> a -> a
gmappend

instance FromJSON PartialNodeConfiguration where
  parseJSON :: Value -> Parser PartialNodeConfiguration
parseJSON =
    String
-> (Object -> Parser PartialNodeConfiguration)
-> Value
-> Parser PartialNodeConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialNodeConfiguration" ((Object -> Parser PartialNodeConfiguration)
 -> Value -> Parser PartialNodeConfiguration)
-> (Object -> Parser PartialNodeConfiguration)
-> Value
-> Parser PartialNodeConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
v -> do

      -- Node parameters, not protocol-specific
      Last SocketPath
pncSocketPath <- Maybe SocketPath -> Last SocketPath
forall a. Maybe a -> Last a
Last (Maybe SocketPath -> Last SocketPath)
-> Parser (Maybe SocketPath) -> Parser (Last SocketPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe SocketPath)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"SocketPath"
      Last DiffusionMode
pncDiffusionMode
        <- Maybe DiffusionMode -> Last DiffusionMode
forall a. Maybe a -> Last a
Last (Maybe DiffusionMode -> Last DiffusionMode)
-> (Maybe NodeDiffusionMode -> Maybe DiffusionMode)
-> Maybe NodeDiffusionMode
-> Last DiffusionMode
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (NodeDiffusionMode -> DiffusionMode)
-> Maybe NodeDiffusionMode -> Maybe DiffusionMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeDiffusionMode -> DiffusionMode
getDiffusionMode (Maybe NodeDiffusionMode -> Last DiffusionMode)
-> Parser (Maybe NodeDiffusionMode) -> Parser (Last DiffusionMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe NodeDiffusionMode)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"DiffusionMode"
      Last SnapshotInterval
pncSnapshotInterval
        <- Maybe SnapshotInterval -> Last SnapshotInterval
forall a. Maybe a -> Last a
Last (Maybe SnapshotInterval -> Last SnapshotInterval)
-> (Maybe DiffTime -> Maybe SnapshotInterval)
-> Maybe DiffTime
-> Last SnapshotInterval
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (DiffTime -> SnapshotInterval)
-> Maybe DiffTime -> Maybe SnapshotInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DiffTime -> SnapshotInterval
RequestedSnapshotInterval (Maybe DiffTime -> Last SnapshotInterval)
-> Parser (Maybe DiffTime) -> Parser (Last SnapshotInterval)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe DiffTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"SnapshotInterval"
      Last Bool
pncTestEnableDevelopmentNetworkProtocols
        <- Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Maybe Bool -> Last Bool)
-> Parser (Maybe Bool) -> Parser (Last Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestEnableDevelopmentNetworkProtocols"

      -- Blockfetch parameters
      Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync <- Maybe MaxConcurrencyBulkSync -> Last MaxConcurrencyBulkSync
forall a. Maybe a -> Last a
Last (Maybe MaxConcurrencyBulkSync -> Last MaxConcurrencyBulkSync)
-> Parser (Maybe MaxConcurrencyBulkSync)
-> Parser (Last MaxConcurrencyBulkSync)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe MaxConcurrencyBulkSync)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"MaxConcurrencyBulkSync"
      Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline <- Maybe MaxConcurrencyDeadline -> Last MaxConcurrencyDeadline
forall a. Maybe a -> Last a
Last (Maybe MaxConcurrencyDeadline -> Last MaxConcurrencyDeadline)
-> Parser (Maybe MaxConcurrencyDeadline)
-> Parser (Last MaxConcurrencyDeadline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe MaxConcurrencyDeadline)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"MaxConcurrencyDeadline"

      -- Logging parameters
      Last Bool
pncLoggingSwitch <- Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Maybe Bool -> Last Bool)
-> (Bool -> Maybe Bool) -> Bool -> Last Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Last Bool) -> Parser Bool -> Parser (Last Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TurnOnLogging" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
      Last Bool
pncLogMetrics    <- Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last        (Maybe Bool -> Last Bool)
-> Parser (Maybe Bool) -> Parser (Last Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TurnOnLogMetrics"
      Last TraceOptions
pncTraceConfig   <- Maybe TraceOptions -> Last TraceOptions
forall a. Maybe a -> Last a
Last (Maybe TraceOptions -> Last TraceOptions)
-> (TraceOptions -> Maybe TraceOptions)
-> TraceOptions
-> Last TraceOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TraceOptions -> Maybe TraceOptions
forall a. a -> Maybe a
Just (TraceOptions -> Last TraceOptions)
-> Parser TraceOptions -> Parser (Last TraceOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser TraceOptions
traceConfigParser Object
v

      -- Protocol parameters
      Protocol
protocol <-  Object
v Object -> Text -> Parser (Maybe Protocol)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Protocol" Parser (Maybe Protocol) -> Protocol -> Parser Protocol
forall a. Parser (Maybe a) -> a -> Parser a
.!= Protocol
ColeProtocol
      Last NodeProtocolConfiguration
pncProtocolConfig <-
        case Protocol
protocol of
          Protocol
ColeProtocol ->
            Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeColeProtocolConfiguration
    -> Maybe NodeProtocolConfiguration)
-> NodeColeProtocolConfiguration
-> Last NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration
forall a. a -> Maybe a
Just (NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration)
-> (NodeColeProtocolConfiguration -> NodeProtocolConfiguration)
-> NodeColeProtocolConfiguration
-> Maybe NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeColeProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationCole (NodeColeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> Parser NodeColeProtocolConfiguration
-> Parser (Last NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeColeProtocolConfiguration
parseColeProtocol Object
v

          Protocol
SophieProtocol ->
            Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeSophieProtocolConfiguration
    -> Maybe NodeProtocolConfiguration)
-> NodeSophieProtocolConfiguration
-> Last NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration
forall a. a -> Maybe a
Just (NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration)
-> (NodeSophieProtocolConfiguration -> NodeProtocolConfiguration)
-> NodeSophieProtocolConfiguration
-> Maybe NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeSophieProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationSophie (NodeSophieProtocolConfiguration -> Last NodeProtocolConfiguration)
-> Parser NodeSophieProtocolConfiguration
-> Parser (Last NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeSophieProtocolConfiguration
parseSophieProtocol Object
v

          Protocol
BccProtocol ->
            Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration)
-> NodeProtocolConfiguration
-> Last NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeProtocolConfiguration -> Maybe NodeProtocolConfiguration
forall a. a -> Maybe a
Just  (NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> Parser NodeProtocolConfiguration
-> Parser (Last NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NodeColeProtocolConfiguration
-> NodeSophieProtocolConfiguration
-> NodeAurumProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> NodeProtocolConfiguration
NodeProtocolConfigurationBcc (NodeColeProtocolConfiguration
 -> NodeSophieProtocolConfiguration
 -> NodeAurumProtocolConfiguration
 -> NodeHardForkProtocolConfiguration
 -> NodeProtocolConfiguration)
-> Parser NodeColeProtocolConfiguration
-> Parser
     (NodeSophieProtocolConfiguration
      -> NodeAurumProtocolConfiguration
      -> NodeHardForkProtocolConfiguration
      -> NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeColeProtocolConfiguration
parseColeProtocol Object
v
                                                               Parser
  (NodeSophieProtocolConfiguration
   -> NodeAurumProtocolConfiguration
   -> NodeHardForkProtocolConfiguration
   -> NodeProtocolConfiguration)
-> Parser NodeSophieProtocolConfiguration
-> Parser
     (NodeAurumProtocolConfiguration
      -> NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser NodeSophieProtocolConfiguration
parseSophieProtocol Object
v
                                                               Parser
  (NodeAurumProtocolConfiguration
   -> NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
-> Parser NodeAurumProtocolConfiguration
-> Parser
     (NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser NodeAurumProtocolConfiguration
parseAurumProtocol Object
v
                                                               Parser
  (NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
-> Parser NodeHardForkProtocolConfiguration
-> Parser NodeProtocolConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser NodeHardForkProtocolConfiguration
parseHardForkProtocol Object
v)
      PartialNodeConfiguration -> Parser PartialNodeConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialNodeConfiguration :: Last NodeHostIPv4Address
-> Last NodeHostIPv6Address
-> Last PortNumber
-> Last ConfigYamlFilePath
-> Last TopologyFile
-> Last DbFile
-> Last ProtocolFilepaths
-> Last Bool
-> Last (Maybe Fd)
-> Last MaxSlotNo
-> Last NodeProtocolConfiguration
-> Last SocketPath
-> Last DiffusionMode
-> Last SnapshotInterval
-> Last Bool
-> Last MaxConcurrencyBulkSync
-> Last MaxConcurrencyDeadline
-> Last Bool
-> Last Bool
-> Last TraceOptions
-> PartialNodeConfiguration
PartialNodeConfiguration {
             Last NodeProtocolConfiguration
pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig
           , Last SocketPath
pncSocketPath :: Last SocketPath
pncSocketPath :: Last SocketPath
pncSocketPath
           , Last DiffusionMode
pncDiffusionMode :: Last DiffusionMode
pncDiffusionMode :: Last DiffusionMode
pncDiffusionMode
           , Last SnapshotInterval
pncSnapshotInterval :: Last SnapshotInterval
pncSnapshotInterval :: Last SnapshotInterval
pncSnapshotInterval
           , Last Bool
pncTestEnableDevelopmentNetworkProtocols :: Last Bool
pncTestEnableDevelopmentNetworkProtocols :: Last Bool
pncTestEnableDevelopmentNetworkProtocols
           , Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync :: Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync :: Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync
           , Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline :: Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline :: Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline
           , Last Bool
pncLoggingSwitch :: Last Bool
pncLoggingSwitch :: Last Bool
pncLoggingSwitch
           , Last Bool
pncLogMetrics :: Last Bool
pncLogMetrics :: Last Bool
pncLogMetrics
           , Last TraceOptions
pncTraceConfig :: Last TraceOptions
pncTraceConfig :: Last TraceOptions
pncTraceConfig
           , pncNodeIPv4Addr :: Last NodeHostIPv4Address
pncNodeIPv4Addr = Last NodeHostIPv4Address
forall a. Monoid a => a
mempty
           , pncNodeIPv6Addr :: Last NodeHostIPv6Address
pncNodeIPv6Addr = Last NodeHostIPv6Address
forall a. Monoid a => a
mempty
           , pncNodePortNumber :: Last PortNumber
pncNodePortNumber = Last PortNumber
forall a. Monoid a => a
mempty
           , pncConfigFile :: Last ConfigYamlFilePath
pncConfigFile = Last ConfigYamlFilePath
forall a. Monoid a => a
mempty
           , pncTopologyFile :: Last TopologyFile
pncTopologyFile = Last TopologyFile
forall a. Monoid a => a
mempty
           , pncDatabaseFile :: Last DbFile
pncDatabaseFile = Last DbFile
forall a. Monoid a => a
mempty
           , pncProtocolFiles :: Last ProtocolFilepaths
pncProtocolFiles = Last ProtocolFilepaths
forall a. Monoid a => a
mempty
           , pncValidateDB :: Last Bool
pncValidateDB = Last Bool
forall a. Monoid a => a
mempty
           , pncShutdownIPC :: Last (Maybe Fd)
pncShutdownIPC = Last (Maybe Fd)
forall a. Monoid a => a
mempty
           , pncShutdownOnSlotSynced :: Last MaxSlotNo
pncShutdownOnSlotSynced = Last MaxSlotNo
forall a. Monoid a => a
mempty
           }
    where
      parseColeProtocol :: Object -> Parser NodeColeProtocolConfiguration
parseColeProtocol Object
v = do
        Maybe GenesisFile
primary   <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ColeGenesisFile"
        Maybe GenesisFile
secondary <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"GenesisFile"
        GenesisFile
npcColeGenesisFile <-
          case (Maybe GenesisFile
primary, Maybe GenesisFile
secondary) of
            (Just GenesisFile
g, Maybe GenesisFile
Nothing)  -> GenesisFile -> Parser GenesisFile
forall (m :: * -> *) a. Monad m => a -> m a
return GenesisFile
g
            (Maybe GenesisFile
Nothing, Just GenesisFile
g)  -> GenesisFile -> Parser GenesisFile
forall (m :: * -> *) a. Monad m => a -> m a
return GenesisFile
g
            (Maybe GenesisFile
Nothing, Maybe GenesisFile
Nothing) -> String -> Parser GenesisFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ String
"Missing required field, either "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ColeGenesisFile or GenesisFile"
            (Just GenesisFile
_, Just GenesisFile
_)   -> String -> Parser GenesisFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ String
"Specify either ColeGenesisFile"
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or GenesisFile, but not both"
        Maybe GenesisHash
npcColeGenesisFileHash <- Object
v Object -> Text -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ColeGenesisHash"

        RequiresNetworkMagic
npcColeReqNetworkMagic     <- Object
v Object -> Text -> Parser (Maybe RequiresNetworkMagic)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"RequiresNetworkMagic"
                                         Parser (Maybe RequiresNetworkMagic)
-> RequiresNetworkMagic -> Parser RequiresNetworkMagic
forall a. Parser (Maybe a) -> a -> Parser a
.!= RequiresNetworkMagic
RequiresNoMagic
        Maybe Double
npcColePbftSignatureThresh <- Object
v Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"PBftSignatureThreshold"
        ApplicationName
npcColeApplicationName     <- Object
v Object -> Text -> Parser (Maybe ApplicationName)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ApplicationName"
                                         Parser (Maybe ApplicationName)
-> ApplicationName -> Parser ApplicationName
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text -> ApplicationName
Cole.ApplicationName Text
"bcc-sl"
        NumSoftwareVersion
npcColeApplicationVersion  <- Object
v Object -> Text -> Parser (Maybe NumSoftwareVersion)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ApplicationVersion" Parser (Maybe NumSoftwareVersion)
-> NumSoftwareVersion -> Parser NumSoftwareVersion
forall a. Parser (Maybe a) -> a -> Parser a
.!= NumSoftwareVersion
1
        Word16
protVerMajor                <- Object
v Object -> Text -> Parser Word16
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"LastKnownBlockVersion-Major"
        Word16
protVerSentry                <- Object
v Object -> Text -> Parser Word16
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"LastKnownBlockVersion-Sentry"
                        

        NodeColeProtocolConfiguration
-> Parser NodeColeProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeColeProtocolConfiguration :: GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> NodeColeProtocolConfiguration
NodeColeProtocolConfiguration {
               GenesisFile
npcColeGenesisFile :: GenesisFile
npcColeGenesisFile :: GenesisFile
npcColeGenesisFile
             , Maybe GenesisHash
npcColeGenesisFileHash :: Maybe GenesisHash
npcColeGenesisFileHash :: Maybe GenesisHash
npcColeGenesisFileHash
             , RequiresNetworkMagic
npcColeReqNetworkMagic :: RequiresNetworkMagic
npcColeReqNetworkMagic :: RequiresNetworkMagic
npcColeReqNetworkMagic
             , Maybe Double
npcColePbftSignatureThresh :: Maybe Double
npcColePbftSignatureThresh :: Maybe Double
npcColePbftSignatureThresh
             , ApplicationName
npcColeApplicationName :: ApplicationName
npcColeApplicationName :: ApplicationName
npcColeApplicationName
             , NumSoftwareVersion
npcColeApplicationVersion :: NumSoftwareVersion
npcColeApplicationVersion :: NumSoftwareVersion
npcColeApplicationVersion
             , npcColeSupportedProtocolVersionMajor :: Word16
npcColeSupportedProtocolVersionMajor = Word16
protVerMajor
             , npcColeSupportedProtocolVersionSentry :: Word16
npcColeSupportedProtocolVersionSentry = Word16
protVerSentry
             }

      parseSophieProtocol :: Object -> Parser NodeSophieProtocolConfiguration
parseSophieProtocol Object
v = do
        Maybe GenesisFile
primary   <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"SophieGenesisFile"
        Maybe GenesisFile
secondary <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"GenesisFile"
        GenesisFile
npcSophieGenesisFile <-
          case (Maybe GenesisFile
primary, Maybe GenesisFile
secondary) of
            (Just GenesisFile
g, Maybe GenesisFile
Nothing)  -> GenesisFile -> Parser GenesisFile
forall (m :: * -> *) a. Monad m => a -> m a
return GenesisFile
g
            (Maybe GenesisFile
Nothing, Just GenesisFile
g)  -> GenesisFile -> Parser GenesisFile
forall (m :: * -> *) a. Monad m => a -> m a
return GenesisFile
g
            (Maybe GenesisFile
Nothing, Maybe GenesisFile
Nothing) -> String -> Parser GenesisFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ String
"Missing required field, either "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"SophieGenesisFile or GenesisFile"
            (Just GenesisFile
_, Just GenesisFile
_)   -> String -> Parser GenesisFile
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GenesisFile) -> String -> Parser GenesisFile
forall a b. (a -> b) -> a -> b
$ String
"Specify either SophieGenesisFile"
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or GenesisFile, but not both"
        Maybe GenesisHash
npcSophieGenesisFileHash <- Object
v Object -> Text -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"SophieGenesisHash"

        NodeSophieProtocolConfiguration
-> Parser NodeSophieProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeSophieProtocolConfiguration :: GenesisFile -> Maybe GenesisHash -> NodeSophieProtocolConfiguration
NodeSophieProtocolConfiguration {
               GenesisFile
npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile
             , Maybe GenesisHash
npcSophieGenesisFileHash :: Maybe GenesisHash
npcSophieGenesisFileHash :: Maybe GenesisHash
npcSophieGenesisFileHash
             }

      parseAurumProtocol :: Object -> Parser NodeAurumProtocolConfiguration
parseAurumProtocol Object
v = do
        GenesisFile
npcAurumGenesisFile     <- Object
v Object -> Text -> Parser GenesisFile
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"AurumGenesisFile"
        Maybe GenesisHash
npcAurumGenesisFileHash <- Object
v Object -> Text -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"AurumGenesisHash"

        NodeAurumProtocolConfiguration
-> Parser NodeAurumProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeAurumProtocolConfiguration :: GenesisFile -> Maybe GenesisHash -> NodeAurumProtocolConfiguration
NodeAurumProtocolConfiguration {
               GenesisFile
npcAurumGenesisFile :: GenesisFile
npcAurumGenesisFile :: GenesisFile
npcAurumGenesisFile
             , Maybe GenesisHash
npcAurumGenesisFileHash :: Maybe GenesisHash
npcAurumGenesisFileHash :: Maybe GenesisHash
npcAurumGenesisFileHash
             }

      parseHardForkProtocol :: Object -> Parser NodeHardForkProtocolConfiguration
parseHardForkProtocol Object
v = do
        Bool
npcTestEnableDevelopmentHardForkEras
          <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestEnableDevelopmentHardForkEras"
               Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

        Maybe EpochNo
npcTestSophieHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestSophieHardForkAtEpoch"
        Maybe Word
npcTestSophieHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestSophieHardForkAtVersion"

        Maybe EpochNo
npcTestEvieHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestEvieHardForkAtEpoch"
        Maybe Word
npcTestEvieHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestEvieHardForkAtVersion"

        Maybe EpochNo
npcTestJenHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestJenHardForkAtEpoch"
        Maybe Word
npcTestJenHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestJenHardForkAtVersion"

        Maybe EpochNo
npcTestAurumHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestAurumHardForkAtEpoch"
        Maybe Word
npcTestAurumHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestAurumHardForkAtVersion"

        NodeHardForkProtocolConfiguration
-> Parser NodeHardForkProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeHardForkProtocolConfiguration :: Bool
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> Maybe EpochNo
-> Maybe Word
-> NodeHardForkProtocolConfiguration
NodeHardForkProtocolConfiguration {
               Bool
npcTestEnableDevelopmentHardForkEras :: Bool
npcTestEnableDevelopmentHardForkEras :: Bool
npcTestEnableDevelopmentHardForkEras,

               Maybe EpochNo
npcTestSophieHardForkAtEpoch :: Maybe EpochNo
npcTestSophieHardForkAtEpoch :: Maybe EpochNo
npcTestSophieHardForkAtEpoch,
               Maybe Word
npcTestSophieHardForkAtVersion :: Maybe Word
npcTestSophieHardForkAtVersion :: Maybe Word
npcTestSophieHardForkAtVersion,

               Maybe EpochNo
npcTestEvieHardForkAtEpoch :: Maybe EpochNo
npcTestEvieHardForkAtEpoch :: Maybe EpochNo
npcTestEvieHardForkAtEpoch,
               Maybe Word
npcTestEvieHardForkAtVersion :: Maybe Word
npcTestEvieHardForkAtVersion :: Maybe Word
npcTestEvieHardForkAtVersion,

               Maybe EpochNo
npcTestJenHardForkAtEpoch :: Maybe EpochNo
npcTestJenHardForkAtEpoch :: Maybe EpochNo
npcTestJenHardForkAtEpoch,
               Maybe Word
npcTestJenHardForkAtVersion :: Maybe Word
npcTestJenHardForkAtVersion :: Maybe Word
npcTestJenHardForkAtVersion,

               Maybe EpochNo
npcTestAurumHardForkAtEpoch :: Maybe EpochNo
npcTestAurumHardForkAtEpoch :: Maybe EpochNo
npcTestAurumHardForkAtEpoch,
               Maybe Word
npcTestAurumHardForkAtVersion :: Maybe Word
npcTestAurumHardForkAtVersion :: Maybe Word
npcTestAurumHardForkAtVersion
             }

-- | Default configuration is mainnet
defaultPartialNodeConfiguration :: PartialNodeConfiguration
defaultPartialNodeConfiguration :: PartialNodeConfiguration
defaultPartialNodeConfiguration =
  PartialNodeConfiguration :: Last NodeHostIPv4Address
-> Last NodeHostIPv6Address
-> Last PortNumber
-> Last ConfigYamlFilePath
-> Last TopologyFile
-> Last DbFile
-> Last ProtocolFilepaths
-> Last Bool
-> Last (Maybe Fd)
-> Last MaxSlotNo
-> Last NodeProtocolConfiguration
-> Last SocketPath
-> Last DiffusionMode
-> Last SnapshotInterval
-> Last Bool
-> Last MaxConcurrencyBulkSync
-> Last MaxConcurrencyDeadline
-> Last Bool
-> Last Bool
-> Last TraceOptions
-> PartialNodeConfiguration
PartialNodeConfiguration
    { pncConfigFile :: Last ConfigYamlFilePath
pncConfigFile = Maybe ConfigYamlFilePath -> Last ConfigYamlFilePath
forall a. Maybe a -> Last a
Last (Maybe ConfigYamlFilePath -> Last ConfigYamlFilePath)
-> (ConfigYamlFilePath -> Maybe ConfigYamlFilePath)
-> ConfigYamlFilePath
-> Last ConfigYamlFilePath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConfigYamlFilePath -> Maybe ConfigYamlFilePath
forall a. a -> Maybe a
Just (ConfigYamlFilePath -> Last ConfigYamlFilePath)
-> ConfigYamlFilePath -> Last ConfigYamlFilePath
forall a b. (a -> b) -> a -> b
$ String -> ConfigYamlFilePath
ConfigYamlFilePath String
"configuration/bcc/mainnet-config.json"
    , pncDatabaseFile :: Last DbFile
pncDatabaseFile = Maybe DbFile -> Last DbFile
forall a. Maybe a -> Last a
Last (Maybe DbFile -> Last DbFile)
-> (DbFile -> Maybe DbFile) -> DbFile -> Last DbFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DbFile -> Maybe DbFile
forall a. a -> Maybe a
Just (DbFile -> Last DbFile) -> DbFile -> Last DbFile
forall a b. (a -> b) -> a -> b
$ String -> DbFile
DbFile String
"mainnet/db/"
    , pncLoggingSwitch :: Last Bool
pncLoggingSwitch = Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Maybe Bool -> Last Bool) -> Maybe Bool -> Last Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    , pncSocketPath :: Last SocketPath
pncSocketPath = Last SocketPath
forall a. Monoid a => a
mempty
    , pncDiffusionMode :: Last DiffusionMode
pncDiffusionMode = Maybe DiffusionMode -> Last DiffusionMode
forall a. Maybe a -> Last a
Last (Maybe DiffusionMode -> Last DiffusionMode)
-> Maybe DiffusionMode -> Last DiffusionMode
forall a b. (a -> b) -> a -> b
$ DiffusionMode -> Maybe DiffusionMode
forall a. a -> Maybe a
Just DiffusionMode
InitiatorAndResponderDiffusionMode
    , pncSnapshotInterval :: Last SnapshotInterval
pncSnapshotInterval = Maybe SnapshotInterval -> Last SnapshotInterval
forall a. Maybe a -> Last a
Last (Maybe SnapshotInterval -> Last SnapshotInterval)
-> Maybe SnapshotInterval -> Last SnapshotInterval
forall a b. (a -> b) -> a -> b
$ SnapshotInterval -> Maybe SnapshotInterval
forall a. a -> Maybe a
Just SnapshotInterval
DefaultSnapshotInterval
    , pncTestEnableDevelopmentNetworkProtocols :: Last Bool
pncTestEnableDevelopmentNetworkProtocols = Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Maybe Bool -> Last Bool) -> Maybe Bool -> Last Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    , pncTopologyFile :: Last TopologyFile
pncTopologyFile = Maybe TopologyFile -> Last TopologyFile
forall a. Maybe a -> Last a
Last (Maybe TopologyFile -> Last TopologyFile)
-> (TopologyFile -> Maybe TopologyFile)
-> TopologyFile
-> Last TopologyFile
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TopologyFile -> Maybe TopologyFile
forall a. a -> Maybe a
Just (TopologyFile -> Last TopologyFile)
-> TopologyFile -> Last TopologyFile
forall a b. (a -> b) -> a -> b
$ String -> TopologyFile
TopologyFile String
"configuration/bcc/mainnet-topology.json"
    , pncNodeIPv4Addr :: Last NodeHostIPv4Address
pncNodeIPv4Addr = Last NodeHostIPv4Address
forall a. Monoid a => a
mempty
    , pncNodeIPv6Addr :: Last NodeHostIPv6Address
pncNodeIPv6Addr = Last NodeHostIPv6Address
forall a. Monoid a => a
mempty
    , pncNodePortNumber :: Last PortNumber
pncNodePortNumber = Last PortNumber
forall a. Monoid a => a
mempty
    , pncProtocolFiles :: Last ProtocolFilepaths
pncProtocolFiles = Last ProtocolFilepaths
forall a. Monoid a => a
mempty
    , pncValidateDB :: Last Bool
pncValidateDB = Last Bool
forall a. Monoid a => a
mempty
    , pncShutdownIPC :: Last (Maybe Fd)
pncShutdownIPC = Last (Maybe Fd)
forall a. Monoid a => a
mempty
    , pncShutdownOnSlotSynced :: Last MaxSlotNo
pncShutdownOnSlotSynced = Last MaxSlotNo
forall a. Monoid a => a
mempty
    , pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig = Last NodeProtocolConfiguration
forall a. Monoid a => a
mempty
    , pncMaxConcurrencyBulkSync :: Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync = Last MaxConcurrencyBulkSync
forall a. Monoid a => a
mempty
    , pncMaxConcurrencyDeadline :: Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline = Last MaxConcurrencyDeadline
forall a. Monoid a => a
mempty
    , pncLogMetrics :: Last Bool
pncLogMetrics = Last Bool
forall a. Monoid a => a
mempty
    , pncTraceConfig :: Last TraceOptions
pncTraceConfig = Last TraceOptions
forall a. Monoid a => a
mempty
    }

lastOption :: Parser a -> Parser (Last a)
lastOption :: Parser a -> Parser (Last a)
lastOption = (Maybe a -> Last a) -> Parser (Maybe a) -> Parser (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Parser (Maybe a) -> Parser (Last a))
-> (Parser a -> Parser (Maybe a)) -> Parser a -> Parser (Last a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional

lastToEither :: String -> Last a -> Either String a
lastToEither :: String -> Last a -> Either String a
lastToEither String
errMsg (Last Maybe a
x) = Either String a
-> (a -> Either String a) -> Maybe a -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String a
forall a b. a -> Either a b
Left String
errMsg) a -> Either String a
forall a b. b -> Either a b
Right Maybe a
x

makeNodeConfiguration :: PartialNodeConfiguration -> Either String NodeConfiguration
makeNodeConfiguration :: PartialNodeConfiguration -> Either String NodeConfiguration
makeNodeConfiguration PartialNodeConfiguration
pnc = do
  ConfigYamlFilePath
configFile <- String
-> Last ConfigYamlFilePath -> Either String ConfigYamlFilePath
forall a. String -> Last a -> Either String a
lastToEither String
"Missing YAML config file" (Last ConfigYamlFilePath -> Either String ConfigYamlFilePath)
-> Last ConfigYamlFilePath -> Either String ConfigYamlFilePath
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last ConfigYamlFilePath
pncConfigFile PartialNodeConfiguration
pnc
  TopologyFile
topologyFile <- String -> Last TopologyFile -> Either String TopologyFile
forall a. String -> Last a -> Either String a
lastToEither String
"Missing TopologyFile" (Last TopologyFile -> Either String TopologyFile)
-> Last TopologyFile -> Either String TopologyFile
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last TopologyFile
pncTopologyFile PartialNodeConfiguration
pnc
  DbFile
databaseFile <- String -> Last DbFile -> Either String DbFile
forall a. String -> Last a -> Either String a
lastToEither String
"Missing DatabaseFile" (Last DbFile -> Either String DbFile)
-> Last DbFile -> Either String DbFile
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last DbFile
pncDatabaseFile PartialNodeConfiguration
pnc
  ProtocolFilepaths
protocolFiles <- String -> Last ProtocolFilepaths -> Either String ProtocolFilepaths
forall a. String -> Last a -> Either String a
lastToEither String
"Missing ProtocolFiles" (Last ProtocolFilepaths -> Either String ProtocolFilepaths)
-> Last ProtocolFilepaths -> Either String ProtocolFilepaths
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last ProtocolFilepaths
pncProtocolFiles PartialNodeConfiguration
pnc
  Bool
validateDB <- String -> Last Bool -> Either String Bool
forall a. String -> Last a -> Either String a
lastToEither String
"Missing ValidateDB" (Last Bool -> Either String Bool)
-> Last Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last Bool
pncValidateDB PartialNodeConfiguration
pnc
  Maybe Fd
shutdownIPC <- String -> Last (Maybe Fd) -> Either String (Maybe Fd)
forall a. String -> Last a -> Either String a
lastToEither String
"Missing ShutdownIPC" (Last (Maybe Fd) -> Either String (Maybe Fd))
-> Last (Maybe Fd) -> Either String (Maybe Fd)
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last (Maybe Fd)
pncShutdownIPC PartialNodeConfiguration
pnc
  MaxSlotNo
shutdownOnSlotSynced <- String -> Last MaxSlotNo -> Either String MaxSlotNo
forall a. String -> Last a -> Either String a
lastToEither String
"Missing ShutdownOnSlotSynced" (Last MaxSlotNo -> Either String MaxSlotNo)
-> Last MaxSlotNo -> Either String MaxSlotNo
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last MaxSlotNo
pncShutdownOnSlotSynced PartialNodeConfiguration
pnc
  NodeProtocolConfiguration
protocolConfig <- String
-> Last NodeProtocolConfiguration
-> Either String NodeProtocolConfiguration
forall a. String -> Last a -> Either String a
lastToEither String
"Missing ProtocolConfig" (Last NodeProtocolConfiguration
 -> Either String NodeProtocolConfiguration)
-> Last NodeProtocolConfiguration
-> Either String NodeProtocolConfiguration
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last NodeProtocolConfiguration
pncProtocolConfig PartialNodeConfiguration
pnc
  Bool
loggingSwitch <- String -> Last Bool -> Either String Bool
forall a. String -> Last a -> Either String a
lastToEither String
"Missing LoggingSwitch" (Last Bool -> Either String Bool)
-> Last Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last Bool
pncLoggingSwitch PartialNodeConfiguration
pnc
  Bool
logMetrics <- String -> Last Bool -> Either String Bool
forall a. String -> Last a -> Either String a
lastToEither String
"Missing LogMetrics" (Last Bool -> Either String Bool)
-> Last Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last Bool
pncLogMetrics PartialNodeConfiguration
pnc
  TraceOptions
traceConfig <- String -> Last TraceOptions -> Either String TraceOptions
forall a. String -> Last a -> Either String a
lastToEither String
"Missing TraceConfig" (Last TraceOptions -> Either String TraceOptions)
-> Last TraceOptions -> Either String TraceOptions
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last TraceOptions
pncTraceConfig PartialNodeConfiguration
pnc
  DiffusionMode
diffusionMode <- String -> Last DiffusionMode -> Either String DiffusionMode
forall a. String -> Last a -> Either String a
lastToEither String
"Missing DiffusionMode" (Last DiffusionMode -> Either String DiffusionMode)
-> Last DiffusionMode -> Either String DiffusionMode
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last DiffusionMode
pncDiffusionMode PartialNodeConfiguration
pnc
  SnapshotInterval
snapshotInterval <- String -> Last SnapshotInterval -> Either String SnapshotInterval
forall a. String -> Last a -> Either String a
lastToEither String
"Missing SnapshotInterval" (Last SnapshotInterval -> Either String SnapshotInterval)
-> Last SnapshotInterval -> Either String SnapshotInterval
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last SnapshotInterval
pncSnapshotInterval PartialNodeConfiguration
pnc

  Bool
testEnableDevelopmentNetworkProtocols <-
    String -> Last Bool -> Either String Bool
forall a. String -> Last a -> Either String a
lastToEither String
"Missing TestEnableDevelopmentNetworkProtocols" (Last Bool -> Either String Bool)
-> Last Bool -> Either String Bool
forall a b. (a -> b) -> a -> b
$
      PartialNodeConfiguration -> Last Bool
pncTestEnableDevelopmentNetworkProtocols PartialNodeConfiguration
pnc
  NodeConfiguration -> Either String NodeConfiguration
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeConfiguration -> Either String NodeConfiguration)
-> NodeConfiguration -> Either String NodeConfiguration
forall a b. (a -> b) -> a -> b
$ NodeConfiguration :: Maybe NodeHostIPv4Address
-> Maybe NodeHostIPv6Address
-> Maybe PortNumber
-> ConfigYamlFilePath
-> TopologyFile
-> DbFile
-> ProtocolFilepaths
-> Bool
-> Maybe Fd
-> MaxSlotNo
-> NodeProtocolConfiguration
-> Maybe SocketPath
-> DiffusionMode
-> SnapshotInterval
-> Bool
-> Maybe MaxConcurrencyBulkSync
-> Maybe MaxConcurrencyDeadline
-> Bool
-> Bool
-> TraceOptions
-> NodeConfiguration
NodeConfiguration
             { ncNodeIPv4Addr :: Maybe NodeHostIPv4Address
ncNodeIPv4Addr = Last NodeHostIPv4Address -> Maybe NodeHostIPv4Address
forall a. Last a -> Maybe a
getLast (Last NodeHostIPv4Address -> Maybe NodeHostIPv4Address)
-> Last NodeHostIPv4Address -> Maybe NodeHostIPv4Address
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last NodeHostIPv4Address
pncNodeIPv4Addr PartialNodeConfiguration
pnc
             , ncNodeIPv6Addr :: Maybe NodeHostIPv6Address
ncNodeIPv6Addr = Last NodeHostIPv6Address -> Maybe NodeHostIPv6Address
forall a. Last a -> Maybe a
getLast (Last NodeHostIPv6Address -> Maybe NodeHostIPv6Address)
-> Last NodeHostIPv6Address -> Maybe NodeHostIPv6Address
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last NodeHostIPv6Address
pncNodeIPv6Addr PartialNodeConfiguration
pnc
             , ncNodePortNumber :: Maybe PortNumber
ncNodePortNumber = Last PortNumber -> Maybe PortNumber
forall a. Last a -> Maybe a
getLast (Last PortNumber -> Maybe PortNumber)
-> Last PortNumber -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last PortNumber
pncNodePortNumber PartialNodeConfiguration
pnc
             , ncConfigFile :: ConfigYamlFilePath
ncConfigFile = ConfigYamlFilePath
configFile
             , ncTopologyFile :: TopologyFile
ncTopologyFile = TopologyFile
topologyFile
             , ncDatabaseFile :: DbFile
ncDatabaseFile = DbFile
databaseFile
             , ncProtocolFiles :: ProtocolFilepaths
ncProtocolFiles = ProtocolFilepaths
protocolFiles
             , ncValidateDB :: Bool
ncValidateDB = Bool
validateDB
             , ncShutdownIPC :: Maybe Fd
ncShutdownIPC = Maybe Fd
shutdownIPC
             , ncShutdownOnSlotSynced :: MaxSlotNo
ncShutdownOnSlotSynced = MaxSlotNo
shutdownOnSlotSynced
             , ncProtocolConfig :: NodeProtocolConfiguration
ncProtocolConfig = NodeProtocolConfiguration
protocolConfig
             , ncSocketPath :: Maybe SocketPath
ncSocketPath = Last SocketPath -> Maybe SocketPath
forall a. Last a -> Maybe a
getLast (Last SocketPath -> Maybe SocketPath)
-> Last SocketPath -> Maybe SocketPath
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last SocketPath
pncSocketPath PartialNodeConfiguration
pnc
             , ncDiffusionMode :: DiffusionMode
ncDiffusionMode = DiffusionMode
diffusionMode
             , ncSnapshotInterval :: SnapshotInterval
ncSnapshotInterval = SnapshotInterval
snapshotInterval
             , ncTestEnableDevelopmentNetworkProtocols :: Bool
ncTestEnableDevelopmentNetworkProtocols = Bool
testEnableDevelopmentNetworkProtocols
             , ncMaxConcurrencyBulkSync :: Maybe MaxConcurrencyBulkSync
ncMaxConcurrencyBulkSync = Last MaxConcurrencyBulkSync -> Maybe MaxConcurrencyBulkSync
forall a. Last a -> Maybe a
getLast (Last MaxConcurrencyBulkSync -> Maybe MaxConcurrencyBulkSync)
-> Last MaxConcurrencyBulkSync -> Maybe MaxConcurrencyBulkSync
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync PartialNodeConfiguration
pnc
             , ncMaxConcurrencyDeadline :: Maybe MaxConcurrencyDeadline
ncMaxConcurrencyDeadline = Last MaxConcurrencyDeadline -> Maybe MaxConcurrencyDeadline
forall a. Last a -> Maybe a
getLast (Last MaxConcurrencyDeadline -> Maybe MaxConcurrencyDeadline)
-> Last MaxConcurrencyDeadline -> Maybe MaxConcurrencyDeadline
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline PartialNodeConfiguration
pnc
             , ncLoggingSwitch :: Bool
ncLoggingSwitch = Bool
loggingSwitch
             , ncLogMetrics :: Bool
ncLogMetrics = Bool
logMetrics
             , ncTraceConfig :: TraceOptions
ncTraceConfig = if Bool
loggingSwitch then TraceOptions
traceConfig
                                                else TraceOptions
TracingOff
             }

ncProtocol :: NodeConfiguration -> Protocol
ncProtocol :: NodeConfiguration -> Protocol
ncProtocol NodeConfiguration
nc =
  case NodeConfiguration -> NodeProtocolConfiguration
ncProtocolConfig NodeConfiguration
nc of
    NodeProtocolConfigurationCole{}   -> Protocol
ColeProtocol
    NodeProtocolConfigurationSophie{} -> Protocol
SophieProtocol
    NodeProtocolConfigurationBcc{} -> Protocol
BccProtocol

pncProtocol :: PartialNodeConfiguration -> Either Text Protocol
pncProtocol :: PartialNodeConfiguration -> Either Text Protocol
pncProtocol PartialNodeConfiguration
pnc =
  case PartialNodeConfiguration -> Last NodeProtocolConfiguration
pncProtocolConfig PartialNodeConfiguration
pnc of
    Last Maybe NodeProtocolConfiguration
Nothing -> Text -> Either Text Protocol
forall a b. a -> Either a b
Left Text
"Node protocol configuration not found"
    Last (Just NodeProtocolConfigurationCole{})   -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
ColeProtocol
    Last (Just NodeProtocolConfigurationSophie{}) -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
SophieProtocol
    Last (Just NodeProtocolConfigurationBcc{}) -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
BccProtocol

parseNodeConfigurationFP :: Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration
parseNodeConfigurationFP :: Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration
parseNodeConfigurationFP Maybe ConfigYamlFilePath
Nothing = Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration
parseNodeConfigurationFP (Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration)
-> (Last ConfigYamlFilePath -> Maybe ConfigYamlFilePath)
-> Last ConfigYamlFilePath
-> IO PartialNodeConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Last ConfigYamlFilePath -> Maybe ConfigYamlFilePath
forall a. Last a -> Maybe a
getLast (Last ConfigYamlFilePath -> IO PartialNodeConfiguration)
-> Last ConfigYamlFilePath -> IO PartialNodeConfiguration
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> Last ConfigYamlFilePath
pncConfigFile PartialNodeConfiguration
defaultPartialNodeConfiguration
parseNodeConfigurationFP (Just (ConfigYamlFilePath String
fp)) = do
    PartialNodeConfiguration
nc <- String -> IO PartialNodeConfiguration
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow String
fp
    -- Make all the files be relative to the location of the config file.
    PartialNodeConfiguration -> IO PartialNodeConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialNodeConfiguration -> IO PartialNodeConfiguration)
-> PartialNodeConfiguration -> IO PartialNodeConfiguration
forall a b. (a -> b) -> a -> b
$ ShowS -> PartialNodeConfiguration -> PartialNodeConfiguration
forall a. AdjustFilePaths a => ShowS -> a -> a
adjustFilePaths (ShowS
takeDirectory String
fp String -> ShowS
</>) PartialNodeConfiguration
nc