diff --git a/cabal.project b/cabal.project index b3b0812e87b..0e58b5058f8 100644 --- a/cabal.project +++ b/cabal.project @@ -134,50 +134,50 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: iohk-monitoring source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: contra-tracer source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: plugins/scribe-systemd source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: plugins/backend-aggregation source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: plugins/backend-ekg source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: plugins/backend-monitoring source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: d6f760591bc6f54e8c333986cf6cf7fb737747df - --sha256: 1l4rrll76wss4xsil788r1ffcwb4hqgl74bc29hsjxlygdfv09yc + tag: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca + --sha256: 0lnfqvrna4x5sqxq71m5717adrp0qfhzjc9g2wr0rflh6d1yb9ag subdir: tracer-transformers source-repository-package diff --git a/cardano-node/src/Cardano/Tracing/MicroBenchmarking.hs b/cardano-node/src/Cardano/Tracing/MicroBenchmarking.hs index e98d05ace0d..5420cc679d9 100644 --- a/cardano-node/src/Cardano/Tracing/MicroBenchmarking.hs +++ b/cardano-node/src/Cardano/Tracing/MicroBenchmarking.hs @@ -9,13 +9,12 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Cardano.Tracing.MicroBenchmarking ( MeasureTxs (..) , measureTxsStart , measureTxsEnd - , MeasureBlockForging (..) - , measureBlockForgeStart - , measureBlockForgeEnd -- * Re-exports so we localize the changes , Outcome (..) , OutcomeEnhancedTracer @@ -24,15 +23,17 @@ module Cardano.Tracing.MicroBenchmarking import Cardano.Prelude -import Control.Monad.Class.MonadTime (DiffTime, Time (..), diffTime, - getMonotonicTime) +import Control.Monad.Class.MonadTime (DiffTime, MonadTime, Time (..), + diffTime, getMonotonicTime) import Data.Aeson (Value (..), toJSON, (.=)) import Data.Time.Clock (diffTimeToPicoseconds) +import Cardano.BM.Data.LogItem (LOContent (..), LogObject (..), + mkLOMeta) import Cardano.BM.Data.Severity (Severity (..)) -import Cardano.BM.Data.Trace -import Cardano.BM.Data.Tracer +import Cardano.BM.Tracing +import Cardano.BM.Data.Tracer (trStructured, emptyObject, mkObject) import Control.Tracer.Transformers.ObserveOutcome @@ -171,78 +172,74 @@ instance (Monad m, ApplyTx blk, HasTxId (GenTx blk)) => Outcome m (MeasureTxs bl -- Measure block forging time -------------------------------------------------------------------------------- --- | Definition of the measurement datatype for the block forge time. -data MeasureBlockForging blk - = MeasureBlockTimeStart !SlotNo !Time - | MeasureBlockTimeStop !SlotNo blk !MempoolSize !Time - -deriving instance (Eq blk, Eq (GenTx blk)) => Eq (MeasureBlockForging blk) -deriving instance (Show blk, Show (GenTx blk)) => Show (MeasureBlockForging blk) - -instance Transformable Text IO (MeasureBlockForging blk) where - trTransformer _ verb tr = trStructured verb tr - -instance DefinePrivacyAnnotation (MeasureBlockForging blk) -instance DefineSeverity (MeasureBlockForging blk) where - defineSeverity _ = Info - -instance ToObject (MeasureBlockForging blk) where - toObject _verb (MeasureBlockTimeStart slotNo (Time time)) = - mkObject - [ "kind" .= String "MeasureBlockTimeStart" - , "slot" .= toJSON (unSlotNo slotNo) - , "time(ps)" .= toJSON (diffTimeToPicoseconds time) - ] - toObject _verb (MeasureBlockTimeStop slotNo _blk mempoolSize (Time time)) = - mkObject - [ "kind" .= String "MeasureBlockTimeStop" - , "slot" .= toJSON (unSlotNo slotNo) - , "mempoolNumTxs" .= toJSON (msNumTxs mempoolSize) - , "mempoolNumBytes" .= toJSON (msNumBytes mempoolSize) - , "time(ps)" .= toJSON (diffTimeToPicoseconds time) - ] - --- | Transformer for the start of the block forge, when the current slot is the slot of the --- node and the protocol starts. -measureBlockForgeStart :: Trace IO Text -> Tracer IO (TraceForgeEvent blk (GenTx blk)) -measureBlockForgeStart tracer = measureBlockForgeStartInter $ toLogObject tracer - where - measureBlockForgeStartInter :: Tracer IO (MeasureBlockForging blk) -> Tracer IO (TraceForgeEvent blk (GenTx blk)) - measureBlockForgeStartInter tracer' = Tracer $ \case - TraceNodeIsLeader slotNo - -> traceWith tracer' =<< (MeasureBlockTimeStart slotNo <$> getMonotonicTime) - _ -> pure () - --- | Transformer for the end of the block forge, when the block was created/forged. -measureBlockForgeEnd :: Trace IO Text -> Tracer IO (TraceForgeEvent blk (GenTx blk)) -measureBlockForgeEnd tracer = measureTxsEndInter $ toLogObject tracer - where - measureTxsEndInter :: Tracer IO (MeasureBlockForging blk) -> Tracer IO (TraceForgeEvent blk (GenTx blk)) - measureTxsEndInter tracer' = Tracer $ \case - TraceForgedBlock slotNo _ blk mempoolSize - -> traceWith tracer' =<< (MeasureBlockTimeStop slotNo blk mempoolSize <$> getMonotonicTime) - _ -> pure () - - --- | The outcome for the block forging time. It's a @Maybe@ since --- the slot number might not be equal from when we start the measurement. -instance (Monad m) => Outcome m (MeasureBlockForging blk) where - type IntermediateValue (MeasureBlockForging blk) = (SlotNo, Time, MempoolSize) - type OutcomeMetric (MeasureBlockForging blk) = Maybe (SlotNo, DiffTime, MempoolSize) +instance (Monad m, MonadTime m) => Outcome m (TraceForgeEvent blk (GenTx blk)) where + type IntermediateValue (TraceForgeEvent blk (GenTx blk)) = (SlotNo, Time, MempoolSize) + type OutcomeMetric (TraceForgeEvent blk (GenTx blk)) = Maybe (SlotNo, DiffTime, MempoolSize) --classifyObservable :: a -> m OutcomeProgressionStatus classifyObservable = pure . \case - MeasureBlockTimeStart {} -> OutcomeStarts - MeasureBlockTimeStop {} -> OutcomeEnds + TraceNodeIsLeader {} -> OutcomeStarts + TraceForgedBlock {} -> OutcomeEnds + _ -> OutcomeOther --captureObservableValue :: a -> m (IntermediateValue a) - captureObservableValue (MeasureBlockTimeStart slotNo time) = + captureObservableValue (TraceNodeIsLeader slotNo) = do + time <- getMonotonicTime pure (slotNo, time, mempty) - captureObservableValue (MeasureBlockTimeStop slotNo _blk mempoolSize time) = + captureObservableValue (TraceForgedBlock slotNo _ _blk mempoolSize) = do + time <- getMonotonicTime pure (slotNo, time, mempoolSize) + -- will never be called, just to make the pattern match complete + captureObservableValue _ = do + time <- getMonotonicTime + pure (0, time, mempty) + + --computeOutcomeMetric :: a -> IntermediateValue a -> IntermediateValue a -> m (OutcomeMetric a) computeOutcomeMetric _ (startSlot, absTimeStart, _) (stopSlot, absTimeStop, mempoolSize) | startSlot == stopSlot = pure $ Just (startSlot, (diffTime absTimeStop absTimeStart), mempoolSize) | otherwise = pure Nothing + +instance DefinePrivacyAnnotation (Either + (TraceForgeEvent blk (GenTx blk)) + (OutcomeFidelity + (Maybe + (SlotNo, DiffTime, MempoolSize)))) +instance DefineSeverity (Either + (TraceForgeEvent blk (GenTx blk)) + (OutcomeFidelity + (Maybe + (SlotNo, DiffTime, MempoolSize)))) where + defineSeverity _ = Info + +instance Transformable Text IO + (Either + (TraceForgeEvent blk (GenTx blk)) + (OutcomeFidelity + (Maybe + (SlotNo, DiffTime, MempoolSize)))) where + trTransformer StructuredLogging verb tr = trStructured verb tr + trTransformer _ _verb tr = Tracer $ \ev -> do + meta <- mkLOMeta (defineSeverity ev) (definePrivacyAnnotation ev) + traceWith tr (mempty, LogObject mempty meta (LogMessage "Outcome of TraceForgeEvent")) + +instance ToObject + (Either + (TraceForgeEvent blk (GenTx blk)) + (OutcomeFidelity + (Maybe + (SlotNo, DiffTime, MempoolSize)))) where + toObject _verb (Left _ev) = emptyObject + toObject _verb (Right EndsBeforeStarted) = emptyObject + toObject _verb (Right (ProgressedNormally (Just (slotno, difftime, mpsize)))) = + mkObject + [ "kind" .= String "OutcomeTraceForgeEvent" + , "slot" .= toJSON (unSlotNo slotno) + , "difftime" .= toJSON (diffTimeToPicoseconds difftime) + , "mempoolnumtx" .= toJSON (msNumTxs mpsize) + , "mempoolbytes" .= toJSON (msNumBytes mpsize) + ] + toObject _verb (Right _) = emptyObject + diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index bde98b77e13..44d2b4ce84a 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -186,7 +186,7 @@ mkTracers traceOptions tracer = do -- for measuring the time it takes a transaction to get into -- a block. --txsOutcomeExtractor <- mkOutcomeExtractor @_ @(MeasureTxs blk) - --blockForgeOutcomeExtractor <- mkOutcomeExtractor @_ @(MeasureBlockForging blk) + blockForgeOutcomeExtractor <- mkOutcomeExtractor elided <- newstate -- for eliding messages in ChainDB tracer @@ -198,7 +198,7 @@ mkTracers traceOptions tracer = do $ appendName "ChainDB" $ tracer , consensusTracers - = mkConsensusTracers forgeTracers traceOptions + = mkConsensusTracers blockForgeOutcomeExtractor forgeTracers traceOptions , protocolTracers = mkProtocolTracers traceOptions , ipSubscriptionTracer @@ -349,8 +349,6 @@ mkTracers traceOptions tracer = do -> Tracer IO (Consensus.TraceForgeEvent blk (GenTx blk)) forgeTracer forgeTracers traceOpts = Tracer $ \ev -> do traceWith (measureTxsEnd tracer) ev - traceWith (measureBlockForgeStart tracer) ev - traceWith (measureBlockForgeEnd tracer) ev traceWith (consensusForgeTracer) ev where -- The consensus tracer. @@ -415,8 +413,9 @@ mkTracers traceOptions tracer = do LogValue "nodeIsLeader" $ PureI $ fromIntegral $ unSlotNo slot mkConsensusTracers - :: ForgeTracers -> TraceOptions -> Consensus.Tracers' peer blk (Tracer IO) - mkConsensusTracers forgeTracers traceOpts = Consensus.Tracers + :: (OutcomeEnhancedTracer IO (Consensus.TraceForgeEvent blk (GenTx blk)) -> Tracer IO (Consensus.TraceForgeEvent blk (GenTx blk))) + -> ForgeTracers -> TraceOptions -> Consensus.Tracers' peer blk (Tracer IO) + mkConsensusTracers measureBlockForging forgeTracers traceOpts = Consensus.Tracers { Consensus.chainSyncClientTracer = tracerOnOff (traceChainSyncClient traceOpts) $ toLogObject' StructuredLogging tracingVerbosity @@ -457,7 +456,11 @@ mkTracers traceOptions tracer = do , Consensus.mempoolTracer = tracerOnOff (traceMempool traceOpts) $ mempoolTracer , Consensus.forgeTracer - = forgeTracer forgeTracers traceOpts + = Tracer $ \ev -> do + traceWith (forgeTracer forgeTracers traceOpts) ev + traceWith ( measureBlockForging + $ toLogObject' StructuredLogging tracingVerbosity + $ appendName "ForgeTime" tracer) ev , Consensus.blockchainTimeTracer = Tracer $ \ev -> traceWith (toLogObject tracer) (readableTraceBlockchainTimeEvent ev) diff --git a/stack.yaml b/stack.yaml index f4fea59f472..5c34b464ef8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -97,7 +97,7 @@ extra-deps: # iohk-monitoring-framework currently not pinned to a release - git: https://github.com/input-output-hk/iohk-monitoring-framework - commit: d6f760591bc6f54e8c333986cf6cf7fb737747df + commit: 43a912b94498dcdeaaad71c37a6b58dceefaf1ca subdirs: - contra-tracer - iohk-monitoring