\subsection{Cardano.BM.Backend.Monitoring}
\label{module:Cardano.BM.Backend.Monitoring}



%if style == newcode
\begin{code}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}

{-@ embed Ratio * as int             @-}
{-@ embed GHC.Natural.Natural as int @-}

module Cardano.BM.Backend.Monitoring
    (
      Monitor
    -- * Plugin
    , 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
        -- link the given Async to the current thread, such that if the Async
        -- raises an exception, that exception will be re-thrown in the current
        -- thread, wrapped in ExceptionInLinkedThread.
        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))
        -- send terminating item to the queue
        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
        -- wait for the dispatcher to exit
        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
    {-@ lazy qProc @-}
    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
    -- Here we take all var names for all monitors, just in case.
    [(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
                    -- There's no precondition, do monitor as usual.
                    MEvPreCond
Nothing -> Bool
True
                    -- Precondition is defined, do monitor only if it is True.
                    Just MEvExpr
preCondExpr -> Environment -> MEvExpr -> Bool
evaluate Environment
env' MEvExpr
preCondExpr
            -- In this place env' already must contain opvn..
            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
    -- catch all
    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}