{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Network.Tracing.TxSubmission () where import Data.Aeson import Data.IntMap.Strict qualified as IntMap import Data.Map.Strict qualified as Map import Cardano.Logging import Ouroboros.Network.Tx (HasRawTxId) import Ouroboros.Network.TxSubmission.Inbound.V2.Types instance (Show txid, Show peeraddr, HasRawTxId txid) => LogFormatting (TraceTxLogic peeraddr txid tx) where forMachine :: DetailLevel -> TraceTxLogic peeraddr txid tx -> Object forMachine DetailLevel dtal (TraceSharedTxState SharedTxState {Int Word64 Map (RawTxId txid) TxKey IntMap txid IntMap (TxEntry peeraddr) RetainedTxs sharedTxTable :: IntMap (TxEntry peeraddr) sharedRetainedTxs :: RetainedTxs sharedTxIdToKey :: Map (RawTxId txid) TxKey sharedKeyToTxId :: IntMap txid sharedNextTxKey :: Int sharedGeneration :: Word64 sharedRevision :: Word64 sharedGeneration :: forall peeraddr txid. SharedTxState peeraddr txid -> Word64 sharedKeyToTxId :: forall peeraddr txid. SharedTxState peeraddr txid -> IntMap txid sharedNextTxKey :: forall peeraddr txid. SharedTxState peeraddr txid -> Int sharedRetainedTxs :: forall peeraddr txid. SharedTxState peeraddr txid -> RetainedTxs sharedRevision :: forall peeraddr txid. SharedTxState peeraddr txid -> Word64 sharedTxIdToKey :: forall peeraddr txid. SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey sharedTxTable :: forall peeraddr txid. SharedTxState peeraddr txid -> IntMap (TxEntry peeraddr) ..}) = [Object] -> Object forall a. Monoid a => [a] -> a mconcat ([Object] -> Object) -> [Object] -> Object forall a b. (a -> b) -> a -> b $ [ Key "kind" Key -> Value -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Value String Text "TraceSharedTxState" , Key "sharedGeneration" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 sharedGeneration , Key "activeTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= IntMap (TxEntry peeraddr) -> Int forall a. IntMap a -> Int IntMap.size IntMap (TxEntry peeraddr) sharedTxTable , Key "retainedTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= RetainedTxs -> Int retainedSize RetainedTxs sharedRetainedTxs , Key "internedTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Map (RawTxId txid) TxKey -> Int forall k a. Map k a -> Int Map.size Map (RawTxId txid) TxKey sharedTxIdToKey , Key "leasedTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int leasedTxCount , Key "claimableTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int claimableTxCount , Key "totalAttemptCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int totalAttemptCount , Key "submittingTxCount" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int submittingTxCount ] [Object] -> [Object] -> [Object] forall a. [a] -> [a] -> [a] ++ [Object] more where activeEntries :: [TxEntry peeraddr] activeEntries = IntMap (TxEntry peeraddr) -> [TxEntry peeraddr] forall a. IntMap a -> [a] IntMap.elems IntMap (TxEntry peeraddr) sharedTxTable leasedTxCount :: Int leasedTxCount = [()] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [ () | TxEntry { txLease :: forall peeraddr. TxEntry peeraddr -> TxLease peeraddr txLease = TxLeased peeraddr _ Time _ } <- [TxEntry peeraddr] activeEntries ] claimableTxCount :: Int claimableTxCount = [()] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [ () | TxEntry { txLease :: forall peeraddr. TxEntry peeraddr -> TxLease peeraddr txLease = TxClaimable Time _ } <- [TxEntry peeraddr] activeEntries ] totalAttemptCount :: Int totalAttemptCount = [Int] -> Int forall a. Num a => [a] -> a forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum [ TxEntry peeraddr -> Int forall peeraddr. TxEntry peeraddr -> Int txAttempt TxEntry peeraddr entry | TxEntry peeraddr entry <- [TxEntry peeraddr] activeEntries ] submittingTxCount :: Int submittingTxCount = [()] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [ () | TxEntry { txInSubmission :: forall peeraddr. TxEntry peeraddr -> Bool txInSubmission = Bool True } <- [TxEntry peeraddr] activeEntries ] renderTxId :: Int -> String renderTxId Int txKey = String -> (txid -> String) -> Maybe txid -> String forall b a. b -> (a -> b) -> Maybe a -> b maybe String "<missing-txid>" txid -> String forall a. Show a => a -> String show (Int -> IntMap txid -> Maybe txid forall a. Int -> IntMap a -> Maybe a IntMap.lookup Int txKey IntMap txid sharedKeyToTxId) more :: [Object] more = case DetailLevel dtal of DetailLevel DMaximum -> [ Key "sharedTxTable" Key -> [(String, String)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= [ (Int -> String renderTxId Int txKey, TxEntry peeraddr -> String forall a. Show a => a -> String show TxEntry peeraddr txEntry) | (Int txKey, TxEntry peeraddr txEntry) <- IntMap (TxEntry peeraddr) -> [(Int, TxEntry peeraddr)] forall a. IntMap a -> [(Int, a)] IntMap.toList IntMap (TxEntry peeraddr) sharedTxTable ] , Key "sharedRetainedTxs" Key -> [(String, String)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= [ (Int -> String renderTxId Int txKey, Time -> String forall a. Show a => a -> String show Time retainUntil) | (Int txKey, Time retainUntil) <- RetainedTxs -> [(Int, Time)] retainedToList RetainedTxs sharedRetainedTxs ] , Key "internedTxIds" Key -> [String] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (RawTxId txid -> String) -> [RawTxId txid] -> [String] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap RawTxId txid -> String forall a. Show a => a -> String show (Map (RawTxId txid) TxKey -> [RawTxId txid] forall k a. Map k a -> [k] Map.keys Map (RawTxId txid) TxKey sharedTxIdToKey) ] DetailLevel _otherwise -> [] instance MetaTrace (TraceTxLogic peeraddr txid tx) where namespaceFor :: TraceTxLogic peeraddr txid tx -> Namespace (TraceTxLogic peeraddr txid tx) namespaceFor TraceSharedTxState {} = [Text] -> [Text] -> Namespace (TraceTxLogic peeraddr txid tx) forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "TraceSharedTxState"] severityFor :: Namespace (TraceTxLogic peeraddr txid tx) -> Maybe (TraceTxLogic peeraddr txid tx) -> Maybe SeverityS severityFor Namespace (TraceTxLogic peeraddr txid tx) _ Maybe (TraceTxLogic peeraddr txid tx) _ = SeverityS -> Maybe SeverityS forall a. a -> Maybe a Just SeverityS Debug documentFor :: Namespace (TraceTxLogic peeraddr txid tx) -> Maybe Text documentFor (Namespace [] [Text "TraceSharedTxState"]) = Text -> Maybe Text forall a. a -> Maybe a Just Text "Internal bookkeeping of tx-submission shared state for peer coordination" documentFor Namespace (TraceTxLogic peeraddr txid tx) _ = Maybe Text forall a. Maybe a Nothing allNamespaces :: [Namespace (TraceTxLogic peeraddr txid tx)] allNamespaces = [ [Text] -> [Text] -> Namespace (TraceTxLogic peeraddr txid tx) forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "TraceSharedTxState"] ] instance LogFormatting TxSubmissionCounters where forMachine :: DetailLevel -> TxSubmissionCounters -> Object forMachine DetailLevel _dtal TxSubmissionCounters {Word64 txIdMessagesSent :: Word64 txIdsRequested :: Word64 txIdRepliesReceived :: Word64 txIdsReceived :: Word64 txMessagesSent :: Word64 txsRequested :: Word64 txRepliesReceived :: Word64 txsReceived :: Word64 txsOmitted :: Word64 lateBodies :: Word64 txsAccepted :: Word64 txsRejected :: Word64 txIdBlockingReqsSent :: Word64 txIdPipelinedReqsSent :: Word64 txIdBlockingWaitMs :: Word64 txPipelineWaitMs :: Word64 txSubmissionWaitMs :: Word64 lateBodies :: TxSubmissionCounters -> Word64 txIdBlockingReqsSent :: TxSubmissionCounters -> Word64 txIdBlockingWaitMs :: TxSubmissionCounters -> Word64 txIdMessagesSent :: TxSubmissionCounters -> Word64 txIdPipelinedReqsSent :: TxSubmissionCounters -> Word64 txIdRepliesReceived :: TxSubmissionCounters -> Word64 txIdsReceived :: TxSubmissionCounters -> Word64 txIdsRequested :: TxSubmissionCounters -> Word64 txMessagesSent :: TxSubmissionCounters -> Word64 txPipelineWaitMs :: TxSubmissionCounters -> Word64 txRepliesReceived :: TxSubmissionCounters -> Word64 txSubmissionWaitMs :: TxSubmissionCounters -> Word64 txsAccepted :: TxSubmissionCounters -> Word64 txsOmitted :: TxSubmissionCounters -> Word64 txsReceived :: TxSubmissionCounters -> Word64 txsRejected :: TxSubmissionCounters -> Word64 txsRequested :: TxSubmissionCounters -> Word64 ..} = [Object] -> Object forall a. Monoid a => [a] -> a mconcat [ Key "kind" Key -> Value -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Value String Text "TxSubmissionCounters" , Key "txIdMessagesSent" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdMessagesSent , Key "txIdsRequested" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdsRequested , Key "txIdRepliesReceived" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdRepliesReceived , Key "txIdsReceived" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdsReceived , Key "txMessagesSent" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txMessagesSent , Key "txsRequested" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txsRequested , Key "txRepliesReceived" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txRepliesReceived , Key "txsReceived" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txsReceived , Key "txsOmitted" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txsOmitted , Key "lateBodies" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 lateBodies , Key "txsAccepted" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txsAccepted , Key "txsRejected" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txsRejected , Key "txIdBlockingReqsSent" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdBlockingReqsSent , Key "txIdPipelinedReqsSent" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdPipelinedReqsSent , Key "txIdBlockingWaitMs" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txIdBlockingWaitMs , Key "txPipelineWaitMs" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txPipelineWaitMs , Key "txSubmissionWaitMs" Key -> Word64 -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Word64 txSubmissionWaitMs ] asMetrics :: TxSubmissionCounters -> [Metric] asMetrics TxSubmissionCounters {Word64 lateBodies :: TxSubmissionCounters -> Word64 txIdBlockingReqsSent :: TxSubmissionCounters -> Word64 txIdBlockingWaitMs :: TxSubmissionCounters -> Word64 txIdMessagesSent :: TxSubmissionCounters -> Word64 txIdPipelinedReqsSent :: TxSubmissionCounters -> Word64 txIdRepliesReceived :: TxSubmissionCounters -> Word64 txIdsReceived :: TxSubmissionCounters -> Word64 txIdsRequested :: TxSubmissionCounters -> Word64 txMessagesSent :: TxSubmissionCounters -> Word64 txPipelineWaitMs :: TxSubmissionCounters -> Word64 txRepliesReceived :: TxSubmissionCounters -> Word64 txSubmissionWaitMs :: TxSubmissionCounters -> Word64 txsAccepted :: TxSubmissionCounters -> Word64 txsOmitted :: TxSubmissionCounters -> Word64 txsReceived :: TxSubmissionCounters -> Word64 txsRejected :: TxSubmissionCounters -> Word64 txsRequested :: TxSubmissionCounters -> Word64 txIdMessagesSent :: Word64 txIdsRequested :: Word64 txIdRepliesReceived :: Word64 txIdsReceived :: Word64 txMessagesSent :: Word64 txsRequested :: Word64 txRepliesReceived :: Word64 txsReceived :: Word64 txsOmitted :: Word64 lateBodies :: Word64 txsAccepted :: Word64 txsRejected :: Word64 txIdBlockingReqsSent :: Word64 txIdPipelinedReqsSent :: Word64 txIdBlockingWaitMs :: Word64 txPipelineWaitMs :: Word64 txSubmissionWaitMs :: Word64 ..} = [ Text -> Integer -> Metric IntM Text "txSubmission.txIdMessagesSent" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdMessagesSent) , Text -> Integer -> Metric IntM Text "txSubmission.txIdsRequested" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdsRequested) , Text -> Integer -> Metric IntM Text "txSubmission.txIdRepliesReceived" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdRepliesReceived) , Text -> Integer -> Metric IntM Text "txSubmission.txIdsReceived" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdsReceived) , Text -> Integer -> Metric IntM Text "txSubmission.txMessagesSent" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txMessagesSent) , Text -> Integer -> Metric IntM Text "txSubmission.txsRequested" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txsRequested) , Text -> Integer -> Metric IntM Text "txSubmission.txRepliesReceived" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txRepliesReceived) , Text -> Integer -> Metric IntM Text "txSubmission.txsReceived" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txsReceived) , Text -> Integer -> Metric IntM Text "txSubmission.txsOmitted" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txsOmitted) , Text -> Integer -> Metric IntM Text "txSubmission.lateBodies" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 lateBodies) , Text -> Integer -> Metric IntM Text "txSubmission.txsAccepted" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txsAccepted) , Text -> Integer -> Metric IntM Text "txSubmission.txsRejected" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txsRejected) , Text -> Integer -> Metric IntM Text "txSubmission.txIdBlockingReqsSent" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdBlockingReqsSent) , Text -> Integer -> Metric IntM Text "txSubmission.txIdPipelinedReqsSent" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdPipelinedReqsSent) , Text -> Integer -> Metric IntM Text "txSubmission.txIdBlockingWaitMs" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txIdBlockingWaitMs) , Text -> Integer -> Metric IntM Text "txSubmission.txPipelineWaitMs" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txPipelineWaitMs) , Text -> Integer -> Metric IntM Text "txSubmission.txSubmissionWaitMs" (Word64 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 txSubmissionWaitMs) ] instance MetaTrace TxSubmissionCounters where namespaceFor :: TxSubmissionCounters -> Namespace TxSubmissionCounters namespaceFor TxSubmissionCounters {} = [Text] -> [Text] -> Namespace TxSubmissionCounters forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "Counters"] severityFor :: Namespace TxSubmissionCounters -> Maybe TxSubmissionCounters -> Maybe SeverityS severityFor Namespace TxSubmissionCounters _ Maybe TxSubmissionCounters _ = SeverityS -> Maybe SeverityS forall a. a -> Maybe a Just SeverityS Debug documentFor :: Namespace TxSubmissionCounters -> Maybe Text documentFor (Namespace [] [Text "Counters"]) = Text -> Maybe Text forall a. a -> Maybe a Just Text "Counters for TxSubmission v2" documentFor Namespace TxSubmissionCounters _ = Maybe Text forall a. Maybe a Nothing metricsDocFor :: Namespace TxSubmissionCounters -> [(Text, Text)] metricsDocFor (Namespace [] [Text "Counters"]) = [ (Text "txSubmission.txIdMessagesSent", Text "number of txid request messages sent") , (Text "txSubmission.txIdsRequested", Text "number of txids requested from remote peers") , (Text "txSubmission.txIdRepliesReceived", Text "number of txid reply messages received") , (Text "txSubmission.txIdsReceived", Text "number of txids received in reply batches") , (Text "txSubmission.txMessagesSent", Text "number of tx body request messages sent") , (Text "txSubmission.txsRequested", Text "number of tx bodies requested from remote peers") , (Text "txSubmission.txRepliesReceived", Text "number of tx body reply messages received") , (Text "txSubmission.txsReceived", Text "number of tx bodies received") , (Text "txSubmission.txsOmitted", Text "number of requested tx bodies omitted from replies") , (Text "txSubmission.lateBodies", Text "number of tx bodies received after local resolution") , (Text "txSubmission.txsAccepted", Text "number of tx bodies resolved into the mempool") , (Text "txSubmission.txsRejected", Text "number of tx bodies rejected by the mempool") , (Text "txSubmission.txIdBlockingReqsSent", Text "number of blocking txid request messages sent") , (Text "txSubmission.txIdPipelinedReqsSent", Text "number of pipelined txid request messages sent") , (Text "txSubmission.txIdBlockingWaitMs", Text "cumulative milliseconds spent waiting for blocking txid replies (idle state proxy)") , (Text "txSubmission.txPipelineWaitMs", Text "cumulative milliseconds the pipeline was active from first body request until full drain (loading state proxy)") , (Text "txSubmission.txSubmissionWaitMs", Text "cumulative milliseconds spent in mempoolAddTxs; high values indicate mempool backpressure") ] metricsDocFor Namespace TxSubmissionCounters _ = [] allNamespaces :: [Namespace TxSubmissionCounters] allNamespaces = [ [Text] -> [Text] -> Namespace TxSubmissionCounters forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "Counters"] ]