{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Network.Tracing.TxSubmission () where import Control.Arrow import Control.Monad.Class.MonadTime.SI import Data.Aeson import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Cardano.Logging import Ouroboros.Network.TxSubmission.Inbound.V2.Types instance (Show txid, Show peeraddr) => LogFormatting (TraceTxLogic peeraddr txid tx) where forMachine :: DetailLevel -> TraceTxLogic peeraddr txid tx -> Object forMachine DetailLevel dtal (TraceSharedTxState String label SharedTxState {StdGen Map txid Int Map txid (Maybe tx) Map peeraddr (PeerTxState txid tx) Map Time [txid] peerTxStates :: Map peeraddr (PeerTxState txid tx) inflightTxs :: Map txid Int bufferedTxs :: Map txid (Maybe tx) referenceCounts :: Map txid Int timedTxs :: Map Time [txid] inSubmissionToMempoolTxs :: Map txid Int peerRng :: StdGen bufferedTxs :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map txid (Maybe tx) inSubmissionToMempoolTxs :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map txid Int inflightTxs :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map txid Int peerRng :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> StdGen peerTxStates :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map peeraddr (PeerTxState txid tx) referenceCounts :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map txid Int timedTxs :: forall peeraddr txid tx. SharedTxState peeraddr txid tx -> Map Time [txid] ..}) = [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 "label" Key -> String -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= String label , Key "inflightTxs" Key -> [(String, Int)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (((txid, Int) -> (String, Int)) -> [(txid, Int)] -> [(String, Int)] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((txid -> String) -> (txid, Int) -> (String, Int) forall b c d. (b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first txid -> String forall a. Show a => a -> String show) ([(txid, Int)] -> [(String, Int)]) -> (Map txid Int -> [(txid, Int)]) -> Map txid Int -> [(String, Int)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map txid Int -> [(txid, Int)] forall k a. Map k a -> [(k, a)] Map.toList (Map txid Int -> [(String, Int)]) -> Map txid Int -> [(String, Int)] forall a b. (a -> b) -> a -> b $ Map txid Int inflightTxs) , Key "bufferedTxs" Key -> [String] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= ((txid -> String) -> [txid] -> [String] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap txid -> String forall a. Show a => a -> String show ([txid] -> [String]) -> (Map txid (Maybe tx) -> [txid]) -> Map txid (Maybe tx) -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . Set txid -> [txid] forall a. Set a -> [a] Set.toList (Set txid -> [txid]) -> (Map txid (Maybe tx) -> Set txid) -> Map txid (Maybe tx) -> [txid] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map txid (Maybe tx) -> Set txid forall k a. Map k a -> Set k Map.keysSet (Map txid (Maybe tx) -> [String]) -> Map txid (Maybe tx) -> [String] forall a b. (a -> b) -> a -> b $ Map txid (Maybe tx) bufferedTxs) , Key "timedTxs" Key -> [(DiffTime, [String])] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (((Time, [txid]) -> (DiffTime, [String])) -> [(Time, [txid])] -> [(DiffTime, [String])] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(Time DiffTime t, [txid] txids) -> (DiffTime t, (txid -> String) -> [txid] -> [String] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap txid -> String forall a. Show a => a -> String show [txid] txids)) ([(Time, [txid])] -> [(DiffTime, [String])]) -> (Map Time [txid] -> [(Time, [txid])]) -> Map Time [txid] -> [(DiffTime, [String])] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map Time [txid] -> [(Time, [txid])] forall k a. Map k a -> [(k, a)] Map.toList (Map Time [txid] -> [(DiffTime, [String])]) -> Map Time [txid] -> [(DiffTime, [String])] forall a b. (a -> b) -> a -> b $ Map Time [txid] timedTxs) , Key "inSubmissionToMempoolTxs" Key -> [(String, Int)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (((txid, Int) -> (String, Int)) -> [(txid, Int)] -> [(String, Int)] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((txid -> String) -> (txid, Int) -> (String, Int) forall b c d. (b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first txid -> String forall a. Show a => a -> String show) ([(txid, Int)] -> [(String, Int)]) -> (Map txid Int -> [(txid, Int)]) -> Map txid Int -> [(String, Int)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map txid Int -> [(txid, Int)] forall k a. Map k a -> [(k, a)] Map.toList (Map txid Int -> [(String, Int)]) -> Map txid Int -> [(String, Int)] forall a b. (a -> b) -> a -> b $ Map txid Int inSubmissionToMempoolTxs) ] [Object] -> [Object] -> [Object] forall a. [a] -> [a] -> [a] ++ [Object] more where more :: [Object] more = case DetailLevel dtal of DetailLevel DMaximum -> [ Key "peerTxStates" Key -> [(String, Int)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (((txid, Int) -> (String, Int)) -> [(txid, Int)] -> [(String, Int)] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((txid -> String) -> (txid, Int) -> (String, Int) forall b c d. (b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first txid -> String forall a. Show a => a -> String show) ([(txid, Int)] -> [(String, Int)]) -> (Map txid Int -> [(txid, Int)]) -> Map txid Int -> [(String, Int)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map txid Int -> [(txid, Int)] forall k a. Map k a -> [(k, a)] Map.toList (Map txid Int -> [(String, Int)]) -> Map txid Int -> [(String, Int)] forall a b. (a -> b) -> a -> b $ Map txid Int inflightTxs) , Key "referenceCounts" Key -> [(String, Int)] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (((txid, Int) -> (String, Int)) -> [(txid, Int)] -> [(String, Int)] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((txid -> String) -> (txid, Int) -> (String, Int) forall b c d. (b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first txid -> String forall a. Show a => a -> String show) ([(txid, Int)] -> [(String, Int)]) -> (Map txid Int -> [(txid, Int)]) -> Map txid Int -> [(String, Int)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map txid Int -> [(txid, Int)] forall k a. Map k a -> [(k, a)] Map.toList (Map txid Int -> [(String, Int)]) -> Map txid Int -> [(String, Int)] forall a b. (a -> b) -> a -> b $ Map txid Int referenceCounts) ] DetailLevel _otherwise -> [] forMachine DetailLevel dtal (TraceTxDecisions Map peeraddr (TxDecision txid tx) decisionMap) = (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 "TraceTxDecisions") Object -> Object -> Object forall a. Semigroup a => a -> a -> a <> case DetailLevel dtal of DetailLevel DMaximum -> Key "decisions" Key -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])] -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= let g :: TxsToMempool b b -> [String] g (TxsToMempool [(b, b)] txs) = ((b, b) -> String) -> [(b, b)] -> [String] forall a b. (a -> b) -> [a] -> [b] map (b -> String forall a. Show a => a -> String show (b -> String) -> ((b, b) -> b) -> (b, b) -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . (b, b) -> b forall a b. (a, b) -> a fst) [(b, b)] txs f :: TxDecision b b -> [(Int, Int, [(String, SizeInBytes)], [String])] f TxDecision {Bool Map b SizeInBytes NumTxIdsToReq TxsToMempool b b NumTxIdsToAck txdTxIdsToAcknowledge :: NumTxIdsToAck txdTxIdsToRequest :: NumTxIdsToReq txdPipelineTxIds :: Bool txdTxsToRequest :: Map b SizeInBytes txdTxsToMempool :: TxsToMempool b b txdPipelineTxIds :: forall txid tx. TxDecision txid tx -> Bool txdTxIdsToAcknowledge :: forall txid tx. TxDecision txid tx -> NumTxIdsToAck txdTxIdsToRequest :: forall txid tx. TxDecision txid tx -> NumTxIdsToReq txdTxsToMempool :: forall txid tx. TxDecision txid tx -> TxsToMempool txid tx txdTxsToRequest :: forall txid tx. TxDecision txid tx -> Map txid SizeInBytes ..} = [( NumTxIdsToAck -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral NumTxIdsToAck txdTxIdsToAcknowledge :: Int, NumTxIdsToReq -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral NumTxIdsToReq txdTxIdsToRequest :: Int , ((b, SizeInBytes) -> (String, SizeInBytes)) -> [(b, SizeInBytes)] -> [(String, SizeInBytes)] forall a b. (a -> b) -> [a] -> [b] map ((b -> String) -> (b, SizeInBytes) -> (String, SizeInBytes) forall b c d. (b -> c) -> (b, d) -> (c, d) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first b -> String forall a. Show a => a -> String show) ([(b, SizeInBytes)] -> [(String, SizeInBytes)]) -> (Map b SizeInBytes -> [(b, SizeInBytes)]) -> Map b SizeInBytes -> [(String, SizeInBytes)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map b SizeInBytes -> [(b, SizeInBytes)] forall k a. Map k a -> [(k, a)] Map.toList (Map b SizeInBytes -> [(String, SizeInBytes)]) -> Map b SizeInBytes -> [(String, SizeInBytes)] forall a b. (a -> b) -> a -> b $ Map b SizeInBytes txdTxsToRequest, TxsToMempool b b -> [String] forall {b} {b}. Show b => TxsToMempool b b -> [String] g TxsToMempool b b txdTxsToMempool)] in ((peeraddr, TxDecision txid tx) -> (String, [(Int, Int, [(String, SizeInBytes)], [String])])) -> [(peeraddr, TxDecision txid tx)] -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])] forall a b. (a -> b) -> [a] -> [b] map (\(peeraddr peer, TxDecision txid tx decision) -> (peeraddr -> String forall a. Show a => a -> String show peeraddr peer, TxDecision txid tx -> [(Int, Int, [(String, SizeInBytes)], [String])] forall {b} {b}. Show b => TxDecision b b -> [(Int, Int, [(String, SizeInBytes)], [String])] f TxDecision txid tx decision)) ([(peeraddr, TxDecision txid tx)] -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])]) -> (Map peeraddr (TxDecision txid tx) -> [(peeraddr, TxDecision txid tx)]) -> Map peeraddr (TxDecision txid tx) -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])] forall b c a. (b -> c) -> (a -> b) -> a -> c . Map peeraddr (TxDecision txid tx) -> [(peeraddr, TxDecision txid tx)] forall k a. Map k a -> [(k, a)] Map.toList (Map peeraddr (TxDecision txid tx) -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])]) -> Map peeraddr (TxDecision txid tx) -> [(String, [(Int, Int, [(String, SizeInBytes)], [String])])] forall a b. (a -> b) -> a -> b $ Map peeraddr (TxDecision txid tx) decisionMap DetailLevel _otherwise -> let f :: TxDecision k tx -> Bool f TxDecision {Bool Map k SizeInBytes NumTxIdsToReq TxsToMempool k tx NumTxIdsToAck txdPipelineTxIds :: forall txid tx. TxDecision txid tx -> Bool txdTxIdsToAcknowledge :: forall txid tx. TxDecision txid tx -> NumTxIdsToAck txdTxIdsToRequest :: forall txid tx. TxDecision txid tx -> NumTxIdsToReq txdTxsToMempool :: forall txid tx. TxDecision txid tx -> TxsToMempool txid tx txdTxsToRequest :: forall txid tx. TxDecision txid tx -> Map txid SizeInBytes txdTxIdsToAcknowledge :: NumTxIdsToAck txdTxIdsToRequest :: NumTxIdsToReq txdPipelineTxIds :: Bool txdTxsToRequest :: Map k SizeInBytes txdTxsToMempool :: TxsToMempool k tx ..} = NumTxIdsToAck txdTxIdsToAcknowledge NumTxIdsToAck -> NumTxIdsToAck -> Bool forall a. Eq a => a -> a -> Bool == NumTxIdsToAck 0 Bool -> Bool -> Bool && NumTxIdsToReq txdTxIdsToRequest NumTxIdsToReq -> NumTxIdsToReq -> Bool forall a. Eq a => a -> a -> Bool == NumTxIdsToReq 0 Bool -> Bool -> Bool && Map k SizeInBytes -> Bool forall k a. Map k a -> Bool Map.null Map k SizeInBytes txdTxsToRequest in Key "decision-count" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Map peeraddr (TxDecision txid tx) -> Int forall k a. Map k a -> Int Map.size ((TxDecision txid tx -> Bool) -> Map peeraddr (TxDecision txid tx) -> Map peeraddr (TxDecision txid tx) forall a k. (a -> Bool) -> Map k a -> Map k a Map.filter (Bool -> Bool not (Bool -> Bool) -> (TxDecision txid tx -> Bool) -> TxDecision txid tx -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . TxDecision txid tx -> Bool forall txid tx. TxDecision txid tx -> Bool f) Map peeraddr (TxDecision txid tx) decisionMap) 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"] namespaceFor TraceTxDecisions {} = [Text] -> [Text] -> Namespace (TraceTxLogic peeraddr txid tx) forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "TraceTxDecisions"] 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 determining fetch decisions" 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"], [Text] -> [Text] -> Namespace (TraceTxLogic peeraddr txid tx) forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "TraceTxDecisions"] ] instance LogFormatting TxSubmissionCounters where forMachine :: DetailLevel -> TxSubmissionCounters -> Object forMachine DetailLevel _dtal TxSubmissionCounters {Int numOfOutstandingTxIds :: Int numOfBufferedTxs :: Int numOfInSubmissionToMempoolTxs :: Int numOfTxIdsInflight :: Int numOfBufferedTxs :: TxSubmissionCounters -> Int numOfInSubmissionToMempoolTxs :: TxSubmissionCounters -> Int numOfOutstandingTxIds :: TxSubmissionCounters -> Int numOfTxIdsInflight :: TxSubmissionCounters -> Int ..} = [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 "numOfOutstandingTxIds" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int numOfOutstandingTxIds , Key "numOfBufferedTxs" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int numOfBufferedTxs , Key "numOfInSubmissionToMempoolTxs" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int numOfInSubmissionToMempoolTxs , Key "numOfTxIdsInflight" Key -> Int -> Object forall v. ToJSON v => Key -> v -> Object forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int numOfTxIdsInflight ] asMetrics :: TxSubmissionCounters -> [Metric] asMetrics TxSubmissionCounters {Int numOfBufferedTxs :: TxSubmissionCounters -> Int numOfInSubmissionToMempoolTxs :: TxSubmissionCounters -> Int numOfOutstandingTxIds :: TxSubmissionCounters -> Int numOfTxIdsInflight :: TxSubmissionCounters -> Int numOfOutstandingTxIds :: Int numOfBufferedTxs :: Int numOfInSubmissionToMempoolTxs :: Int numOfTxIdsInflight :: Int ..} = [ Text -> Integer -> Metric IntM Text "txSubmission.numOfOutstandingTxIds" (Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Int numOfOutstandingTxIds) , Text -> Integer -> Metric IntM Text "txSubmission.numOfBufferedTxs" (Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Int numOfBufferedTxs) , Text -> Integer -> Metric IntM Text "txSubmission.numOfInSubmissionToMempoolTxs" (Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Int numOfInSubmissionToMempoolTxs) , Text -> Integer -> Metric IntM Text "txSubmission.numOfTxIdsInflight" (Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral Int numOfTxIdsInflight) ] 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.numOfOutstandingTxIds", Text "txid's which are not yet downloaded") , (Text "txSubmission.numOfBufferedTxs", Text "tx's which have been recently successfully applied to the mempool") , (Text "txSubmission.numOfInSubmissionToMempoolTxs", Text "number of all tx's which are enqueued to the mempool") , (Text "txSubmission.numOfTxIdsInflight", Text "number of all in-flight txid's") ] metricsDocFor Namespace TxSubmissionCounters _ = [] allNamespaces :: [Namespace TxSubmissionCounters] allNamespaces = [ [Text] -> [Text] -> Namespace TxSubmissionCounters forall a. [Text] -> [Text] -> Namespace a Namespace [] [Text "Counters"] ]