\subsection{Cardano.BM.Configuration.Model}
\label{code:Cardano.BM.Configuration.Model}

%if style == newcode
\begin{code}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

{-@ LIQUID "--max-case-expand=4" @-}

module Cardano.BM.Configuration.Model
    ( Configuration (..)
    , ConfigurationInternal (..)
    , empty
    , evalFilters
    , exportConfiguration
    , findSubTrace
    , getAggregatedKind
    , getAcceptAt
    , getBackends
    , getCachedScribes
    , getDefaultBackends
    , getEKGBindAddr
    , getForwardTo
    , getForwardDelay
    , getGUIport
    , getGraylogPort
    , getMapOption
    , getMonitors
    , getOption
    , getPrometheusBindAddr
    , getScribes
    , getSetupBackends
    , getSetupScribes
    , getTextOption
    , inspectSeverity
    , minSeverity
    , setAcceptAt
    , setAggregatedKind
    , setBackends
    , setCachedScribes
    , setDefaultAggregatedKind
    , setDefaultBackends
    , setDefaultScribes
    , setEKGBindAddr
    , setForwardTo
    , setForwardDelay
    , setGUIport
    , setGraylogPort
    , setMinSeverity
    , setMonitors
    , setOption
    , setPrometheusBindAddr
    , setScribes
    , setSetupBackends
    , setSetupScribes
    , setSeverity
    , setSubTrace
    , setTextOption
    , setup
    , setupFromRepresentation
    , testSubTrace
    , toRepresentation
    , updateOption
    ) where

import           Control.Applicative (Alternative ((<|>)))
import           Control.Concurrent.MVar (MVar, newMVar, readMVar,
                     modifyMVar_)
import           Control.Monad (when)
import qualified Data.HashMap.Strict as HM
import           Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Text as T
import           Data.Text (Text, pack, unpack)
import qualified Data.Vector as Vector
import           Data.Yaml as Yaml

import           Cardano.BM.Data.AggregatedKind (AggregatedKind(..))
import           Cardano.BM.Data.BackendKind
import qualified Cardano.BM.Data.Configuration as R
import           Cardano.BM.Data.Configuration (RemoteAddr(..), RemoteAddrNamed(..))
import           Cardano.BM.Data.LogItem (LogObject (..), LoggerName, LOContent (..), severity)
import           Cardano.BM.Data.MonitoringEval (MEvExpr, MEvPreCond, MEvAction)
import           Cardano.BM.Data.Output (ScribeDefinition (..), ScribeId,
                     ScribeKind (..))
import           Cardano.BM.Data.Rotation (RotationParameters (..))
import           Cardano.BM.Data.Severity
import           Cardano.BM.Data.SubTrace

\end{code}
%endif

\subsubsection{Configuration.Model}\label{code:Configuration}
\begin{figure}[ht]
\centering{
  \includegraphics[scale=0.54]{ConfigurationModel.pdf}
}
\caption{Configuration model}\label{fig:configuration}
\end{figure}

\begin{code}
type ConfigurationMVar = MVar ConfigurationInternal
newtype Configuration = Configuration
    { Configuration -> ConfigurationMVar
getCG :: ConfigurationMVar }

-- Our internal state; see {-"\nameref{fig:configuration}"-}
data ConfigurationInternal = ConfigurationInternal
    { ConfigurationInternal -> Severity
cgMinSeverity       :: Severity
    -- minimum severity level of every object that will be output
    , ConfigurationInternal -> Maybe RotationParameters
cgDefRotation       :: Maybe RotationParameters
    -- default rotation parameters
    , ConfigurationInternal -> HashMap LoggerName Severity
cgMapSeverity       :: HM.HashMap LoggerName Severity
    -- severity filter per loggername
    , ConfigurationInternal -> HashMap LoggerName SubTrace
cgMapSubtrace       :: HM.HashMap LoggerName SubTrace
    -- type of trace per loggername
    , ConfigurationInternal -> HashMap LoggerName Value
cgOptions           :: HM.HashMap Text Value
    -- options needed for tracing, logging and monitoring
    , ConfigurationInternal -> HashMap LoggerName [BackendKind]
cgMapBackend        :: HM.HashMap LoggerName [BackendKind]
    -- backends that will be used for the specific loggername
    , ConfigurationInternal -> [BackendKind]
cgDefBackendKs      :: [BackendKind]
    -- backends that will be used if a set of backends for the
    -- specific loggername is not set
    , ConfigurationInternal -> [BackendKind]
cgSetupBackends     :: [BackendKind]
    -- backends to setup; every backend to be used must have
    -- been declared here
    , ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribe         :: HM.HashMap LoggerName [ScribeId]
    -- katip scribes that will be used for the specific loggername
    , ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribeCache    :: HM.HashMap LoggerName [ScribeId]
    -- map to cache info of the cgMapScribe
    , ConfigurationInternal -> [LoggerName]
cgDefScribes        :: [ScribeId]
    -- katip scribes that will be used if a set of scribes for the
    -- specific loggername is not set
    , ConfigurationInternal -> [ScribeDefinition]
cgSetupScribes      :: [ScribeDefinition]
    -- katip scribes to setup; every scribe to be used must have
    -- been declared here
    , ConfigurationInternal -> HashMap LoggerName AggregatedKind
cgMapAggregatedKind :: HM.HashMap LoggerName AggregatedKind
    -- kind of Aggregated that will be used for the specific loggername
    , ConfigurationInternal -> AggregatedKind
cgDefAggregatedKind :: AggregatedKind
    -- kind of Aggregated that will be used if a set of scribes for the
    -- specific loggername is not set
    , ConfigurationInternal
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors          :: HM.HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
    , ConfigurationInternal -> Maybe Endpoint
cgBindAddrEKG       :: Maybe R.Endpoint
    -- host/port for EKG server
    , ConfigurationInternal -> Int
cgPortGraylog       :: Int
    -- port to Graylog server
    , ConfigurationInternal -> Maybe (String, Int)
cgBindAddrPrometheus :: Maybe (String, Int)
    -- host/port to bind Prometheus server at
    , ConfigurationInternal -> Maybe RemoteAddr
cgForwardTo         :: Maybe RemoteAddr
    -- trace acceptor to forward to
    , ConfigurationInternal -> Maybe Word
cgForwardDelay      :: Maybe Word
    -- delay before sending log items from the queue
    , ConfigurationInternal -> Maybe [RemoteAddrNamed]
cgAcceptAt          :: Maybe [RemoteAddrNamed]
    -- accept remote traces at this address
    , ConfigurationInternal -> Int
cgPortGUI           :: Int
    -- port for changes at runtime
    } deriving (Int -> ConfigurationInternal -> ShowS
[ConfigurationInternal] -> ShowS
ConfigurationInternal -> String
(Int -> ConfigurationInternal -> ShowS)
-> (ConfigurationInternal -> String)
-> ([ConfigurationInternal] -> ShowS)
-> Show ConfigurationInternal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationInternal] -> ShowS
$cshowList :: [ConfigurationInternal] -> ShowS
show :: ConfigurationInternal -> String
$cshow :: ConfigurationInternal -> String
showsPrec :: Int -> ConfigurationInternal -> ShowS
$cshowsPrec :: Int -> ConfigurationInternal -> ShowS
Show, ConfigurationInternal -> ConfigurationInternal -> Bool
(ConfigurationInternal -> ConfigurationInternal -> Bool)
-> (ConfigurationInternal -> ConfigurationInternal -> Bool)
-> Eq ConfigurationInternal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationInternal -> ConfigurationInternal -> Bool
$c/= :: ConfigurationInternal -> ConfigurationInternal -> Bool
== :: ConfigurationInternal -> ConfigurationInternal -> Bool
$c== :: ConfigurationInternal -> ConfigurationInternal -> Bool
Eq)

\end{code}

\subsubsection{Backends configured in the |Switchboard|}
For a given context name return the list of backends configured,
or, in case no such configuration exists, return the default backends.
\begin{code}
getBackends :: Configuration -> LoggerName -> IO [BackendKind]
getBackends :: Configuration -> LoggerName -> IO [BackendKind]
getBackends Configuration
configuration LoggerName
name = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration
    -- let outs = HM.lookup name (cgMapBackend cg)
    -- case outs of
    --     Nothing -> return (cgDefBackendKs cg)
    --     Just os -> return os
    let defs :: [BackendKind]
defs = ConfigurationInternal -> [BackendKind]
cgDefBackendKs ConfigurationInternal
cg
    let mapbks :: HashMap LoggerName [BackendKind]
mapbks = ConfigurationInternal -> HashMap LoggerName [BackendKind]
cgMapBackend ConfigurationInternal
cg
    let find_s :: [LoggerName] -> [BackendKind]
find_s [] = [BackendKind]
defs
        find_s [LoggerName]
lnames = case LoggerName
-> HashMap LoggerName [BackendKind] -> Maybe [BackendKind]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (LoggerName -> [LoggerName] -> LoggerName
T.intercalate LoggerName
"." [LoggerName]
lnames) HashMap LoggerName [BackendKind]
mapbks of
            Maybe [BackendKind]
Nothing -> [LoggerName] -> [BackendKind]
find_s ([LoggerName] -> [LoggerName]
forall a. [a] -> [a]
init [LoggerName]
lnames)
            Just [BackendKind]
os -> [BackendKind]
os
    [BackendKind] -> IO [BackendKind]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BackendKind] -> IO [BackendKind])
-> [BackendKind] -> IO [BackendKind]
forall a b. (a -> b) -> a -> b
$ [LoggerName] -> [BackendKind]
find_s ([LoggerName] -> [BackendKind]) -> [LoggerName] -> [BackendKind]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> LoggerName -> [LoggerName]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') LoggerName
name

getDefaultBackends :: Configuration -> IO [BackendKind]
getDefaultBackends :: Configuration -> IO [BackendKind]
getDefaultBackends Configuration
configuration =
    ConfigurationInternal -> [BackendKind]
cgDefBackendKs (ConfigurationInternal -> [BackendKind])
-> IO ConfigurationInternal -> IO [BackendKind]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setDefaultBackends :: Configuration -> [BackendKind] -> IO ()
setDefaultBackends :: Configuration -> [BackendKind] -> IO ()
setDefaultBackends Configuration
configuration [BackendKind]
bes =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgDefBackendKs :: [BackendKind]
cgDefBackendKs = [BackendKind]
bes }

setBackends :: Configuration -> LoggerName -> Maybe [BackendKind] -> IO ()
setBackends :: Configuration -> LoggerName -> Maybe [BackendKind] -> IO ()
setBackends Configuration
configuration LoggerName
name Maybe [BackendKind]
be =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapBackend :: HashMap LoggerName [BackendKind]
cgMapBackend = (Maybe [BackendKind] -> Maybe [BackendKind])
-> LoggerName
-> HashMap LoggerName [BackendKind]
-> HashMap LoggerName [BackendKind]
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe [BackendKind]
_ -> Maybe [BackendKind]
be) LoggerName
name (ConfigurationInternal -> HashMap LoggerName [BackendKind]
cgMapBackend ConfigurationInternal
cg) }

\end{code}

\subsubsection{Backends to be setup by the |Switchboard|}
Defines the list of |Backend|s that need to be setup by the |Switchboard|.
\begin{code}
setSetupBackends :: Configuration -> [BackendKind] -> IO ()
setSetupBackends :: Configuration -> [BackendKind] -> IO ()
setSetupBackends Configuration
configuration [BackendKind]
bes =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgSetupBackends :: [BackendKind]
cgSetupBackends = [BackendKind]
bes }

getSetupBackends :: Configuration -> IO [BackendKind]
getSetupBackends :: Configuration -> IO [BackendKind]
getSetupBackends Configuration
configuration =
    ConfigurationInternal -> [BackendKind]
cgSetupBackends (ConfigurationInternal -> [BackendKind])
-> IO ConfigurationInternal -> IO [BackendKind]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

\end{code}

\subsubsection{Scribes configured in the |Log| backend}
For a given context name return the list of scribes to output to,
or, in case no such configuration exists, return the default scribes to use.
\begin{code}
getScribes :: Configuration -> LoggerName -> IO [ScribeId]
getScribes :: Configuration -> LoggerName -> IO [LoggerName]
getScribes Configuration
configuration LoggerName
name = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (Configuration -> ConfigurationMVar
getCG Configuration
configuration)
    (Bool
updateCache, [LoggerName]
scribes) <- do
        let defs :: [LoggerName]
defs = ConfigurationInternal -> [LoggerName]
cgDefScribes ConfigurationInternal
cg
        let mapscribes :: HashMap LoggerName [LoggerName]
mapscribes = ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribe ConfigurationInternal
cg
        let find_s :: [LoggerName] -> [LoggerName]
find_s [] = [LoggerName]
defs
            find_s [LoggerName]
lnames = case LoggerName -> HashMap LoggerName [LoggerName] -> Maybe [LoggerName]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (LoggerName -> [LoggerName] -> LoggerName
T.intercalate LoggerName
"." [LoggerName]
lnames) HashMap LoggerName [LoggerName]
mapscribes of
                Maybe [LoggerName]
Nothing -> [LoggerName] -> [LoggerName]
find_s ([LoggerName] -> [LoggerName]
forall a. [a] -> [a]
init [LoggerName]
lnames)
                Just [LoggerName]
os -> [LoggerName]
os
        let outs :: Maybe [LoggerName]
outs = LoggerName -> HashMap LoggerName [LoggerName] -> Maybe [LoggerName]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribeCache ConfigurationInternal
cg)
        -- look if scribes are already cached
        (Bool, [LoggerName]) -> IO (Bool, [LoggerName])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, [LoggerName]) -> IO (Bool, [LoggerName]))
-> (Bool, [LoggerName]) -> IO (Bool, [LoggerName])
forall a b. (a -> b) -> a -> b
$ case Maybe [LoggerName]
outs of
            -- if no cached scribes found; search the appropriate scribes that
            -- they must inherit and update the cached map
            Maybe [LoggerName]
Nothing -> (Bool
True, [LoggerName] -> [LoggerName]
find_s ([LoggerName] -> [LoggerName]) -> [LoggerName] -> [LoggerName]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> LoggerName -> [LoggerName]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') LoggerName
name)
            Just [LoggerName]
os -> (Bool
False, [LoggerName]
os)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updateCache (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> LoggerName -> Maybe [LoggerName] -> IO ()
setCachedScribes Configuration
configuration LoggerName
name (Maybe [LoggerName] -> IO ()) -> Maybe [LoggerName] -> IO ()
forall a b. (a -> b) -> a -> b
$ [LoggerName] -> Maybe [LoggerName]
forall a. a -> Maybe a
Just [LoggerName]
scribes
    [LoggerName] -> IO [LoggerName]
forall (m :: * -> *) a. Monad m => a -> m a
return [LoggerName]
scribes

getCachedScribes :: Configuration -> LoggerName -> IO (Maybe [ScribeId])
getCachedScribes :: Configuration -> LoggerName -> IO (Maybe [LoggerName])
getCachedScribes Configuration
configuration LoggerName
name = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration
    Maybe [LoggerName] -> IO (Maybe [LoggerName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [LoggerName] -> IO (Maybe [LoggerName]))
-> Maybe [LoggerName] -> IO (Maybe [LoggerName])
forall a b. (a -> b) -> a -> b
$ LoggerName -> HashMap LoggerName [LoggerName] -> Maybe [LoggerName]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (HashMap LoggerName [LoggerName] -> Maybe [LoggerName])
-> HashMap LoggerName [LoggerName] -> Maybe [LoggerName]
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribeCache ConfigurationInternal
cg

setScribes :: Configuration -> LoggerName -> Maybe [ScribeId] -> IO ()
setScribes :: Configuration -> LoggerName -> Maybe [LoggerName] -> IO ()
setScribes Configuration
configuration LoggerName
name Maybe [LoggerName]
scribes =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapScribe :: HashMap LoggerName [LoggerName]
cgMapScribe = (Maybe [LoggerName] -> Maybe [LoggerName])
-> LoggerName
-> HashMap LoggerName [LoggerName]
-> HashMap LoggerName [LoggerName]
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe [LoggerName]
_ -> Maybe [LoggerName]
scribes) LoggerName
name (ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribe ConfigurationInternal
cg) }

setCachedScribes :: Configuration -> LoggerName -> Maybe [ScribeId] -> IO ()
setCachedScribes :: Configuration -> LoggerName -> Maybe [LoggerName] -> IO ()
setCachedScribes Configuration
configuration LoggerName
name Maybe [LoggerName]
scribes =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapScribeCache :: HashMap LoggerName [LoggerName]
cgMapScribeCache = (Maybe [LoggerName] -> Maybe [LoggerName])
-> LoggerName
-> HashMap LoggerName [LoggerName]
-> HashMap LoggerName [LoggerName]
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe [LoggerName]
_ -> Maybe [LoggerName]
scribes) LoggerName
name (ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribeCache ConfigurationInternal
cg) }

setDefaultScribes :: Configuration -> [ScribeId] -> IO ()
setDefaultScribes :: Configuration -> [LoggerName] -> IO ()
setDefaultScribes Configuration
configuration [LoggerName]
scs =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgDefScribes :: [LoggerName]
cgDefScribes = [LoggerName]
scs }

\end{code}

\subsubsection{Scribes to be setup in the |Log| backend}
Defines the list of |Scribe|s that need to be setup in the |Log| backend.
\begin{code}
setSetupScribes :: Configuration -> [ScribeDefinition] -> IO ()
setSetupScribes :: Configuration -> [ScribeDefinition] -> IO ()
setSetupScribes Configuration
configuration [ScribeDefinition]
sds =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgSetupScribes :: [ScribeDefinition]
cgSetupScribes = [ScribeDefinition]
sds }

getSetupScribes :: Configuration -> IO [ScribeDefinition]
getSetupScribes :: Configuration -> IO [ScribeDefinition]
getSetupScribes Configuration
configuration =
    ConfigurationInternal -> [ScribeDefinition]
cgSetupScribes (ConfigurationInternal -> [ScribeDefinition])
-> IO ConfigurationInternal -> IO [ScribeDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (Configuration -> ConfigurationMVar
getCG Configuration
configuration)

\end{code}

\subsubsection{|AggregatedKind| to define the type of measurement}
For a given context name return its |AggregatedKind| or in case no
such configuration exists, return the default |AggregatedKind| to use.
\begin{code}
getAggregatedKind :: Configuration -> LoggerName -> IO AggregatedKind
getAggregatedKind :: Configuration -> LoggerName -> IO AggregatedKind
getAggregatedKind Configuration
configuration LoggerName
name = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration
    let outs :: Maybe AggregatedKind
outs = LoggerName
-> HashMap LoggerName AggregatedKind -> Maybe AggregatedKind
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (ConfigurationInternal -> HashMap LoggerName AggregatedKind
cgMapAggregatedKind ConfigurationInternal
cg)
    case Maybe AggregatedKind
outs of
        Maybe AggregatedKind
Nothing -> AggregatedKind -> IO AggregatedKind
forall (m :: * -> *) a. Monad m => a -> m a
return (AggregatedKind -> IO AggregatedKind)
-> AggregatedKind -> IO AggregatedKind
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> AggregatedKind
cgDefAggregatedKind ConfigurationInternal
cg
        Just AggregatedKind
os -> AggregatedKind -> IO AggregatedKind
forall (m :: * -> *) a. Monad m => a -> m a
return (AggregatedKind -> IO AggregatedKind)
-> AggregatedKind -> IO AggregatedKind
forall a b. (a -> b) -> a -> b
$ AggregatedKind
os

setDefaultAggregatedKind :: Configuration -> AggregatedKind -> IO ()
setDefaultAggregatedKind :: Configuration -> AggregatedKind -> IO ()
setDefaultAggregatedKind Configuration
configuration AggregatedKind
defAK =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgDefAggregatedKind :: AggregatedKind
cgDefAggregatedKind = AggregatedKind
defAK }

setAggregatedKind :: Configuration -> LoggerName -> Maybe AggregatedKind -> IO ()
setAggregatedKind :: Configuration -> LoggerName -> Maybe AggregatedKind -> IO ()
setAggregatedKind Configuration
configuration LoggerName
name Maybe AggregatedKind
ak =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapAggregatedKind :: HashMap LoggerName AggregatedKind
cgMapAggregatedKind = (Maybe AggregatedKind -> Maybe AggregatedKind)
-> LoggerName
-> HashMap LoggerName AggregatedKind
-> HashMap LoggerName AggregatedKind
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe AggregatedKind
_ -> Maybe AggregatedKind
ak) LoggerName
name (ConfigurationInternal -> HashMap LoggerName AggregatedKind
cgMapAggregatedKind ConfigurationInternal
cg) }

\end{code}

\subsubsection{Access hosts and port numbers of EKG, Prometheus, GUI}
\begin{code}
getEKGBindAddr :: Configuration -> IO (Maybe R.Endpoint)
getEKGBindAddr :: Configuration -> IO (Maybe Endpoint)
getEKGBindAddr Configuration
configuration =
    ConfigurationInternal -> Maybe Endpoint
cgBindAddrEKG (ConfigurationInternal -> Maybe Endpoint)
-> IO ConfigurationInternal -> IO (Maybe Endpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setEKGBindAddr :: Configuration -> Maybe R.Endpoint -> IO ()
setEKGBindAddr :: Configuration -> Maybe Endpoint -> IO ()
setEKGBindAddr Configuration
configuration Maybe Endpoint
mHostPort =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgBindAddrEKG :: Maybe Endpoint
cgBindAddrEKG = Maybe Endpoint
mHostPort }

getGraylogPort :: Configuration -> IO Int
getGraylogPort :: Configuration -> IO Int
getGraylogPort Configuration
configuration =
    ConfigurationInternal -> Int
cgPortGraylog (ConfigurationInternal -> Int)
-> IO ConfigurationInternal -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setGraylogPort :: Configuration -> Int -> IO ()
setGraylogPort :: Configuration -> Int -> IO ()
setGraylogPort Configuration
configuration Int
port =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgPortGraylog :: Int
cgPortGraylog = Int
port }

getPrometheusBindAddr :: Configuration -> IO (Maybe (String, Int))
getPrometheusBindAddr :: Configuration -> IO (Maybe (String, Int))
getPrometheusBindAddr Configuration
configuration =
    ConfigurationInternal -> Maybe (String, Int)
cgBindAddrPrometheus (ConfigurationInternal -> Maybe (String, Int))
-> IO ConfigurationInternal -> IO (Maybe (String, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setPrometheusBindAddr :: Configuration -> Maybe (String, Int) -> IO ()
setPrometheusBindAddr :: Configuration -> Maybe (String, Int) -> IO ()
setPrometheusBindAddr Configuration
configuration Maybe (String, Int)
mHostPort =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgBindAddrPrometheus :: Maybe (String, Int)
cgBindAddrPrometheus = Maybe (String, Int)
mHostPort }

getGUIport :: Configuration -> IO Int
getGUIport :: Configuration -> IO Int
getGUIport Configuration
configuration =
    ConfigurationInternal -> Int
cgPortGUI (ConfigurationInternal -> Int)
-> IO ConfigurationInternal -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setGUIport :: Configuration -> Int -> IO ()
setGUIport :: Configuration -> Int -> IO ()
setGUIport Configuration
configuration Int
port =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgPortGUI :: Int
cgPortGUI = Int
port }

getAcceptAt :: Configuration -> IO (Maybe [RemoteAddrNamed])
getAcceptAt :: Configuration -> IO (Maybe [RemoteAddrNamed])
getAcceptAt = (ConfigurationInternal -> Maybe [RemoteAddrNamed])
-> IO ConfigurationInternal -> IO (Maybe [RemoteAddrNamed])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConfigurationInternal -> Maybe [RemoteAddrNamed]
cgAcceptAt (IO ConfigurationInternal -> IO (Maybe [RemoteAddrNamed]))
-> (Configuration -> IO ConfigurationInternal)
-> Configuration
-> IO (Maybe [RemoteAddrNamed])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> (Configuration -> ConfigurationMVar)
-> Configuration
-> IO ConfigurationInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> ConfigurationMVar
getCG

setAcceptAt :: Configuration -> Maybe [RemoteAddrNamed] -> IO ()
setAcceptAt :: Configuration -> Maybe [RemoteAddrNamed] -> IO ()
setAcceptAt Configuration
cf Maybe [RemoteAddrNamed]
mran =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
cf) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgAcceptAt :: Maybe [RemoteAddrNamed]
cgAcceptAt = Maybe [RemoteAddrNamed]
mran }

getForwardTo :: Configuration -> IO (Maybe RemoteAddr)
getForwardTo :: Configuration -> IO (Maybe RemoteAddr)
getForwardTo = (ConfigurationInternal -> Maybe RemoteAddr)
-> IO ConfigurationInternal -> IO (Maybe RemoteAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConfigurationInternal -> Maybe RemoteAddr
cgForwardTo (IO ConfigurationInternal -> IO (Maybe RemoteAddr))
-> (Configuration -> IO ConfigurationInternal)
-> Configuration
-> IO (Maybe RemoteAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> (Configuration -> ConfigurationMVar)
-> Configuration
-> IO ConfigurationInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> ConfigurationMVar
getCG

setForwardTo :: Configuration -> Maybe RemoteAddr -> IO ()
setForwardTo :: Configuration -> Maybe RemoteAddr -> IO ()
setForwardTo Configuration
cf Maybe RemoteAddr
mra =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
cf) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgForwardTo :: Maybe RemoteAddr
cgForwardTo = Maybe RemoteAddr
mra }

getForwardDelay :: Configuration -> IO (Maybe Word)
getForwardDelay :: Configuration -> IO (Maybe Word)
getForwardDelay = (ConfigurationInternal -> Maybe Word)
-> IO ConfigurationInternal -> IO (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConfigurationInternal -> Maybe Word
cgForwardDelay (IO ConfigurationInternal -> IO (Maybe Word))
-> (Configuration -> IO ConfigurationInternal)
-> Configuration
-> IO (Maybe Word)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> (Configuration -> ConfigurationMVar)
-> Configuration
-> IO ConfigurationInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> ConfigurationMVar
getCG

setForwardDelay :: Configuration -> Maybe Word -> IO ()
setForwardDelay :: Configuration -> Maybe Word -> IO ()
setForwardDelay Configuration
cf Maybe Word
mc =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
cf) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgForwardDelay :: Maybe Word
cgForwardDelay = Maybe Word
mc }
\end{code}

\subsubsection{Options}
\begin{code}
getMapOption' :: HM.HashMap Text Value -> Text -> Maybe Object
getMapOption' :: HashMap LoggerName Value
-> LoggerName -> Maybe (HashMap LoggerName Value)
getMapOption' HashMap LoggerName Value
m ((LoggerName -> HashMap LoggerName Value -> Maybe Value)
-> HashMap LoggerName Value -> LoggerName -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggerName -> HashMap LoggerName Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap LoggerName Value
m -> Just (Object HashMap LoggerName Value
x)) = HashMap LoggerName Value -> Maybe (HashMap LoggerName Value)
forall a. a -> Maybe a
Just HashMap LoggerName Value
x
getMapOption' HashMap LoggerName Value
_ LoggerName
_ = Maybe (HashMap LoggerName Value)
forall a. Maybe a
Nothing

getTextOption' :: HM.HashMap Text Value -> Text -> Maybe Text
getTextOption' :: HashMap LoggerName Value -> LoggerName -> Maybe LoggerName
getTextOption' HashMap LoggerName Value
m ((LoggerName -> HashMap LoggerName Value -> Maybe Value)
-> HashMap LoggerName Value -> LoggerName -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggerName -> HashMap LoggerName Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap LoggerName Value
m -> Just (String LoggerName
x)) = LoggerName -> Maybe LoggerName
forall a. a -> Maybe a
Just LoggerName
x
getTextOption' HashMap LoggerName Value
_ LoggerName
_ = Maybe LoggerName
forall a. Maybe a
Nothing

getOption :: Configuration -> Text -> IO (Maybe Value)
getOption :: Configuration -> LoggerName -> IO (Maybe Value)
getOption Configuration
configuration LoggerName
name =
  LoggerName -> HashMap LoggerName Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (HashMap LoggerName Value -> Maybe Value)
-> (ConfigurationInternal -> HashMap LoggerName Value)
-> ConfigurationInternal
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationInternal -> HashMap LoggerName Value
cgOptions (ConfigurationInternal -> Maybe Value)
-> IO ConfigurationInternal -> IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (Configuration -> ConfigurationMVar
getCG Configuration
configuration)

getTextOption :: Configuration -> Text -> IO (Maybe Text)
getTextOption :: Configuration -> LoggerName -> IO (Maybe LoggerName)
getTextOption Configuration
configuration LoggerName
name =
  (HashMap LoggerName Value -> LoggerName -> Maybe LoggerName)
-> LoggerName -> HashMap LoggerName Value -> Maybe LoggerName
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap LoggerName Value -> LoggerName -> Maybe LoggerName
getTextOption' LoggerName
name (HashMap LoggerName Value -> Maybe LoggerName)
-> (ConfigurationInternal -> HashMap LoggerName Value)
-> ConfigurationInternal
-> Maybe LoggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationInternal -> HashMap LoggerName Value
cgOptions (ConfigurationInternal -> Maybe LoggerName)
-> IO ConfigurationInternal -> IO (Maybe LoggerName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (Configuration -> ConfigurationMVar
getCG Configuration
configuration)

getMapOption :: Configuration -> Text -> IO (Maybe Object)
getMapOption :: Configuration
-> LoggerName -> IO (Maybe (HashMap LoggerName Value))
getMapOption Configuration
configuration LoggerName
name =
  (HashMap LoggerName Value
 -> LoggerName -> Maybe (HashMap LoggerName Value))
-> LoggerName
-> HashMap LoggerName Value
-> Maybe (HashMap LoggerName Value)
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashMap LoggerName Value
-> LoggerName -> Maybe (HashMap LoggerName Value)
getMapOption' LoggerName
name (HashMap LoggerName Value -> Maybe (HashMap LoggerName Value))
-> (ConfigurationInternal -> HashMap LoggerName Value)
-> ConfigurationInternal
-> Maybe (HashMap LoggerName Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigurationInternal -> HashMap LoggerName Value
cgOptions (ConfigurationInternal -> Maybe (HashMap LoggerName Value))
-> IO ConfigurationInternal
-> IO (Maybe (HashMap LoggerName Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (Configuration -> ConfigurationMVar
getCG Configuration
configuration)

updateOption :: Configuration -> Text -> (Maybe Value -> Value) -> IO ()
updateOption :: Configuration -> LoggerName -> (Maybe Value -> Value) -> IO ()
updateOption Configuration
configuration LoggerName
name Maybe Value -> Value
f =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgOptions :: HashMap LoggerName Value
cgOptions = (Maybe Value -> Maybe Value)
-> LoggerName
-> HashMap LoggerName Value
-> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (Maybe Value -> Value) -> Maybe Value -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> Value
f) LoggerName
name (ConfigurationInternal -> HashMap LoggerName Value
cgOptions ConfigurationInternal
cg) }

setOption :: Configuration -> Text -> Value -> IO ()
setOption :: Configuration -> LoggerName -> Value -> IO ()
setOption Configuration
configuration LoggerName
name = Configuration -> LoggerName -> (Maybe Value -> Value) -> IO ()
updateOption Configuration
configuration LoggerName
name ((Maybe Value -> Value) -> IO ())
-> (Value -> Maybe Value -> Value) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Value -> Value
forall a b. a -> b -> a
const

setTextOption :: Configuration -> Text -> Text -> IO ()
setTextOption :: Configuration -> LoggerName -> LoggerName -> IO ()
setTextOption Configuration
configuration LoggerName
name = Configuration -> LoggerName -> Value -> IO ()
setOption Configuration
configuration LoggerName
name (Value -> IO ()) -> (LoggerName -> Value) -> LoggerName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerName -> Value
String

\end{code}

\subsubsection{Global setting of minimum severity}
\begin{code}
minSeverity :: Configuration -> IO Severity
minSeverity :: Configuration -> IO Severity
minSeverity Configuration
configuration =
    ConfigurationInternal -> Severity
cgMinSeverity (ConfigurationInternal -> Severity)
-> IO ConfigurationInternal -> IO Severity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setMinSeverity :: Configuration -> Severity -> IO ()
setMinSeverity :: Configuration -> Severity -> IO ()
setMinSeverity Configuration
configuration Severity
sev =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMinSeverity :: Severity
cgMinSeverity = Severity
sev }

\end{code}

\subsubsection{Relation of context name to minimum severity}
\begin{code}
inspectSeverity :: Configuration -> Text -> IO (Maybe Severity)
inspectSeverity :: Configuration -> LoggerName -> IO (Maybe Severity)
inspectSeverity Configuration
configuration LoggerName
name = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration
    Maybe Severity -> IO (Maybe Severity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Severity -> IO (Maybe Severity))
-> Maybe Severity -> IO (Maybe Severity)
forall a b. (a -> b) -> a -> b
$ LoggerName -> HashMap LoggerName Severity -> Maybe Severity
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (ConfigurationInternal -> HashMap LoggerName Severity
cgMapSeverity ConfigurationInternal
cg)

setSeverity :: Configuration -> Text -> Maybe Severity -> IO ()
setSeverity :: Configuration -> LoggerName -> Maybe Severity -> IO ()
setSeverity Configuration
configuration LoggerName
name Maybe Severity
sev =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapSeverity :: HashMap LoggerName Severity
cgMapSeverity = (Maybe Severity -> Maybe Severity)
-> LoggerName
-> HashMap LoggerName Severity
-> HashMap LoggerName Severity
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe Severity
_ -> Maybe Severity
sev) LoggerName
name (ConfigurationInternal -> HashMap LoggerName Severity
cgMapSeverity ConfigurationInternal
cg) }

\end{code}

\subsubsection{Relation of context name to SubTrace}\label{code:findSubTrace}\label{code:setSubTrace}
A new context may contain a different type of |Trace|.
The function |appendName| will look up the |SubTrace| for the context's name.
\begin{code}
findSubTrace :: Configuration -> Text -> IO (Maybe SubTrace)
findSubTrace :: Configuration -> LoggerName -> IO (Maybe SubTrace)
findSubTrace Configuration
configuration LoggerName
name =
    LoggerName -> HashMap LoggerName SubTrace -> Maybe SubTrace
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name (HashMap LoggerName SubTrace -> Maybe SubTrace)
-> (ConfigurationInternal -> HashMap LoggerName SubTrace)
-> ConfigurationInternal
-> Maybe SubTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigurationInternal -> HashMap LoggerName SubTrace
cgMapSubtrace (ConfigurationInternal -> Maybe SubTrace)
-> IO ConfigurationInternal -> IO (Maybe SubTrace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration)

setSubTrace :: Configuration -> Text -> Maybe SubTrace -> IO ()
setSubTrace :: Configuration -> LoggerName -> Maybe SubTrace -> IO ()
setSubTrace Configuration
configuration LoggerName
name Maybe SubTrace
trafo =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMapSubtrace :: HashMap LoggerName SubTrace
cgMapSubtrace = (Maybe SubTrace -> Maybe SubTrace)
-> LoggerName
-> HashMap LoggerName SubTrace
-> HashMap LoggerName SubTrace
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter (\Maybe SubTrace
_ -> Maybe SubTrace
trafo) LoggerName
name (ConfigurationInternal -> HashMap LoggerName SubTrace
cgMapSubtrace ConfigurationInternal
cg) }

\end{code}

\subsubsection{Monitors}

\begin{spec}
Just (
  fromList [
    ("chain.creation.block", Array [
      Object (fromList [("monitor", String "((time > (23 s)) Or (time < (17 s)))")]),
      Object (fromList [("actions", Array [
        String "AlterMinSeverity \"chain.creation\" Debug"])])])
  , ("#aggregation.critproc.observable", Array [
      Object (fromList [("monitor", String "(mean >= (42))")]),
      Object (fromList [("actions", Array [
        String "CreateMessage \"exceeded\" \"the observable has been too long too high!\"",
        String "AlterGlobalMinSeverity Info"])]) ]) ] )
\end{spec}

\begin{code}
getMonitors :: Configuration -> IO (HM.HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]))
getMonitors :: Configuration
-> IO (HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]))
getMonitors Configuration
configuration = do
    ConfigurationInternal
cg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar (ConfigurationMVar -> IO ConfigurationInternal)
-> ConfigurationMVar -> IO ConfigurationInternal
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigurationMVar
getCG Configuration
configuration
    HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
-> IO (HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]))
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigurationInternal
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors ConfigurationInternal
cg)

setMonitors :: Configuration -> HM.HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]) -> IO ()
setMonitors :: Configuration
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]) -> IO ()
setMonitors Configuration
configuration HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
monitors =
    ConfigurationMVar
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Configuration -> ConfigurationMVar
getCG Configuration
configuration) ((ConfigurationInternal -> IO ConfigurationInternal) -> IO ())
-> (ConfigurationInternal -> IO ConfigurationInternal) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ConfigurationInternal
cg ->
        ConfigurationInternal -> IO ConfigurationInternal
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigurationInternal
cg { cgMonitors :: HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors = HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
monitors }
\end{code}

\subsubsection{Parse configuration from file}
Parse the configuration into an internal representation first. Then, fill in |Configuration|
after refinement.
\begin{code}
setup :: FilePath -> IO Configuration
setup :: String -> IO Configuration
setup String
fp = do
    Representation
r <- String -> IO Representation
R.readRepresentation String
fp
    Representation -> IO Configuration
setupFromRepresentation Representation
r

parseMonitors :: Maybe (HM.HashMap Text Value) -> HM.HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
parseMonitors :: Maybe (HashMap LoggerName Value)
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
parseMonitors Maybe (HashMap LoggerName Value)
Nothing = HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
forall k v. HashMap k v
HM.empty
parseMonitors (Just HashMap LoggerName Value
hmv) = (Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction]))
-> HashMap LoggerName Value
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction])
mkMonitor HashMap LoggerName Value
hmv
    where
    mkMonitor :: Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction])
    mkMonitor :: Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction])
mkMonitor = (Value -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
-> Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction])
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe ((Value -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
 -> Value -> Maybe (MEvPreCond, MEvExpr, [MEvAction]))
-> (Value -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
-> Value
-> Maybe (MEvPreCond, MEvExpr, [MEvAction])
forall a b. (a -> b) -> a -> b
$ \Value
v ->
                    (String
-> (HashMap LoggerName Value
    -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
-> Value
-> Parser (MEvPreCond, MEvExpr, [MEvAction])
forall a.
String
-> (HashMap LoggerName Value -> Parser a) -> Value -> Parser a
withObject String
"" ((HashMap LoggerName Value
  -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
 -> Value -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
-> (HashMap LoggerName Value
    -> Parser (MEvPreCond, MEvExpr, [MEvAction]))
-> Value
-> Parser (MEvPreCond, MEvExpr, [MEvAction])
forall a b. (a -> b) -> a -> b
$ \HashMap LoggerName Value
o ->
                        (,,) (MEvPreCond
 -> MEvExpr -> [MEvAction] -> (MEvPreCond, MEvExpr, [MEvAction]))
-> Parser MEvPreCond
-> Parser
     (MEvExpr -> [MEvAction] -> (MEvPreCond, MEvExpr, [MEvAction]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap LoggerName Value
o HashMap LoggerName Value -> LoggerName -> Parser MEvPreCond
forall a.
FromJSON a =>
HashMap LoggerName Value -> LoggerName -> Parser (Maybe a)
.:? LoggerName
"monitor-if"
                             Parser
  (MEvExpr -> [MEvAction] -> (MEvPreCond, MEvExpr, [MEvAction]))
-> Parser MEvExpr
-> Parser ([MEvAction] -> (MEvPreCond, MEvExpr, [MEvAction]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap LoggerName Value
o HashMap LoggerName Value -> LoggerName -> Parser MEvExpr
forall a.
FromJSON a =>
HashMap LoggerName Value -> LoggerName -> Parser a
.:  LoggerName
"monitor"
                             Parser ([MEvAction] -> (MEvPreCond, MEvExpr, [MEvAction]))
-> Parser [MEvAction] -> Parser (MEvPreCond, MEvExpr, [MEvAction])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap LoggerName Value
o HashMap LoggerName Value -> LoggerName -> Parser [MEvAction]
forall a.
FromJSON a =>
HashMap LoggerName Value -> LoggerName -> Parser a
.:  LoggerName
"actions") Value
v
                    Parser (MEvPreCond, MEvExpr, [MEvAction])
-> Parser (MEvPreCond, MEvExpr, [MEvAction])
-> Parser (MEvPreCond, MEvExpr, [MEvAction])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (MEvPreCond, MEvExpr, [MEvAction])
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

setupFromRepresentation :: R.Representation -> IO Configuration
setupFromRepresentation :: Representation -> IO Configuration
setupFromRepresentation Representation
r = do
    let getMap :: LoggerName -> Maybe (HashMap LoggerName Value)
getMap             = HashMap LoggerName Value
-> LoggerName -> Maybe (HashMap LoggerName Value)
getMapOption' (Representation -> HashMap LoggerName Value
R.options Representation
r)
        mapscribes :: HashMap LoggerName [LoggerName]
mapscribes         = Maybe (HashMap LoggerName Value) -> HashMap LoggerName [LoggerName]
forall k. Maybe (HashMap k Value) -> HashMap k [LoggerName]
parseScribeMap (Maybe (HashMap LoggerName Value)
 -> HashMap LoggerName [LoggerName])
-> Maybe (HashMap LoggerName Value)
-> HashMap LoggerName [LoggerName]
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapScribes"
        defRotation :: Maybe RotationParameters
defRotation        = Representation -> Maybe RotationParameters
R.rotation Representation
r

    ConfigurationMVar
cgref <- ConfigurationInternal -> IO ConfigurationMVar
forall a. a -> IO (MVar a)
newMVar (ConfigurationInternal -> IO ConfigurationMVar)
-> ConfigurationInternal -> IO ConfigurationMVar
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal :: Severity
-> Maybe RotationParameters
-> HashMap LoggerName Severity
-> HashMap LoggerName SubTrace
-> HashMap LoggerName Value
-> HashMap LoggerName [BackendKind]
-> [BackendKind]
-> [BackendKind]
-> HashMap LoggerName [LoggerName]
-> HashMap LoggerName [LoggerName]
-> [LoggerName]
-> [ScribeDefinition]
-> HashMap LoggerName AggregatedKind
-> AggregatedKind
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
-> Maybe Endpoint
-> Int
-> Maybe (String, Int)
-> Maybe RemoteAddr
-> Maybe Word
-> Maybe [RemoteAddrNamed]
-> Int
-> ConfigurationInternal
ConfigurationInternal
        { cgMinSeverity :: Severity
cgMinSeverity       = Representation -> Severity
R.minSeverity Representation
r
        , cgDefRotation :: Maybe RotationParameters
cgDefRotation       = Maybe RotationParameters
defRotation
        , cgMapSeverity :: HashMap LoggerName Severity
cgMapSeverity       = Maybe (HashMap LoggerName Value) -> HashMap LoggerName Severity
parseSeverityMap (Maybe (HashMap LoggerName Value) -> HashMap LoggerName Severity)
-> Maybe (HashMap LoggerName Value) -> HashMap LoggerName Severity
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapSeverity"
        , cgMapSubtrace :: HashMap LoggerName SubTrace
cgMapSubtrace       = Maybe (HashMap LoggerName Value) -> HashMap LoggerName SubTrace
parseSubtraceMap (Maybe (HashMap LoggerName Value) -> HashMap LoggerName SubTrace)
-> Maybe (HashMap LoggerName Value) -> HashMap LoggerName SubTrace
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapSubtrace"
        , cgOptions :: HashMap LoggerName Value
cgOptions           = Representation -> HashMap LoggerName Value
R.options Representation
r
        , cgMapBackend :: HashMap LoggerName [BackendKind]
cgMapBackend        = Maybe (HashMap LoggerName Value)
-> HashMap LoggerName [BackendKind]
forall k. Maybe (HashMap k Value) -> HashMap k [BackendKind]
parseBackendMap (Maybe (HashMap LoggerName Value)
 -> HashMap LoggerName [BackendKind])
-> Maybe (HashMap LoggerName Value)
-> HashMap LoggerName [BackendKind]
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapBackends"
        , cgDefBackendKs :: [BackendKind]
cgDefBackendKs      = Representation -> [BackendKind]
R.defaultBackends Representation
r
        , cgSetupBackends :: [BackendKind]
cgSetupBackends     = Representation -> [BackendKind]
R.setupBackends Representation
r
        , cgMapScribe :: HashMap LoggerName [LoggerName]
cgMapScribe         = HashMap LoggerName [LoggerName]
mapscribes
        , cgMapScribeCache :: HashMap LoggerName [LoggerName]
cgMapScribeCache    = HashMap LoggerName [LoggerName]
mapscribes
        , cgDefScribes :: [LoggerName]
cgDefScribes        = Representation -> [LoggerName]
r_defaultScribes Representation
r
        , cgSetupScribes :: [ScribeDefinition]
cgSetupScribes      = Maybe RotationParameters
-> [ScribeDefinition] -> [ScribeDefinition]
fillRotationParams Maybe RotationParameters
defRotation (Representation -> [ScribeDefinition]
R.setupScribes Representation
r)
        , cgMapAggregatedKind :: HashMap LoggerName AggregatedKind
cgMapAggregatedKind = Maybe (HashMap LoggerName Value)
-> HashMap LoggerName AggregatedKind
parseAggregatedKindMap (Maybe (HashMap LoggerName Value)
 -> HashMap LoggerName AggregatedKind)
-> Maybe (HashMap LoggerName Value)
-> HashMap LoggerName AggregatedKind
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapAggregatedkinds"
        , cgDefAggregatedKind :: AggregatedKind
cgDefAggregatedKind = AggregatedKind
StatsAK
        , cgMonitors :: HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors          = Maybe (HashMap LoggerName Value)
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
parseMonitors (Maybe (HashMap LoggerName Value)
 -> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction]))
-> Maybe (HashMap LoggerName Value)
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
forall a b. (a -> b) -> a -> b
$ LoggerName -> Maybe (HashMap LoggerName Value)
getMap LoggerName
"mapMonitors"
        , cgBindAddrEKG :: Maybe Endpoint
cgBindAddrEKG       = Representation -> Maybe Endpoint
r_hasEKG Representation
r
        , cgPortGraylog :: Int
cgPortGraylog       = Representation -> Int
r_hasGraylog Representation
r
        , cgBindAddrPrometheus :: Maybe (String, Int)
cgBindAddrPrometheus = Representation -> Maybe (String, Int)
r_hasPrometheus Representation
r
        , cgPortGUI :: Int
cgPortGUI           = Representation -> Int
r_hasGUI Representation
r
        , cgForwardTo :: Maybe RemoteAddr
cgForwardTo         = Representation -> Maybe RemoteAddr
r_forward Representation
r
        , cgForwardDelay :: Maybe Word
cgForwardDelay      = Representation -> Maybe Word
r_forward_delay Representation
r
        , cgAcceptAt :: Maybe [RemoteAddrNamed]
cgAcceptAt          = Representation -> Maybe [RemoteAddrNamed]
r_accept Representation
r
        }
    Configuration -> IO Configuration
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration -> IO Configuration)
-> Configuration -> IO Configuration
forall a b. (a -> b) -> a -> b
$ ConfigurationMVar -> Configuration
Configuration ConfigurationMVar
cgref
  where
    parseSeverityMap :: Maybe (HM.HashMap Text Value) -> HM.HashMap Text Severity
    parseSeverityMap :: Maybe (HashMap LoggerName Value) -> HashMap LoggerName Severity
parseSeverityMap Maybe (HashMap LoggerName Value)
Nothing = HashMap LoggerName Severity
forall k v. HashMap k v
HM.empty
    parseSeverityMap (Just HashMap LoggerName Value
hmv) = (Value -> Maybe Severity)
-> HashMap LoggerName Value -> HashMap LoggerName Severity
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe Value -> Maybe Severity
mkSeverity HashMap LoggerName Value
hmv
      where
        mkSeverity :: Value -> Maybe Severity
mkSeverity (String LoggerName
s) = Severity -> Maybe Severity
forall a. a -> Maybe a
Just (String -> Severity
forall a. Read a => String -> a
read (LoggerName -> String
unpack LoggerName
s) :: Severity)
        mkSeverity Value
_ = Maybe Severity
forall a. Maybe a
Nothing

    fillRotationParams :: Maybe RotationParameters -> [ScribeDefinition] -> [ScribeDefinition]
    fillRotationParams :: Maybe RotationParameters
-> [ScribeDefinition] -> [ScribeDefinition]
fillRotationParams Maybe RotationParameters
defaultRotation = (ScribeDefinition -> ScribeDefinition)
-> [ScribeDefinition] -> [ScribeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map ((ScribeDefinition -> ScribeDefinition)
 -> [ScribeDefinition] -> [ScribeDefinition])
-> (ScribeDefinition -> ScribeDefinition)
-> [ScribeDefinition]
-> [ScribeDefinition]
forall a b. (a -> b) -> a -> b
$ \ScribeDefinition
sd ->
        if ScribeDefinition -> ScribeKind
scKind ScribeDefinition
sd ScribeKind -> ScribeKind -> Bool
forall a. Eq a => a -> a -> Bool
== ScribeKind
FileSK
        then
            ScribeDefinition
sd { scRotation :: Maybe RotationParameters
scRotation = Maybe RotationParameters
-> (RotationParameters -> Maybe RotationParameters)
-> Maybe RotationParameters
-> Maybe RotationParameters
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe RotationParameters
defaultRotation RotationParameters -> Maybe RotationParameters
forall a. a -> Maybe a
Just (ScribeDefinition -> Maybe RotationParameters
scRotation ScribeDefinition
sd) }
        else
            -- stdout, stderr, /dev/null and systemd cannot be rotated
            ScribeDefinition
sd { scRotation :: Maybe RotationParameters
scRotation = Maybe RotationParameters
forall a. Maybe a
Nothing }

    parseBackendMap :: Maybe (HashMap k Value) -> HashMap k [BackendKind]
parseBackendMap Maybe (HashMap k Value)
Nothing = HashMap k [BackendKind]
forall k v. HashMap k v
HM.empty
    parseBackendMap (Just HashMap k Value
hmv) = (Value -> [BackendKind])
-> HashMap k Value -> HashMap k [BackendKind]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Value -> [BackendKind]
mkBackends HashMap k Value
hmv
      where
        mkBackends :: Value -> [BackendKind]
mkBackends (Array Array
bes) = [Maybe BackendKind] -> [BackendKind]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BackendKind] -> [BackendKind])
-> [Maybe BackendKind] -> [BackendKind]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe BackendKind) -> [Value] -> [Maybe BackendKind]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Maybe BackendKind
mkBackend ([Value] -> [Maybe BackendKind]) -> [Value] -> [Maybe BackendKind]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
bes
        mkBackends Value
_ = []
        mkBackend :: Value -> Maybe BackendKind
        mkBackend :: Value -> Maybe BackendKind
mkBackend = (Value -> Parser BackendKind) -> Value -> Maybe BackendKind
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser BackendKind
forall a. FromJSON a => Value -> Parser a
parseJSON

    parseScribeMap :: Maybe (HashMap k Value) -> HashMap k [LoggerName]
parseScribeMap Maybe (HashMap k Value)
Nothing = HashMap k [LoggerName]
forall k v. HashMap k v
HM.empty
    parseScribeMap (Just HashMap k Value
hmv) = (Value -> [LoggerName])
-> HashMap k Value -> HashMap k [LoggerName]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Value -> [LoggerName]
mkScribes HashMap k Value
hmv
      where
        mkScribes :: Value -> [LoggerName]
mkScribes (Array Array
scs) = [Maybe LoggerName] -> [LoggerName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe LoggerName] -> [LoggerName])
-> [Maybe LoggerName] -> [LoggerName]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe LoggerName) -> [Value] -> [Maybe LoggerName]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Maybe LoggerName
mkScribe ([Value] -> [Maybe LoggerName]) -> [Value] -> [Maybe LoggerName]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
scs
        mkScribes (String LoggerName
s) = [(LoggerName
s :: ScribeId)]
        mkScribes Value
_ = []
        mkScribe :: Value -> Maybe ScribeId
        mkScribe :: Value -> Maybe LoggerName
mkScribe = (Value -> Parser LoggerName) -> Value -> Maybe LoggerName
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser LoggerName
forall a. FromJSON a => Value -> Parser a
parseJSON

    parseSubtraceMap :: Maybe (HM.HashMap Text Value) -> HM.HashMap Text SubTrace
    parseSubtraceMap :: Maybe (HashMap LoggerName Value) -> HashMap LoggerName SubTrace
parseSubtraceMap Maybe (HashMap LoggerName Value)
Nothing = HashMap LoggerName SubTrace
forall k v. HashMap k v
HM.empty
    parseSubtraceMap (Just HashMap LoggerName Value
hmv) = (Value -> Maybe SubTrace)
-> HashMap LoggerName Value -> HashMap LoggerName SubTrace
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe Value -> Maybe SubTrace
mkSubtrace HashMap LoggerName Value
hmv
      where
        mkSubtrace :: Value -> Maybe SubTrace
        mkSubtrace :: Value -> Maybe SubTrace
mkSubtrace = (Value -> Parser SubTrace) -> Value -> Maybe SubTrace
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser SubTrace
forall a. FromJSON a => Value -> Parser a
parseJSON

    r_hasEKG :: Representation -> Maybe Endpoint
r_hasEKG Representation
repr = Representation -> Maybe Endpoint
R.hasEKG Representation
repr
    r_hasGraylog :: Representation -> Int
r_hasGraylog Representation
repr = case (Representation -> Maybe Int
R.hasGraylog Representation
repr) of
                       Maybe Int
Nothing -> Int
0
                       Just Int
p  -> Int
p
    r_hasPrometheus :: Representation -> Maybe (String, Int)
r_hasPrometheus Representation
repr = Representation -> Maybe (String, Int)
R.hasPrometheus Representation
repr
    r_hasGUI :: Representation -> Int
r_hasGUI Representation
repr = case (Representation -> Maybe Int
R.hasGUI Representation
repr) of
                       Maybe Int
Nothing -> Int
0
                       Just Int
p  -> Int
p
    r_forward :: Representation -> Maybe RemoteAddr
r_forward Representation
repr = Representation -> Maybe RemoteAddr
R.traceForwardTo Representation
repr
    r_forward_delay :: Representation -> Maybe Word
r_forward_delay Representation
repr = Representation -> Maybe Word
R.forwardDelay Representation
repr
    r_accept :: Representation -> Maybe [RemoteAddrNamed]
r_accept Representation
repr = Representation -> Maybe [RemoteAddrNamed]
R.traceAcceptAt Representation
repr
    r_defaultScribes :: Representation -> [LoggerName]
r_defaultScribes Representation
repr = ((ScribeKind, LoggerName) -> LoggerName)
-> [(ScribeKind, LoggerName)] -> [LoggerName]
forall a b. (a -> b) -> [a] -> [b]
map (\(ScribeKind
k,LoggerName
n) -> String -> LoggerName
pack(ScribeKind -> String
forall a. Show a => a -> String
show ScribeKind
k) LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"::" LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
n) (Representation -> [(ScribeKind, LoggerName)]
R.defaultScribes Representation
repr)

parseAggregatedKindMap :: Maybe (HM.HashMap Text Value) -> HM.HashMap LoggerName AggregatedKind
parseAggregatedKindMap :: Maybe (HashMap LoggerName Value)
-> HashMap LoggerName AggregatedKind
parseAggregatedKindMap Maybe (HashMap LoggerName Value)
Nothing    = HashMap LoggerName AggregatedKind
forall k v. HashMap k v
HM.empty
parseAggregatedKindMap (Just HashMap LoggerName Value
hmv) = (Value -> Maybe AggregatedKind)
-> HashMap LoggerName Value -> HashMap LoggerName AggregatedKind
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe Value -> Maybe AggregatedKind
mkAggregatedKind HashMap LoggerName Value
hmv
    where
    mkAggregatedKind :: Value -> Maybe AggregatedKind
    mkAggregatedKind :: Value -> Maybe AggregatedKind
mkAggregatedKind (String LoggerName
s) = AggregatedKind -> Maybe AggregatedKind
forall a. a -> Maybe a
Just (AggregatedKind -> Maybe AggregatedKind)
-> AggregatedKind -> Maybe AggregatedKind
forall a b. (a -> b) -> a -> b
$ String -> AggregatedKind
forall a. Read a => String -> a
read (String -> AggregatedKind) -> String -> AggregatedKind
forall a b. (a -> b) -> a -> b
$ LoggerName -> String
unpack LoggerName
s
    mkAggregatedKind Value
v = ((Value -> Parser AggregatedKind) -> Value -> Maybe AggregatedKind
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser AggregatedKind
forall a. FromJSON a => Value -> Parser a
parseJSON) Value
v

\end{code}

\subsubsection{Setup empty configuration}
\begin{code}
empty :: IO Configuration
empty :: IO Configuration
empty = do
    ConfigurationMVar
cgref <- ConfigurationInternal -> IO ConfigurationMVar
forall a. a -> IO (MVar a)
newMVar (ConfigurationInternal -> IO ConfigurationMVar)
-> ConfigurationInternal -> IO ConfigurationMVar
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal :: Severity
-> Maybe RotationParameters
-> HashMap LoggerName Severity
-> HashMap LoggerName SubTrace
-> HashMap LoggerName Value
-> HashMap LoggerName [BackendKind]
-> [BackendKind]
-> [BackendKind]
-> HashMap LoggerName [LoggerName]
-> HashMap LoggerName [LoggerName]
-> [LoggerName]
-> [ScribeDefinition]
-> HashMap LoggerName AggregatedKind
-> AggregatedKind
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
-> Maybe Endpoint
-> Int
-> Maybe (String, Int)
-> Maybe RemoteAddr
-> Maybe Word
-> Maybe [RemoteAddrNamed]
-> Int
-> ConfigurationInternal
ConfigurationInternal
                           { cgMinSeverity :: Severity
cgMinSeverity       = Severity
Debug
                           , cgDefRotation :: Maybe RotationParameters
cgDefRotation       = Maybe RotationParameters
forall a. Maybe a
Nothing
                           , cgMapSeverity :: HashMap LoggerName Severity
cgMapSeverity       = HashMap LoggerName Severity
forall k v. HashMap k v
HM.empty
                           , cgMapSubtrace :: HashMap LoggerName SubTrace
cgMapSubtrace       = HashMap LoggerName SubTrace
forall k v. HashMap k v
HM.empty
                           , cgOptions :: HashMap LoggerName Value
cgOptions           = HashMap LoggerName Value
forall k v. HashMap k v
HM.empty
                           , cgMapBackend :: HashMap LoggerName [BackendKind]
cgMapBackend        = HashMap LoggerName [BackendKind]
forall k v. HashMap k v
HM.empty
                           , cgDefBackendKs :: [BackendKind]
cgDefBackendKs      = []
                           , cgSetupBackends :: [BackendKind]
cgSetupBackends     = []
                           , cgMapScribe :: HashMap LoggerName [LoggerName]
cgMapScribe         = HashMap LoggerName [LoggerName]
forall k v. HashMap k v
HM.empty
                           , cgMapScribeCache :: HashMap LoggerName [LoggerName]
cgMapScribeCache    = HashMap LoggerName [LoggerName]
forall k v. HashMap k v
HM.empty
                           , cgDefScribes :: [LoggerName]
cgDefScribes        = []
                           , cgSetupScribes :: [ScribeDefinition]
cgSetupScribes      = []
                           , cgMapAggregatedKind :: HashMap LoggerName AggregatedKind
cgMapAggregatedKind = HashMap LoggerName AggregatedKind
forall k v. HashMap k v
HM.empty
                           , cgDefAggregatedKind :: AggregatedKind
cgDefAggregatedKind = AggregatedKind
StatsAK
                           , cgMonitors :: HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors          = HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
forall k v. HashMap k v
HM.empty
                           , cgBindAddrEKG :: Maybe Endpoint
cgBindAddrEKG       = Maybe Endpoint
forall a. Maybe a
Nothing
                           , cgPortGraylog :: Int
cgPortGraylog       = Int
0
                           , cgBindAddrPrometheus :: Maybe (String, Int)
cgBindAddrPrometheus = Maybe (String, Int)
forall a. Maybe a
Nothing
                           , cgPortGUI :: Int
cgPortGUI           = Int
0
                           , cgForwardTo :: Maybe RemoteAddr
cgForwardTo         = Maybe RemoteAddr
forall a. Maybe a
Nothing
                           , cgForwardDelay :: Maybe Word
cgForwardDelay      = Maybe Word
forall a. Maybe a
Nothing
                           , cgAcceptAt :: Maybe [RemoteAddrNamed]
cgAcceptAt          = Maybe [RemoteAddrNamed]
forall a. Maybe a
Nothing
                           }
    Configuration -> IO Configuration
forall (m :: * -> *) a. Monad m => a -> m a
return (Configuration -> IO Configuration)
-> Configuration -> IO Configuration
forall a b. (a -> b) -> a -> b
$ ConfigurationMVar -> Configuration
Configuration ConfigurationMVar
cgref

\end{code}

\subsubsection{toRepresentation}\label{code:toRepresentation}\index{toRepresentation}
\begin{code}
toRepresentation :: Configuration -> IO R.Representation
toRepresentation :: Configuration -> IO Representation
toRepresentation (Configuration ConfigurationMVar
c) = do
    ConfigurationInternal
cfg <- ConfigurationMVar -> IO ConfigurationInternal
forall a. MVar a -> IO a
readMVar ConfigurationMVar
c
    let portGraylog :: Int
portGraylog = ConfigurationInternal -> Int
cgPortGraylog ConfigurationInternal
cfg
        portGUI :: Int
portGUI = ConfigurationInternal -> Int
cgPortGUI ConfigurationInternal
cfg
        otherOptions :: HashMap LoggerName Value
otherOptions = ConfigurationInternal -> HashMap LoggerName Value
cgOptions ConfigurationInternal
cfg
        defScribes :: [LoggerName]
defScribes = ConfigurationInternal -> [LoggerName]
cgDefScribes ConfigurationInternal
cfg
        splitScribeId :: ScribeId -> (ScribeKind, Text)
        splitScribeId :: LoggerName -> (ScribeKind, LoggerName)
splitScribeId LoggerName
x =
            -- "(ScribeId)" = "(ScribeKind) :: (Filename)"
            let (LoggerName
a,LoggerName
b) = LoggerName -> LoggerName -> (LoggerName, LoggerName)
T.breakOn LoggerName
"::" LoggerName
x
            in
                (String -> ScribeKind
forall a. Read a => String -> a
read (String -> ScribeKind) -> String -> ScribeKind
forall a b. (a -> b) -> a -> b
$ LoggerName -> String
unpack LoggerName
a, Int -> LoggerName -> LoggerName
T.drop Int
2 LoggerName
b)
        createOption :: Text -> (a -> Value) -> HM.HashMap Text a -> HM.HashMap Text Value
        createOption :: LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
name a -> Value
f HashMap LoggerName a
hashmap =
          if HashMap LoggerName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap LoggerName a
hashmap
          then HashMap LoggerName Value
forall k v. HashMap k v
HM.empty
          else LoggerName -> Value -> HashMap LoggerName Value
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton LoggerName
name (Value -> HashMap LoggerName Value)
-> Value -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ HashMap LoggerName Value -> Value
Object ((a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Value
f HashMap LoggerName a
hashmap)
        toString :: Show a => a -> Value
        toString :: a -> Value
toString = LoggerName -> Value
String (LoggerName -> Value) -> (a -> LoggerName) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LoggerName
pack (String -> LoggerName) -> (a -> String) -> a -> LoggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
        toObject :: (MEvPreCond, MEvExpr, [MEvAction]) -> Value
        toObject :: (MEvPreCond, MEvExpr, [MEvAction]) -> Value
toObject (MEvPreCond
Nothing, MEvExpr
expr, [MEvAction]
actions) =
            [Pair] -> Value
object [ LoggerName
"monitor" LoggerName -> MEvExpr -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= MEvExpr
expr
                   , LoggerName
"actions" LoggerName -> [MEvAction] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= [MEvAction]
actions
                   ]
        toObject (Just MEvExpr
precond, MEvExpr
expr, [MEvAction]
actions) =
            [Pair] -> Value
object [ LoggerName
"monitor-if" LoggerName -> MEvExpr -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= MEvExpr
precond
                   , LoggerName
"monitor"    LoggerName -> MEvExpr -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= MEvExpr
expr
                   , LoggerName
"actions"    LoggerName -> [MEvAction] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= [MEvAction]
actions
                   ]
        toJSON' :: [ScribeId] -> Value
        toJSON' :: [LoggerName] -> Value
toJSON' [LoggerName
sid] = LoggerName -> Value
forall a. ToJSON a => a -> Value
toJSON LoggerName
sid
        toJSON' [LoggerName]
ss    = [LoggerName] -> Value
forall a. ToJSON a => a -> Value
toJSON [LoggerName]
ss
        mapSeverities, mapBackends, mapAggKinds, mapScribes, mapSubtrace, mapMonitors ::
          HM.HashMap Text Value
        mapSeverities :: HashMap LoggerName Value
mapSeverities = LoggerName
-> (Severity -> Value)
-> HashMap LoggerName Severity
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapSeverity"        Severity -> Value
forall a. ToJSON a => a -> Value
toJSON   (HashMap LoggerName Severity -> HashMap LoggerName Value)
-> HashMap LoggerName Severity -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName Severity
cgMapSeverity       ConfigurationInternal
cfg
        mapBackends :: HashMap LoggerName Value
mapBackends   = LoggerName
-> ([BackendKind] -> Value)
-> HashMap LoggerName [BackendKind]
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapBackends"        [BackendKind] -> Value
forall a. ToJSON a => a -> Value
toJSON   (HashMap LoggerName [BackendKind] -> HashMap LoggerName Value)
-> HashMap LoggerName [BackendKind] -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName [BackendKind]
cgMapBackend        ConfigurationInternal
cfg
        mapAggKinds :: HashMap LoggerName Value
mapAggKinds   = LoggerName
-> (AggregatedKind -> Value)
-> HashMap LoggerName AggregatedKind
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapAggregatedkinds" AggregatedKind -> Value
forall a. Show a => a -> Value
toString (HashMap LoggerName AggregatedKind -> HashMap LoggerName Value)
-> HashMap LoggerName AggregatedKind -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName AggregatedKind
cgMapAggregatedKind ConfigurationInternal
cfg
        mapScribes :: HashMap LoggerName Value
mapScribes    = LoggerName
-> ([LoggerName] -> Value)
-> HashMap LoggerName [LoggerName]
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapScribes"         [LoggerName] -> Value
toJSON'  (HashMap LoggerName [LoggerName] -> HashMap LoggerName Value)
-> HashMap LoggerName [LoggerName] -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribe         ConfigurationInternal
cfg
        mapSubtrace :: HashMap LoggerName Value
mapSubtrace   = LoggerName
-> (SubTrace -> Value)
-> HashMap LoggerName SubTrace
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapSubtrace"        SubTrace -> Value
forall a. ToJSON a => a -> Value
toJSON   (HashMap LoggerName SubTrace -> HashMap LoggerName Value)
-> HashMap LoggerName SubTrace -> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal -> HashMap LoggerName SubTrace
cgMapSubtrace       ConfigurationInternal
cfg
        mapMonitors :: HashMap LoggerName Value
mapMonitors   = LoggerName
-> ((MEvPreCond, MEvExpr, [MEvAction]) -> Value)
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
-> HashMap LoggerName Value
forall a.
LoggerName
-> (a -> Value) -> HashMap LoggerName a -> HashMap LoggerName Value
createOption LoggerName
"mapMonitors"        (MEvPreCond, MEvExpr, [MEvAction]) -> Value
toObject (HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
 -> HashMap LoggerName Value)
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
-> HashMap LoggerName Value
forall a b. (a -> b) -> a -> b
$ ConfigurationInternal
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors          ConfigurationInternal
cfg

    Representation -> IO Representation
forall (m :: * -> *) a. Monad m => a -> m a
return (Representation -> IO Representation)
-> Representation -> IO Representation
forall a b. (a -> b) -> a -> b
$
        Representation :: Severity
-> Maybe RotationParameters
-> [ScribeDefinition]
-> [(ScribeKind, LoggerName)]
-> [BackendKind]
-> [BackendKind]
-> Maybe Endpoint
-> Maybe Int
-> Maybe (String, Int)
-> Maybe Int
-> Maybe RemoteAddr
-> Maybe Word
-> Maybe [RemoteAddrNamed]
-> HashMap LoggerName Value
-> Representation
R.Representation
            { minSeverity :: Severity
R.minSeverity     = ConfigurationInternal -> Severity
cgMinSeverity ConfigurationInternal
cfg
            , rotation :: Maybe RotationParameters
R.rotation        = ConfigurationInternal -> Maybe RotationParameters
cgDefRotation ConfigurationInternal
cfg
            , setupScribes :: [ScribeDefinition]
R.setupScribes    = ConfigurationInternal -> [ScribeDefinition]
cgSetupScribes ConfigurationInternal
cfg
            , defaultScribes :: [(ScribeKind, LoggerName)]
R.defaultScribes  = (LoggerName -> (ScribeKind, LoggerName))
-> [LoggerName] -> [(ScribeKind, LoggerName)]
forall a b. (a -> b) -> [a] -> [b]
map LoggerName -> (ScribeKind, LoggerName)
splitScribeId [LoggerName]
defScribes
            , setupBackends :: [BackendKind]
R.setupBackends   = ConfigurationInternal -> [BackendKind]
cgSetupBackends ConfigurationInternal
cfg
            , defaultBackends :: [BackendKind]
R.defaultBackends = ConfigurationInternal -> [BackendKind]
cgDefBackendKs ConfigurationInternal
cfg
            , hasEKG :: Maybe Endpoint
R.hasEKG          = ConfigurationInternal -> Maybe Endpoint
cgBindAddrEKG ConfigurationInternal
cfg
            , hasGraylog :: Maybe Int
R.hasGraylog      = if Int
portGraylog Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
portGraylog
            , hasPrometheus :: Maybe (String, Int)
R.hasPrometheus   = ConfigurationInternal -> Maybe (String, Int)
cgBindAddrPrometheus ConfigurationInternal
cfg
            , hasGUI :: Maybe Int
R.hasGUI          = if Int
portGUI Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
portGUI
            , traceForwardTo :: Maybe RemoteAddr
R.traceForwardTo  = ConfigurationInternal -> Maybe RemoteAddr
cgForwardTo ConfigurationInternal
cfg
            , forwardDelay :: Maybe Word
R.forwardDelay    = ConfigurationInternal -> Maybe Word
cgForwardDelay ConfigurationInternal
cfg
            , traceAcceptAt :: Maybe [RemoteAddrNamed]
R.traceAcceptAt   = ConfigurationInternal -> Maybe [RemoteAddrNamed]
cgAcceptAt ConfigurationInternal
cfg
            , options :: HashMap LoggerName Value
R.options         = HashMap LoggerName Value
mapSeverities HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
mapBackends   HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
mapAggKinds   HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
mapSubtrace   HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
mapScribes    HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
mapMonitors   HashMap LoggerName Value
-> HashMap LoggerName Value -> HashMap LoggerName Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union`
                                  HashMap LoggerName Value
otherOptions
            }

\end{code}

\subsubsection{Export |Configuration| into a file}\label{code:exportConfiguration}\index{exportConfiguration}
Converts |Configuration| into the form of |Representation| and writes it to
the given file.
\begin{code}
exportConfiguration :: Configuration -> FilePath -> IO ()
exportConfiguration :: Configuration -> String -> IO ()
exportConfiguration Configuration
cfg String
file = do
    Representation
representation <- Configuration -> IO Representation
toRepresentation Configuration
cfg
    String -> Representation -> IO ()
forall a. ToJSON a => String -> a -> IO ()
Yaml.encodeFile String
file Representation
representation

\end{code}

\subsubsection{Evaluation of |FilterTrace|}\label{code:evalFilters}\index{evalFilters}\label{code:testSubTrace}\index{testSubTrace}

A filter consists of a |DropName| and a list of |UnhideNames|. If the context name matches
the |DropName| filter, then at least one of the |UnhideNames| must match the name to have
the evaluation of the filters return |True|.

\begin{code}
findRootSubTrace :: Configuration -> LoggerName -> IO (Maybe SubTrace)
findRootSubTrace :: Configuration -> LoggerName -> IO (Maybe SubTrace)
findRootSubTrace Configuration
config LoggerName
loggername =
    -- Try to find SubTrace by provided name.
    let find_s :: [Text] -> IO (Maybe SubTrace)
        find_s :: [LoggerName] -> IO (Maybe SubTrace)
find_s [] = Maybe SubTrace -> IO (Maybe SubTrace)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SubTrace
forall a. Maybe a
Nothing
        find_s [LoggerName]
lnames = Configuration -> LoggerName -> IO (Maybe SubTrace)
findSubTrace Configuration
config (LoggerName -> [LoggerName] -> LoggerName
T.intercalate LoggerName
"." [LoggerName]
lnames) IO (Maybe SubTrace)
-> (Maybe SubTrace -> IO (Maybe SubTrace)) -> IO (Maybe SubTrace)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just SubTrace
subtrace -> Maybe SubTrace -> IO (Maybe SubTrace)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SubTrace -> IO (Maybe SubTrace))
-> Maybe SubTrace -> IO (Maybe SubTrace)
forall a b. (a -> b) -> a -> b
$ SubTrace -> Maybe SubTrace
forall a. a -> Maybe a
Just SubTrace
subtrace
                Maybe SubTrace
Nothing -> [LoggerName] -> IO (Maybe SubTrace)
find_s ([LoggerName] -> [LoggerName]
forall a. [a] -> [a]
init [LoggerName]
lnames)
    in [LoggerName] -> IO (Maybe SubTrace)
find_s ([LoggerName] -> IO (Maybe SubTrace))
-> [LoggerName] -> IO (Maybe SubTrace)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> LoggerName -> [LoggerName]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') LoggerName
loggername

testSubTrace :: Configuration -> LoggerName -> LogObject a -> IO (Maybe (LogObject a))
testSubTrace :: Configuration
-> LoggerName -> LogObject a -> IO (Maybe (LogObject a))
testSubTrace Configuration
config LoggerName
loggername LogObject a
lo = do
    SubTrace
subtrace <- SubTrace -> Maybe SubTrace -> SubTrace
forall a. a -> Maybe a -> a
fromMaybe SubTrace
Neutral (Maybe SubTrace -> SubTrace) -> IO (Maybe SubTrace) -> IO SubTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> LoggerName -> IO (Maybe SubTrace)
findRootSubTrace Configuration
config LoggerName
loggername
    Maybe (LogObject a) -> IO (Maybe (LogObject a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LogObject a) -> IO (Maybe (LogObject a)))
-> Maybe (LogObject a) -> IO (Maybe (LogObject a))
forall a b. (a -> b) -> a -> b
$ LogObject a -> SubTrace -> Maybe (LogObject a)
forall a. LogObject a -> SubTrace -> Maybe (LogObject a)
testSubTrace' LogObject a
lo SubTrace
subtrace
  where
    testSubTrace' :: LogObject a -> SubTrace -> Maybe (LogObject a)
    testSubTrace' :: LogObject a -> SubTrace -> Maybe (LogObject a)
testSubTrace' LogObject a
_ SubTrace
NoTrace = Maybe (LogObject a)
forall a. Maybe a
Nothing
    testSubTrace' (LogObject LoggerName
_ LOMeta
_ (ObserveOpen CounterState
_)) SubTrace
DropOpening = Maybe (LogObject a)
forall a. Maybe a
Nothing
    testSubTrace' o :: LogObject a
o@(LogObject LoggerName
_ LOMeta
_ (LogValue LoggerName
vname Measurable
_)) (FilterTrace [(DropName, UnhideNames)]
filters) =
        if [(DropName, UnhideNames)] -> LoggerName -> Bool
evalFilters [(DropName, UnhideNames)]
filters (LoggerName
loggername LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
vname)
        then LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just LogObject a
o
        else Maybe (LogObject a)
forall a. Maybe a
Nothing
    testSubTrace' LogObject a
o (FilterTrace [(DropName, UnhideNames)]
filters) =
        if [(DropName, UnhideNames)] -> LoggerName -> Bool
evalFilters [(DropName, UnhideNames)]
filters LoggerName
loggername
        then LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just LogObject a
o
        else Maybe (LogObject a)
forall a. Maybe a
Nothing
    testSubTrace' LogObject a
o (SetSeverity Severity
sev) = LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just (LogObject a -> Maybe (LogObject a))
-> LogObject a -> Maybe (LogObject a)
forall a b. (a -> b) -> a -> b
$ LogObject a
o{ loMeta :: LOMeta
loMeta = (LogObject a -> LOMeta
forall a. LogObject a -> LOMeta
loMeta LogObject a
o){ severity :: Severity
severity = Severity
sev } }
    testSubTrace' LogObject a
o SubTrace
_ = LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just LogObject a
o -- fallback: all pass

evalFilters :: [(DropName, UnhideNames)] -> LoggerName -> Bool
evalFilters :: [(DropName, UnhideNames)] -> LoggerName -> Bool
evalFilters [(DropName, UnhideNames)]
fs LoggerName
nm =
    ((DropName, UnhideNames) -> Bool)
-> [(DropName, UnhideNames)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(DropName
no, UnhideNames
yes) -> if (LoggerName -> DropName -> Bool
dropFilter LoggerName
nm DropName
no) then (LoggerName -> UnhideNames -> Bool
unhideFilter LoggerName
nm UnhideNames
yes) else Bool
True) [(DropName, UnhideNames)]
fs
  where
    dropFilter :: LoggerName -> DropName -> Bool
    dropFilter :: LoggerName -> DropName -> Bool
dropFilter LoggerName
name (Drop NameSelector
sel) = (LoggerName -> NameSelector -> Bool
matchName LoggerName
name NameSelector
sel)
    unhideFilter :: LoggerName -> UnhideNames -> Bool
    unhideFilter :: LoggerName -> UnhideNames -> Bool
unhideFilter LoggerName
_ (Unhide []) = Bool
False
    unhideFilter LoggerName
name (Unhide [NameSelector]
us) = (NameSelector -> Bool) -> [NameSelector] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\NameSelector
sel -> LoggerName -> NameSelector -> Bool
matchName LoggerName
name NameSelector
sel) [NameSelector]
us
    matchName :: LoggerName -> NameSelector -> Bool
    matchName :: LoggerName -> NameSelector -> Bool
matchName LoggerName
name (Exact LoggerName
name') = LoggerName
name LoggerName -> LoggerName -> Bool
forall a. Eq a => a -> a -> Bool
== LoggerName
name'
    matchName LoggerName
name (StartsWith LoggerName
prefix) = LoggerName -> LoggerName -> Bool
T.isPrefixOf LoggerName
prefix LoggerName
name
    matchName LoggerName
name (EndsWith LoggerName
postfix) = LoggerName -> LoggerName -> Bool
T.isSuffixOf LoggerName
postfix LoggerName
name
    matchName LoggerName
name (Contains LoggerName
name') = LoggerName -> LoggerName -> Bool
T.isInfixOf LoggerName
name' LoggerName
name
\end{code}