{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Tracing.MicroBenchmarking
( MeasureTxs (..)
, measureTxsStart
, measureTxsEnd
, Outcome (..)
, OutcomeEnhancedTracer
, mkOutcomeExtractor
) where
import Cardano.Prelude
import Control.Monad.Class.MonadTime (DiffTime, MonadTime, Time (..), diffTime,
getMonotonicTime)
import Data.Aeson (Value (..), toJSON, (.=))
import Data.Time.Clock (diffTimeToPicoseconds)
import Cardano.BM.Data.Tracer (emptyObject, mkObject, trStructured)
import Cardano.BM.Tracing
import Control.Tracer.Transformers.ObserveOutcome
import Ouroboros.Network.Block (SlotNo (..))
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, HasTxId, txId)
import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..))
import Ouroboros.Consensus.Node.Tracers (TraceForgeEvent (..))
data MeasureTxs blk
= MeasureTxsTimeStart (GenTx blk) !Word !Word !Time
| MeasureTxsTimeStop !SlotNo blk [GenTx blk] !Time
deriving instance (Eq blk, Eq (GenTx blk)) => Eq (MeasureTxs blk)
deriving instance (Show blk, Show (GenTx blk)) => Show (MeasureTxs blk)
instance Transformable Text IO (MeasureTxs blk) where
trTransformer :: TracingVerbosity -> Trace IO Text -> Tracer IO (MeasureTxs blk)
trTransformer = TracingVerbosity -> Trace IO Text -> Tracer IO (MeasureTxs blk)
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured
instance HasPrivacyAnnotation (MeasureTxs blk)
instance HasSeverityAnnotation (MeasureTxs blk) where
getSeverityAnnotation :: MeasureTxs blk -> Severity
getSeverityAnnotation MeasureTxs blk
_ = Severity
Info
instance ToObject (MeasureTxs blk) where
toObject :: TracingVerbosity -> MeasureTxs blk -> Object
toObject TracingVerbosity
_verb (MeasureTxsTimeStart GenTx blk
_txs Word
mempoolNumTxs Word
mempoolNumBytes (Time DiffTime
time)) =
[(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
[ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MeasureTxsTimeStart"
, Text
"mempoolNumTxs" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
mempoolNumTxs
, Text
"mempoolNumBytes" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word -> Value
forall a. ToJSON a => a -> Value
toJSON Word
mempoolNumBytes
, Text
"time(ps)" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time)
]
toObject TracingVerbosity
_verb (MeasureTxsTimeStop SlotNo
slotNo blk
_blk [GenTx blk]
_txs (Time DiffTime
time)) =
[(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
[ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MeasureTxsTimeStop"
, Text
"slot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotNo)
, Text
"time(ps)" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time)
]
measureTxsStart :: forall blk. Trace IO Text -> Tracer IO (TraceEventMempool blk)
measureTxsStart :: Trace IO Text -> Tracer IO (TraceEventMempool blk)
measureTxsStart Trace IO Text
tracer = Tracer IO (MeasureTxs blk) -> Tracer IO (TraceEventMempool blk)
measureTxsStartInter (Tracer IO (MeasureTxs blk) -> Tracer IO (TraceEventMempool blk))
-> Tracer IO (MeasureTxs blk) -> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ Trace IO Text -> Tracer IO (MeasureTxs blk)
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
Trace m a -> Tracer m b
toLogObject Trace IO Text
tracer
where
measureTxsStartInter :: Tracer IO (MeasureTxs blk) -> Tracer IO (TraceEventMempool blk)
measureTxsStartInter :: Tracer IO (MeasureTxs blk) -> Tracer IO (TraceEventMempool blk)
measureTxsStartInter Tracer IO (MeasureTxs blk)
tracer' = (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk))
-> (TraceEventMempool blk -> IO ())
-> Tracer IO (TraceEventMempool blk)
forall a b. (a -> b) -> a -> b
$ \case
TraceMempoolAddedTx GenTx blk
tx MempoolSize
_mpSizeBefore MempoolSize
mpSizeAfter ->
Tracer IO (MeasureTxs blk) -> MeasureTxs blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (MeasureTxs blk)
tracer' (MeasureTxs blk -> IO ()) -> IO (MeasureTxs blk) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MempoolSize -> IO (MeasureTxs blk)
measureTxsEvent MempoolSize
mpSizeAfter
where
measureTxsEvent :: MempoolSize -> IO (MeasureTxs blk)
measureTxsEvent :: MempoolSize -> IO (MeasureTxs blk)
measureTxsEvent MempoolSize{Word32
msNumTxs :: MempoolSize -> Word32
msNumTxs :: Word32
msNumTxs, Word32
msNumBytes :: MempoolSize -> Word32
msNumBytes :: Word32
msNumBytes} =
GenTx blk -> Word -> Word -> Time -> MeasureTxs blk
forall blk. GenTx blk -> Word -> Word -> Time -> MeasureTxs blk
MeasureTxsTimeStart
GenTx blk
tx
(Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
msNumTxs)
(Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
msNumBytes)
(Time -> MeasureTxs blk) -> IO Time -> IO (MeasureTxs blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
TraceEventMempool blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
measureTxsEnd :: forall blk. Trace IO Text -> Tracer IO (TraceForgeEvent blk)
measureTxsEnd :: Trace IO Text -> Tracer IO (TraceForgeEvent blk)
measureTxsEnd Trace IO Text
tracer = Tracer IO (MeasureTxs blk) -> Tracer IO (TraceForgeEvent blk)
measureTxsEndInter (Tracer IO (MeasureTxs blk) -> Tracer IO (TraceForgeEvent blk))
-> Tracer IO (MeasureTxs blk) -> Tracer IO (TraceForgeEvent blk)
forall a b. (a -> b) -> a -> b
$ Trace IO Text -> Tracer IO (MeasureTxs blk)
forall (m :: * -> *) a b.
(ToLogObject m, ToObject a, Transformable a m b) =>
Trace m a -> Tracer m b
toLogObject Trace IO Text
tracer
where
measureTxsEndInter :: Tracer IO (MeasureTxs blk) -> Tracer IO (TraceForgeEvent blk)
measureTxsEndInter :: Tracer IO (MeasureTxs blk) -> Tracer IO (TraceForgeEvent blk)
measureTxsEndInter Tracer IO (MeasureTxs blk)
tracer' = (TraceForgeEvent blk -> IO ()) -> Tracer IO (TraceForgeEvent blk)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceForgeEvent blk -> IO ()) -> Tracer IO (TraceForgeEvent blk))
-> (TraceForgeEvent blk -> IO ())
-> Tracer IO (TraceForgeEvent blk)
forall a b. (a -> b) -> a -> b
$ \case
TraceAdoptedBlock SlotNo
slotNo blk
blk [GenTx blk]
txs ->
Tracer IO (MeasureTxs blk) -> MeasureTxs blk -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (MeasureTxs blk)
tracer' (MeasureTxs blk -> IO ()) -> IO (MeasureTxs blk) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (MeasureTxs blk)
measureTxsEvent
where
measureTxsEvent :: IO (MeasureTxs blk)
measureTxsEvent :: IO (MeasureTxs blk)
measureTxsEvent = SlotNo -> blk -> [GenTx blk] -> Time -> MeasureTxs blk
forall blk. SlotNo -> blk -> [GenTx blk] -> Time -> MeasureTxs blk
MeasureTxsTimeStop SlotNo
slotNo blk
blk [GenTx blk]
txs (Time -> MeasureTxs blk) -> IO Time -> IO (MeasureTxs blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
TraceForgeEvent blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (Monad m, HasTxId (GenTx blk)) => Outcome m (MeasureTxs blk) where
type IntermediateValue (MeasureTxs blk) = [(GenTx blk, Time)]
type OutcomeMetric (MeasureTxs blk) = [(GenTxId blk, DiffTime)]
classifyObservable :: MeasureTxs blk -> m OutcomeProgressionStatus
classifyObservable = OutcomeProgressionStatus -> m OutcomeProgressionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OutcomeProgressionStatus -> m OutcomeProgressionStatus)
-> (MeasureTxs blk -> OutcomeProgressionStatus)
-> MeasureTxs blk
-> m OutcomeProgressionStatus
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
MeasureTxsTimeStart {} -> OutcomeProgressionStatus
OutcomeStarts
MeasureTxsTimeStop {} -> OutcomeProgressionStatus
OutcomeEnds
captureObservableValue :: MeasureTxs blk -> m (IntermediateValue (MeasureTxs blk))
captureObservableValue (MeasureTxsTimeStart GenTx blk
tx Word
_ Word
_ Time
time) =
[(GenTx blk, Time)] -> m [(GenTx blk, Time)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(GenTx blk
tx, Time
time)]
captureObservableValue (MeasureTxsTimeStop SlotNo
_sloNo blk
_blk [GenTx blk]
txs Time
time) =
[(GenTx blk, Time)] -> m [(GenTx blk, Time)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(GenTx blk
tx, Time
time) | GenTx blk
tx <- [GenTx blk]
txs]
computeOutcomeMetric :: MeasureTxs blk
-> IntermediateValue (MeasureTxs blk)
-> IntermediateValue (MeasureTxs blk)
-> m (OutcomeMetric (MeasureTxs blk))
computeOutcomeMetric MeasureTxs blk
_ IntermediateValue (MeasureTxs blk)
xs IntermediateValue (MeasureTxs blk)
ys = [(GenTxId blk, DiffTime)] -> m [(GenTxId blk, DiffTime)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(GenTxId blk, DiffTime)] -> m [(GenTxId blk, DiffTime)])
-> ([((GenTxId blk, Time), (GenTxId blk, Time))]
-> [(GenTxId blk, DiffTime)])
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
-> m [(GenTxId blk, DiffTime)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [((GenTxId blk, Time), (GenTxId blk, Time))]
-> [(GenTxId blk, DiffTime)]
computeFinalValues ([((GenTxId blk, Time), (GenTxId blk, Time))]
-> m [(GenTxId blk, DiffTime)])
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
-> m [(GenTxId blk, DiffTime)]
forall a b. (a -> b) -> a -> b
$ [(GenTxId blk, Time)]
-> [(GenTxId blk, Time)]
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
computeIntermediateValues [(GenTxId blk, Time)]
xsTxId [(GenTxId blk, Time)]
ysTxId
where
xsTxId :: [(GenTxId blk, Time)]
xsTxId = ((GenTx blk, Time) -> (GenTxId blk, Time))
-> [(GenTx blk, Time)] -> [(GenTxId blk, Time)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((GenTx blk -> GenTxId blk)
-> (GenTx blk, Time) -> (GenTxId blk, Time)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GenTx blk -> GenTxId blk
forall tx. HasTxId tx => tx -> TxId tx
txId) [(GenTx blk, Time)]
IntermediateValue (MeasureTxs blk)
xs
ysTxId :: [(GenTxId blk, Time)]
ysTxId = ((GenTx blk, Time) -> (GenTxId blk, Time))
-> [(GenTx blk, Time)] -> [(GenTxId blk, Time)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((GenTx blk -> GenTxId blk)
-> (GenTx blk, Time) -> (GenTxId blk, Time)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GenTx blk -> GenTxId blk
forall tx. HasTxId tx => tx -> TxId tx
txId) [(GenTx blk, Time)]
IntermediateValue (MeasureTxs blk)
ys
computeIntermediateValues
:: [(GenTxId blk, Time)]
-> [(GenTxId blk, Time)]
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
computeIntermediateValues :: [(GenTxId blk, Time)]
-> [(GenTxId blk, Time)]
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
computeIntermediateValues [] [(GenTxId blk, Time)]
_ = []
computeIntermediateValues [(GenTxId blk, Time)]
_ [] = []
computeIntermediateValues [(GenTxId blk, Time)]
xs' [(GenTxId blk, Time)]
ys' = do
x :: (GenTxId blk, Time)
x@(GenTxId blk
xTx, Time
_) <- [(GenTxId blk, Time)]
xs'
y :: (GenTxId blk, Time)
y@(GenTxId blk
yTx, Time
_) <- [(GenTxId blk, Time)]
ys'
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GenTxId blk
xTx GenTxId blk -> GenTxId blk -> Bool
forall a. Eq a => a -> a -> Bool
== GenTxId blk
yTx)
((GenTxId blk, Time), (GenTxId blk, Time))
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
forall (m :: * -> *) a. Monad m => a -> m a
return ((GenTxId blk, Time)
x, (GenTxId blk, Time)
y)
computeFinalValues
:: [((GenTxId blk, Time), (GenTxId blk, Time))]
-> [(GenTxId blk, DiffTime)]
computeFinalValues :: [((GenTxId blk, Time), (GenTxId blk, Time))]
-> [(GenTxId blk, DiffTime)]
computeFinalValues [((GenTxId blk, Time), (GenTxId blk, Time))]
intermediateValues =
(((GenTxId blk, Time), (GenTxId blk, Time))
-> (GenTxId blk, DiffTime))
-> [((GenTxId blk, Time), (GenTxId blk, Time))]
-> [(GenTxId blk, DiffTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\((GenTxId blk
blk, Time
timeStart), (GenTxId blk
_, Time
timeEnd)) -> (GenTxId blk
blk, Time -> Time -> DiffTime
diffTime Time
timeEnd Time
timeStart)) [((GenTxId blk, Time), (GenTxId blk, Time))]
intermediateValues
instance (Monad m, MonadTime m) => Outcome m (TraceForgeEvent blk) where
type IntermediateValue (TraceForgeEvent blk) = (SlotNo, Time, MempoolSize)
type OutcomeMetric (TraceForgeEvent blk) = Maybe (SlotNo, DiffTime, MempoolSize)
classifyObservable :: TraceForgeEvent blk -> m OutcomeProgressionStatus
classifyObservable = OutcomeProgressionStatus -> m OutcomeProgressionStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OutcomeProgressionStatus -> m OutcomeProgressionStatus)
-> (TraceForgeEvent blk -> OutcomeProgressionStatus)
-> TraceForgeEvent blk
-> m OutcomeProgressionStatus
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
TraceNodeIsLeader {} -> OutcomeProgressionStatus
OutcomeStarts
TraceForgedBlock {} -> OutcomeProgressionStatus
OutcomeEnds
TraceForgeEvent blk
_ -> OutcomeProgressionStatus
OutcomeOther
captureObservableValue :: TraceForgeEvent blk -> m (IntermediateValue (TraceForgeEvent blk))
captureObservableValue (TraceNodeIsLeader SlotNo
slotNo) = do
Time
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
(SlotNo, Time, MempoolSize) -> m (SlotNo, Time, MempoolSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slotNo, Time
time, MempoolSize
forall a. Monoid a => a
mempty)
captureObservableValue (TraceForgedBlock SlotNo
slotNo Point blk
_ blk
_blk MempoolSize
mempoolSize) = do
Time
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
(SlotNo, Time, MempoolSize) -> m (SlotNo, Time, MempoolSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slotNo, Time
time, MempoolSize
mempoolSize)
captureObservableValue TraceForgeEvent blk
_ = do
Time
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
(SlotNo, Time, MempoolSize) -> m (SlotNo, Time, MempoolSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
0, Time
time, MempoolSize
forall a. Monoid a => a
mempty)
computeOutcomeMetric :: TraceForgeEvent blk
-> IntermediateValue (TraceForgeEvent blk)
-> IntermediateValue (TraceForgeEvent blk)
-> m (OutcomeMetric (TraceForgeEvent blk))
computeOutcomeMetric TraceForgeEvent blk
_ (startSlot, absTimeStart, _) (stopSlot, absTimeStop, mempoolSize)
| SlotNo
startSlot SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
stopSlot = Maybe (SlotNo, DiffTime, MempoolSize)
-> m (Maybe (SlotNo, DiffTime, MempoolSize))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SlotNo, DiffTime, MempoolSize)
-> m (Maybe (SlotNo, DiffTime, MempoolSize)))
-> Maybe (SlotNo, DiffTime, MempoolSize)
-> m (Maybe (SlotNo, DiffTime, MempoolSize))
forall a b. (a -> b) -> a -> b
$ (SlotNo, DiffTime, MempoolSize)
-> Maybe (SlotNo, DiffTime, MempoolSize)
forall a. a -> Maybe a
Just (SlotNo
startSlot, Time -> Time -> DiffTime
diffTime Time
absTimeStop Time
absTimeStart, MempoolSize
mempoolSize)
| Bool
otherwise = Maybe (SlotNo, DiffTime, MempoolSize)
-> m (Maybe (SlotNo, DiffTime, MempoolSize))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SlotNo, DiffTime, MempoolSize)
forall a. Maybe a
Nothing
instance HasPrivacyAnnotation (Either
(TraceForgeEvent blk)
(OutcomeFidelity
(Maybe
(SlotNo, DiffTime, MempoolSize))))
instance HasSeverityAnnotation (Either
(TraceForgeEvent blk)
(OutcomeFidelity
(Maybe
(SlotNo, DiffTime, MempoolSize)))) where
getSeverityAnnotation :: Either
(TraceForgeEvent blk)
(OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize)))
-> Severity
getSeverityAnnotation Either
(TraceForgeEvent blk)
(OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize)))
_ = Severity
Info
instance Transformable Text IO
(Either
(TraceForgeEvent blk)
(OutcomeFidelity
(Maybe
(SlotNo, DiffTime, MempoolSize)))) where
trTransformer :: TracingVerbosity
-> Trace IO Text
-> Tracer
IO
(Either
(TraceForgeEvent blk)
(OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize))))
trTransformer = TracingVerbosity
-> Trace IO Text
-> Tracer
IO
(Either
(TraceForgeEvent blk)
(OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize))))
forall b (m :: * -> *) a.
(ToObject b, MonadIO m, HasPrivacyAnnotation b,
HasSeverityAnnotation b) =>
TracingVerbosity -> Trace m a -> Tracer m b
trStructured
instance ToObject
(Either
(TraceForgeEvent blk)
(OutcomeFidelity
(Maybe
(SlotNo, DiffTime, MempoolSize)))) where
toObject :: TracingVerbosity
-> Either
(TraceForgeEvent blk)
(OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize)))
-> Object
toObject TracingVerbosity
_verb (Left TraceForgeEvent blk
_ev) = Object
forall a. ToObject a => HashMap Text a
emptyObject
toObject TracingVerbosity
_verb (Right OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize))
EndsBeforeStarted) = Object
forall a. ToObject a => HashMap Text a
emptyObject
toObject TracingVerbosity
_verb (Right (ProgressedNormally (Just (SlotNo
slotno, DiffTime
difftime, MempoolSize
mpsize)))) =
[(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
[ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"OutcomeTraceForgeEvent"
, Text
"slot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON (SlotNo -> Word64
unSlotNo SlotNo
slotno)
, Text
"difftime" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
difftime)
, Text
"mempoolnumtx" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (MempoolSize -> Word32
msNumTxs MempoolSize
mpsize)
, Text
"mempoolbytes" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word32 -> Value
forall a. ToJSON a => a -> Value
toJSON (MempoolSize -> Word32
msNumBytes MempoolSize
mpsize)
]
toObject TracingVerbosity
_verb (Right OutcomeFidelity (Maybe (SlotNo, DiffTime, MempoolSize))
_) = Object
forall a. ToObject a => HashMap Text a
emptyObject