{-# 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)
, 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
, NodeConfiguration -> NodeProtocolConfiguration
ncProtocolConfig :: !NodeProtocolConfiguration
, NodeConfiguration -> Maybe SocketPath
ncSocketPath :: !(Maybe SocketPath)
, NodeConfiguration -> DiffusionMode
ncDiffusionMode :: !DiffusionMode
, NodeConfiguration -> Maybe MaxConcurrencyBulkSync
ncMaxConcurrencyBulkSync :: !(Maybe MaxConcurrencyBulkSync)
, NodeConfiguration -> Maybe MaxConcurrencyDeadline
ncMaxConcurrencyDeadline :: !(Maybe MaxConcurrencyDeadline)
, 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)
, 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)
, PartialNodeConfiguration -> Last NodeProtocolConfiguration
pncProtocolConfig :: !(Last NodeProtocolConfiguration)
, PartialNodeConfiguration -> Last SocketPath
pncSocketPath :: !(Last SocketPath)
, PartialNodeConfiguration -> Last DiffusionMode
pncDiffusionMode :: !(Last DiffusionMode)
, PartialNodeConfiguration -> Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync :: !(Last MaxConcurrencyBulkSync)
, PartialNodeConfiguration -> Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline :: !(Last MaxConcurrencyDeadline)
, 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
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 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"
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
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"
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
}
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
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