\subsection{Cardano.BM.Configuration.Model}
\label{code:Cardano.BM.Configuration.Model}
%if style == newcode
\begin{code}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
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 }
data ConfigurationInternal = ConfigurationInternal
{ ConfigurationInternal -> Severity
cgMinSeverity :: Severity
, ConfigurationInternal -> Maybe RotationParameters
cgDefRotation :: Maybe RotationParameters
, ConfigurationInternal -> HashMap LoggerName Severity
cgMapSeverity :: HM.HashMap LoggerName Severity
, ConfigurationInternal -> HashMap LoggerName SubTrace
cgMapSubtrace :: HM.HashMap LoggerName SubTrace
, ConfigurationInternal -> HashMap LoggerName Value
cgOptions :: HM.HashMap Text Value
, ConfigurationInternal -> HashMap LoggerName [BackendKind]
cgMapBackend :: HM.HashMap LoggerName [BackendKind]
, ConfigurationInternal -> [BackendKind]
cgDefBackendKs :: [BackendKind]
, ConfigurationInternal -> [BackendKind]
cgSetupBackends :: [BackendKind]
, ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribe :: HM.HashMap LoggerName [ScribeId]
, ConfigurationInternal -> HashMap LoggerName [LoggerName]
cgMapScribeCache :: HM.HashMap LoggerName [ScribeId]
, ConfigurationInternal -> [LoggerName]
cgDefScribes :: [ScribeId]
, ConfigurationInternal -> [ScribeDefinition]
cgSetupScribes :: [ScribeDefinition]
, ConfigurationInternal -> HashMap LoggerName AggregatedKind
cgMapAggregatedKind :: HM.HashMap LoggerName AggregatedKind
, ConfigurationInternal -> AggregatedKind
cgDefAggregatedKind :: AggregatedKind
, ConfigurationInternal
-> HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
cgMonitors :: HM.HashMap LoggerName (MEvPreCond, MEvExpr, [MEvAction])
, ConfigurationInternal -> Maybe Endpoint
cgBindAddrEKG :: Maybe R.Endpoint
, ConfigurationInternal -> Int
cgPortGraylog :: Int
, ConfigurationInternal -> Maybe (String, Int)
cgBindAddrPrometheus :: Maybe (String, Int)
, ConfigurationInternal -> Maybe RemoteAddr
cgForwardTo :: Maybe RemoteAddr
, ConfigurationInternal -> Maybe Word
cgForwardDelay :: Maybe Word
, ConfigurationInternal -> Maybe [RemoteAddrNamed]
cgAcceptAt :: Maybe [RemoteAddrNamed]
, ConfigurationInternal -> Int
cgPortGUI :: Int
} 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 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)
(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
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
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 =
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 =
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
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}