\subsection{Cardano.BM.Observer.Monadic}
\label{code:Cardano.BM.Observer.Monadic}
%if style == newcode
\begin{code}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.BM.Observer.Monadic
(
bracketObserveIO
, bracketObserveM
, bracketObserveX
, observeOpen
, observeClose
) where
import Control.Exception.Safe (MonadCatch, SomeException, catch, throwM)
import Control.Monad (forM_)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import Data.Text
import qualified Data.Text.IO as TIO
import System.IO (stderr)
import Cardano.BM.Data.Counter (CounterState (..), diffCounters)
import Cardano.BM.Data.LogItem (LOContent (..), LOMeta,
PrivacyAnnotation(Confidential), mkLOMeta)
import Cardano.BM.Data.Severity (Severity)
import qualified Cardano.BM.Configuration as Config
import Cardano.BM.Counters (readCounters)
import Cardano.BM.Data.SubTrace (SubTrace (Neutral, NoTrace))
import Cardano.BM.Trace (Trace, traceNamedObject)
\end{code}
%endif
\subsubsection{Monadic.bracketObserverIO}
Observes an |IO| action. The subtrace type is found in the configuration with
the passed-in name.
\newline
\par\noindent
Microbenchmarking steps:
\newline
\par
1. Create a |trace| which will have been configured
to observe things besides logging.
\begin{spec}
import qualified Cardano.BM.Configuration.Model as CM
. . .
c <- config
trace <- setupTrace (Right c) "demo-playground"
where
config :: IO CM.Configuration
config = do
c <- CM.empty
CM.setMinSeverity c Debug
CM.setSetupBackends c [KatipBK, AggregationBK]
CM.setDefaultBackends c [KatipBK, AggregationBK]
CM.setSetupScribes c [ ScribeDefinition {
scName = "stdout"
, scKind = StdoutSK
, scRotation = Nothing
}
]
CM.setDefaultScribes c ["StdoutSK::stdout"]
return c
\end{spec}
2. |c| is the |Configuration| of |trace|. In order to
enable the collection and processing of measurements
(min, max, mean, std-dev) |AggregationBK| is needed.
\begin{spec}
CM.setDefaultBackends c [KatipBK, AggregationBK]
\end{spec}
in a configuration file (YAML) means
\begin{spec}
defaultBackends:
- KatipBK
- AggregationBK
\end{spec}
3. Set the measurements that you want to take by changing
the configuration of the |trace| using |setSubTrace|,
in order to declare the namespace where we want to
enable the particular measurements and the list with
the kind of measurements.
\begin{spec}
CM.setSubTrace
config
"submit-tx"
(Just $ ObservableTraceSelf observablesSet)
where
observablesSet = [MonotonicClock, MemoryStats]
\end{spec}
4. Find an action to measure. e.g.:
\begin{spec}
runProtocolWithPipe x hdl proto `catch` (\ProtocolStopped -> return ())
\end{spec}
and use |bracketObserveIO|. e.g.:
\begin{spec}
bracketObserveIO trace "submit-tx" $
runProtocolWithPipe x hdl proto `catch` (\ProtocolStopped -> return ())
\end{spec}
\begin{code}
bracketObserveIO :: Config.Configuration -> Trace IO a -> Severity -> Text -> IO t -> IO t
bracketObserveIO :: Configuration -> Trace IO a -> Severity -> Text -> IO t -> IO t
bracketObserveIO Configuration
config Trace IO a
trace Severity
severity Text
name IO t
action = do
SubTrace
subTrace <- SubTrace -> Maybe SubTrace -> SubTrace
forall a. a -> Maybe a -> a
fromMaybe SubTrace
Neutral (Maybe SubTrace -> SubTrace) -> IO (Maybe SubTrace) -> IO SubTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> Text -> IO (Maybe SubTrace)
Config.findSubTrace Configuration
config Text
name
SubTrace -> Severity -> Trace IO a -> IO t -> IO t
forall a t. SubTrace -> Severity -> Trace IO a -> IO t -> IO t
bracketObserveIO' SubTrace
subTrace Severity
severity Trace IO a
trace IO t
action
where
bracketObserveIO' :: SubTrace -> Severity -> Trace IO a -> IO t -> IO t
bracketObserveIO' :: SubTrace -> Severity -> Trace IO a -> IO t -> IO t
bracketObserveIO' SubTrace
NoTrace Severity
_ Trace IO a
_ IO t
act = IO t
act
bracketObserveIO' SubTrace
subtrace Severity
sev Trace IO a
logTrace IO t
act = do
Either SomeException CounterState
mCountersid <- SubTrace
-> Severity -> Trace IO a -> IO (Either SomeException CounterState)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
SubTrace
-> Severity -> Trace m a -> m (Either SomeException CounterState)
observeOpen SubTrace
subtrace Severity
sev Trace IO a
logTrace
t
t <- IO t
act IO t -> (SomeException -> IO t) -> IO t
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)) IO () -> IO t -> IO t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO t
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e))
case Either SomeException CounterState
mCountersid of
Left SomeException
openException ->
Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"ObserveOpen: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
openException))
Right CounterState
countersid -> do
Either SomeException ()
res <- SubTrace
-> Severity
-> Trace IO a
-> CounterState
-> [(LOMeta, LOContent a)]
-> IO (Either SomeException ())
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m (Either SomeException ())
observeClose SubTrace
subtrace Severity
sev Trace IO a
logTrace CounterState
countersid []
case Either SomeException ()
res of
Left SomeException
ex -> Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"ObserveClose: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
ex))
Either SomeException ()
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
t -> IO t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
\end{code}
\subsubsection{Monadic.bracketObserverM}
Observes a |MonadIO m => m| action.
\begin{code}
bracketObserveM :: (MonadCatch m, MonadIO m) => Config.Configuration -> Trace m a -> Severity -> Text -> m t -> m t
bracketObserveM :: Configuration -> Trace m a -> Severity -> Text -> m t -> m t
bracketObserveM Configuration
config Trace m a
trace Severity
severity Text
name m t
action = do
SubTrace
subTrace <- IO SubTrace -> m SubTrace
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubTrace -> m SubTrace) -> IO SubTrace -> m SubTrace
forall a b. (a -> b) -> a -> b
$ SubTrace -> Maybe SubTrace -> SubTrace
forall a. a -> Maybe a -> a
fromMaybe SubTrace
Neutral (Maybe SubTrace -> SubTrace) -> IO (Maybe SubTrace) -> IO SubTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> Text -> IO (Maybe SubTrace)
Config.findSubTrace Configuration
config Text
name
SubTrace -> Severity -> Trace m a -> m t -> m t
forall (m :: * -> *) a t.
(MonadCatch m, MonadIO m) =>
SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveM' SubTrace
subTrace Severity
severity Trace m a
trace m t
action
where
bracketObserveM' :: (MonadCatch m, MonadIO m) => SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveM' :: SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveM' SubTrace
NoTrace Severity
_ Trace m a
_ m t
act = m t
act
bracketObserveM' SubTrace
subtrace Severity
sev Trace m a
logTrace m t
act = do
Either SomeException CounterState
mCountersid <- SubTrace
-> Severity -> Trace m a -> m (Either SomeException CounterState)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
SubTrace
-> Severity -> Trace m a -> m (Either SomeException CounterState)
observeOpen SubTrace
subtrace Severity
sev Trace m a
logTrace
t
t <- m t
act m t -> (SomeException -> m t) -> m t
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)) IO () -> IO t -> IO t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO t
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e))
case Either SomeException CounterState
mCountersid of
Left SomeException
openException ->
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"ObserveOpen: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
openException))
Right CounterState
countersid -> do
Either SomeException ()
res <- SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m (Either SomeException ())
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m (Either SomeException ())
observeClose SubTrace
subtrace Severity
sev Trace m a
logTrace CounterState
countersid []
case Either SomeException ()
res of
Left SomeException
ex -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text
"ObserveClose: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
ex)))
Either SomeException ()
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
\end{code}
\subsubsection{Monadic.bracketObserver}
Observes a |MonadIO m => m| action. This observer bracket does not interfere
on exceptions.
\begin{code}
bracketObserveX :: (MonadIO m) => Config.Configuration -> Trace m a -> Severity -> Text -> m t -> m t
bracketObserveX :: Configuration -> Trace m a -> Severity -> Text -> m t -> m t
bracketObserveX Configuration
config Trace m a
trace Severity
severity Text
name m t
action = do
SubTrace
subTrace <- IO SubTrace -> m SubTrace
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubTrace -> m SubTrace) -> IO SubTrace -> m SubTrace
forall a b. (a -> b) -> a -> b
$ SubTrace -> Maybe SubTrace -> SubTrace
forall a. a -> Maybe a -> a
fromMaybe SubTrace
Neutral (Maybe SubTrace -> SubTrace) -> IO (Maybe SubTrace) -> IO SubTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> Text -> IO (Maybe SubTrace)
Config.findSubTrace Configuration
config Text
name
SubTrace -> Severity -> Trace m a -> m t -> m t
forall (m :: * -> *) a t.
MonadIO m =>
SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveX' SubTrace
subTrace Severity
severity Trace m a
trace m t
action
where
bracketObserveX' :: (MonadIO m) => SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveX' :: SubTrace -> Severity -> Trace m a -> m t -> m t
bracketObserveX' SubTrace
NoTrace Severity
_ Trace m a
_ m t
act = m t
act
bracketObserveX' SubTrace
subtrace Severity
sev Trace m a
logTrace m t
act = do
CounterState
countersid <- SubTrace -> Severity -> Trace m a -> m CounterState
forall (m :: * -> *) a.
MonadIO m =>
SubTrace -> Severity -> Trace m a -> m CounterState
observeOpen0 SubTrace
subtrace Severity
sev Trace m a
logTrace
t
t <- m t
act
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m ()
forall (m :: * -> *) a.
MonadIO m =>
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m ()
observeClose0 SubTrace
subtrace Severity
sev Trace m a
logTrace CounterState
countersid []
t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t
\end{code}
\subsubsection{observerOpen}\label{observeOpen}
\begin{code}
observeOpen :: (MonadCatch m, MonadIO m) => SubTrace -> Severity -> Trace m a -> m (Either SomeException CounterState)
observeOpen :: SubTrace
-> Severity -> Trace m a -> m (Either SomeException CounterState)
observeOpen SubTrace
subtrace Severity
severity Trace m a
logTrace = (do
CounterState
state <- SubTrace -> Severity -> Trace m a -> m CounterState
forall (m :: * -> *) a.
MonadIO m =>
SubTrace -> Severity -> Trace m a -> m CounterState
observeOpen0 SubTrace
subtrace Severity
severity Trace m a
logTrace
Either SomeException CounterState
-> m (Either SomeException CounterState)
forall (m :: * -> *) a. Monad m => a -> m a
return (CounterState -> Either SomeException CounterState
forall a b. b -> Either a b
Right CounterState
state)) m (Either SomeException CounterState)
-> (SomeException -> m (Either SomeException CounterState))
-> m (Either SomeException CounterState)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (Either SomeException CounterState
-> m (Either SomeException CounterState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException CounterState
-> m (Either SomeException CounterState))
-> (SomeException -> Either SomeException CounterState)
-> SomeException
-> m (Either SomeException CounterState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException CounterState
forall a b. a -> Either a b
Left)
observeOpen0 :: (MonadIO m) => SubTrace -> Severity -> Trace m a -> m CounterState
observeOpen0 :: SubTrace -> Severity -> Trace m a -> m CounterState
observeOpen0 SubTrace
subtrace Severity
severity Trace m a
logTrace = do
[Counter]
counters <- IO [Counter] -> m [Counter]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Counter] -> m [Counter]) -> IO [Counter] -> m [Counter]
forall a b. (a -> b) -> a -> b
$ SubTrace -> IO [Counter]
readCounters SubTrace
subtrace
let state :: CounterState
state = [Counter] -> CounterState
CounterState [Counter]
counters
if [Counter]
counters [Counter] -> [Counter] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
LOMeta
meta <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
severity PrivacyAnnotation
Confidential
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
logTrace (LOMeta
meta, CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveOpen CounterState
state)
CounterState -> m CounterState
forall (m :: * -> *) a. Monad m => a -> m a
return CounterState
state
\end{code}
\subsubsection{observeClose}\label{observeClose}
\begin{code}
observeClose
:: (MonadCatch m, MonadIO m) => SubTrace -> Severity -> Trace m a
-> CounterState -> [(LOMeta, LOContent a)]
-> m (Either SomeException ())
observeClose :: SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m (Either SomeException ())
observeClose SubTrace
subtrace Severity
sev Trace m a
logTrace CounterState
initState [(LOMeta, LOContent a)]
logObjects = (do
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m ()
forall (m :: * -> *) a.
MonadIO m =>
SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m ()
observeClose0 SubTrace
subtrace Severity
sev Trace m a
logTrace CounterState
initState [(LOMeta, LOContent a)]
logObjects
Either SomeException () -> m (Either SomeException ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either SomeException ()
forall a b. b -> Either a b
Right ())) m (Either SomeException ())
-> (SomeException -> m (Either SomeException ()))
-> m (Either SomeException ())
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (Either SomeException () -> m (Either SomeException ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException () -> m (Either SomeException ()))
-> (SomeException -> Either SomeException ())
-> SomeException
-> m (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException ()
forall a b. a -> Either a b
Left)
observeClose0 :: (MonadIO m) => SubTrace -> Severity -> Trace m a
-> CounterState -> [(LOMeta, LOContent a)]
-> m ()
observeClose0 :: SubTrace
-> Severity
-> Trace m a
-> CounterState
-> [(LOMeta, LOContent a)]
-> m ()
observeClose0 SubTrace
subtrace Severity
sev Trace m a
logTrace CounterState
initState [(LOMeta, LOContent a)]
logObjects = do
let initialCounters :: [Counter]
initialCounters = CounterState -> [Counter]
csCounters CounterState
initState
[Counter]
counters <- IO [Counter] -> m [Counter]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Counter] -> m [Counter]) -> IO [Counter] -> m [Counter]
forall a b. (a -> b) -> a -> b
$ SubTrace -> IO [Counter]
readCounters SubTrace
subtrace
if [Counter]
counters [Counter] -> [Counter] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
LOMeta
mle <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
Confidential
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
logTrace ((LOMeta, LOContent a) -> m ()) -> (LOMeta, LOContent a) -> m ()
forall a b. (a -> b) -> a -> b
$
(LOMeta
mle, CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveClose ([Counter] -> CounterState
CounterState [Counter]
counters))
Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
logTrace ((LOMeta, LOContent a) -> m ()) -> (LOMeta, LOContent a) -> m ()
forall a b. (a -> b) -> a -> b
$
(LOMeta
mle, CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveDiff ([Counter] -> CounterState
CounterState ([Counter] -> [Counter] -> [Counter]
diffCounters [Counter]
initialCounters [Counter]
counters)))
[(LOMeta, LOContent a)] -> ((LOMeta, LOContent a) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(LOMeta, LOContent a)]
logObjects (((LOMeta, LOContent a) -> m ()) -> m ())
-> ((LOMeta, LOContent a) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
logTrace
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
\end{code}