{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData          #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Logging.ConfigurationParser
  ( mkConfiguration
  , mkConfigurationWithFallback
  , readConfiguration
  , readConfigurationWithFallback
  , readConfiguration'
  , readConfigurationWithFallback'
  , readConfigurationWithDefault
  , readConfigurationWithFallbackAndDefault
  , applyFallback
  , configToRepresentation
  ) where

import           Cardano.Logging.Types               hiding (backends, detail,
                                                      maxFrequency, severity)

import           Control.Applicative                 ((<|>))
import           Control.Exception                   (throwIO)
import qualified Data.Aeson                          as AE
import           Data.List                           as List (foldl')
import qualified Data.Map.Strict                     as Map
import           Data.Maybe
import           Data.Text                           as T (Text, intercalate, last,
                                                           null, snoc, splitOn)
import           Data.Yaml                           hiding (decodeFileEither)
import           Data.Yaml.Include                   (decodeFileEither)
import           System.Directory                    (doesFileExist)

-- -----------------------------------------------------------------------------
-- Configuration file

-- | The external representation of a configuration file
data ConfigRepresentation = ConfigRepresentation {
    ConfigRepresentation -> OptionsRepresentation
traceOptions                      :: OptionsRepresentation
  , ConfigRepresentation -> Maybe TraceOptionForwarder
traceOptionForwarder              :: Maybe TraceOptionForwarder
  , ConfigRepresentation -> Maybe Text
traceOptionNodeName               :: Maybe Text
  , ConfigRepresentation -> Maybe Text
traceOptionMetricsPrefix          :: Maybe Text
  , ConfigRepresentation -> Maybe Int
traceOptionResourceFrequency      :: Maybe Int
  , ConfigRepresentation -> Maybe Int
traceOptionLedgerMetricsFrequency :: Maybe Int
  , ConfigRepresentation -> Maybe PrometheusSimpleRun
tracePrometheusSimpleRun          :: Maybe PrometheusSimpleRun
  }
  deriving Int -> ConfigRepresentation -> ShowS
[ConfigRepresentation] -> ShowS
ConfigRepresentation -> String
(Int -> ConfigRepresentation -> ShowS)
-> (ConfigRepresentation -> String)
-> ([ConfigRepresentation] -> ShowS)
-> Show ConfigRepresentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigRepresentation -> ShowS
showsPrec :: Int -> ConfigRepresentation -> ShowS
$cshow :: ConfigRepresentation -> String
show :: ConfigRepresentation -> String
$cshowList :: [ConfigRepresentation] -> ShowS
showList :: [ConfigRepresentation] -> ShowS
Show

instance AE.FromJSON ConfigRepresentation where
    parseJSON :: Value -> Parser ConfigRepresentation
parseJSON = String
-> (Object -> Parser ConfigRepresentation)
-> Value
-> Parser ConfigRepresentation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HermodTracing" ((Object -> Parser ConfigRepresentation)
 -> Value -> Parser ConfigRepresentation)
-> (Object -> Parser ConfigRepresentation)
-> Value
-> Parser ConfigRepresentation
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Object -> Parser ConfigRepresentation
parseAsLegacy Object
obj Parser ConfigRepresentation
-> Parser ConfigRepresentation -> Parser ConfigRepresentation
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser ConfigRepresentation
parseAsOuter Object
obj Parser ConfigRepresentation
-> Parser ConfigRepresentation -> Parser ConfigRepresentation
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser ConfigRepresentation
parseAsInner Object
obj
      where
        -- the legacy format which current config files use
        parseAsLegacy :: Object -> Parser ConfigRepresentation
parseAsLegacy Object
obj =
          OptionsRepresentation
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe PrometheusSimpleRun
-> ConfigRepresentation
ConfigRepresentation
            (OptionsRepresentation
 -> Maybe TraceOptionForwarder
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe PrometheusSimpleRun
 -> ConfigRepresentation)
-> Parser OptionsRepresentation
-> Parser
     (Maybe TraceOptionForwarder
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser OptionsRepresentation
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"TraceOptions"
            Parser
  (Maybe TraceOptionForwarder
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe TraceOptionForwarder)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe TraceOptionForwarder)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionForwarder"
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionNodeName"
            Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionMetricsPrefix"
            Parser
  (Maybe Int
   -> Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionResourceFrequency"
            Parser
  (Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe Int)
-> Parser (Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionLedgerMetricsFrequency"
            Parser (Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe PrometheusSimpleRun)
-> Parser ConfigRepresentation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe PrometheusSimpleRun)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TracePrometheusSimpleRun"

        -- configuration object has a top-level key -> object value "HermodTracing": {}
        parseAsOuter :: Object -> Parser ConfigRepresentation
parseAsOuter Object
obj =
          Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"HermodTracing" Parser Object
-> (Object -> Parser ConfigRepresentation)
-> Parser ConfigRepresentation
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Parser ConfigRepresentation
parseAsInner

        -- configuration object uses all HermodTracing key/values top-level
        parseAsInner :: Object -> Parser ConfigRepresentation
parseAsInner Object
obj =
          OptionsRepresentation
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe PrometheusSimpleRun
-> ConfigRepresentation
ConfigRepresentation
            (OptionsRepresentation
 -> Maybe TraceOptionForwarder
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe PrometheusSimpleRun
 -> ConfigRepresentation)
-> Parser OptionsRepresentation
-> Parser
     (Maybe TraceOptionForwarder
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser OptionsRepresentation
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Options"
            Parser
  (Maybe TraceOptionForwarder
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe TraceOptionForwarder)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe TraceOptionForwarder)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Forwarder"
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe PrometheusSimpleRun
      -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ApplicationName"
            Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe PrometheusSimpleRun
   -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"MetricsPrefix"

            -- Those two will eventually be covered by a generalized configration for named periodic tracers.
            Parser
  (Maybe Int
   -> Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> Parser (Maybe Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
            Parser
  (Maybe Int -> Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe Int)
-> Parser (Maybe PrometheusSimpleRun -> ConfigRepresentation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> Parser (Maybe Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing

            Parser (Maybe PrometheusSimpleRun -> ConfigRepresentation)
-> Parser (Maybe PrometheusSimpleRun)
-> Parser ConfigRepresentation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe PrometheusSimpleRun)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"PrometheusSimpleRun"


instance AE.ToJSON ConfigRepresentation where
  toJSON :: ConfigRepresentation -> Value
toJSON ConfigRepresentation{Maybe Int
Maybe Text
Maybe PrometheusSimpleRun
Maybe TraceOptionForwarder
OptionsRepresentation
traceOptions :: ConfigRepresentation -> OptionsRepresentation
traceOptionForwarder :: ConfigRepresentation -> Maybe TraceOptionForwarder
traceOptionNodeName :: ConfigRepresentation -> Maybe Text
traceOptionMetricsPrefix :: ConfigRepresentation -> Maybe Text
traceOptionResourceFrequency :: ConfigRepresentation -> Maybe Int
traceOptionLedgerMetricsFrequency :: ConfigRepresentation -> Maybe Int
tracePrometheusSimpleRun :: ConfigRepresentation -> Maybe PrometheusSimpleRun
traceOptions :: OptionsRepresentation
traceOptionForwarder :: Maybe TraceOptionForwarder
traceOptionNodeName :: Maybe Text
traceOptionMetricsPrefix :: Maybe Text
traceOptionResourceFrequency :: Maybe Int
traceOptionLedgerMetricsFrequency :: Maybe Int
tracePrometheusSimpleRun :: Maybe PrometheusSimpleRun
..} = [Pair] -> Value
object
    [ Key
"Options"                  Key -> OptionsRepresentation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OptionsRepresentation
traceOptions
    , Key
"Forwarder"                Key -> Maybe TraceOptionForwarder -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe TraceOptionForwarder
traceOptionForwarder
    , Key
"ApplicationName"          Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
traceOptionNodeName
    , Key
"MetricsPrefix"            Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
traceOptionMetricsPrefix
    , Key
"PrometheusSimpleRun"      Key -> Maybe PrometheusSimpleRun -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PrometheusSimpleRun
tracePrometheusSimpleRun
    ]

type OptionsRepresentation = Map.Map Text ConfigOptionRep

-- | In the external configuration representation for configuration files
-- all options for a namespace are part of a record
data ConfigOptionRep = ConfigOptionRep
    { ConfigOptionRep -> Maybe SeverityF
severity     :: Maybe SeverityF
    , ConfigOptionRep -> Maybe DetailLevel
detail       :: Maybe DetailLevel
    , ConfigOptionRep -> Maybe [BackendConfig]
backends     :: Maybe [BackendConfig]
    , ConfigOptionRep -> Maybe Double
maxFrequency :: Maybe Double
    }
  deriving Int -> ConfigOptionRep -> ShowS
[ConfigOptionRep] -> ShowS
ConfigOptionRep -> String
(Int -> ConfigOptionRep -> ShowS)
-> (ConfigOptionRep -> String)
-> ([ConfigOptionRep] -> ShowS)
-> Show ConfigOptionRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigOptionRep -> ShowS
showsPrec :: Int -> ConfigOptionRep -> ShowS
$cshow :: ConfigOptionRep -> String
show :: ConfigOptionRep -> String
$cshowList :: [ConfigOptionRep] -> ShowS
showList :: [ConfigOptionRep] -> ShowS
Show

instance AE.FromJSON ConfigOptionRep where
  parseJSON :: Value -> Parser ConfigOptionRep
parseJSON = String
-> (Object -> Parser ConfigOptionRep)
-> Value
-> Parser ConfigOptionRep
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConfigOptionRep" ((Object -> Parser ConfigOptionRep)
 -> Value -> Parser ConfigOptionRep)
-> (Object -> Parser ConfigOptionRep)
-> Value
-> Parser ConfigOptionRep
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe SeverityF
-> Maybe DetailLevel
-> Maybe [BackendConfig]
-> Maybe Double
-> ConfigOptionRep
ConfigOptionRep
      (Maybe SeverityF
 -> Maybe DetailLevel
 -> Maybe [BackendConfig]
 -> Maybe Double
 -> ConfigOptionRep)
-> Parser (Maybe SeverityF)
-> Parser
     (Maybe DetailLevel
      -> Maybe [BackendConfig] -> Maybe Double -> ConfigOptionRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe SeverityF)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"severity"
      Parser
  (Maybe DetailLevel
   -> Maybe [BackendConfig] -> Maybe Double -> ConfigOptionRep)
-> Parser (Maybe DetailLevel)
-> Parser
     (Maybe [BackendConfig] -> Maybe Double -> ConfigOptionRep)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe DetailLevel)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"detail"
      Parser (Maybe [BackendConfig] -> Maybe Double -> ConfigOptionRep)
-> Parser (Maybe [BackendConfig])
-> Parser (Maybe Double -> ConfigOptionRep)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe [BackendConfig])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backends"
      Parser (Maybe Double -> ConfigOptionRep)
-> Parser (Maybe Double) -> Parser ConfigOptionRep
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxFrequency"

instance AE.ToJSON ConfigOptionRep where
  toJSON :: ConfigOptionRep -> Value
toJSON ConfigOptionRep{Maybe Double
Maybe [BackendConfig]
Maybe SeverityF
Maybe DetailLevel
severity :: ConfigOptionRep -> Maybe SeverityF
detail :: ConfigOptionRep -> Maybe DetailLevel
backends :: ConfigOptionRep -> Maybe [BackendConfig]
maxFrequency :: ConfigOptionRep -> Maybe Double
severity :: Maybe SeverityF
detail :: Maybe DetailLevel
backends :: Maybe [BackendConfig]
maxFrequency :: Maybe Double
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
      [ (Key
"severity" Key -> SeverityF -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)     (SeverityF -> Pair) -> Maybe SeverityF -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SeverityF
severity
      , (Key
"detail" Key -> DetailLevel -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)       (DetailLevel -> Pair) -> Maybe DetailLevel -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DetailLevel
detail
      , (Key
"backends" Key -> [BackendConfig] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=)     ([BackendConfig] -> Pair) -> Maybe [BackendConfig] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [BackendConfig]
backends
      , (Key
"maxFrequency" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Double -> Pair) -> Maybe Double -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
maxFrequency
      ]

instance AE.ToJSON TraceConfig where
  toJSON :: TraceConfig -> Value
toJSON = ConfigRepresentation -> Value
forall a. ToJSON a => a -> Value
toJSON (ConfigRepresentation -> Value)
-> (TraceConfig -> ConfigRepresentation) -> TraceConfig -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceConfig -> ConfigRepresentation
configToRepresentation


-- | Creates the minimal viable configuration by only setting fallback values in an empty TraceConfig.
--   Fallback options for the namespace root: Notice severity, normal detail, JSON stdout logging.
--   Notice severity was chosen as it will never filter out any actionable traces while creating minimal noise in the log.
mkConfiguration :: TraceConfig
mkConfiguration :: TraceConfig
mkConfiguration = SeverityS -> DetailLevel -> BackendConfig -> TraceConfig
mkConfigurationWithFallback SeverityS
Notice DetailLevel
DNormal (FormatLogging -> BackendConfig
Stdout FormatLogging
MachineFormat)

-- | Creates the minimal viable configuration by only setting custom fallback values in an empty TraceConfig.
--   Fallback options for the namespace root: custom values.
mkConfigurationWithFallback :: SeverityS -> DetailLevel -> BackendConfig -> TraceConfig
mkConfigurationWithFallback :: SeverityS -> DetailLevel -> BackendConfig -> TraceConfig
mkConfigurationWithFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack = SeverityS
-> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack TraceConfig
emptyTraceConfig

-- | Read a configuration file and return the internal representation.
--   Fallback options for the namespace root: Notice severity, normal detail, JSON stdout logging.
readConfiguration :: FilePath -> IO TraceConfig
readConfiguration :: String -> IO TraceConfig
readConfiguration = SeverityS
-> DetailLevel -> BackendConfig -> String -> IO TraceConfig
readConfigurationWithFallback SeverityS
Notice DetailLevel
DNormal (FormatLogging -> BackendConfig
Stdout FormatLogging
MachineFormat)

-- | Read a configuration file and return the internal representation.
--   Fallback options for the namespace root: custom values.
readConfigurationWithFallback :: SeverityS -> DetailLevel -> BackendConfig -> FilePath -> IO TraceConfig
readConfigurationWithFallback :: SeverityS
-> DetailLevel -> BackendConfig -> String -> IO TraceConfig
readConfigurationWithFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack = (TraceConfig -> TraceConfig) -> String -> IO TraceConfig
readConfigurationInt TraceConfig -> TraceConfig
apFallback
  where
    apFallback :: TraceConfig -> TraceConfig
apFallback = SeverityS
-> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack

-- | Read a configuration file and return the internal representation.
--   This will silently provide a minimal viable config via @mkConfiguration@ when the file is absent.
--   Fallback options for the namespace root: Notice severity, normal detail, JSON stdout logging.
readConfiguration' :: FilePath -> IO TraceConfig
readConfiguration' :: String -> IO TraceConfig
readConfiguration' = SeverityS
-> DetailLevel -> BackendConfig -> String -> IO TraceConfig
readConfigurationWithFallback' SeverityS
Notice DetailLevel
DNormal (FormatLogging -> BackendConfig
Stdout FormatLogging
MachineFormat)

-- | Read a configuration file and return the internal representation.
--   This will silently provide a minimal viable config via @mkConfigurationWithFallback@ when the file is absent.
--   Fallback options for the namespace root: custom values.
readConfigurationWithFallback' :: SeverityS -> DetailLevel -> BackendConfig -> FilePath -> IO TraceConfig
readConfigurationWithFallback' :: SeverityS
-> DetailLevel -> BackendConfig -> String -> IO TraceConfig
readConfigurationWithFallback' SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack String
fp = do
  Bool
exists <- String -> IO Bool
doesFileExist String
fp
  if Bool
exists
    then (TraceConfig -> TraceConfig) -> String -> IO TraceConfig
readConfigurationInt (SeverityS
-> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack) String
fp
    else TraceConfig -> IO TraceConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceConfig -> IO TraceConfig) -> TraceConfig -> IO TraceConfig
forall a b. (a -> b) -> a -> b
$ SeverityS -> DetailLevel -> BackendConfig -> TraceConfig
mkConfigurationWithFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack

-- | Read a configuration file and return the internal representation.
--   TraceConfig fields not specified in the file will be taken from the provided @defaultConf@ (when given there).
--   Fallback options for the namespace root: Notice severity, normal detail, JSON stdout logging.
readConfigurationWithDefault :: FilePath -> TraceConfig -> IO TraceConfig
readConfigurationWithDefault :: String -> TraceConfig -> IO TraceConfig
readConfigurationWithDefault = SeverityS
-> DetailLevel
-> BackendConfig
-> String
-> TraceConfig
-> IO TraceConfig
readConfigurationWithFallbackAndDefault SeverityS
Notice DetailLevel
DNormal (FormatLogging -> BackendConfig
Stdout FormatLogging
MachineFormat)

-- | Read a configuration file and return the internal representation.
--   TraceConfig fields not specified in the file will be taken from the provided @defaultConf@ (when given there).
--   Fallback options for the namespace root: custom values.
readConfigurationWithFallbackAndDefault :: SeverityS -> DetailLevel -> BackendConfig -> FilePath -> TraceConfig -> IO TraceConfig
readConfigurationWithFallbackAndDefault :: SeverityS
-> DetailLevel
-> BackendConfig
-> String
-> TraceConfig
-> IO TraceConfig
readConfigurationWithFallbackAndDefault SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack String
fp TraceConfig
defaultConf = (TraceConfig -> TraceConfig) -> String -> IO TraceConfig
readConfigurationInt (TraceConfig -> TraceConfig
apFallback (TraceConfig -> TraceConfig)
-> (TraceConfig -> TraceConfig) -> TraceConfig -> TraceConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceConfig -> TraceConfig
apDefault) String
fp
  where
    apFallback :: TraceConfig -> TraceConfig
apFallback = SeverityS
-> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack
    apDefault :: TraceConfig -> TraceConfig
apDefault  = TraceConfig -> TraceConfig -> TraceConfig
mergeWithDefault TraceConfig
defaultConf


-- In the config object, if the "HermodTracing" value is not an Object itself but a String,
-- it will be interpreted as a file path reference to the actual tracing config object.
newtype ExternalFile = ExternalFile FilePath

instance FromJSON ExternalFile where
  parseJSON :: Value -> Parser ExternalFile
parseJSON = String
-> (Object -> Parser ExternalFile) -> Value -> Parser ExternalFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HermodTracing" ((Object -> Parser ExternalFile) -> Value -> Parser ExternalFile)
-> (Object -> Parser ExternalFile) -> Value -> Parser ExternalFile
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    String -> ExternalFile
ExternalFile (String -> ExternalFile) -> Parser String -> Parser ExternalFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"HermodTracing"

readConfigurationInt ::
     (TraceConfig -> TraceConfig)
  -> FilePath
  -> IO TraceConfig
readConfigurationInt :: (TraceConfig -> TraceConfig) -> String -> IO TraceConfig
readConfigurationInt TraceConfig -> TraceConfig
modifyConf = Int -> String -> IO TraceConfig
go Int
4
  where
  go :: Int -> FilePath -> IO TraceConfig
  go :: Int -> String -> IO TraceConfig
go Int
redirects String
fp = do
    Either ParseException ExternalFile
external :: Either ParseException ExternalFile <- String -> IO (Either ParseException ExternalFile)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fp
    case Either ParseException ExternalFile
external of
      Right (ExternalFile String
fp')
        | Int
redirects Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> String -> IO TraceConfig
go (Int
redirects Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
fp'
        | Bool
otherwise     -> String -> IO TraceConfig
forall a. HasCallStack => String -> a
error String
"hermod.readConfigurationInt: too many redirects"
      Left{} -> do
        Either ParseException ConfigRepresentation
confRep_ :: Either ParseException ConfigRepresentation <- String -> IO (Either ParseException ConfigRepresentation)
forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
fp
        case Either ParseException ConfigRepresentation
confRep_ of
          Right ConfigRepresentation
confRep -> TraceConfig -> IO TraceConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceConfig -> IO TraceConfig) -> TraceConfig -> IO TraceConfig
forall a b. (a -> b) -> a -> b
$! TraceConfig -> TraceConfig
modifyConf (TraceConfig -> TraceConfig) -> TraceConfig -> TraceConfig
forall a b. (a -> b) -> a -> b
$ ConfigRepresentation -> TraceConfig
representationToConfig (ConfigRepresentation -> TraceConfig)
-> ConfigRepresentation -> TraceConfig
forall a b. (a -> b) -> a -> b
$ ConfigRepresentation -> ConfigRepresentation
unAliasRoot ConfigRepresentation
confRep
          Left ParseException
e        -> ParseException -> IO TraceConfig
forall e a. Exception e => e -> IO a
throwIO ParseException
e

-- right biased merge
mergeWithDefault :: TraceConfig -> TraceConfig -> TraceConfig
mergeWithDefault :: TraceConfig -> TraceConfig -> TraceConfig
mergeWithDefault TraceConfig
defaultConf TraceConfig
fileConf =
  Map [Text] [ConfigOption]
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe PrometheusSimpleRun
-> TraceConfig
TraceConfig
    (if (Bool -> Bool
not (Bool -> Bool)
-> (Map [Text] [ConfigOption] -> Bool)
-> Map [Text] [ConfigOption]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Text] [ConfigOption] -> Bool
forall k a. Map k a -> Bool
Map.null) (TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
fileConf)
      then TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
fileConf
      else TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
defaultConf)
    (TraceConfig -> Maybe TraceOptionForwarder
tcForwarder TraceConfig
fileConf Maybe TraceOptionForwarder
-> Maybe TraceOptionForwarder -> Maybe TraceOptionForwarder
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe TraceOptionForwarder
tcForwarder TraceConfig
defaultConf)
    (TraceConfig -> Maybe Text
tcNodeName TraceConfig
fileConf Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe Text
tcNodeName TraceConfig
defaultConf)
    (TraceConfig -> Maybe Text
tcMetricsPrefix TraceConfig
fileConf Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe Text
tcMetricsPrefix TraceConfig
defaultConf)
    (TraceConfig -> Maybe Int
tcResourceFrequency TraceConfig
fileConf Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe Int
tcResourceFrequency TraceConfig
defaultConf)
    (TraceConfig -> Maybe Int
tcLedgerMetricsFrequency TraceConfig
fileConf Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe Int
tcLedgerMetricsFrequency TraceConfig
defaultConf)
    (TraceConfig -> Maybe PrometheusSimpleRun
tcPrometheusSimpleRun TraceConfig
fileConf Maybe PrometheusSimpleRun
-> Maybe PrometheusSimpleRun -> Maybe PrometheusSimpleRun
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TraceConfig -> Maybe PrometheusSimpleRun
tcPrometheusSimpleRun TraceConfig
defaultConf)

-- left biased merge
mergeOptionRepFields :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
mergeOptionRepFields :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
mergeOptionRepFields ConfigOptionRep
o1 ConfigOptionRep
o2 =
  Maybe SeverityF
-> Maybe DetailLevel
-> Maybe [BackendConfig]
-> Maybe Double
-> ConfigOptionRep
ConfigOptionRep
    (ConfigOptionRep -> Maybe SeverityF
severity ConfigOptionRep
o1     Maybe SeverityF -> Maybe SeverityF -> Maybe SeverityF
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigOptionRep -> Maybe SeverityF
severity ConfigOptionRep
o2)
    (ConfigOptionRep -> Maybe DetailLevel
detail ConfigOptionRep
o1       Maybe DetailLevel -> Maybe DetailLevel -> Maybe DetailLevel
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigOptionRep -> Maybe DetailLevel
detail ConfigOptionRep
o2)
    (ConfigOptionRep -> Maybe [BackendConfig]
backends ConfigOptionRep
o1     Maybe [BackendConfig]
-> Maybe [BackendConfig] -> Maybe [BackendConfig]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigOptionRep -> Maybe [BackendConfig]
backends ConfigOptionRep
o2)
    (ConfigOptionRep -> Maybe Double
maxFrequency ConfigOptionRep
o1 Maybe Double -> Maybe Double -> Maybe Double
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigOptionRep -> Maybe Double
maxFrequency ConfigOptionRep
o2)

-- | Applies the fallback values to the namespace root, or creates a namespace root from them if none is present.
--   Furthermore, it ensures a metric prefix is properly namespaced, if there is one configured.
--   If you do not use any of mkConfiguration* or readConfiguration* to create your TraceConfig, but do it manually,
--   it is highly recommended to call @applyFallback@ on that TraceConfig value as a last step before using it.
applyFallback :: SeverityS -> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback :: SeverityS
-> DetailLevel -> BackendConfig -> TraceConfig -> TraceConfig
applyFallback SeverityS
fallbSev DetailLevel
fallbDet BackendConfig
fallbBack tc :: TraceConfig
tc@TraceConfig{Map [Text] [ConfigOption]
tcOptions :: TraceConfig -> Map [Text] [ConfigOption]
tcOptions :: Map [Text] [ConfigOption]
tcOptions, Maybe Text
tcMetricsPrefix :: TraceConfig -> Maybe Text
tcMetricsPrefix :: Maybe Text
tcMetricsPrefix} =
  TraceConfig
tc {tcOptions = Map.alter apply [] tcOptions, tcMetricsPrefix = sanitizePrefix `fmap` tcMetricsPrefix}
  where
    apply :: Maybe [ConfigOption] -> Maybe [ConfigOption]
apply Maybe [ConfigOption]
Nothing     = [ConfigOption] -> Maybe [ConfigOption]
forall a. a -> Maybe a
Just ([ConfigOption] -> Maybe [ConfigOption])
-> [ConfigOption] -> Maybe [ConfigOption]
forall a b. (a -> b) -> a -> b
$ ConfigOptionRep -> [ConfigOption]
representationToOptions ConfigOptionRep
fallback
    apply (Just [ConfigOption]
root) = [ConfigOption] -> Maybe [ConfigOption]
forall a. a -> Maybe a
Just ([ConfigOption] -> Maybe [ConfigOption])
-> [ConfigOption] -> Maybe [ConfigOption]
forall a b. (a -> b) -> a -> b
$ ConfigOptionRep -> [ConfigOption]
representationToOptions (ConfigOptionRep -> [ConfigOption])
-> ConfigOptionRep -> [ConfigOption]
forall a b. (a -> b) -> a -> b
$
      [ConfigOption] -> ConfigOptionRep
optionsToRepresentation [ConfigOption]
root ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
`mergeOptionRepFields` ConfigOptionRep
fallback

    fallback :: ConfigOptionRep
fallback = ConfigOptionRep
      { severity :: Maybe SeverityF
severity      = SeverityF -> Maybe SeverityF
forall a. a -> Maybe a
Just (Maybe SeverityS -> SeverityF
SeverityF (Maybe SeverityS -> SeverityF) -> Maybe SeverityS -> SeverityF
forall a b. (a -> b) -> a -> b
$ SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
fallbSev)
      , detail :: Maybe DetailLevel
detail        = DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
fallbDet
      , backends :: Maybe [BackendConfig]
backends      = [BackendConfig] -> Maybe [BackendConfig]
forall a. a -> Maybe a
Just [BackendConfig
fallbBack]
      , maxFrequency :: Maybe Double
maxFrequency  = Maybe Double
forall a. Maybe a
Nothing
      }

    sanitizePrefix :: Text -> Text
sanitizePrefix Text
t
      | Text -> Bool
T.null Text
t  = Text
t
      | Bool
otherwise = if HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Text
t else Text
t Text -> Char -> Text
`T.snoc` Char
'.'

-- The namespace root "" in the external representation can be aliased as "_root_".
-- Even though an empty JSON string is a valid key in an object, it does not
-- always play well with automations creating configs to enforce this.
-- This will remove aliasing from the representation; if both "_root_" and "" are defined in the config,
-- their options will be merged - however, this case should be avoided for clarity.
unAliasRoot :: ConfigRepresentation -> ConfigRepresentation
unAliasRoot :: ConfigRepresentation -> ConfigRepresentation
unAliasRoot confRep :: ConfigRepresentation
confRep@ConfigRepresentation{OptionsRepresentation
traceOptions :: ConfigRepresentation -> OptionsRepresentation
traceOptions :: OptionsRepresentation
traceOptions} =
  let
    alias :: Maybe ConfigOptionRep
alias = Text -> OptionsRepresentation -> Maybe ConfigOptionRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
theAlias OptionsRepresentation
traceOptions
    root :: Maybe ConfigOptionRep
root  = Text -> OptionsRepresentation -> Maybe ConfigOptionRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"" OptionsRepresentation
traceOptions
  in case Maybe ConfigOptionRep
alias Maybe ConfigOptionRep
-> Maybe ConfigOptionRep -> Maybe ConfigOptionRep
`combine` Maybe ConfigOptionRep
root of
    Maybe ConfigOptionRep
Nothing   -> ConfigRepresentation
confRep
    Just ConfigOptionRep
opts ->
      let m' :: OptionsRepresentation
m' = Text
-> ConfigOptionRep
-> OptionsRepresentation
-> OptionsRepresentation
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"" ConfigOptionRep
opts (OptionsRepresentation -> OptionsRepresentation)
-> OptionsRepresentation -> OptionsRepresentation
forall a b. (a -> b) -> a -> b
$ Text -> OptionsRepresentation -> OptionsRepresentation
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
theAlias OptionsRepresentation
traceOptions
      in  ConfigRepresentation
confRep {traceOptions = m'}
  where
    theAlias :: Text
    theAlias :: Text
theAlias = Text
"_root_"

    combine :: Maybe ConfigOptionRep
-> Maybe ConfigOptionRep -> Maybe ConfigOptionRep
combine (Just ConfigOptionRep
a) (Just ConfigOptionRep
b) = ConfigOptionRep -> Maybe ConfigOptionRep
forall a. a -> Maybe a
Just (ConfigOptionRep -> Maybe ConfigOptionRep)
-> ConfigOptionRep -> Maybe ConfigOptionRep
forall a b. (a -> b) -> a -> b
$ ConfigOptionRep
a ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
`mergeOptionRepFields` ConfigOptionRep
b
    combine Maybe ConfigOptionRep
a Maybe ConfigOptionRep
b               = Maybe ConfigOptionRep
a Maybe ConfigOptionRep
-> Maybe ConfigOptionRep -> Maybe ConfigOptionRep
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ConfigOptionRep
b

-- | Convert from external to internal representation
representationToConfig :: ConfigRepresentation -> TraceConfig
representationToConfig :: ConfigRepresentation -> TraceConfig
representationToConfig = TraceConfig -> ConfigRepresentation -> TraceConfig
transform TraceConfig
emptyTraceConfig
  where
    transform :: TraceConfig -> ConfigRepresentation -> TraceConfig
    transform :: TraceConfig -> ConfigRepresentation -> TraceConfig
transform TraceConfig {tcOptions :: TraceConfig -> Map [Text] [ConfigOption]
tcOptions=Map [Text] [ConfigOption]
to'} ConfigRepresentation
cr =
      let to'' :: Map [Text] [ConfigOption]
to''  = (Map [Text] [ConfigOption]
 -> (Text, ConfigOptionRep) -> Map [Text] [ConfigOption])
-> Map [Text] [ConfigOption]
-> [(Text, ConfigOptionRep)]
-> Map [Text] [ConfigOption]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ Map [Text] [ConfigOption]
tci (Text
nsp, ConfigOptionRep
opts') ->
                              let ns' :: [Text]
ns' = if Text -> Bool
T.null Text
nsp then [] else HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
"." Text
nsp
                              in ([ConfigOption] -> [ConfigOption] -> [ConfigOption])
-> [Text]
-> [ConfigOption]
-> Map [Text] [ConfigOption]
-> Map [Text] [ConfigOption]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
                                  [ConfigOption] -> [ConfigOption] -> [ConfigOption]
forall a. [a] -> [a] -> [a]
(++)
                                  [Text]
ns'
                                  (ConfigOptionRep -> [ConfigOption]
representationToOptions ConfigOptionRep
opts')
                                  Map [Text] [ConfigOption]
tci)
                           Map [Text] [ConfigOption]
to' (OptionsRepresentation -> [(Text, ConfigOptionRep)]
forall k a. Map k a -> [(k, a)]
Map.toList (ConfigRepresentation -> OptionsRepresentation
traceOptions ConfigRepresentation
cr))
      in Map [Text] [ConfigOption]
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe PrometheusSimpleRun
-> TraceConfig
TraceConfig
          Map [Text] [ConfigOption]
to''
          (ConfigRepresentation -> Maybe TraceOptionForwarder
traceOptionForwarder ConfigRepresentation
cr)
          (ConfigRepresentation -> Maybe Text
traceOptionNodeName ConfigRepresentation
cr)
          (ConfigRepresentation -> Maybe Text
traceOptionMetricsPrefix ConfigRepresentation
cr)
          (ConfigRepresentation -> Maybe Int
traceOptionResourceFrequency ConfigRepresentation
cr)
          (ConfigRepresentation -> Maybe Int
traceOptionLedgerMetricsFrequency ConfigRepresentation
cr)
          (ConfigRepresentation -> Maybe PrometheusSimpleRun
tracePrometheusSimpleRun ConfigRepresentation
cr)

-- | Convert options from external to internal representation
representationToOptions :: ConfigOptionRep -> [ConfigOption]
representationToOptions :: ConfigOptionRep -> [ConfigOption]
representationToOptions ConfigOptionRep{Maybe Double
Maybe [BackendConfig]
Maybe SeverityF
Maybe DetailLevel
severity :: ConfigOptionRep -> Maybe SeverityF
detail :: ConfigOptionRep -> Maybe DetailLevel
backends :: ConfigOptionRep -> Maybe [BackendConfig]
maxFrequency :: ConfigOptionRep -> Maybe Double
severity :: Maybe SeverityF
detail :: Maybe DetailLevel
backends :: Maybe [BackendConfig]
maxFrequency :: Maybe Double
..} =
  [Maybe ConfigOption] -> [ConfigOption]
forall a. [Maybe a] -> [a]
catMaybes
    [ SeverityF -> ConfigOption
ConfSeverity  (SeverityF -> ConfigOption)
-> Maybe SeverityF -> Maybe ConfigOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SeverityF
severity
    , DetailLevel -> ConfigOption
ConfDetail    (DetailLevel -> ConfigOption)
-> Maybe DetailLevel -> Maybe ConfigOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DetailLevel
detail
    , [BackendConfig] -> ConfigOption
ConfBackend   ([BackendConfig] -> ConfigOption)
-> Maybe [BackendConfig] -> Maybe ConfigOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [BackendConfig]
backends
    , Double -> ConfigOption
ConfLimiter   (Double -> ConfigOption) -> Maybe Double -> Maybe ConfigOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
maxFrequency
    ]

-- | Convert config from internal to external representation
configToRepresentation :: TraceConfig -> ConfigRepresentation
configToRepresentation :: TraceConfig -> ConfigRepresentation
configToRepresentation TraceConfig
traceConfig =
     OptionsRepresentation
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe PrometheusSimpleRun
-> ConfigRepresentation
ConfigRepresentation
        (Map [Text] [ConfigOption] -> OptionsRepresentation
toOptionRepresentation (TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
traceConfig))
        (TraceConfig -> Maybe TraceOptionForwarder
tcForwarder TraceConfig
traceConfig)
        (TraceConfig -> Maybe Text
tcNodeName TraceConfig
traceConfig)
        (TraceConfig -> Maybe Text
tcMetricsPrefix TraceConfig
traceConfig)
        (TraceConfig -> Maybe Int
tcResourceFrequency TraceConfig
traceConfig)
        (TraceConfig -> Maybe Int
tcLedgerMetricsFrequency TraceConfig
traceConfig)
        (TraceConfig -> Maybe PrometheusSimpleRun
tcPrometheusSimpleRun TraceConfig
traceConfig)
  where
    toOptionRepresentation :: Map.Map [Text] [ConfigOption]
                              ->  Map.Map Text ConfigOptionRep
    toOptionRepresentation :: Map [Text] [ConfigOption] -> OptionsRepresentation
toOptionRepresentation Map [Text] [ConfigOption]
internalOptMap =
      (OptionsRepresentation
 -> ([Text], [ConfigOption]) -> OptionsRepresentation)
-> OptionsRepresentation
-> [([Text], [ConfigOption])]
-> OptionsRepresentation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' OptionsRepresentation
-> ([Text], [ConfigOption]) -> OptionsRepresentation
conversion OptionsRepresentation
forall k a. Map k a
Map.empty (Map [Text] [ConfigOption] -> [([Text], [ConfigOption])]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] [ConfigOption]
internalOptMap)

    conversion :: Map.Map Text ConfigOptionRep
                -> ([Text],[ConfigOption])
                -> Map.Map Text ConfigOptionRep
    conversion :: OptionsRepresentation
-> ([Text], [ConfigOption]) -> OptionsRepresentation
conversion OptionsRepresentation
accuMap ([Text]
ns, [ConfigOption]
options) =
      let nssingle :: Text
nssingle   = Text -> [Text] -> Text
intercalate Text
"." [Text]
ns
          optionRep :: ConfigOptionRep
optionRep = [ConfigOption] -> ConfigOptionRep
optionsToRepresentation [ConfigOption]
options
      in  Text
-> ConfigOptionRep
-> OptionsRepresentation
-> OptionsRepresentation
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
nssingle ConfigOptionRep
optionRep OptionsRepresentation
accuMap

-- | Convert options from internal to external representation
optionsToRepresentation :: [ConfigOption] -> ConfigOptionRep
optionsToRepresentation :: [ConfigOption] -> ConfigOptionRep
optionsToRepresentation [ConfigOption]
opts =
  ConfigOptionRep
  { severity :: Maybe SeverityF
severity     = [SeverityF] -> Maybe SeverityF
forall a. [a] -> Maybe a
listToMaybe [SeverityF
d | ConfSeverity SeverityF
d <- [ConfigOption]
opts]
  , detail :: Maybe DetailLevel
detail       = [DetailLevel] -> Maybe DetailLevel
forall a. [a] -> Maybe a
listToMaybe [DetailLevel
d | ConfDetail DetailLevel
d <- [ConfigOption]
opts]
  , backends :: Maybe [BackendConfig]
backends     = [[BackendConfig]] -> Maybe [BackendConfig]
forall a. [a] -> Maybe a
listToMaybe [[BackendConfig]
d | ConfBackend [BackendConfig]
d <- [ConfigOption]
opts]
  , maxFrequency :: Maybe Double
maxFrequency = [Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe [Double
d | ConfLimiter Double
d <- [ConfigOption]
opts]
  }