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

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

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

import           Cardano.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 Cardano.Chain.Update as Byron
import           Cardano.Crypto (RequiresNetworkMagic (..))
import           Cardano.Node.Protocol.Types (Protocol (..))
import           Cardano.Node.Types
import           Cardano.Tracing.Config
import           Ouroboros.Network.Block (MaxSlotNo (..))
import           Ouroboros.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 cardano 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

         -- 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 cardano 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)

         -- 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"

      -- 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
      Bool
pncLoggingSwitch' <- 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'   <- if Bool
pncLoggingSwitch'
                           then 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
                           else Last TraceOptions -> Parser (Last TraceOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Last TraceOptions -> Parser (Last TraceOptions))
-> (Maybe TraceOptions -> Last TraceOptions)
-> Maybe TraceOptions
-> Parser (Last TraceOptions)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe TraceOptions -> Last TraceOptions
forall a. Maybe a -> Last a
Last (Maybe TraceOptions -> Parser (Last TraceOptions))
-> Maybe TraceOptions -> Parser (Last TraceOptions)
forall a b. (a -> b) -> a -> b
$ TraceOptions -> Maybe TraceOptions
forall a. a -> Maybe a
Just TraceOptions
TracingOff

      -- 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
ByronProtocol
      Last NodeProtocolConfiguration
pncProtocolConfig' <-
        case Protocol
protocol of
          Protocol
ByronProtocol ->
            Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeByronProtocolConfiguration
    -> Maybe NodeProtocolConfiguration)
-> NodeByronProtocolConfiguration
-> 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)
-> (NodeByronProtocolConfiguration -> NodeProtocolConfiguration)
-> NodeByronProtocolConfiguration
-> Maybe NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeByronProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationByron (NodeByronProtocolConfiguration -> Last NodeProtocolConfiguration)
-> Parser NodeByronProtocolConfiguration
-> Parser (Last NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeByronProtocolConfiguration
parseByronProtocol Object
v

          Protocol
ShelleyProtocol ->
            Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration
forall a. Maybe a -> Last a
Last (Maybe NodeProtocolConfiguration -> Last NodeProtocolConfiguration)
-> (NodeShelleyProtocolConfiguration
    -> Maybe NodeProtocolConfiguration)
-> NodeShelleyProtocolConfiguration
-> 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)
-> (NodeShelleyProtocolConfiguration -> NodeProtocolConfiguration)
-> NodeShelleyProtocolConfiguration
-> Maybe NodeProtocolConfiguration
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NodeShelleyProtocolConfiguration -> NodeProtocolConfiguration
NodeProtocolConfigurationShelley (NodeShelleyProtocolConfiguration
 -> Last NodeProtocolConfiguration)
-> Parser NodeShelleyProtocolConfiguration
-> Parser (Last NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeShelleyProtocolConfiguration
parseShelleyProtocol Object
v

          Protocol
CardanoProtocol ->
            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
<$> (NodeByronProtocolConfiguration
-> NodeShelleyProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> NodeProtocolConfiguration
NodeProtocolConfigurationCardano (NodeByronProtocolConfiguration
 -> NodeShelleyProtocolConfiguration
 -> NodeHardForkProtocolConfiguration
 -> NodeProtocolConfiguration)
-> Parser NodeByronProtocolConfiguration
-> Parser
     (NodeShelleyProtocolConfiguration
      -> NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser NodeByronProtocolConfiguration
parseByronProtocol Object
v
                                                               Parser
  (NodeShelleyProtocolConfiguration
   -> NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
-> Parser NodeShelleyProtocolConfiguration
-> Parser
     (NodeHardForkProtocolConfiguration -> NodeProtocolConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser NodeShelleyProtocolConfiguration
parseShelleyProtocol 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 MaxConcurrencyBulkSync
-> Last MaxConcurrencyDeadline
-> Last Bool
-> Last Bool
-> Last TraceOptions
-> PartialNodeConfiguration
PartialNodeConfiguration {
             pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig = Last NodeProtocolConfiguration
pncProtocolConfig'
           , pncSocketPath :: Last SocketPath
pncSocketPath = Last SocketPath
pncSocketPath'
           , pncDiffusionMode :: Last DiffusionMode
pncDiffusionMode = Last DiffusionMode
pncDiffusionMode'
           , pncMaxConcurrencyBulkSync :: Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync = Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync'
           , pncMaxConcurrencyDeadline :: Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline = Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline'
           , 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
pncLoggingSwitch'
           , pncLogMetrics :: Last Bool
pncLogMetrics = Last Bool
pncLogMetrics'
           , 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
      parseByronProtocol :: Object -> Parser NodeByronProtocolConfiguration
parseByronProtocol Object
v = do
        Maybe GenesisFile
primary   <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ByronGenesisFile"
        Maybe GenesisFile
secondary <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"GenesisFile"
        GenesisFile
npcByronGenesisFile <-
          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
"ByronGenesisFile 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 ByronGenesisFile"
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or GenesisFile, but not both"
        Maybe GenesisHash
npcByronGenesisFileHash <- Object
v Object -> Text -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ByronGenesisHash"

        RequiresNetworkMagic
npcByronReqNetworkMagic     <- 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
npcByronPbftSignatureThresh <- Object
v Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"PBftSignatureThreshold"
        ApplicationName
npcByronApplicationName     <- 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
Byron.ApplicationName Text
"cardano-sl"
        NumSoftwareVersion
npcByronApplicationVersion  <- 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
protVerMinor                <- Object
v Object -> Text -> Parser Word16
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"LastKnownBlockVersion-Minor"
        Word8
protVerAlt                  <- Object
v Object -> Text -> Parser (Maybe Word8)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"LastKnownBlockVersion-Alt" Parser (Maybe Word8) -> Word8 -> Parser Word8
forall a. Parser (Maybe a) -> a -> Parser a
.!= Word8
0

        NodeByronProtocolConfiguration
-> Parser NodeByronProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeByronProtocolConfiguration :: GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> Maybe Double
-> ApplicationName
-> NumSoftwareVersion
-> Word16
-> Word16
-> Word8
-> NodeByronProtocolConfiguration
NodeByronProtocolConfiguration {
               GenesisFile
npcByronGenesisFile :: GenesisFile
npcByronGenesisFile :: GenesisFile
npcByronGenesisFile
             , Maybe GenesisHash
npcByronGenesisFileHash :: Maybe GenesisHash
npcByronGenesisFileHash :: Maybe GenesisHash
npcByronGenesisFileHash
             , RequiresNetworkMagic
npcByronReqNetworkMagic :: RequiresNetworkMagic
npcByronReqNetworkMagic :: RequiresNetworkMagic
npcByronReqNetworkMagic
             , Maybe Double
npcByronPbftSignatureThresh :: Maybe Double
npcByronPbftSignatureThresh :: Maybe Double
npcByronPbftSignatureThresh
             , ApplicationName
npcByronApplicationName :: ApplicationName
npcByronApplicationName :: ApplicationName
npcByronApplicationName
             , NumSoftwareVersion
npcByronApplicationVersion :: NumSoftwareVersion
npcByronApplicationVersion :: NumSoftwareVersion
npcByronApplicationVersion
             , npcByronSupportedProtocolVersionMajor :: Word16
npcByronSupportedProtocolVersionMajor = Word16
protVerMajor
             , npcByronSupportedProtocolVersionMinor :: Word16
npcByronSupportedProtocolVersionMinor = Word16
protVerMinor
             , npcByronSupportedProtocolVersionAlt :: Word8
npcByronSupportedProtocolVersionAlt   = Word8
protVerAlt
             }

      parseShelleyProtocol :: Object -> Parser NodeShelleyProtocolConfiguration
parseShelleyProtocol Object
v = do
        Maybe GenesisFile
primary   <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ShelleyGenesisFile"
        Maybe GenesisFile
secondary <- Object
v Object -> Text -> Parser (Maybe GenesisFile)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"GenesisFile"
        GenesisFile
npcShelleyGenesisFile <-
          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
"ShelleyGenesisFile 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 ShelleyGenesisFile"
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or GenesisFile, but not both"
        Maybe GenesisHash
npcShelleyGenesisFileHash <- Object
v Object -> Text -> Parser (Maybe GenesisHash)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ShelleyGenesisHash"

        --TODO: these are silly names, allow better aliases:
        Natural
protVerMajor    <- Object
v Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"LastKnownBlockVersion-Major"
        Natural
protVerMinor    <- Object
v Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"LastKnownBlockVersion-Minor"

        NodeShelleyProtocolConfiguration
-> Parser NodeShelleyProtocolConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeShelleyProtocolConfiguration :: GenesisFile
-> Maybe GenesisHash
-> Natural
-> Natural
-> NodeShelleyProtocolConfiguration
NodeShelleyProtocolConfiguration {
               GenesisFile
npcShelleyGenesisFile :: GenesisFile
npcShelleyGenesisFile :: GenesisFile
npcShelleyGenesisFile
             , Maybe GenesisHash
npcShelleyGenesisFileHash :: Maybe GenesisHash
npcShelleyGenesisFileHash :: Maybe GenesisHash
npcShelleyGenesisFileHash
             , npcShelleySupportedProtocolVersionMajor :: Natural
npcShelleySupportedProtocolVersionMajor = Natural
protVerMajor
             , npcShelleySupportedProtocolVersionMinor :: Natural
npcShelleySupportedProtocolVersionMinor = Natural
protVerMinor
             }

      parseHardForkProtocol :: Object -> Parser NodeHardForkProtocolConfiguration
parseHardForkProtocol Object
v = do
        Maybe EpochNo
npcTestShelleyHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestShelleyHardForkAtEpoch"
        Maybe Word
npcTestShelleyHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestShelleyHardForkAtVersion"
        Maybe EpochNo
npcShelleyHardForkNotBeforeEpoch <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ShelleyHardForkNotBeforeEpoch"

        Maybe EpochNo
npcTestAllegraHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestAllegraHardForkAtEpoch"
        Maybe Word
npcTestAllegraHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestAllegraHardForkAtVersion"
        Maybe EpochNo
npcAllegraHardForkNotBeforeEpoch <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"AllegraHardForkNotBeforeEpoch"

        Maybe EpochNo
npcTestMaryHardForkAtEpoch   <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestMaryHardForkAtEpoch"
        Maybe Word
npcTestMaryHardForkAtVersion <- Object
v Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"TestMaryHardForkAtVersion"
        Maybe EpochNo
npcMaryHardForkNotBeforeEpoch <- Object
v Object -> Text -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"MaryHardForkNotBeforeEpoch"

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

               Maybe EpochNo
npcTestAllegraHardForkAtEpoch :: Maybe EpochNo
npcTestAllegraHardForkAtEpoch :: Maybe EpochNo
npcTestAllegraHardForkAtEpoch,
               Maybe Word
npcTestAllegraHardForkAtVersion :: Maybe Word
npcTestAllegraHardForkAtVersion :: Maybe Word
npcTestAllegraHardForkAtVersion,
               Maybe EpochNo
npcAllegraHardForkNotBeforeEpoch :: Maybe EpochNo
npcAllegraHardForkNotBeforeEpoch :: Maybe EpochNo
npcAllegraHardForkNotBeforeEpoch,

               Maybe EpochNo
npcTestMaryHardForkAtEpoch :: Maybe EpochNo
npcTestMaryHardForkAtEpoch :: Maybe EpochNo
npcTestMaryHardForkAtEpoch,
               Maybe Word
npcTestMaryHardForkAtVersion :: Maybe Word
npcTestMaryHardForkAtVersion :: Maybe Word
npcTestMaryHardForkAtVersion,
               Maybe EpochNo
npcMaryHardForkNotBeforeEpoch :: Maybe EpochNo
npcMaryHardForkNotBeforeEpoch :: Maybe EpochNo
npcMaryHardForkNotBeforeEpoch
             }

-- | 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 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/cardano/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
    , 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/cardano/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
  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
-> 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
             , 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 = TraceOptions
traceConfig
             }

ncProtocol :: NodeConfiguration -> Protocol
ncProtocol :: NodeConfiguration -> Protocol
ncProtocol NodeConfiguration
nc =
  case NodeConfiguration -> NodeProtocolConfiguration
ncProtocolConfig NodeConfiguration
nc of
    NodeProtocolConfigurationByron{}   -> Protocol
ByronProtocol
    NodeProtocolConfigurationShelley{} -> Protocol
ShelleyProtocol
    NodeProtocolConfigurationCardano{} -> Protocol
CardanoProtocol

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 NodeProtocolConfigurationByron{})   -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
ByronProtocol
    Last (Just NodeProtocolConfigurationShelley{}) -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
ShelleyProtocol
    Last (Just NodeProtocolConfigurationCardano{}) -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right Protocol
CardanoProtocol

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