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

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Network.Tracing.TxSubmission.Outbound () where

import Data.Aeson
import Data.Text qualified as Text

import Cardano.Logging
import Ouroboros.Network.TxSubmission.Outbound

--------------------------------------------------------------------------------
-- TxOutbound Tracer
--------------------------------------------------------------------------------

instance (Show txid, Show tx)
      => LogFormatting (TraceTxSubmissionOutbound txid tx) where
  forMachine :: DetailLevel -> TraceTxSubmissionOutbound txid tx -> Object
forMachine DetailLevel
dtal (TraceTxSubmissionOutboundRecvMsgRequestTxs [txid]
txids) =
       (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
"TraceTxSubmissionOutboundRecvMsgRequestTxs")
    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 (TraceTxSubmissionOutboundSendMsgReplyTxs [tx]
txs) =
       (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
"TraceTxSubmissionOutboundSendMsgReplyTxs")
    Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> case DetailLevel
dtal of
             DetailLevel
DDetailed  -> Key
"txs" 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 (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [tx] -> String
forall a. Show a => a -> String
show [tx]
txs)
             DetailLevel
_otherwise -> Object
forall a. Monoid a => a
mempty

  forMachine DetailLevel
_dtal (TraceControlMessage ControlMessage
msg) =
    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
"TraceControlMessage" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ControlMessage -> String
forall a. Show a => a -> String
show ControlMessage
msg))

instance MetaTrace (TraceTxSubmissionOutbound txid tx) where
    namespaceFor :: TraceTxSubmissionOutbound txid tx
-> Namespace (TraceTxSubmissionOutbound txid tx)
namespaceFor TraceTxSubmissionOutboundRecvMsgRequestTxs {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RecvMsgRequest"]
    namespaceFor TraceTxSubmissionOutboundSendMsgReplyTxs {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendMsgReply"]
    namespaceFor TraceControlMessage {} =
      [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ControlMessage"]

    severityFor :: Namespace (TraceTxSubmissionOutbound txid tx)
-> Maybe (TraceTxSubmissionOutbound txid tx) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"RecvMsgRequest"]) Maybe (TraceTxSubmissionOutbound txid tx)
_ =
      SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"SendMsgReply"]) Maybe (TraceTxSubmissionOutbound txid tx)
_ =
      SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"ControlMessage"]) Maybe (TraceTxSubmissionOutbound txid tx)
_ =
      SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor Namespace (TraceTxSubmissionOutbound txid tx)
_ Maybe (TraceTxSubmissionOutbound txid tx)
_ = Maybe SeverityS
forall a. Maybe a
Nothing

    documentFor :: Namespace (TraceTxSubmissionOutbound txid tx) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"RecvMsgRequest"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The IDs of the transactions requested."
    documentFor (Namespace [Text]
_ [Text
"SendMsgReply"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The transactions to be sent in the response."
    documentFor (Namespace [Text]
_ [Text
"ControlMessage"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Peer selection control instruction"
    documentFor Namespace (TraceTxSubmissionOutbound txid tx)
_ = Maybe Text
forall a. Maybe a
Nothing

    allNamespaces :: [Namespace (TraceTxSubmissionOutbound txid tx)]
allNamespaces =
      [ [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RecvMsgRequest"]
      , [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SendMsgReply"]
      , [Text] -> [Text] -> Namespace (TraceTxSubmissionOutbound txid tx)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ControlMessage"]
      ]