{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Logging.ConfigurationParser
  (
    readConfiguration
  , readConfigurationWithDefault
  , configToRepresentation
  ) where

import           Cardano.Logging.Types

import           Control.Applicative ((<|>))
import           Control.Exception (throwIO)
import qualified Data.Aeson as AE
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import           Data.List as List (foldl')
import qualified Data.Map.Strict as Map
import           Data.Maybe (catMaybes, listToMaybe)
import           Data.Text (Text, intercalate, split)
import           Data.Yaml

-- -----------------------------------------------------------------------------
-- 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
  }
  deriving (ConfigRepresentation -> ConfigRepresentation -> Bool
(ConfigRepresentation -> ConfigRepresentation -> Bool)
-> (ConfigRepresentation -> ConfigRepresentation -> Bool)
-> Eq ConfigRepresentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigRepresentation -> ConfigRepresentation -> Bool
== :: ConfigRepresentation -> ConfigRepresentation -> Bool
$c/= :: ConfigRepresentation -> ConfigRepresentation -> Bool
/= :: ConfigRepresentation -> ConfigRepresentation -> Bool
Eq, Eq ConfigRepresentation
Eq ConfigRepresentation =>
(ConfigRepresentation -> ConfigRepresentation -> Ordering)
-> (ConfigRepresentation -> ConfigRepresentation -> Bool)
-> (ConfigRepresentation -> ConfigRepresentation -> Bool)
-> (ConfigRepresentation -> ConfigRepresentation -> Bool)
-> (ConfigRepresentation -> ConfigRepresentation -> Bool)
-> (ConfigRepresentation
    -> ConfigRepresentation -> ConfigRepresentation)
-> (ConfigRepresentation
    -> ConfigRepresentation -> ConfigRepresentation)
-> Ord ConfigRepresentation
ConfigRepresentation -> ConfigRepresentation -> Bool
ConfigRepresentation -> ConfigRepresentation -> Ordering
ConfigRepresentation
-> ConfigRepresentation -> ConfigRepresentation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfigRepresentation -> ConfigRepresentation -> Ordering
compare :: ConfigRepresentation -> ConfigRepresentation -> Ordering
$c< :: ConfigRepresentation -> ConfigRepresentation -> Bool
< :: ConfigRepresentation -> ConfigRepresentation -> Bool
$c<= :: ConfigRepresentation -> ConfigRepresentation -> Bool
<= :: ConfigRepresentation -> ConfigRepresentation -> Bool
$c> :: ConfigRepresentation -> ConfigRepresentation -> Bool
> :: ConfigRepresentation -> ConfigRepresentation -> Bool
$c>= :: ConfigRepresentation -> ConfigRepresentation -> Bool
>= :: ConfigRepresentation -> ConfigRepresentation -> Bool
$cmax :: ConfigRepresentation
-> ConfigRepresentation -> ConfigRepresentation
max :: ConfigRepresentation
-> ConfigRepresentation -> ConfigRepresentation
$cmin :: ConfigRepresentation
-> ConfigRepresentation -> ConfigRepresentation
min :: ConfigRepresentation
-> ConfigRepresentation -> ConfigRepresentation
Ord, 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 (Object Object
obj) = OptionsRepresentation
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> ConfigRepresentation
ConfigRepresentation
                           (OptionsRepresentation
 -> Maybe TraceOptionForwarder
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> ConfigRepresentation)
-> Parser OptionsRepresentation
-> Parser
     (Maybe TraceOptionForwarder
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> 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
   -> ConfigRepresentation)
-> Parser (Maybe TraceOptionForwarder)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Int -> Maybe Int -> 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 -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Int -> Maybe Int -> 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 -> ConfigRepresentation)
-> Parser (Maybe Text)
-> Parser (Maybe Int -> Maybe Int -> 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 -> ConfigRepresentation)
-> Parser (Maybe Int) -> Parser (Maybe Int -> 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 -> ConfigRepresentation)
-> Parser (Maybe Int) -> 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 Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"TraceOptionLedgerMetricsFrequency"
    parseJSON Value
_ = Parser ConfigRepresentation
forall a. Monoid a => a
mempty

instance AE.ToJSON ConfigRepresentation where
  toJSON :: ConfigRepresentation -> Value
toJSON ConfigRepresentation{Maybe Int
Maybe Text
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
traceOptions :: OptionsRepresentation
traceOptionForwarder :: Maybe TraceOptionForwarder
traceOptionNodeName :: Maybe Text
traceOptionMetricsPrefix :: Maybe Text
traceOptionResourceFrequency :: Maybe Int
traceOptionLedgerMetricsFrequency :: Maybe Int
..} = [Pair] -> Value
object
    [ Key
"TraceOptions"                  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
"TraceOptionForwarder"          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
"TraceOptionNodeName"           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
"TraceOptionMetricsPrefix"      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
"TraceOptionResourceFrequency"  Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
traceOptionResourceFrequency
    , Key
"TraceOptionLedgerMetricsFrequency" Key -> Maybe Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
traceOptionLedgerMetricsFrequency
    ]

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 (ConfigOptionRep -> ConfigOptionRep -> Bool
(ConfigOptionRep -> ConfigOptionRep -> Bool)
-> (ConfigOptionRep -> ConfigOptionRep -> Bool)
-> Eq ConfigOptionRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigOptionRep -> ConfigOptionRep -> Bool
== :: ConfigOptionRep -> ConfigOptionRep -> Bool
$c/= :: ConfigOptionRep -> ConfigOptionRep -> Bool
/= :: ConfigOptionRep -> ConfigOptionRep -> Bool
Eq, Eq ConfigOptionRep
Eq ConfigOptionRep =>
(ConfigOptionRep -> ConfigOptionRep -> Ordering)
-> (ConfigOptionRep -> ConfigOptionRep -> Bool)
-> (ConfigOptionRep -> ConfigOptionRep -> Bool)
-> (ConfigOptionRep -> ConfigOptionRep -> Bool)
-> (ConfigOptionRep -> ConfigOptionRep -> Bool)
-> (ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep)
-> (ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep)
-> Ord ConfigOptionRep
ConfigOptionRep -> ConfigOptionRep -> Bool
ConfigOptionRep -> ConfigOptionRep -> Ordering
ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfigOptionRep -> ConfigOptionRep -> Ordering
compare :: ConfigOptionRep -> ConfigOptionRep -> Ordering
$c< :: ConfigOptionRep -> ConfigOptionRep -> Bool
< :: ConfigOptionRep -> ConfigOptionRep -> Bool
$c<= :: ConfigOptionRep -> ConfigOptionRep -> Bool
<= :: ConfigOptionRep -> ConfigOptionRep -> Bool
$c> :: ConfigOptionRep -> ConfigOptionRep -> Bool
> :: ConfigOptionRep -> ConfigOptionRep -> Bool
$c>= :: ConfigOptionRep -> ConfigOptionRep -> Bool
>= :: ConfigOptionRep -> ConfigOptionRep -> Bool
$cmax :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
max :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
$cmin :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
min :: ConfigOptionRep -> ConfigOptionRep -> ConfigOptionRep
Ord, 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 (Object 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"

  parseJSON Value
_ = Parser ConfigOptionRep
forall a. Monoid a => a
mempty

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] -> [Pair]
conss [])
    where
      consMay :: Key -> Maybe a -> [b] -> [b]
consMay Key
attr = ([b] -> [b]) -> (a -> [b] -> [b]) -> Maybe a -> [b] -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [b] -> [b]
forall a. a -> a
id ((:) (b -> [b] -> [b]) -> (a -> b) -> a -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
attr Key -> a -> b
forall v. ToJSON v => Key -> v -> b
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=))
      conss :: [Pair] -> [Pair]
conss = Key -> Maybe SeverityF -> [Pair] -> [Pair]
forall {e} {b} {a}.
(KeyValue e b, ToJSON a) =>
Key -> Maybe a -> [b] -> [b]
consMay Key
"severity" Maybe SeverityF
severity
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe DetailLevel -> [Pair] -> [Pair]
forall {e} {b} {a}.
(KeyValue e b, ToJSON a) =>
Key -> Maybe a -> [b] -> [b]
consMay Key
"detail" Maybe DetailLevel
detail
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe [BackendConfig] -> [Pair] -> [Pair]
forall {e} {b} {a}.
(KeyValue e b, ToJSON a) =>
Key -> Maybe a -> [b] -> [b]
consMay Key
"backends" Maybe [BackendConfig]
backends
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Double -> [Pair] -> [Pair]
forall {e} {b} {a}.
(KeyValue e b, ToJSON a) =>
Key -> Maybe a -> [b] -> [b]
consMay Key
"maxFrequency" Maybe Double
maxFrequency

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

-- | Read a configuration file and returns the internal representation
readConfiguration :: FilePath -> IO TraceConfig
readConfiguration :: String -> IO TraceConfig
readConfiguration String
fp =
    (ParseException -> IO TraceConfig)
-> (TraceConfig -> IO TraceConfig)
-> Either ParseException TraceConfig
-> IO TraceConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO TraceConfig
forall e a. Exception e => e -> IO a
throwIO TraceConfig -> IO TraceConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException TraceConfig -> IO TraceConfig)
-> (ByteString -> Either ParseException TraceConfig)
-> ByteString
-> IO TraceConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException TraceConfig
parseRepresentation (ByteString -> IO TraceConfig) -> IO ByteString -> IO TraceConfig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
fp

-- | Read a configuration file and returns the internal representation
-- Uses values which are not in the file fram the defaultConfig
readConfigurationWithDefault :: FilePath -> TraceConfig -> IO TraceConfig
readConfigurationWithDefault :: String -> TraceConfig -> IO TraceConfig
readConfigurationWithDefault String
fp TraceConfig
defaultConf = do
    TraceConfig
fileConf <- (ParseException -> IO TraceConfig)
-> (TraceConfig -> IO TraceConfig)
-> Either ParseException TraceConfig
-> IO TraceConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO TraceConfig
forall e a. Exception e => e -> IO a
throwIO TraceConfig -> IO TraceConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException TraceConfig -> IO TraceConfig)
-> (ByteString -> Either ParseException TraceConfig)
-> ByteString
-> IO TraceConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException TraceConfig
parseRepresentation (ByteString -> IO TraceConfig) -> IO ByteString -> IO TraceConfig
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
fp
    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
mergeWithDefault TraceConfig
fileConf
  where
    mergeWithDefault ::  TraceConfig -> TraceConfig
    mergeWithDefault :: TraceConfig -> TraceConfig
mergeWithDefault TraceConfig
fileConf =
      Map [Text] [ConfigOption]
-> Maybe TraceOptionForwarder
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> 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)

-- | Parse the byteString as external representation and converts to internal
-- representation
parseRepresentation :: ByteString -> Either ParseException TraceConfig
parseRepresentation :: ByteString -> Either ParseException TraceConfig
parseRepresentation ByteString
bs = Either ParseException ConfigRepresentation
-> Either ParseException TraceConfig
transform (ByteString -> Either ParseException ConfigRepresentation
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' ByteString
bs)
  where
    transform ::
         Either ParseException ConfigRepresentation
         -> Either ParseException TraceConfig
    transform :: Either ParseException ConfigRepresentation
-> Either ParseException TraceConfig
transform (Left ParseException
e)   = ParseException -> Either ParseException TraceConfig
forall a b. a -> Either a b
Left ParseException
e
    transform (Right ConfigRepresentation
rl) = TraceConfig -> Either ParseException TraceConfig
forall a b. b -> Either a b
Right (TraceConfig -> Either ParseException TraceConfig)
-> TraceConfig -> Either ParseException TraceConfig
forall a b. (a -> b) -> a -> b
$ TraceConfig -> ConfigRepresentation -> TraceConfig
transform' TraceConfig
emptyTraceConfig ConfigRepresentation
rl
    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' = (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') Text
nsp
                                  ns'' :: [Text]
ns'' = if [Text]
ns' [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
""] then [] else [Text]
ns'
                                  ns''' :: [Text]
ns''' = case [Text]
ns'' of
                                            Text
"Cardano" : [Text]
tl -> [Text]
tl
                                            [Text]
other -> [Text]
other
                              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]
toConfigOptions 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
-> 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)


    -- | Convert from external to internal representation
    toConfigOptions :: ConfigOptionRep -> [ConfigOption]
    toConfigOptions :: ConfigOptionRep -> [ConfigOption]
toConfigOptions 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 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
-> 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)
  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
fromOptions [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

    fromOptions :: [ConfigOption] -> ConfigOptionRep
    fromOptions :: [ConfigOption] -> ConfigOptionRep
fromOptions [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]
      }