{-# 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.Error
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Cbor (DecoderError)
import Cardano.Api.Serialise.Raw (SerialiseAsRawBytesError)
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
  | -- | Span trace marking SearchUtxos query
    TraceRpcQuerySearchUtxosSpan 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 UsingRawBytesHex Word64
_) -> Doc ann
"Started query params method"
    TraceRpcQueryParamsSpan (SpanEnd UsingRawBytesHex Word64
_) -> Doc ann
"Finished query params method"
    TraceRpcQueryReadUtxosSpan (SpanBegin UsingRawBytesHex Word64
_) -> Doc ann
"Started query read UTXO method"
    TraceRpcQueryReadUtxosSpan (SpanEnd UsingRawBytesHex Word64
_) -> Doc ann
"Finished query read UTXO method"
    TraceRpcQuerySearchUtxosSpan (SpanBegin UsingRawBytesHex Word64
_) -> Doc ann
"Started query search UTXO method"
    TraceRpcQuerySearchUtxosSpan (SpanEnd UsingRawBytesHex Word64
_) -> Doc ann
"Finished query search UTXO method"

instance Error TraceRpcQuery where
  prettyError :: forall ann. TraceRpcQuery -> Doc ann
prettyError = TraceRpcQuery -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TraceRpcQuery -> Doc ann
pretty

-- | Traces used in SubmitTx service
data TraceRpcSubmit
  = -- | Node-to-client exception
    TraceRpcSubmitN2cConnectionError SomeException
  | -- | Transaction deserialisation error
    TraceRpcSubmitTxDecodingError DecoderError
  | -- | Transaction submission error
    TraceRpcSubmitTxValidationError TxValidationErrorInCardanoMode
  | -- | Transaction submission span
    TraceRpcSubmitSpan TraceSpanEvent
  | -- | Transaction evaluation deserialisation error
    TraceRpcEvalTxDecodingError SerialiseAsRawBytesError
  | -- | Transaction evaluation span
    TraceRpcEvalTxSpan 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 UsingRawBytesHex Word64
_) -> Doc ann
"Started submit method"
    TraceRpcSubmitSpan (SpanEnd UsingRawBytesHex Word64
_) -> Doc ann
"Finished submit method"
    TraceRpcEvalTxSpan (SpanBegin UsingRawBytesHex Word64
_) -> Doc ann
"Started eval tx method"
    TraceRpcEvalTxSpan (SpanEnd UsingRawBytesHex Word64
_) -> Doc ann
"Finished eval tx method"
    TraceRpcEvalTxDecodingError SerialiseAsRawBytesError
e -> Doc ann
"Failed to decode transaction for evaluation: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SerialiseAsRawBytesError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow SerialiseAsRawBytesError
e
    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
    TraceRpcSubmitTxDecodingError DecoderError
e -> Doc ann
"Failed to decode transaction: " 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 TxValidationErrorInCardanoMode
e -> Doc ann
"Failed to submit transaction: " 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 Error TraceRpcSubmit where
  prettyError :: forall ann. TraceRpcSubmit -> Doc ann
prettyError = TraceRpcSubmit -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TraceRpcSubmit -> Doc ann
pretty

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

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