\subsection{Cardano.BM.Backend.EKGView}
\label{code:Cardano.BM.Backend.EKGView}
%if style == newcode
\begin{code}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.BM.Backend.EKGView
(
EKGView
, plugin
) where
import Control.Concurrent (killThread, threadDelay)
import qualified Control.Concurrent.Async as Async
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar,
readMVar, withMVar, modifyMVar_, tryTakeMVar)
import Control.Concurrent.STM (atomically)
import qualified Control.Concurrent.STM.TBQueue as TBQ
import Control.Exception (Exception, SomeException, catch, throwIO)
import Control.Exception.Safe (throwM)
import Control.Monad (void, forM_)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON, encode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import Data.Text (Text, pack, stripPrefix)
import qualified Data.Text.IO as TIO
import Data.Version (showVersion)
import System.IO (stderr)
import qualified System.Metrics.Gauge as Gauge
import qualified System.Metrics.Label as Label
import System.Remote.Monitoring (Server, forkServer,
getGauge, getLabel, serverThreadId)
import Paths_iohk_monitoring (version)
import Cardano.BM.Backend.ProcessQueue (processQueue)
import Cardano.BM.Backend.Prometheus (spawnPrometheus)
import Cardano.BM.Configuration (Configuration, getEKGBindAddr,
getPrometheusBindAddr, getTextOption, testSubTrace)
import Cardano.BM.Data.Aggregated
import Cardano.BM.Data.Backend
import Cardano.BM.Data.Configuration (Endpoint (..))
import Cardano.BM.Data.LogItem
import Cardano.BM.Data.Severity
import Cardano.BM.Data.Trace
import Cardano.BM.Data.Tracer (Tracer (..), traceWith)
import Cardano.BM.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
EKGView a
be :: Cardano.BM.Backend.EKGView.EKGView a <- Configuration -> Trace IO a -> s a -> IO (EKGView 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 = EKGView a -> LogObject a -> IO ()
forall (t :: * -> *) a.
IsEffectuator t a =>
t a -> LogObject a -> IO ()
effectuate EKGView a
be, bUnrealize :: IO ()
bUnrealize = EKGView a -> IO ()
forall (t :: * -> *) a. IsBackend t a => t a -> IO ()
unrealize EKGView a
be })
(EKGView a -> BackendKind
forall (t :: * -> *) a. IsBackend t a => t a -> BackendKind
bekind EKGView a
be)
\end{code}
\subsubsection{Structure of EKGView}\label{code:EKGView}\index{EKGView}
\begin{code}
type EKGViewMVar a = MVar (EKGViewInternal a)
newtype EKGView a = EKGView
{ EKGView a -> EKGViewMVar a
getEV :: EKGViewMVar a }
data EKGViewInternal a = EKGViewInternal
{ EKGViewInternal a -> Maybe (TBQueue (Maybe (LogObject a)))
evQueue :: Maybe (TBQ.TBQueue (Maybe (LogObject a)))
, EKGViewInternal a -> EKGViewMap Label
evLabels :: !(EKGViewMap Label.Label)
, EKGViewInternal a -> EKGViewMap Gauge
evGauges :: !(EKGViewMap Gauge.Gauge)
, EKGViewInternal a -> Maybe Server
evServer :: Maybe Server
, EKGViewInternal a -> Maybe (Async ())
evDispatch :: Maybe (Async.Async ())
, EKGViewInternal a -> Maybe (Async ())
evPrometheusDispatch :: Maybe (Async.Async ())
}
\end{code}
\subsubsection{Relation from variable name to label handler}
We keep the label handlers for later update in a |HashMap|.
\begin{code}
type EKGViewMap a = HM.HashMap Text a
\end{code}
\subsubsection{Internal |Trace|}
This is an internal |Trace|, named "\#ekgview", which can be used to control
the messages that are being displayed by EKG.
\begin{code}
ekgTrace :: ToJSON a => EKGView a -> Configuration -> Trace IO a
ekgTrace :: EKGView a -> Configuration -> Trace IO a
ekgTrace EKGView a
ekg Configuration
_c =
LoggerName -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. LoggerName -> Trace m a -> Trace m a
Trace.appendName LoggerName
"#ekgview" (Trace IO a -> Trace IO a) -> Trace IO a -> Trace IO a
forall a b. (a -> b) -> a -> b
$ EKGView a -> Trace IO a
forall a. ToJSON a => EKGView a -> Trace IO a
ekgTrace' EKGView a
ekg
where
ekgTrace' :: ToJSON a => EKGView a -> Trace IO a
ekgTrace' :: EKGView a -> Trace IO a
ekgTrace' EKGView a
ekgview = ((LoggerName, LogObject a) -> IO ()) -> Trace IO a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (((LoggerName, LogObject a) -> IO ()) -> Trace IO a)
-> ((LoggerName, LogObject a) -> IO ()) -> Trace IO a
forall a b. (a -> b) -> a -> b
$ \(LoggerName
_ctx,lo :: LogObject a
lo@(LogObject LoggerName
outerloname LOMeta
_ LOContent a
_)) -> do
let setLabel :: Text -> Text -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setLabel :: LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
setLabel LoggerName
name LoggerName
label ekg_i :: EKGViewInternal a
ekg_i@(EKGViewInternal Maybe (TBQueue (Maybe (LogObject a)))
_ EKGViewMap Label
labels EKGViewMap Gauge
_ Maybe Server
mserver Maybe (Async ())
_ Maybe (Async ())
_) =
case (LoggerName -> EKGViewMap Label -> Maybe Label
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name EKGViewMap Label
labels, Maybe Server
mserver) of
(Maybe Label
Nothing, Just Server
server) -> do
Label
ekghdl <- LoggerName -> Server -> IO Label
getLabel LoggerName
name Server
server
Label -> LoggerName -> IO ()
Label.set Label
ekghdl LoggerName
label
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a)))
-> Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall a b. (a -> b) -> a -> b
$ EKGViewInternal a -> Maybe (EKGViewInternal a)
forall a. a -> Maybe a
Just (EKGViewInternal a -> Maybe (EKGViewInternal a))
-> EKGViewInternal a -> Maybe (EKGViewInternal a)
forall a b. (a -> b) -> a -> b
$ EKGViewInternal a
ekg_i { evLabels :: EKGViewMap Label
evLabels = LoggerName -> Label -> EKGViewMap Label -> EKGViewMap Label
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert LoggerName
name Label
ekghdl EKGViewMap Label
labels}
(Just Label
ekghdl, Maybe Server
_) -> do
Label -> LoggerName -> IO ()
Label.set Label
ekghdl LoggerName
label
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EKGViewInternal a)
forall a. Maybe a
Nothing
(Maybe Label
Nothing, Maybe Server
Nothing) ->
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EKGViewInternal a)
forall a. Maybe a
Nothing
setGauge :: Text -> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge :: LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge LoggerName
name Int64
value ekg_i :: EKGViewInternal a
ekg_i@(EKGViewInternal Maybe (TBQueue (Maybe (LogObject a)))
_ EKGViewMap Label
_ EKGViewMap Gauge
gauges Maybe Server
mserver Maybe (Async ())
_ Maybe (Async ())
_) =
case (LoggerName -> EKGViewMap Gauge -> Maybe Gauge
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup LoggerName
name EKGViewMap Gauge
gauges, Maybe Server
mserver) of
(Maybe Gauge
Nothing, Just Server
server) -> do
Gauge
ekghdl <- LoggerName -> Server -> IO Gauge
getGauge LoggerName
name Server
server
Gauge -> Int64 -> IO ()
Gauge.set Gauge
ekghdl Int64
value
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a)))
-> Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall a b. (a -> b) -> a -> b
$ EKGViewInternal a -> Maybe (EKGViewInternal a)
forall a. a -> Maybe a
Just (EKGViewInternal a -> Maybe (EKGViewInternal a))
-> EKGViewInternal a -> Maybe (EKGViewInternal a)
forall a b. (a -> b) -> a -> b
$ EKGViewInternal a
ekg_i { evGauges :: EKGViewMap Gauge
evGauges = LoggerName -> Gauge -> EKGViewMap Gauge -> EKGViewMap Gauge
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert LoggerName
name Gauge
ekghdl EKGViewMap Gauge
gauges}
(Just Gauge
ekghdl, Maybe Server
_) -> do
Gauge -> Int64 -> IO ()
Gauge.set Gauge
ekghdl Int64
value
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EKGViewInternal a)
forall a. Maybe a
Nothing
(Maybe Gauge
Nothing, Maybe Server
Nothing) ->
Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EKGViewInternal a)
forall a. Maybe a
Nothing
update :: ToJSON a => LogObject a -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
update :: LogObject a -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
update (LogObject LoggerName
loname LOMeta
_ (LogMessage a
logitem)) EKGViewInternal a
ekg_i =
LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
setLabel LoggerName
loname (String -> LoggerName
pack (String -> LoggerName) -> String -> LoggerName
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
logitem) EKGViewInternal a
ekg_i
update (LogObject LoggerName
loname LOMeta
_ (LogValue LoggerName
iname Measurable
value)) EKGViewInternal a
ekg_i =
let logname :: LoggerName
logname = LoggerName
loname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
iname
in
case Measurable
value of
(Microseconds Word64
x) -> LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".us") (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) EKGViewInternal a
ekg_i
(Nanoseconds Word64
x) -> LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".ns") (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) EKGViewInternal a
ekg_i
(Seconds Word64
x) -> LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".s") (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) EKGViewInternal a
ekg_i
(Bytes Word64
x) -> LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".B") (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) EKGViewInternal a
ekg_i
(PureI Integer
x) -> LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> Int64 -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
setGauge (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".int") (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) EKGViewInternal a
ekg_i
(PureD Double
_) -> LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
setLabel (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".real") (String -> LoggerName
pack (String -> LoggerName) -> String -> LoggerName
forall a b. (a -> b) -> a -> b
$ Measurable -> String
forall a. Show a => a -> String
show Measurable
value) EKGViewInternal a
ekg_i
(Severity Severity
_) -> LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
forall a.
LoggerName
-> LoggerName
-> EKGViewInternal a
-> IO (Maybe (EKGViewInternal a))
setLabel (LoggerName
logname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".sev") (String -> LoggerName
pack (String -> LoggerName) -> String -> LoggerName
forall a b. (a -> b) -> a -> b
$ Measurable -> String
forall a. Show a => a -> String
show Measurable
value) EKGViewInternal a
ekg_i
update LogObject a
_ EKGViewInternal a
_ = Maybe (EKGViewInternal a) -> IO (Maybe (EKGViewInternal a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EKGViewInternal a)
forall a. Maybe a
Nothing
MVar (EKGViewInternal a)
-> (EKGViewInternal a -> IO (EKGViewInternal a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (EKGView a -> MVar (EKGViewInternal a)
forall a. EKGView a -> EKGViewMVar a
getEV EKGView a
ekgview) ((EKGViewInternal a -> IO (EKGViewInternal a)) -> IO ())
-> (EKGViewInternal a -> IO (EKGViewInternal a)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \EKGViewInternal a
ekgup -> do
let
loname1 :: LoggerName
loname1 = LoggerName -> Maybe LoggerName -> LoggerName
forall a. a -> Maybe a -> a
fromMaybe LoggerName
outerloname (Maybe LoggerName -> LoggerName) -> Maybe LoggerName -> LoggerName
forall a b. (a -> b) -> a -> b
$ LoggerName -> LoggerName -> Maybe LoggerName
stripPrefix LoggerName
"#ekgview" LoggerName
outerloname
loname :: LoggerName
loname = LoggerName -> Maybe LoggerName -> LoggerName
forall a. a -> Maybe a -> a
fromMaybe LoggerName
loname1 (Maybe LoggerName -> LoggerName) -> Maybe LoggerName -> LoggerName
forall a b. (a -> b) -> a -> b
$ LoggerName -> LoggerName -> Maybe LoggerName
stripPrefix LoggerName
"#aggregation" LoggerName
loname1
Maybe (EKGViewInternal a)
upd <- LogObject a -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
forall a.
ToJSON a =>
LogObject a -> EKGViewInternal a -> IO (Maybe (EKGViewInternal a))
update LogObject a
lo{ loName :: LoggerName
loName = LoggerName
loname } EKGViewInternal a
ekgup
case Maybe (EKGViewInternal a)
upd of
Maybe (EKGViewInternal a)
Nothing -> EKGViewInternal a -> IO (EKGViewInternal a)
forall (m :: * -> *) a. Monad m => a -> m a
return EKGViewInternal a
ekgup
Just EKGViewInternal a
ekgup' -> EKGViewInternal a -> IO (EKGViewInternal a)
forall (m :: * -> *) a. Monad m => a -> m a
return EKGViewInternal a
ekgup'
\end{code}
\subsubsection{EKG view is an effectuator}\index{EKGView!instance of IsEffectuator}
Function |effectuate| is called to pass in a |LogObject| for display in EKG.
If the log item is an |AggregatedStats| message, then all its constituents are
put into the queue. In case the queue is full, all new items are dropped.
\begin{code}
instance IsEffectuator EKGView a where
effectuate :: EKGView a -> LogObject a -> IO ()
effectuate EKGView a
ekgview LogObject a
item = do
EKGViewInternal a
ekg <- MVar (EKGViewInternal a) -> IO (EKGViewInternal a)
forall a. MVar a -> IO a
readMVar (EKGView a -> MVar (EKGViewInternal a)
forall a. EKGView a -> EKGViewMVar a
getEV EKGView a
ekgview)
case EKGViewInternal a -> Maybe (TBQueue (Maybe (LogObject a)))
forall a.
EKGViewInternal a -> Maybe (TBQueue (Maybe (LogObject a)))
evQueue EKGViewInternal a
ekg of
Maybe (TBQueue (Maybe (LogObject a)))
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just TBQueue (Maybe (LogObject a))
queue -> TBQueue (Maybe (LogObject a)) -> IO ()
doEnqueue TBQueue (Maybe (LogObject a))
queue
where
doEnqueue :: TBQ.TBQueue (Maybe (LogObject a)) -> IO ()
doEnqueue :: TBQueue (Maybe (LogObject a)) -> IO ()
doEnqueue TBQueue (Maybe (LogObject a))
queue =
let enqueue :: LogObject a -> IO ()
enqueue LogObject a
a = do
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 TBQueue (Maybe (LogObject a))
queue
if Bool
nocapacity
then EKGView a -> IO ()
forall (t :: * -> *) a. IsEffectuator t a => t a -> IO ()
handleOverflow EKGView a
ekgview
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 TBQueue (Maybe (LogObject a))
queue (LogObject a -> Maybe (LogObject a)
forall a. a -> Maybe a
Just LogObject a
a)
in
case LogObject a
item of
(LogObject LoggerName
loname LOMeta
lometa (AggregatedMessage [(LoggerName, Aggregated)]
ags)) -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let traceAgg :: [(Text,Aggregated)] -> IO ()
traceAgg :: [(LoggerName, Aggregated)] -> IO ()
traceAgg [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceAgg ((LoggerName
n,AggregatedEWMA EWMA
agewma):[(LoggerName, Aggregated)]
r) = do
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject (LoggerName
loname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
n) LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"avg" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ EWMA -> Measurable
avg EWMA
agewma)
[(LoggerName, Aggregated)] -> IO ()
traceAgg [(LoggerName, Aggregated)]
r
traceAgg ((LoggerName
n,AggregatedStats Stats
stats):[(LoggerName, Aggregated)]
r) = do
let statsname :: LoggerName
statsname = LoggerName
loname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
n
qbasestats :: BaseStats -> LoggerName -> IO ()
qbasestats BaseStats
s' LoggerName
nm = do
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"mean" (Double -> Measurable
PureD (Double -> Measurable) -> Double -> Measurable
forall a b. (a -> b) -> a -> b
$ BaseStats -> Double
meanOfStats BaseStats
s'))
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"min" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ BaseStats -> Measurable
fmin BaseStats
s')
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"max" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ BaseStats -> Measurable
fmax BaseStats
s')
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"count" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Integer -> Measurable
PureI (Integer -> Measurable) -> Integer -> Measurable
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ BaseStats -> Word64
fcount BaseStats
s')
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"stdev" (Double -> Measurable
PureD (Double -> Measurable) -> Double -> Measurable
forall a b. (a -> b) -> a -> b
$ BaseStats -> Double
stdevOfStats BaseStats
s'))
LogObject a -> IO ()
enqueue (LogObject a -> IO ()) -> LogObject a -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
statsname LOMeta
lometa (LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
"last" (Measurable -> LOContent a) -> Measurable -> LOContent a
forall a b. (a -> b) -> a -> b
$ Stats -> Measurable
flast Stats
stats)
BaseStats -> LoggerName -> IO ()
qbasestats (Stats -> BaseStats
fbasic Stats
stats) (LoggerName -> IO ()) -> LoggerName -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName
statsname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".basic"
BaseStats -> LoggerName -> IO ()
qbasestats (Stats -> BaseStats
fdelta Stats
stats) (LoggerName -> IO ()) -> LoggerName -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName
statsname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".delta"
BaseStats -> LoggerName -> IO ()
qbasestats (Stats -> BaseStats
ftimed Stats
stats) (LoggerName -> IO ()) -> LoggerName -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName
statsname LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
".timed"
[(LoggerName, Aggregated)] -> IO ()
traceAgg [(LoggerName, Aggregated)]
r
[(LoggerName, Aggregated)] -> IO ()
traceAgg [(LoggerName, Aggregated)]
ags
(LogObject LoggerName
_ LOMeta
_ (LogMessage a
_)) -> LogObject a -> IO ()
enqueue LogObject a
item
(LogObject LoggerName
_ LOMeta
_ (LogValue LoggerName
_ Measurable
_)) -> LogObject a -> IO ()
enqueue LogObject a
item
LogObject a
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleOverflow :: EKGView a -> IO ()
handleOverflow EKGView a
_ = Handle -> LoggerName -> IO ()
TIO.hPutStrLn Handle
stderr LoggerName
"Notice: EKGViews's queue full, dropping log items!"
\end{code}
\subsubsection{|EKGView| implements |Backend| functions}\index{EKGView!instance of IsBackend}
|EKGView| is an |IsBackend|
\begin{code}
instance (ToJSON a, FromJSON a) => IsBackend EKGView a where
type BackendFailure EKGView = EKGBackendFailure
bekind :: EKGView a -> BackendKind
bekind EKGView a
_ = BackendKind
EKGViewBK
realize :: Configuration -> IO (EKGView a)
realize Configuration
_ = String -> IO (EKGView a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"EKGView cannot be instantiated by 'realize'"
realizefrom :: Configuration -> Trace IO a -> s a -> IO (EKGView a)
realizefrom Configuration
config Trace IO a
sbtrace s a
_ = do
MVar (EKGViewInternal a)
evref <- IO (MVar (EKGViewInternal a))
forall a. IO (MVar a)
newEmptyMVar
let ekgview :: EKGView a
ekgview = MVar (EKGViewInternal a) -> EKGView a
forall a. EKGViewMVar a -> EKGView a
EKGView MVar (EKGViewInternal a)
evref
Maybe Endpoint
evHostPort <- Configuration -> IO (Maybe Endpoint)
getEKGBindAddr Configuration
config
(String
evHost, Port
evPort) <- case Maybe Endpoint
evHostPort of
Just (Endpoint (String, Port)
ehp) -> (String, Port) -> IO (String, Port)
forall (m :: * -> *) a. Monad m => a -> m a
return (String, Port)
ehp
Maybe Endpoint
Nothing -> String -> IO (String, Port)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"EKG Backend is enabled, but its host/port are undefined!"
Server
ehdl <- (ByteString -> Port -> IO Server
forkServer (String -> ByteString
BS.pack String
evHost) Port
evPort
IO Server -> IO () -> IO Server
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Port -> IO ()
threadDelay Port
300000)
IO Server -> (SomeException -> IO Server) -> IO Server
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (String -> EKGBackendFailure) -> SomeException -> IO Server
forall b. (String -> EKGBackendFailure) -> SomeException -> IO b
mkHandler String -> EKGBackendFailure
EKGServerStartupError
Label
ekghdl <- LoggerName -> Server -> IO Label
getLabel LoggerName
"iohk-monitoring version" Server
ehdl
Label -> LoggerName -> IO ()
Label.set Label
ekghdl (LoggerName -> IO ()) -> LoggerName -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> LoggerName
pack (Version -> String
showVersion Version
version)
let ekgtrace :: Trace IO a
ekgtrace = EKGView a -> Configuration -> Trace IO a
forall a. ToJSON a => EKGView a -> Configuration -> Trace IO a
ekgTrace EKGView a
ekgview Configuration
config
#ifdef PERFORMANCE_TEST_QUEUE
let qSize = 1000000
#else
let qSize :: Natural
qSize = Natural
5120
#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 <- Configuration
-> TBQueue (Maybe (LogObject a))
-> Trace IO a
-> Trace IO a
-> IO (Async ())
forall a.
Configuration
-> TBQueue (Maybe (LogObject a))
-> Trace IO a
-> Trace IO a
-> IO (Async ())
spawnDispatcher Configuration
config TBQueue (Maybe (LogObject a))
queue Trace IO a
sbtrace Trace IO a
ekgtrace
IO (Async ()) -> (SomeException -> IO (Async ())) -> IO (Async ())
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (String -> EKGBackendFailure) -> SomeException -> IO (Async ())
forall b. (String -> EKGBackendFailure) -> SomeException -> IO b
mkHandler String -> EKGBackendFailure
EKGDispatcherStartupError
Async () -> IO ()
forall a. Async a -> IO ()
Async.link Async ()
dispatcher
Maybe (String, Port)
prometheusBindAddr <- Configuration -> IO (Maybe (String, Port))
getPrometheusBindAddr Configuration
config
Maybe LoggerName
prometheusOutput <- Configuration -> LoggerName -> IO (Maybe LoggerName)
getTextOption Configuration
config LoggerName
"prometheusOutput"
Maybe (Async ())
prometheusDispatcher <-
case Maybe (String, Port)
prometheusBindAddr of
Just (String
host, Port
port) -> do
Async ()
pd <- Server -> ByteString -> Port -> Maybe LoggerName -> IO (Async ())
spawnPrometheus Server
ehdl (String -> ByteString
forall a. IsString a => String -> a
fromString String
host) Port
port Maybe LoggerName
prometheusOutput
IO (Async ()) -> (SomeException -> IO (Async ())) -> IO (Async ())
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (String -> EKGBackendFailure) -> SomeException -> IO (Async ())
forall b. (String -> EKGBackendFailure) -> SomeException -> IO b
mkHandler String -> EKGBackendFailure
EKGPrometheusStartupError
Async () -> IO ()
forall a. Async a -> IO ()
Async.link Async ()
pd
Maybe (Async ()) -> IO (Maybe (Async ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just Async ()
pd)
Maybe (String, Port)
Nothing ->
Maybe (Async ()) -> IO (Maybe (Async ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Async ())
forall a. Maybe a
Nothing
MVar (EKGViewInternal a) -> EKGViewInternal a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (EKGViewInternal a)
evref (EKGViewInternal a -> IO ()) -> EKGViewInternal a -> IO ()
forall a b. (a -> b) -> a -> b
$ EKGViewInternal :: forall a.
Maybe (TBQueue (Maybe (LogObject a)))
-> EKGViewMap Label
-> EKGViewMap Gauge
-> Maybe Server
-> Maybe (Async ())
-> Maybe (Async ())
-> EKGViewInternal a
EKGViewInternal
{ evLabels :: EKGViewMap Label
evLabels = EKGViewMap Label
forall k v. HashMap k v
HM.empty
, evGauges :: EKGViewMap Gauge
evGauges = EKGViewMap Gauge
forall k v. HashMap k v
HM.empty
, evServer :: Maybe Server
evServer = Server -> Maybe Server
forall a. a -> Maybe a
Just Server
ehdl
, evQueue :: Maybe (TBQueue (Maybe (LogObject a)))
evQueue = TBQueue (Maybe (LogObject a))
-> Maybe (TBQueue (Maybe (LogObject a)))
forall a. a -> Maybe a
Just TBQueue (Maybe (LogObject a))
queue
, evDispatch :: Maybe (Async ())
evDispatch = Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just Async ()
dispatcher
, evPrometheusDispatch :: Maybe (Async ())
evPrometheusDispatch = Maybe (Async ())
prometheusDispatcher
}
EKGView a -> IO (EKGView a)
forall (m :: * -> *) a. Monad m => a -> m a
return EKGView a
ekgview
IO (EKGView a)
-> (EKGBackendFailure -> IO (EKGView a)) -> IO (EKGView a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
Trace IO a -> EKGBackendFailure -> IO (EKGView a)
nullSetup Trace IO a
sbtrace
IO (EKGView a)
-> (SomeException -> IO (EKGView a)) -> IO (EKGView a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
(Trace IO a -> EKGBackendFailure -> IO (EKGView a)
nullSetup Trace IO a
sbtrace (EKGBackendFailure -> IO (EKGView a))
-> (SomeException -> EKGBackendFailure)
-> SomeException
-> IO (EKGView a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EKGBackendFailure
EKGUnknownStartupError (String -> EKGBackendFailure)
-> (SomeException -> String) -> SomeException -> EKGBackendFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> String
forall a. Show a => a -> String
show :: SomeException -> String))
where
mkHandler
:: (String -> EKGBackendFailure)
-> SomeException
-> IO b
mkHandler :: (String -> EKGBackendFailure) -> SomeException -> IO b
mkHandler String -> EKGBackendFailure
ctor = EKGBackendFailure -> IO b
forall e a. Exception e => e -> IO a
throwIO (EKGBackendFailure -> IO b)
-> (SomeException -> EKGBackendFailure) -> SomeException -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EKGBackendFailure
ctor (String -> EKGBackendFailure)
-> (SomeException -> String) -> SomeException -> EKGBackendFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show
nullSetup
:: Trace IO a
-> EKGBackendFailure
-> IO (EKGView a)
nullSetup :: Trace IO a -> EKGBackendFailure -> IO (EKGView a)
nullSetup Trace IO a
trace EKGBackendFailure
e = do
LOMeta
meta <- Severity -> PrivacyAnnotation -> IO LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Error PrivacyAnnotation
Public
Trace IO a -> (LoggerName, LogObject a) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO a
trace ((LoggerName, LogObject a) -> IO ())
-> (LoggerName, LogObject a) -> IO ()
forall a b. (a -> b) -> a -> b
$ (LoggerName
"#ekgview.realizeFrom", LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
"#ekgview.realizeFrom" LOMeta
meta (LOContent a -> LogObject a) -> LOContent a -> LogObject a
forall a b. (a -> b) -> a -> b
$
LoggerName -> LOContent a
forall a. LoggerName -> LOContent a
LogError (LoggerName -> LOContent a) -> LoggerName -> LOContent a
forall a b. (a -> b) -> a -> b
$ LoggerName
"EKGView backend disabled due to initialisation error: " LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> (String -> LoggerName
pack (String -> LoggerName) -> String -> LoggerName
forall a b. (a -> b) -> a -> b
$ EKGBackendFailure -> String
forall a. Show a => a -> String
show EKGBackendFailure
e))
TBQueue Any
_ <- STM (TBQueue Any) -> IO (TBQueue Any)
forall a. STM a -> IO a
atomically (STM (TBQueue Any) -> IO (TBQueue Any))
-> STM (TBQueue Any) -> IO (TBQueue Any)
forall a b. (a -> b) -> a -> b
$ Natural -> STM (TBQueue Any)
forall a. Natural -> STM (TBQueue a)
TBQ.newTBQueue Natural
0
MVar (EKGViewInternal a)
ref <- IO (MVar (EKGViewInternal a))
forall a. IO (MVar a)
newEmptyMVar
MVar (EKGViewInternal a) -> EKGViewInternal a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (EKGViewInternal a)
ref (EKGViewInternal a -> IO ()) -> EKGViewInternal a -> IO ()
forall a b. (a -> b) -> a -> b
$ EKGViewInternal :: forall a.
Maybe (TBQueue (Maybe (LogObject a)))
-> EKGViewMap Label
-> EKGViewMap Gauge
-> Maybe Server
-> Maybe (Async ())
-> Maybe (Async ())
-> EKGViewInternal a
EKGViewInternal
{ evLabels :: EKGViewMap Label
evLabels = EKGViewMap Label
forall k v. HashMap k v
HM.empty
, evGauges :: EKGViewMap Gauge
evGauges = EKGViewMap Gauge
forall k v. HashMap k v
HM.empty
, evServer :: Maybe Server
evServer = Maybe Server
forall a. Maybe a
Nothing
, evQueue :: Maybe (TBQueue (Maybe (LogObject a)))
evQueue = Maybe (TBQueue (Maybe (LogObject a)))
forall a. Maybe a
Nothing
, evDispatch :: Maybe (Async ())
evDispatch = Maybe (Async ())
forall a. Maybe a
Nothing
, evPrometheusDispatch :: Maybe (Async ())
evPrometheusDispatch = Maybe (Async ())
forall a. Maybe a
Nothing
}
EKGView a -> IO (EKGView a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EKGView a -> IO (EKGView a)) -> EKGView a -> IO (EKGView a)
forall a b. (a -> b) -> a -> b
$ MVar (EKGViewInternal a) -> EKGView a
forall a. EKGViewMVar a -> EKGView a
EKGView MVar (EKGViewInternal a)
ref
unrealize :: EKGView a -> IO ()
unrealize EKGView a
ekgview = 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
MVar (EKGViewInternal a) -> (EKGViewInternal a -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EKGView a -> MVar (EKGViewInternal a)
forall a. EKGView a -> EKGViewMVar a
getEV EKGView a
ekgview) ((EKGViewInternal a -> IO ()) -> IO ())
-> (EKGViewInternal a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \EKGViewInternal a
ev -> do
Maybe (TBQueue (Maybe (LogObject a)))
-> (TBQueue (Maybe (LogObject a)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EKGViewInternal a -> Maybe (TBQueue (Maybe (LogObject a)))
forall a.
EKGViewInternal a -> Maybe (TBQueue (Maybe (LogObject a)))
evQueue EKGViewInternal a
ev) ((TBQueue (Maybe (LogObject a)) -> IO ()) -> IO ())
-> (TBQueue (Maybe (LogObject a)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\TBQueue (Maybe (LogObject a))
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
Maybe (Async ()) -> (Async () -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EKGViewInternal a -> Maybe (Async ())
forall a. EKGViewInternal a -> Maybe (Async ())
evDispatch EKGViewInternal a
ev) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Async ()
dispatcher -> do
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
Maybe (Async ()) -> (Async () -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EKGViewInternal a -> Maybe (Async ())
forall a. EKGViewInternal a -> Maybe (Async ())
evPrometheusDispatch EKGViewInternal a
ev) ((Async () -> IO ()) -> IO ()) -> (Async () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Async () -> IO ()
forall a. Async a -> IO ()
Async.cancel
MVar (EKGViewInternal a) -> (EKGViewInternal a -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (EKGView a -> MVar (EKGViewInternal a)
forall a. EKGView a -> EKGViewMVar a
getEV EKGView a
ekgview) ((EKGViewInternal a -> IO ()) -> IO ())
-> (EKGViewInternal a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \EKGViewInternal a
ekg ->
Maybe Server -> (Server -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (EKGViewInternal a -> Maybe Server
forall a. EKGViewInternal a -> Maybe Server
evServer EKGViewInternal a
ekg) ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Server
server -> ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ Server -> ThreadId
serverThreadId Server
server
MVar (EKGViewInternal a) -> IO ()
forall b. MVar b -> IO ()
clearMVar (MVar (EKGViewInternal a) -> IO ())
-> MVar (EKGViewInternal a) -> IO ()
forall a b. (a -> b) -> a -> b
$ EKGView a -> MVar (EKGViewInternal a)
forall a. EKGView a -> EKGViewMVar a
getEV EKGView a
ekgview
data EKGBackendFailure
= EKGUnknownStartupError String
| EKGServerStartupError String
| EKGDispatcherStartupError String
| EKGPrometheusStartupError String
deriving Port -> EKGBackendFailure -> ShowS
[EKGBackendFailure] -> ShowS
EKGBackendFailure -> String
(Port -> EKGBackendFailure -> ShowS)
-> (EKGBackendFailure -> String)
-> ([EKGBackendFailure] -> ShowS)
-> Show EKGBackendFailure
forall a.
(Port -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EKGBackendFailure] -> ShowS
$cshowList :: [EKGBackendFailure] -> ShowS
show :: EKGBackendFailure -> String
$cshow :: EKGBackendFailure -> String
showsPrec :: Port -> EKGBackendFailure -> ShowS
$cshowsPrec :: Port -> EKGBackendFailure -> ShowS
Show
instance Exception EKGBackendFailure
\end{code}
\subsubsection{Asynchronously reading log items from the queue and their processing}
\begin{code}
spawnDispatcher :: Configuration
-> TBQ.TBQueue (Maybe (LogObject a))
-> Trace.Trace IO a
-> Trace.Trace IO a
-> IO (Async.Async ())
spawnDispatcher :: Configuration
-> TBQueue (Maybe (LogObject a))
-> Trace IO a
-> Trace IO a
-> IO (Async ())
spawnDispatcher Configuration
config TBQueue (Maybe (LogObject a))
evqueue Trace IO a
_sbtrace Trace IO a
ekgtrace =
IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
Async.async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO ()
qProc
where
qProc :: IO ()
qProc :: IO ()
qProc =
TBQueue (Maybe (LogObject a))
-> (LogObject a -> () -> IO ()) -> () -> (() -> IO ()) -> IO ()
forall a b.
TBQueue (Maybe (LogObject a))
-> (LogObject a -> b -> IO b) -> b -> (b -> IO ()) -> IO ()
processQueue
TBQueue (Maybe (LogObject a))
evqueue
LogObject a -> () -> IO ()
processEKGView
()
(\()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
processEKGView :: LogObject a -> () -> IO ()
processEKGView obj :: LogObject a
obj@(LogObject LoggerName
loname0 LOMeta
_ LOContent a
_) ()
_ = do
Maybe (LogObject a)
obj' <- Configuration
-> LoggerName -> LogObject a -> IO (Maybe (LogObject a))
forall a.
Configuration
-> LoggerName -> LogObject a -> IO (Maybe (LogObject a))
testSubTrace Configuration
config (LoggerName
"#ekgview." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
loname0) LogObject a
obj
case Maybe (LogObject a)
obj' of
Just LogObject a
lo ->
let trace :: Trace IO a
trace = LoggerName -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. LoggerName -> Trace m a -> Trace m a
Trace.appendName LoggerName
loname0 Trace IO a
ekgtrace
in
Trace IO a -> (LoggerName, LogObject a) -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Trace IO a
trace (LoggerName
loname0, LogObject a
lo)
Maybe (LogObject a)
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
\end{code}