-- | Trace context
--
-- See documentation of t'TraceContext'.
module Network.GRPC.Spec.TraceContext (
    -- * Definition
    TraceContext(..)
  , TraceId(..)
  , SpanId(..)
  , TraceOptions(..)
  ) where

import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Base16 qualified as BS.Strict.Base16
import Data.ByteString.Char8 qualified as BS.Strict.Char8
import Data.Default
import Data.String
import GHC.Generics (Generic)

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Trace context
--
-- Representation of the \"trace context\" in OpenTelemetry, corresponding
-- directly to the W3C @traceparent@ header.
--
-- References:
--
-- * <https://www.w3.org/TR/trace-context/#traceparent-header>
--   W3C spec
--
-- * <https://github.com/census-instrumentation/opencensus-specs/blob/master/encodings/BinaryEncoding.md>
--   Binary format used for the @grpc-trace-bin@ header
--
-- * <https://github.com/open-telemetry/opentelemetry-specification/issues/639>
--   Current status of the binary encoding.
--
-- Relation to Haskell OpenTelemetry implementations:
--
-- * The Haskell @opentelemetry@ package calls this a @SpanContext@, but
--    provides no binary @PropagationFormat@, and does not support
--    t'TraceOptions'.
--
--   <https://hackage.haskell.org/package/opentelemetry>
--
-- * The Haskell @hs-opentelemetry@ ecosystem defines @SpanContext@, which is
--   the combination of the W3C @traceparent@ header (our t'TraceContext') and
--   the W3C @tracestate@ header (which we do not support). It too does not
--   support the @grpc-trace-bin@ binary format.
--
--   <https://github.com/iand675/hs-opentelemetry>
--   <https://hackage.haskell.org/package/hs-opentelemetry-propagator-w3c>
data TraceContext = TraceContext {
      TraceContext -> Maybe TraceId
traceContextTraceId  :: Maybe TraceId
    , TraceContext -> Maybe SpanId
traceContextSpanId   :: Maybe SpanId
    , TraceContext -> Maybe TraceOptions
traceContextOptions  :: Maybe TraceOptions
    }
  deriving stock (Int -> TraceContext -> ShowS
[TraceContext] -> ShowS
TraceContext -> String
(Int -> TraceContext -> ShowS)
-> (TraceContext -> String)
-> ([TraceContext] -> ShowS)
-> Show TraceContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceContext -> ShowS
showsPrec :: Int -> TraceContext -> ShowS
$cshow :: TraceContext -> String
show :: TraceContext -> String
$cshowList :: [TraceContext] -> ShowS
showList :: [TraceContext] -> ShowS
Show, TraceContext -> TraceContext -> Bool
(TraceContext -> TraceContext -> Bool)
-> (TraceContext -> TraceContext -> Bool) -> Eq TraceContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceContext -> TraceContext -> Bool
== :: TraceContext -> TraceContext -> Bool
$c/= :: TraceContext -> TraceContext -> Bool
/= :: TraceContext -> TraceContext -> Bool
Eq, (forall x. TraceContext -> Rep TraceContext x)
-> (forall x. Rep TraceContext x -> TraceContext)
-> Generic TraceContext
forall x. Rep TraceContext x -> TraceContext
forall x. TraceContext -> Rep TraceContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceContext -> Rep TraceContext x
from :: forall x. TraceContext -> Rep TraceContext x
$cto :: forall x. Rep TraceContext x -> TraceContext
to :: forall x. Rep TraceContext x -> TraceContext
Generic)

instance Default TraceContext where
  def :: TraceContext
def = TraceContext {
        traceContextTraceId :: Maybe TraceId
traceContextTraceId = Maybe TraceId
forall a. Maybe a
Nothing
      , traceContextSpanId :: Maybe SpanId
traceContextSpanId  = Maybe SpanId
forall a. Maybe a
Nothing
      , traceContextOptions :: Maybe TraceOptions
traceContextOptions = Maybe TraceOptions
forall a. Maybe a
Nothing
      }

-- | Trace ID
--
-- The ID of the whole trace forest. Must be a 16-byte string.
newtype TraceId = TraceId {
      TraceId -> ByteString
getTraceId :: Strict.ByteString
    }
  deriving stock (TraceId -> TraceId -> Bool
(TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool) -> Eq TraceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceId -> TraceId -> Bool
== :: TraceId -> TraceId -> Bool
$c/= :: TraceId -> TraceId -> Bool
/= :: TraceId -> TraceId -> Bool
Eq, (forall x. TraceId -> Rep TraceId x)
-> (forall x. Rep TraceId x -> TraceId) -> Generic TraceId
forall x. Rep TraceId x -> TraceId
forall x. TraceId -> Rep TraceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceId -> Rep TraceId x
from :: forall x. TraceId -> Rep TraceId x
$cto :: forall x. Rep TraceId x -> TraceId
to :: forall x. Rep TraceId x -> TraceId
Generic)

-- | Span ID
--
-- ID of the caller span (parent). Must be an 8-byte string.
newtype SpanId = SpanId {
      SpanId -> ByteString
getSpanId :: Strict.ByteString
    }
  deriving stock (SpanId -> SpanId -> Bool
(SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool) -> Eq SpanId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanId -> SpanId -> Bool
== :: SpanId -> SpanId -> Bool
$c/= :: SpanId -> SpanId -> Bool
/= :: SpanId -> SpanId -> Bool
Eq, (forall x. SpanId -> Rep SpanId x)
-> (forall x. Rep SpanId x -> SpanId) -> Generic SpanId
forall x. Rep SpanId x -> SpanId
forall x. SpanId -> Rep SpanId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpanId -> Rep SpanId x
from :: forall x. SpanId -> Rep SpanId x
$cto :: forall x. Rep SpanId x -> SpanId
to :: forall x. Rep SpanId x -> SpanId
Generic)

-- | Tracing options
--
-- The flags are recommendations given by the caller rather than strict rules to
-- follow for 3 reasons:
--
-- * Trust and abuse.
-- * Bug in caller
-- * Different load between caller service and callee service might force callee
--   to down sample.
data TraceOptions = TraceOptions {
      -- | Sampled
      --
      -- When set, denotes that the caller may have recorded trace data. When
      -- unset, the caller did not record trace data out-of-band.
      TraceOptions -> Bool
traceOptionsSampled :: Bool
    }
  deriving stock (Int -> TraceOptions -> ShowS
[TraceOptions] -> ShowS
TraceOptions -> String
(Int -> TraceOptions -> ShowS)
-> (TraceOptions -> String)
-> ([TraceOptions] -> ShowS)
-> Show TraceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceOptions -> ShowS
showsPrec :: Int -> TraceOptions -> ShowS
$cshow :: TraceOptions -> String
show :: TraceOptions -> String
$cshowList :: [TraceOptions] -> ShowS
showList :: [TraceOptions] -> ShowS
Show, TraceOptions -> TraceOptions -> Bool
(TraceOptions -> TraceOptions -> Bool)
-> (TraceOptions -> TraceOptions -> Bool) -> Eq TraceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceOptions -> TraceOptions -> Bool
== :: TraceOptions -> TraceOptions -> Bool
$c/= :: TraceOptions -> TraceOptions -> Bool
/= :: TraceOptions -> TraceOptions -> Bool
Eq, (forall x. TraceOptions -> Rep TraceOptions x)
-> (forall x. Rep TraceOptions x -> TraceOptions)
-> Generic TraceOptions
forall x. Rep TraceOptions x -> TraceOptions
forall x. TraceOptions -> Rep TraceOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceOptions -> Rep TraceOptions x
from :: forall x. TraceOptions -> Rep TraceOptions x
$cto :: forall x. Rep TraceOptions x -> TraceOptions
to :: forall x. Rep TraceOptions x -> TraceOptions
Generic)

{-------------------------------------------------------------------------------
  Show instances for IDs

  We follow the W3C spec and show these as base16 strings.
-------------------------------------------------------------------------------}

instance Show TraceId where
  show :: TraceId -> String
show (TraceId ByteString
tid) =
      ShowS
forall a. Show a => a -> String
show ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.Strict.Char8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
BS.Strict.Base16.encode ByteString
tid

instance IsString TraceId where
  fromString :: String -> TraceId
fromString String
str =
      case ByteString -> Either String ByteString
BS.Strict.Base16.decode (String -> ByteString
BS.Strict.Char8.pack String
str) of
        Left  String
err -> String -> TraceId
forall a. HasCallStack => String -> a
error String
err
        Right ByteString
tid -> ByteString -> TraceId
TraceId ByteString
tid

instance Show SpanId where
  show :: SpanId -> String
show (SpanId ByteString
tid) =
      ShowS
forall a. Show a => a -> String
show ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.Strict.Char8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
BS.Strict.Base16.encode ByteString
tid

instance IsString SpanId where
  fromString :: String -> SpanId
fromString String
str =
      case ByteString -> Either String ByteString
BS.Strict.Base16.decode (String -> ByteString
BS.Strict.Char8.pack String
str) of
        Left  String
err -> String -> SpanId
forall a. HasCallStack => String -> a
error String
err
        Right ByteString
tid -> ByteString -> SpanId
SpanId ByteString
tid