{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Provides datatypes used in tracing
module Cardano.Rpc.Server.Internal.Tracing where

import Cardano.Api.Consensus (TxValidationErrorInCardanoMode)
import Cardano.Api.Era (Inject (..))
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Cbor (DecoderError)
import Cardano.Api.Serialise.SerialiseUsing

import Control.Exception
import Data.Word (Word64)

-- | A sum type representing all possible traces
data TraceRpc
  = TraceRpcQuery TraceRpcQuery
  | TraceRpcSubmit TraceRpcSubmit
  | TraceRpcError SomeException
  | TraceRpcFatalError SomeException

-- | Traces used in Query service
data TraceRpcQuery
  = -- | Span trace marking ReadParams query
    TraceRpcQueryParamsSpan TraceSpanEvent
  | -- | Span trace marking ReadUtxos query
    TraceRpcQueryReadUtxosSpan TraceSpanEvent
  deriving Int -> TraceRpcQuery -> ShowS
[TraceRpcQuery] -> ShowS
TraceRpcQuery -> String
(Int -> TraceRpcQuery -> ShowS)
-> (TraceRpcQuery -> String)
-> ([TraceRpcQuery] -> ShowS)
-> Show TraceRpcQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceRpcQuery -> ShowS
showsPrec :: Int -> TraceRpcQuery -> ShowS
$cshow :: TraceRpcQuery -> String
show :: TraceRpcQuery -> String
$cshowList :: [TraceRpcQuery] -> ShowS
showList :: [TraceRpcQuery] -> ShowS
Show

instance Pretty TraceRpc where
  pretty :: forall ann. TraceRpc -> Doc ann
pretty = \case
    TraceRpcQuery TraceRpcQuery
t -> TraceRpcQuery -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TraceRpcQuery -> Doc ann
pretty TraceRpcQuery
t
    TraceRpcSubmit TraceRpcSubmit
t -> TraceRpcSubmit -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TraceRpcSubmit -> Doc ann
pretty TraceRpcSubmit
t
    TraceRpcError SomeException
e -> Doc ann
"Exception when processing RPC request:\n" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeException -> Doc ann
forall a ann. Exception a => a -> Doc ann
prettyException SomeException
e
    TraceRpcFatalError SomeException
e -> Doc ann
"RPC server fatal error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeException -> Doc ann
forall a ann. Exception a => a -> Doc ann
prettyException SomeException
e

-- | Span type
data TraceSpanEvent
  = -- | Opening span trace
    SpanBegin SpanId
  | -- | Ending span trace
    SpanEnd SpanId
  deriving Int -> TraceSpanEvent -> ShowS
[TraceSpanEvent] -> ShowS
TraceSpanEvent -> String
(Int -> TraceSpanEvent -> ShowS)
-> (TraceSpanEvent -> String)
-> ([TraceSpanEvent] -> ShowS)
-> Show TraceSpanEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceSpanEvent -> ShowS
showsPrec :: Int -> TraceSpanEvent -> ShowS
$cshow :: TraceSpanEvent -> String
show :: TraceSpanEvent -> String
$cshowList :: [TraceSpanEvent] -> ShowS
showList :: [TraceSpanEvent] -> ShowS
Show

-- | 8-byte span ID, serialised in hex.
type SpanId = UsingRawBytesHex Word64

instance Pretty TraceRpcQuery where
  pretty :: forall ann. TraceRpcQuery -> Doc ann
pretty = \case
    TraceRpcQueryParamsSpan (SpanBegin SpanId
_) -> Doc ann
"Started query params method"
    TraceRpcQueryParamsSpan (SpanEnd SpanId
_) -> Doc ann
"Finished query params method"
    TraceRpcQueryReadUtxosSpan (SpanBegin SpanId
_) -> Doc ann
"Started query read UTXO method"
    TraceRpcQueryReadUtxosSpan (SpanEnd SpanId
_) -> Doc ann
"Finished query read UTXO method"

-- | Traces used in SubmitTx service
data TraceRpcSubmit
  = -- | Node-to-client exception
    TraceRpcSubmitN2cConnectionError SomeException
  | -- | Transaction deserialisation error
    TraceRpcSubmitTxDecodingFailure
      Int
      -- ^ index of a transaction in a request
      DecoderError
  | -- | Transaction submission error
    TraceRpcSubmitTxValidationError
      Int
      -- ^ index of a transaction in a request
      TxValidationErrorInCardanoMode
  | -- | Transaction submission span
    TraceRpcSubmitSpan TraceSpanEvent
  deriving Int -> TraceRpcSubmit -> ShowS
[TraceRpcSubmit] -> ShowS
TraceRpcSubmit -> String
(Int -> TraceRpcSubmit -> ShowS)
-> (TraceRpcSubmit -> String)
-> ([TraceRpcSubmit] -> ShowS)
-> Show TraceRpcSubmit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceRpcSubmit -> ShowS
showsPrec :: Int -> TraceRpcSubmit -> ShowS
$cshow :: TraceRpcSubmit -> String
show :: TraceRpcSubmit -> String
$cshowList :: [TraceRpcSubmit] -> ShowS
showList :: [TraceRpcSubmit] -> ShowS
Show

instance Pretty TraceRpcSubmit where
  pretty :: forall ann. TraceRpcSubmit -> Doc ann
pretty = \case
    TraceRpcSubmitSpan (SpanBegin SpanId
_) -> Doc ann
"Started submit method"
    TraceRpcSubmitSpan (SpanEnd SpanId
_) -> Doc ann
"Finished submit method"
    TraceRpcSubmitN2cConnectionError SomeException
e -> Doc ann
"N2C connection error while trying to submit a transaction: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeException -> Doc ann
forall a ann. Exception a => a -> Doc ann
prettyException SomeException
e
    TraceRpcSubmitTxDecodingFailure Int
i DecoderError
e -> Doc ann
"Failed to decode transaction with index " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow DecoderError
e
    TraceRpcSubmitTxValidationError Int
i TxValidationErrorInCardanoMode
e -> Doc ann
"Failed to submit transaction with index " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TxValidationErrorInCardanoMode -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow TxValidationErrorInCardanoMode
e

instance Inject TraceRpcSubmit TraceRpc where
  inject :: TraceRpcSubmit -> TraceRpc
inject = TraceRpcSubmit -> TraceRpc
TraceRpcSubmit

instance Inject TraceRpcQuery TraceRpc where
  inject :: TraceRpcQuery -> TraceRpc
inject = TraceRpcQuery -> TraceRpc
TraceRpcQuery