\subsection{Cardano.BM.Backend.Monitoring}
\label{module:Cardano.BM.Backend.Monitoring}
%if style == newcode
\begin{code}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.BM.Backend.Monitoring
(
Monitor
, plugin
) where
import qualified Control.Concurrent.Async as Async
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
readMVar, tryReadMVar, tryTakeMVar, withMVar)
import Control.Concurrent.STM (atomically)
import qualified Control.Concurrent.STM.TBQueue as TBQ
import Control.Exception.Safe (throwM)
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.HashMap.Strict as HM
import Data.Maybe (catMaybes)
import Data.Text (Text, pack)
import qualified Data.Text.IO as TIO
import GHC.Clock (getMonotonicTimeNSec)
import System.IO (stderr)
import Cardano.BM.Backend.LogBuffer
import Cardano.BM.Backend.ProcessQueue (processQueue)
import Cardano.BM.Configuration.Model (Configuration, getMonitors)
import Cardano.BM.Data.Aggregated
import Cardano.BM.Data.Backend
import Cardano.BM.Data.Counter (Counter (..), CounterState (..),
nameCounter)
import Cardano.BM.Data.LogItem
import Cardano.BM.Data.MonitoringEval
import Cardano.BM.Plugin (Plugin (..))
import qualified Cardano.BM.Trace as Trace
\end{code}
%endif
\subsubsection{Plugin definition}
\begin{code}
plugin :: (IsEffectuator s a, ToJSON a, FromJSON a)
=> Configuration -> Trace.Trace IO a -> s a -> IO (Plugin a)
plugin :: Configuration -> Trace IO a -> s a -> IO (Plugin a)
plugin Configuration
config Trace IO a
trace s a
sb = do
Monitor a
be :: Cardano.BM.Backend.Monitoring.Monitor a <- Configuration -> Trace IO a -> s a -> IO (Monitor a)
forall (t :: * -> *) a (s :: * -> *).
(IsBackend t a, IsEffectuator s a) =>
Configuration -> Trace IO a -> s a -> IO (t a)
realizefrom Configuration
config Trace IO a
trace s a
sb
Plugin a -> IO (Plugin a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Plugin a -> IO (Plugin a)) -> Plugin a -> IO (Plugin a)
forall a b. (a -> b) -> a -> b
$ Backend a -> BackendKind -> Plugin a
forall a. Backend a -> BackendKind -> Plugin a
BackendPlugin
(MkBackend :: forall a. (LogObject a -> IO ()) -> IO () -> Backend a
MkBackend { bEffectuate :: LogObject a -> IO ()
bEffectuate = Monitor a -> LogObject a -> IO ()
forall (t :: * -> *) a.
IsEffectuator t a =>
t a -> LogObject a -> IO ()
effectuate Monitor a
be, bUnrealize :: IO ()
bUnrealize = Monitor a -> IO ()
forall (t :: * -> *) a. IsBackend t a => t a -> IO ()
unrealize Monitor a
be })
(Monitor a -> BackendKind
forall (t :: * -> *) a. IsBackend t a => t a -> BackendKind
bekind Monitor a
be)
\end{code}
\subsubsection{Structure of Monitoring}\label{code:Monitor}\index{Monitor}
\begin{code}
type MonitorMVar a = MVar (MonitorInternal a)
newtype Monitor a = Monitor
{ Monitor a -> MonitorMVar a
getMon :: MonitorMVar a }
data MonitorInternal a = MonitorInternal
{ MonitorInternal a -> TBQueue (Maybe (LogObject a))
monQueue :: TBQ.TBQueue (Maybe (LogObject a))
, MonitorInternal a -> Async ()
monDispatch :: Async.Async ()
, MonitorInternal a -> LogBuffer a
monBuffer :: !(LogBuffer a)
}
\end{code}
\subsubsection{Relation from context name to monitoring state}\label{code:MonitorMap}\label{code:MonitorState}
We remember the state of each monitored context name.
\begin{code}
data MonitorState = MonitorState {
MonitorState -> MEvPreCond
_preCondition :: !MEvPreCond
, MonitorState -> MEvExpr
_expression :: !MEvExpr
, MonitorState -> [MEvAction]
_actions :: [MEvAction]
, MonitorState -> Environment
_environment :: !Environment
} deriving Int -> MonitorState -> ShowS
[MonitorState] -> ShowS
MonitorState -> String
(Int -> MonitorState -> ShowS)
-> (MonitorState -> String)
-> ([MonitorState] -> ShowS)
-> Show MonitorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonitorState] -> ShowS
$cshowList :: [MonitorState] -> ShowS
show :: MonitorState -> String
$cshow :: MonitorState -> String
showsPrec :: Int -> MonitorState -> ShowS
$cshowsPrec :: Int -> MonitorState -> ShowS
Show
type MonitorMap = HM.HashMap LoggerName MonitorState
\end{code}
\subsubsection{Monitor view is an effectuator}\index{Monitor!instance of IsEffectuator}
Function |effectuate| is called to pass in a |LogObject| for monitoring.
\begin{code}
instance IsEffectuator Monitor a where
effectuate :: Monitor a -> LogObject a -> IO ()
effectuate Monitor a
monitor LogObject a
item = do
MonitorInternal a
mon <- MVar (MonitorInternal a) -> IO (MonitorInternal a)
forall a. MVar a -> IO a
readMVar (Monitor a -> MVar (MonitorInternal a)
forall a. Monitor a -> MonitorMVar a
getMon Monitor a
monitor)
LogBuffer a -> LogObject a -> IO ()
forall (t :: * -> *) a.
IsEffectuator t a =>
t a -> LogObject a -> IO ()
effectuate (MonitorInternal a -> LogBuffer a
forall a. MonitorInternal a -> LogBuffer a
monBuffer MonitorInternal a
mon) LogObject a
item
Bool
nocapacity <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TBQueue (Maybe (LogObject a)) -> STM Bool
forall a. TBQueue a -> STM Bool
TBQ.isFullTBQueue (MonitorInternal a -> TBQueue (Maybe (LogObject a))
forall a. MonitorInternal a -> TBQueue (Maybe (LogObject a))
monQueue MonitorInternal a
mon)
if Bool
nocapacity
then Monitor a -> IO ()
forall (t :: * -> *) a. IsEffectuator t a => t a -> IO ()
handleOverflow Monitor a
monitor
else STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue (Maybe (LogObject a)) -> Maybe (LogObject a) -> STM ()
forall a. TBQueue a -> a -> STM ()
TBQ.writeTBQueue (MonitorInternal a -> TBQueue (Maybe (LogObject a))
forall a. MonitorInternal a -> TBQueue (Maybe (LogObject a))
monQueue MonitorInternal a
mon) (Maybe (LogObject a) -> STM ()) -> Maybe (LogObject a) -> STM ()
forall a b. (a -> b) -> a -> b
$ LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just LogObject a
item
handleOverflow :: Monitor a -> IO ()
handleOverflow Monitor a
_ = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr Text
"Notice: Monitor's queue full, dropping log items!\n"
\end{code}
\subsubsection{|Monitor| implements |Backend| functions}\index{Monitor!instance of IsBackend}
|Monitor| is an |IsBackend|
\begin{code}
instance FromJSON a => IsBackend Monitor a where
bekind :: Monitor a -> BackendKind
bekind Monitor a
_ = BackendKind
MonitoringBK
realize :: Configuration -> IO (Monitor a)
realize Configuration
_ = String -> IO (Monitor a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Monitoring cannot be instantiated by 'realize'"
realizefrom :: Configuration -> Trace IO a -> s a -> IO (Monitor a)
realizefrom Configuration
config Trace IO a
sbtrace s a
_ = do
MVar (MonitorInternal a)
monref <- IO (MVar (MonitorInternal a))
forall a. IO (MVar a)
newEmptyMVar
let monitor :: Monitor a
monitor = MVar (MonitorInternal a) -> Monitor a
forall a. MonitorMVar a -> Monitor a
Monitor MVar (MonitorInternal a)
monref
#ifdef PERFORMANCE_TEST_QUEUE
let qSize = 1000000
#else
let qSize :: Natural
qSize = Natural
512
#endif
TBQueue (Maybe (LogObject a))
queue <- STM (TBQueue (Maybe (LogObject a)))
-> IO (TBQueue (Maybe (LogObject a)))
forall a. STM a -> IO a
atomically (STM (TBQueue (Maybe (LogObject a)))
-> IO (TBQueue (Maybe (LogObject a))))
-> STM (TBQueue (Maybe (LogObject a)))
-> IO (TBQueue (Maybe (LogObject a)))
forall a b. (a -> b) -> a -> b
$ Natural -> STM (TBQueue (Maybe (LogObject a)))
forall a. Natural -> STM (TBQueue a)
TBQ.newTBQueue Natural
qSize
Async ()
dispatcher <- TBQueue (Maybe (LogObject a))
-> Configuration -> Trace IO a -> Monitor a -> IO (Async ())
forall a.
TBQueue (Maybe (LogObject a))
-> Configuration -> Trace IO a -> Monitor a -> IO (Async ())
spawnDispatcher TBQueue (Maybe (LogObject a))
queue Configuration
config Trace IO a
sbtrace Monitor a
monitor
LogBuffer a
monbuf :: Cardano.BM.Backend.LogBuffer.LogBuffer a <- Configuration -> IO (LogBuffer a)
forall (t :: * -> *) a. IsBackend t a => Configuration -> IO (t a)
Cardano.BM.Backend.LogBuffer.realize Configuration
config
Async () -> IO ()
forall a. Async a -> IO ()
Async.link Async ()
dispatcher
MVar (MonitorInternal a) -> MonitorInternal a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (MonitorInternal a)
monref (MonitorInternal a -> IO ()) -> MonitorInternal a -> IO ()
forall a b. (a -> b) -> a -> b
$ MonitorInternal :: forall a.
TBQueue (Maybe (LogObject a))
-> Async () -> LogBuffer a -> MonitorInternal a
MonitorInternal
{ monQueue :: TBQueue (Maybe (LogObject a))
monQueue = TBQueue (Maybe (LogObject a))
queue
, monDispatch :: Async ()
monDispatch = Async ()
dispatcher
, monBuffer :: LogBuffer a
monBuffer = LogBuffer a
monbuf
}
Monitor a -> IO (Monitor a)
forall (m :: * -> *) a. Monad m => a -> m a
return Monitor a
monitor
unrealize :: Monitor a -> IO ()
unrealize Monitor a
monitoring = do
let clearMVar :: MVar b -> IO ()
clearMVar :: MVar b -> IO ()
clearMVar = IO (Maybe b) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe b) -> IO ())
-> (MVar b -> IO (Maybe b)) -> MVar b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar b -> IO (Maybe b)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar
(Async ()
dispatcher, TBQueue (Maybe (LogObject a))
queue) <- MVar (MonitorInternal a)
-> (MonitorInternal a
-> IO (Async (), TBQueue (Maybe (LogObject a))))
-> IO (Async (), TBQueue (Maybe (LogObject a)))
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Monitor a -> MVar (MonitorInternal a)
forall a. Monitor a -> MonitorMVar a
getMon Monitor a
monitoring) (\MonitorInternal a
mon ->
(Async (), TBQueue (Maybe (LogObject a)))
-> IO (Async (), TBQueue (Maybe (LogObject a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MonitorInternal a -> Async ()
forall a. MonitorInternal a -> Async ()
monDispatch MonitorInternal a
mon, MonitorInternal a -> TBQueue (Maybe (LogObject a))
forall a. MonitorInternal a -> TBQueue (Maybe (LogObject a))
monQueue MonitorInternal a
mon))
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue (Maybe (LogObject a)) -> Maybe (LogObject a) -> STM ()
forall a. TBQueue a -> a -> STM ()
TBQ.writeTBQueue TBQueue (Maybe (LogObject a))
queue Maybe (LogObject a)
forall a. Maybe a
Nothing
Either SomeException ()
res <- Async () -> IO (Either SomeException ())
forall a. Async a -> IO (Either SomeException a)
Async.waitCatch Async ()
dispatcher
(SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return Either SomeException ()
res
MVar (MonitorInternal a) -> IO ()
forall b. MVar b -> IO ()
clearMVar (MVar (MonitorInternal a) -> IO ())
-> MVar (MonitorInternal a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Monitor a -> MVar (MonitorInternal a)
forall a. Monitor a -> MonitorMVar a
getMon Monitor a
monitoring
\end{code}
\subsubsection{Asynchronously reading log items from the queue and their processing}
\begin{code}
spawnDispatcher :: TBQ.TBQueue (Maybe (LogObject a))
-> Configuration
-> Trace.Trace IO a
-> Monitor a
-> IO (Async.Async ())
spawnDispatcher :: TBQueue (Maybe (LogObject a))
-> Configuration -> Trace IO a -> Monitor a -> IO (Async ())
spawnDispatcher TBQueue (Maybe (LogObject a))
mqueue Configuration
config Trace IO a
sbtrace Monitor a
monitor =
IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
Async.async (IO (HashMap Text MonitorState)
initMap IO (HashMap Text MonitorState)
-> (HashMap Text MonitorState -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashMap Text MonitorState -> IO ()
qProc)
where
qProc :: HashMap Text MonitorState -> IO ()
qProc HashMap Text MonitorState
state =
TBQueue (Maybe (LogObject a))
-> (LogObject a
-> HashMap Text MonitorState -> IO (HashMap Text MonitorState))
-> HashMap Text MonitorState
-> (HashMap Text MonitorState -> IO ())
-> IO ()
forall a b.
TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b) -> b -> (b -> IO ()) -> IO ()
processQueue
TBQueue (Maybe (LogObject a))
mqueue
LogObject a
-> HashMap Text MonitorState -> IO (HashMap Text MonitorState)
processMonitoring
HashMap Text MonitorState
state
(\HashMap Text MonitorState
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
processMonitoring :: LogObject a
-> HashMap Text MonitorState -> IO (HashMap Text MonitorState)
processMonitoring lo :: LogObject a
lo@LogObject{} HashMap Text MonitorState
state = do
let accessBufferMap :: IO [(Text, LogObject a)]
accessBufferMap = do
Maybe (MonitorInternal a)
mon <- MVar (MonitorInternal a) -> IO (Maybe (MonitorInternal a))
forall a. MVar a -> IO (Maybe a)
tryReadMVar (Monitor a -> MVar (MonitorInternal a)
forall a. Monitor a -> MonitorMVar a
getMon Monitor a
monitor)
case Maybe (MonitorInternal a)
mon of
Maybe (MonitorInternal a)
Nothing -> [(Text, LogObject a)] -> IO [(Text, LogObject a)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just MonitorInternal a
actualMon -> LogBuffer a -> IO [(Text, LogObject a)]
forall a. LogBuffer a -> IO [(Text, LogObject a)]
readBuffer (LogBuffer a -> IO [(Text, LogObject a)])
-> LogBuffer a -> IO [(Text, LogObject a)]
forall a b. (a -> b) -> a -> b
$ MonitorInternal a -> LogBuffer a
forall a. MonitorInternal a -> LogBuffer a
monBuffer MonitorInternal a
actualMon
[(Text, LogObject a)]
mbuf <- IO [(Text, LogObject a)]
accessBufferMap
let sbtraceWithMonitoring :: Trace IO a
sbtraceWithMonitoring = Text -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
Trace.appendName Text
"#monitoring" Trace IO a
sbtrace
[(Text, Measurable)]
valuesForMonitoring <- Configuration -> [(Text, LogObject a)] -> IO [(Text, Measurable)]
forall a.
Configuration -> [(Text, LogObject a)] -> IO [(Text, Measurable)]
getVarValuesForMonitoring Configuration
config [(Text, LogObject a)]
mbuf
HashMap Text MonitorState
state' <- Trace IO a
-> HashMap Text MonitorState
-> LogObject a
-> [(Text, Measurable)]
-> IO (HashMap Text MonitorState)
forall a.
Trace IO a
-> HashMap Text MonitorState
-> LogObject a
-> [(Text, Measurable)]
-> IO (HashMap Text MonitorState)
evalMonitoringAction Trace IO a
sbtraceWithMonitoring
HashMap Text MonitorState
state
LogObject a
lo
[(Text, Measurable)]
valuesForMonitoring
HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text MonitorState
state'
initMap :: IO (HashMap Text MonitorState)
initMap = do
HashMap Text (MEvPreCond, MEvExpr, [MEvAction])
ls <- Configuration
-> IO (HashMap Text (MEvPreCond, MEvExpr, [MEvAction]))
getMonitors Configuration
config
HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text MonitorState -> IO (HashMap Text MonitorState))
-> HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall a b. (a -> b) -> a -> b
$ [(Text, MonitorState)] -> HashMap Text MonitorState
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, MonitorState)] -> HashMap Text MonitorState)
-> [(Text, MonitorState)] -> HashMap Text MonitorState
forall a b. (a -> b) -> a -> b
$ ((Text, (MEvPreCond, MEvExpr, [MEvAction]))
-> (Text, MonitorState))
-> [(Text, (MEvPreCond, MEvExpr, [MEvAction]))]
-> [(Text, MonitorState)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
n, (MEvPreCond
precond,MEvExpr
e,[MEvAction]
as)) -> (Text
n, MEvPreCond -> MEvExpr -> [MEvAction] -> Environment -> MonitorState
MonitorState MEvPreCond
precond MEvExpr
e [MEvAction]
as Environment
forall k v. HashMap k v
HM.empty))
([(Text, (MEvPreCond, MEvExpr, [MEvAction]))]
-> [(Text, MonitorState)])
-> [(Text, (MEvPreCond, MEvExpr, [MEvAction]))]
-> [(Text, MonitorState)]
forall a b. (a -> b) -> a -> b
$ HashMap Text (MEvPreCond, MEvExpr, [MEvAction])
-> [(Text, (MEvPreCond, MEvExpr, [MEvAction]))]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text (MEvPreCond, MEvExpr, [MEvAction])
ls
\end{code}
\begin{code}
getVarValuesForMonitoring :: Configuration
-> [(LoggerName, LogObject a)]
-> IO [(VarName, Measurable)]
getVarValuesForMonitoring :: Configuration -> [(Text, LogObject a)] -> IO [(Text, Measurable)]
getVarValuesForMonitoring Configuration
config [(Text, LogObject a)]
mbuf = do
[(MEvPreCond, MEvExpr, [MEvAction])]
monitorsInfo <- HashMap Text (MEvPreCond, MEvExpr, [MEvAction])
-> [(MEvPreCond, MEvExpr, [MEvAction])]
forall k v. HashMap k v -> [v]
HM.elems (HashMap Text (MEvPreCond, MEvExpr, [MEvAction])
-> [(MEvPreCond, MEvExpr, [MEvAction])])
-> IO (HashMap Text (MEvPreCond, MEvExpr, [MEvAction]))
-> IO [(MEvPreCond, MEvExpr, [MEvAction])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration
-> IO (HashMap Text (MEvPreCond, MEvExpr, [MEvAction]))
getMonitors Configuration
config
let varNames :: [Text]
varNames = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [MEvExpr -> [Text]
extractVarNames MEvExpr
mEvExpr | (MEvPreCond
_, MEvExpr
mEvExpr, [MEvAction]
_) <- [(MEvPreCond, MEvExpr, [MEvAction])]
monitorsInfo]
[(Text, Measurable)] -> IO [(Text, Measurable)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Measurable)] -> IO [(Text, Measurable)])
-> ([[Maybe (Text, Measurable)]] -> [(Text, Measurable)])
-> [[Maybe (Text, Measurable)]]
-> IO [(Text, Measurable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Measurable)] -> [(Text, Measurable)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Measurable)] -> [(Text, Measurable)])
-> ([[Maybe (Text, Measurable)]] -> [Maybe (Text, Measurable)])
-> [[Maybe (Text, Measurable)]]
-> [(Text, Measurable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Text, Measurable)]] -> [Maybe (Text, Measurable)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe (Text, Measurable)]] -> IO [(Text, Measurable)])
-> [[Maybe (Text, Measurable)]] -> IO [(Text, Measurable)]
forall a b. (a -> b) -> a -> b
$ ((Text, LogObject a) -> [Maybe (Text, Measurable)])
-> [(Text, LogObject a)] -> [[Maybe (Text, Measurable)]]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> (Text, LogObject a) -> [Maybe (Text, Measurable)]
forall (t :: * -> *) a a.
Foldable t =>
t Text -> (a, LogObject a) -> [Maybe (Text, Measurable)]
getVNnVal [Text]
varNames) [(Text, LogObject a)]
mbuf
where
extractVarNames :: MEvExpr -> [Text]
extractVarNames MEvExpr
expr = case MEvExpr
expr of
Compare Text
vn (Operator, Operand)
_ -> [Text
vn]
AND MEvExpr
e1 MEvExpr
e2 -> MEvExpr -> [Text]
extractVarNames MEvExpr
e1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ MEvExpr -> [Text]
extractVarNames MEvExpr
e2
OR MEvExpr
e1 MEvExpr
e2 -> MEvExpr -> [Text]
extractVarNames MEvExpr
e1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ MEvExpr -> [Text]
extractVarNames MEvExpr
e2
NOT MEvExpr
e -> MEvExpr -> [Text]
extractVarNames MEvExpr
e
getVNnVal :: t Text -> (a, LogObject a) -> [Maybe (Text, Measurable)]
getVNnVal t Text
varNames (a, LogObject a)
logObj = case (a, LogObject a)
logObj of
(a
_, LogObject Text
_ LOMeta
_ (LogValue Text
vn Measurable
val)) -> [(Text, Measurable) -> Maybe (Text, Measurable)
forall a. a -> Maybe a
Just (Text
vn, Measurable
val) | Text
vn Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
varNames]
(a
_, LogObject Text
_ LOMeta
_ (AggregatedMessage [(Text, Aggregated)]
agg)) -> ((Text, Aggregated) -> [Maybe (Text, Measurable)])
-> [(Text, Aggregated)] -> [Maybe (Text, Measurable)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Aggregated) -> [Maybe (Text, Measurable)]
getMeasurable [(Text, Aggregated)]
agg
(a
_, LogObject a
_) -> []
where
getMeasurable :: (Text, Aggregated) -> [Maybe (VarName, Measurable)]
getMeasurable :: (Text, Aggregated) -> [Maybe (Text, Measurable)]
getMeasurable (Text, Aggregated)
agg = case (Text, Aggregated)
agg of
(Text
vn, AggregatedEWMA (EWMA Double
_ Measurable
val)) -> [(Text, Measurable) -> Maybe (Text, Measurable)
forall a. a -> Maybe a
Just (Text
vn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".ewma.avg", Measurable
val) | Text
vn Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
varNames]
(Text
vn, AggregatedStats Stats
st) -> if Text
vn Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
varNames
then Text -> Stats -> [Maybe (Text, Measurable)]
forall a.
(Semigroup a, IsString a) =>
a -> Stats -> [Maybe (a, Measurable)]
stValues Text
vn Stats
st
else []
(Text, Aggregated)
_ -> []
where
stValues :: a -> Stats -> [Maybe (a, Measurable)]
stValues a
vn Stats
st =
[ (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".flast", Stats -> Measurable
flast Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fold", Stats -> Measurable
fold Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fbasic.fmin", BaseStats -> Measurable
fmin (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fbasic (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fbasic.fmax", BaseStats -> Measurable
fmax (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fbasic (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fbasic.mean", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
meanOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fbasic (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fbasic.stdev", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
stdevOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fbasic (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fbasic.fcount", Integer -> Measurable
PureI (Integer -> Measurable)
-> (Stats -> Integer) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> (Stats -> Word64) -> Stats -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Word64
fcount (BaseStats -> Word64) -> (Stats -> BaseStats) -> Stats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fbasic (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fdelta.fmin", BaseStats -> Measurable
fmin (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fdelta (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fdelta.fmax", BaseStats -> Measurable
fmax (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fdelta (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fdelta.mean", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
meanOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fdelta (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fdelta.stdev", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
stdevOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fdelta (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fdelta.fcount", Integer -> Measurable
PureI (Integer -> Measurable)
-> (Stats -> Integer) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> (Stats -> Word64) -> Stats -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Word64
fcount (BaseStats -> Word64) -> (Stats -> BaseStats) -> Stats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
fdelta (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".ftimed.fmin", BaseStats -> Measurable
fmin (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
ftimed (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".ftimed.fmax", BaseStats -> Measurable
fmax (BaseStats -> Measurable)
-> (Stats -> BaseStats) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
ftimed (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".ftimed.mean", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
meanOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
ftimed (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".ftimed.stdev", Double -> Measurable
PureD (Double -> Measurable) -> (Stats -> Double) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
stdevOfStats (BaseStats -> Double) -> (Stats -> BaseStats) -> Stats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
ftimed (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
, (a, Measurable) -> Maybe (a, Measurable)
forall a. a -> Maybe a
Just (a
vn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".ftimed.fcount", Integer -> Measurable
PureI (Integer -> Measurable)
-> (Stats -> Integer) -> Stats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> (Stats -> Word64) -> Stats -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Word64
fcount (BaseStats -> Word64) -> (Stats -> BaseStats) -> Stats -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats -> BaseStats
ftimed (Stats -> Measurable) -> Stats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats
st)
]
\end{code}
\subsubsection{Evaluation of monitoring action}\label{code:evalMonitoringAction}
Inspect the log message and match it against configured thresholds. If positive,
then run the action on the current state and return the updated state.
\begin{code}
evalMonitoringAction :: Trace.Trace IO a
-> MonitorMap
-> LogObject a
-> [(VarName, Measurable)]
-> IO MonitorMap
evalMonitoringAction :: Trace IO a
-> HashMap Text MonitorState
-> LogObject a
-> [(Text, Measurable)]
-> IO (HashMap Text MonitorState)
evalMonitoringAction Trace IO a
sbtrace HashMap Text MonitorState
mmap logObj :: LogObject a
logObj@(LogObject Text
logname1 LOMeta
_ LOContent a
content) [(Text, Measurable)]
variables = do
let logname :: Text
logname = case LOContent a
content of
ObserveOpen CounterState
_ -> Text
logname1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".open"
ObserveDiff CounterState
_ -> Text
logname1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".diff"
ObserveClose CounterState
_ -> Text
logname1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".close"
LOContent a
_ -> Text
logname1
let sbtrace' :: Trace IO a
sbtrace' = Text -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
Trace.appendName Text
logname Trace IO a
sbtrace
case Text -> HashMap Text MonitorState -> Maybe MonitorState
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
logname HashMap Text MonitorState
mmap of
Maybe MonitorState
Nothing -> HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text MonitorState
mmap
Just mon :: MonitorState
mon@(MonitorState MEvPreCond
precond MEvExpr
expr [MEvAction]
acts Environment
env0) -> do
let env1 :: Environment
env1 = Environment -> LogObject a -> Environment
forall a. Environment -> LogObject a -> Environment
updateEnv Environment
env0 LogObject a
logObj
let env' :: Environment
env' = Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
env1 (Environment -> Environment) -> Environment -> Environment
forall a b. (a -> b) -> a -> b
$ [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, Measurable)]
variables
let doMonitor :: Bool
doMonitor = case MEvPreCond
precond of
MEvPreCond
Nothing -> Bool
True
Just MEvExpr
preCondExpr -> Environment -> MEvExpr -> Bool
evaluate Environment
env' MEvExpr
preCondExpr
let thresholdIsReached :: Bool
thresholdIsReached = Environment -> MEvExpr -> Bool
evaluate Environment
env' MEvExpr
expr
if Bool
doMonitor Bool -> Bool -> Bool
&& Bool
thresholdIsReached then do
Word64
now <- IO Word64
getMonotonicTimeNSec
let env'' :: Environment
env'' = Text -> Measurable -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"lastalert" (Word64 -> Measurable
Nanoseconds Word64
now) Environment
env'
(MEvAction -> IO ()) -> [MEvAction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Trace IO a -> Environment -> MEvExpr -> MEvAction -> IO ()
forall (m :: * -> *) a a a.
(MonadIO m, Show a, Show a) =>
Trace m a -> a -> a -> MEvAction -> m ()
evaluateAction Trace IO a
sbtrace' Environment
env' MEvExpr
expr) [MEvAction]
acts
HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text MonitorState -> IO (HashMap Text MonitorState))
-> HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall a b. (a -> b) -> a -> b
$ Text
-> MonitorState
-> HashMap Text MonitorState
-> HashMap Text MonitorState
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
logname MonitorState
mon{_environment :: Environment
_environment=Environment
env''} HashMap Text MonitorState
mmap
else HashMap Text MonitorState -> IO (HashMap Text MonitorState)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text MonitorState
mmap
where
updateEnv :: Environment -> LogObject a -> Environment
updateEnv :: Environment -> LogObject a -> Environment
updateEnv Environment
env (LogObject Text
loname LOMeta
lometa (ObserveOpen (CounterState [Counter]
counters))) =
let addenv :: Environment
addenv = [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Measurable)] -> Environment)
-> [(Text, Measurable)] -> Environment
forall a b. (a -> b) -> a -> b
$ (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa))
(Text, Measurable) -> [(Text, Measurable)] -> [(Text, Measurable)]
forall a. a -> [a] -> [a]
: Text -> [Counter] -> [(Text, Measurable)]
countersEnvPairs (Text
loname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".open") [Counter]
counters
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
addenv Environment
env
updateEnv Environment
env (LogObject Text
loname LOMeta
lometa (ObserveDiff (CounterState [Counter]
counters))) =
let addenv :: Environment
addenv = [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Measurable)] -> Environment)
-> [(Text, Measurable)] -> Environment
forall a b. (a -> b) -> a -> b
$ (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa))
(Text, Measurable) -> [(Text, Measurable)] -> [(Text, Measurable)]
forall a. a -> [a] -> [a]
: Text -> [Counter] -> [(Text, Measurable)]
countersEnvPairs (Text
loname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".diff") [Counter]
counters
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
addenv Environment
env
updateEnv Environment
env (LogObject Text
loname LOMeta
lometa (ObserveClose (CounterState [Counter]
counters))) =
let addenv :: Environment
addenv = [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Measurable)] -> Environment)
-> [(Text, Measurable)] -> Environment
forall a b. (a -> b) -> a -> b
$ (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa))
(Text, Measurable) -> [(Text, Measurable)] -> [(Text, Measurable)]
forall a. a -> [a] -> [a]
: Text -> [Counter] -> [(Text, Measurable)]
countersEnvPairs (Text
loname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".close") [Counter]
counters
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
addenv Environment
env
updateEnv Environment
env (LogObject Text
_ LOMeta
lometa (LogValue Text
vn Measurable
val)) =
let addenv :: Environment
addenv = [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (Text
vn, Measurable
val)
, (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa))
]
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
addenv Environment
env
updateEnv Environment
env (LogObject Text
_ LOMeta
lometa (LogMessage a
_logitem)) =
let addenv :: Environment
addenv = [(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (Text
"severity", Severity -> Measurable
Severity (LOMeta -> Severity
severity LOMeta
lometa))
, (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa))
]
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Environment
addenv Environment
env
updateEnv Environment
env (LogObject Text
_ LOMeta
lometa (AggregatedMessage [(Text, Aggregated)]
vals)) =
let addenv :: [(Text, Measurable)]
addenv = (Text
"timestamp", Word64 -> Measurable
Nanoseconds (Word64 -> Measurable) -> Word64 -> Measurable
forall a b. (a -> b) -> a -> b
$ UTCTime -> Word64
utc2ns (LOMeta -> UTCTime
tstamp LOMeta
lometa)) (Text, Measurable) -> [(Text, Measurable)] -> [(Text, Measurable)]
forall a. a -> [a] -> [a]
: [(Text, Aggregated)]
-> [(Text, Measurable)] -> [(Text, Measurable)]
forall a.
(Semigroup a, IsString a) =>
[(a, Aggregated)] -> [(a, Measurable)] -> [(a, Measurable)]
aggs2measurables [(Text, Aggregated)]
vals []
in
Environment -> Environment -> Environment
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union ([(Text, Measurable)] -> Environment
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, Measurable)]
addenv) Environment
env
where
aggs2measurables :: [(a, Aggregated)] -> [(a, Measurable)] -> [(a, Measurable)]
aggs2measurables [] [(a, Measurable)]
acc = [(a, Measurable)]
acc
aggs2measurables ((a
n, AggregatedEWMA EWMA
vewma):[(a, Aggregated)]
r) [(a, Measurable)]
acc = [(a, Aggregated)] -> [(a, Measurable)] -> [(a, Measurable)]
aggs2measurables [(a, Aggregated)]
r ([(a, Measurable)] -> [(a, Measurable)])
-> [(a, Measurable)] -> [(a, Measurable)]
forall a b. (a -> b) -> a -> b
$ (a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".avg", EWMA -> Measurable
avg EWMA
vewma) (a, Measurable) -> [(a, Measurable)] -> [(a, Measurable)]
forall a. a -> [a] -> [a]
: [(a, Measurable)]
acc
aggs2measurables ((a
n, AggregatedStats Stats
s):[(a, Aggregated)]
r) [(a, Measurable)]
acc = [(a, Aggregated)] -> [(a, Measurable)] -> [(a, Measurable)]
aggs2measurables [(a, Aggregated)]
r ([(a, Measurable)] -> [(a, Measurable)])
-> [(a, Measurable)] -> [(a, Measurable)]
forall a b. (a -> b) -> a -> b
$
(a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".mean", Double -> Measurable
PureD (Double -> Measurable)
-> (BaseStats -> Double) -> BaseStats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Double
meanOfStats (BaseStats -> Measurable) -> BaseStats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats -> BaseStats
fbasic Stats
s)
(a, Measurable) -> [(a, Measurable)] -> [(a, Measurable)]
forall a. a -> [a] -> [a]
: (a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".flast", Stats -> Measurable
flast Stats
s)
(a, Measurable) -> [(a, Measurable)] -> [(a, Measurable)]
forall a. a -> [a] -> [a]
: (a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".fcount", Integer -> Measurable
PureI (Integer -> Measurable)
-> (BaseStats -> Integer) -> BaseStats -> Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer)
-> (BaseStats -> Word64) -> BaseStats -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseStats -> Word64
fcount (BaseStats -> Measurable) -> BaseStats -> Measurable
forall a b. (a -> b) -> a -> b
$ Stats -> BaseStats
fbasic Stats
s)
(a, Measurable) -> [(a, Measurable)] -> [(a, Measurable)]
forall a. a -> [a] -> [a]
: [(a, Measurable)]
acc
updateEnv Environment
env LogObject a
_ = Environment
env
countersEnvPairs :: Text -> [Counter] -> [(Text, Measurable)]
countersEnvPairs Text
loggerName = (Counter -> (Text, Measurable))
-> [Counter] -> [(Text, Measurable)]
forall a b. (a -> b) -> [a] -> [b]
map ((Counter -> (Text, Measurable))
-> [Counter] -> [(Text, Measurable)])
-> (Counter -> (Text, Measurable))
-> [Counter]
-> [(Text, Measurable)]
forall a b. (a -> b) -> a -> b
$ \Counter
counter ->
let name :: Text
name = Text
loggerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Counter -> Text
nameCounter Counter
counter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Counter -> Text
cName Counter
counter
value :: Measurable
value = Counter -> Measurable
cValue Counter
counter
in
(Text
name, Measurable
value)
evaluateAction :: Trace m a -> a -> a -> MEvAction -> m ()
evaluateAction Trace m a
sbtrace' a
env a
expr (CreateMessage Severity
sev Text
alertMessage) = do
LOMeta
lometa <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
Public
let fullMessage :: Text
fullMessage = Text
alertMessage
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; environment is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
env)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; threshold expression is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
expr)
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
Trace.traceNamedObject Trace m a
sbtrace' (LOMeta
lometa, MonitorAction -> LOContent a
forall a. MonitorAction -> LOContent a
MonitoringEffect (Text -> MonitorAction
MonitorAlert Text
fullMessage))
evaluateAction Trace m a
sbtrace' a
_ a
_ (SetGlobalMinimalSeverity Severity
sev) = do
LOMeta
lometa <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
Public
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
Trace.traceNamedObject Trace m a
sbtrace' (LOMeta
lometa, MonitorAction -> LOContent a
forall a. MonitorAction -> LOContent a
MonitoringEffect (Severity -> MonitorAction
MonitorAlterGlobalSeverity Severity
sev))
evaluateAction Trace m a
sbtrace' a
_ a
_ (AlterSeverity Text
loggerName Severity
sev) = do
LOMeta
lometa <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
Public
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
Trace.traceNamedObject Trace m a
sbtrace' (LOMeta
lometa, MonitorAction -> LOContent a
forall a. MonitorAction -> LOContent a
MonitoringEffect (Text -> Severity -> MonitorAction
MonitorAlterSeverity Text
loggerName Severity
sev))
\end{code}