{-# 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
    -- * Re-exports so we localize the changes
    , 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 (..))

--------------------------------------------------------------------------------
-- Measure transaction forging time
--------------------------------------------------------------------------------

-- | Definition of the measurement datatype for the transactions.
data MeasureTxs blk
    = MeasureTxsTimeStart (GenTx blk) !Word !Word !Time  -- num txs, total size in bytes
    | 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

-- TODO(KS): Time will be removed.
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)
      ]

-- | Transformer for the start of the transaction, when the transaction was added
-- to the mempool.
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

        -- The rest of the constructors.
        TraceEventMempool blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Transformer for the end of the transaction, when the transaction was added to the
-- block and the block was forged.
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

        -- The rest of the constructors.
        TraceForgeEvent blk
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Any Monad m, could be Identity in this case where we have all the data beforehand.
-- The result of this operation is the list of transactions that _made it in the block_
-- and the time it took them to get into the block.
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     :: a -> m OutcomeProgressionStatus
    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 :: a -> m (IntermediateValue a)
    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   :: a -> IntermediateValue a -> IntermediateValue a -> m (OutcomeMetric a)
    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 :: [(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 :: [(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

        -- | Here we filter and match all the transactions that made it into
        -- a block.
        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)]
_ []  = []
        --[ (x, y) | x@(xTx, _) <- xs, y@(yTx, _) <- ys, xTx == yTx ]
        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)

        -- | From all the transactions that made it into a block we simply
        -- diff the time it took them and associate that time with the transaction
        -- that made it into a block.
        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

--------------------------------------------------------------------------------
-- Measure block forging time
--------------------------------------------------------------------------------

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     :: a -> m OutcomeProgressionStatus
    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 :: a -> m (IntermediateValue a)
    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)

    -- will never be called, just to make the pattern match complete
    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   :: a -> IntermediateValue a -> IntermediateValue a -> m (OutcomeMetric a)
    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