{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Network.Tracing.TxSubmission.Inbound () where

import Data.Aeson
import Data.Text qualified as Text

import Cardano.Logging
import Ouroboros.Network.TxSubmission.Inbound.V2.Types

--------------------------------------------------------------------------------
-- TxInbound Tracer
--------------------------------------------------------------------------------

instance (Show txid, Show tx)
      => LogFormatting (TraceTxSubmissionInbound txid tx) where
  forMachine :: DetailLevel -> TraceTxSubmissionInbound txid tx -> Object
forMachine DetailLevel
dtal (TraceTxSubmissionCollected [txid]
txids) =
    [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
"TraceTxSubmissionCollected"
      , Key
"count" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ([txid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [txid]
txids)
      ]
    Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> case DetailLevel
dtal of
         DetailLevel
DDetailed  -> Key
"txIds" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack ([txid] -> String
forall a. Show a => a -> String
show [txid]
txids)
         DetailLevel
_otherwise -> Object
forall a. Monoid a => a
mempty

  forMachine DetailLevel
_dtal (TraceTxSubmissionProcessed ProcessedTxCount
processed) =
    [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
"TraceTxSubmissionProcessed"
      , Key
"accepted" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (ProcessedTxCount -> Int
ptxcAccepted ProcessedTxCount
processed)
      , Key
"rejected" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON (ProcessedTxCount -> Int
ptxcRejected ProcessedTxCount
processed)
      ]

  forMachine DetailLevel
_dtal TraceTxSubmissionInbound txid tx
TraceTxInboundTerminated =
    [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
"TraceTxInboundTerminated"
      ]

  forMachine DetailLevel
_dtal (TraceTxInboundCanRequestMoreTxs Int
count) =
    [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
"TraceTxInboundCanRequestMoreTxs"
      , Key
"count" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
count
      ]

  forMachine DetailLevel
_dtal (TraceTxInboundCannotRequestMoreTxs Int
count) =
    [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
"TraceTxInboundCannotRequestMoreTxs"
      , Key
"count" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
count
      ]

  forMachine DetailLevel
dtal (TraceTxInboundAddedToMempool [txid]
txids DiffTime
dt) =
    [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
"TraceTxInboundAddedToMempool"
      , Key
"count" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ([txid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [txid]
txids)
      , Key
"dt" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON DiffTime
dt]
    Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> case DetailLevel
dtal of
         DetailLevel
DDetailed  -> Key
"txIds" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack ([txid] -> String
forall a. Show a => a -> String
show [txid]
txids)
         DetailLevel
_otherwise -> Object
forall a. Monoid a => a
mempty

  forMachine DetailLevel
dtal (TraceTxInboundRejectedFromMempool [txid]
txids DiffTime
dt) =
    [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
"TraceTxInboundRejectedFromMempool"
      , Key
"count" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON ([txid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [txid]
txids)
      , Key
"dt" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> Value
forall a. ToJSON a => a -> Value
toJSON DiffTime
dt]
    Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> case DetailLevel
dtal of
         DetailLevel
DDetailed  -> Key
"txIds" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack ([txid] -> String
forall a. Show a => a -> String
show [txid]
txids)
         DetailLevel
_otherwise -> Object
forall a. Monoid a => a
mempty

  forMachine DetailLevel
_dtal (TraceTxInboundError TxSubmissionProtocolError
e) =
    [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
"TraceTxInboundError"
      , Key
"error" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack (TxSubmissionProtocolError -> String
forall a. Show a => a -> String
show TxSubmissionProtocolError
e)
      ]

  forMachine DetailLevel
_dtal (TraceTxInboundDecision TxDecision txid tx
decision) =
    [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
"TraceTxInboundDecision"
      , Key
"decision" Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack (TxDecision txid tx -> String
forall a. Show a => a -> String
show TxDecision txid tx
decision)
      ]

  asMetrics :: TraceTxSubmissionInbound txid tx -> [Metric]
asMetrics (TraceTxSubmissionCollected [txid]
txids) =
    [Text -> Maybe Int -> Metric
CounterM Text
"submissions.submitted" (Int -> Maybe Int
forall a. a -> Maybe a
Just ([txid] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [txid]
txids))]
  asMetrics (TraceTxSubmissionProcessed ProcessedTxCount
processed) =
    [ Text -> Maybe Int -> Metric
CounterM Text
"submissions.accepted"
        (Int -> Maybe Int
forall a. a -> Maybe a
Just (ProcessedTxCount -> Int
ptxcAccepted ProcessedTxCount
processed))
    , Text -> Maybe Int -> Metric
CounterM Text
"submissions.rejected"
        (Int -> Maybe Int
forall a. a -> Maybe a
Just (ProcessedTxCount -> Int
ptxcRejected ProcessedTxCount
processed))
    ]
  asMetrics TraceTxSubmissionInbound txid tx
_ = []

instance MetaTrace (TraceTxSubmissionInbound txid tx) where
    namespaceFor :: TraceTxSubmissionInbound txid tx
-> Namespace (TraceTxSubmissionInbound txid tx)
namespaceFor TraceTxSubmissionCollected {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Collected"]
    namespaceFor TraceTxSubmissionProcessed {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Processed"]
    namespaceFor TraceTxInboundTerminated {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Terminated"]
    namespaceFor TraceTxInboundCanRequestMoreTxs {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CanRequestMoreTxs"]
    namespaceFor TraceTxInboundCannotRequestMoreTxs {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CannotRequestMoreTxs"]
    namespaceFor TraceTxInboundAddedToMempool {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedToMempool"]
    namespaceFor TraceTxInboundRejectedFromMempool {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedFromMempool"]
    namespaceFor TraceTxInboundError {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Error"]
    namespaceFor TraceTxInboundDecision {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Decision"]

    severityFor :: Namespace (TraceTxSubmissionInbound txid tx)
-> Maybe (TraceTxSubmissionInbound txid tx) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"Collected"]) Maybe (TraceTxSubmissionInbound txid tx)
_            = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"Processed"]) Maybe (TraceTxSubmissionInbound txid tx)
_            = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"Terminated"]) Maybe (TraceTxSubmissionInbound txid tx)
_           = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
    severityFor (Namespace [Text]
_ [Text
"CanRequestMoreTxs"]) Maybe (TraceTxSubmissionInbound txid tx)
_    = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"CannotRequestMoreTxs"]) Maybe (TraceTxSubmissionInbound txid tx)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"AddedToMempool"]) Maybe (TraceTxSubmissionInbound txid tx)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"RejectedFromMempool"]) Maybe (TraceTxSubmissionInbound txid tx)
_  = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"Error"]) Maybe (TraceTxSubmissionInbound txid tx)
_                = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"Decision"]) Maybe (TraceTxSubmissionInbound txid tx)
_             = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug

    severityFor Namespace (TraceTxSubmissionInbound txid tx)
_ Maybe (TraceTxSubmissionInbound txid tx)
_                                      = Maybe SeverityS
forall a. Maybe a
Nothing

    metricsDocFor :: Namespace (TraceTxSubmissionInbound txid tx) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"Collected"]) =
      [ (Text
"submissions.submitted", Text
"")]
    metricsDocFor (Namespace [Text]
_ [Text
"Processed"]) =
      [ (Text
"submissions.accepted", Text
"")
      , (Text
"submissions.rejected", Text
"")
      ]
    metricsDocFor Namespace (TraceTxSubmissionInbound txid tx)
_ = []

    documentFor :: Namespace (TraceTxSubmissionInbound txid tx) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"Collected"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Number of transactions just about to be inserted."
    documentFor (Namespace [Text]
_ [Text
"Processed"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Just processed transaction pass/fail breakdown."
    documentFor (Namespace [Text]
_ [Text
"Terminated"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Server received 'MsgDone'."
    documentFor (Namespace [Text]
_ [Text
"CanRequestMoreTxs"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"There are no replies in flight, but we do know some more txs we"
      , Text
" can ask for, so lets ask for them and more txids."
      ]
    documentFor (Namespace [Text]
_ [Text
"CannotRequestMoreTxs"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"There's no replies in flight, and we have no more txs we can"
      , Text
" ask for so the only remaining thing to do is to ask for more"
      , Text
" txids. Since this is the only thing to do now, we make this a"
      , Text
" blocking call."
      ]
    documentFor (Namespace [Text]
_ [Text
"AddedToMempool"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Transactions added to the mempool and processing time"
    documentFor (Namespace [Text]
_ [Text
"RejectedFromMempool"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Transactions rejected from mempool and processing time"
    documentFor (Namespace [Text]
_ [Text
"Error"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Protocol violation causing connection reset"
    documentFor (Namespace [Text]
_ [Text
"Decision"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Decision to advance the protocol"
    documentFor Namespace (TraceTxSubmissionInbound txid tx)
_ = Maybe Text
forall a. Maybe a
Nothing

    allNamespaces :: [Namespace (TraceTxSubmissionInbound txid tx)]
allNamespaces = [
          [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Collected"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Processed"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Terminated"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CanRequestMoreTxs"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CannotRequestMoreTxs"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"AddedToMempool"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RejectedFromMempool"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Error"]
        , [Text] -> [Text] -> Namespace (TraceTxSubmissionInbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Decision"]
        ]