module Hasura.Tracing.Context
  ( TraceContext (..),
    TraceMetadata,
  )
where

import Data.Aeson ((.=))
import Data.Aeson qualified as J
import Hasura.Prelude
import Hasura.Tracing.Sampling
import Hasura.Tracing.TraceId

-- | Any additional human-readable key-value pairs relevant to the execution of
-- a span.
--
-- When the Open Telemetry exporter is in use these become attributes. Where
-- possible and appropriate, consider using key names from the documented OT
-- semantic conventions here:
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/
-- This can serve to document the metadata, even for users not using open telemetry.
--
-- We may make this type more closely align with the OT data model in the future
-- (e.g. supporting int, etc)
type TraceMetadata = [(Text, Text)]

-- | A trace context records the current active trace, the active span
-- within that trace, and the span's parent, unless the current span
-- is the root. This is like a call stack.
data TraceContext = TraceContext
  { TraceContext -> TraceId
tcCurrentTrace :: TraceId,
    TraceContext -> SpanId
tcCurrentSpan :: SpanId,
    TraceContext -> Maybe SpanId
tcCurrentParent :: Maybe SpanId,
    TraceContext -> SamplingState
tcSamplingState :: SamplingState
  }

-- Should this be here? This implicitly ties Tracing to the name of fields in HTTP headers.
instance J.ToJSON TraceContext where
  toJSON :: TraceContext -> Value
toJSON TraceContext {Maybe SpanId
SamplingState
SpanId
TraceId
tcCurrentTrace :: TraceContext -> TraceId
tcCurrentSpan :: TraceContext -> SpanId
tcCurrentParent :: TraceContext -> Maybe SpanId
tcSamplingState :: TraceContext -> SamplingState
tcCurrentTrace :: TraceId
tcCurrentSpan :: SpanId
tcCurrentParent :: Maybe SpanId
tcSamplingState :: SamplingState
..} =
    let idFields :: [Pair]
idFields =
          [ Key
"trace_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ByteString -> Text
bsToTxt (TraceId -> ByteString
traceIdToHex TraceId
tcCurrentTrace),
            Key
"span_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ByteString -> Text
bsToTxt (SpanId -> ByteString
spanIdToHex SpanId
tcCurrentSpan)
          ]
        samplingFieldMaybe :: Maybe Pair
samplingFieldMaybe =
          forall s. IsString s => SamplingState -> Maybe s
samplingStateToHeader @Text SamplingState
tcSamplingState Maybe Text -> (Text -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
t ->
            Key
"sampling_state" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
t
     in [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
idFields [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Maybe Pair -> [Pair]
forall a. Maybe a -> [a]
maybeToList Maybe Pair
samplingFieldMaybe