{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

{- |
 Module      :  OpenTelemetry.Trace
 Copyright   :  (c) Ian Duncan, 2021
 License     :  BSD-3
 Description :  Application Tracing API
 Maintainer  :  Ian Duncan
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)

 Traces track the progression of a single request, called a trace, as it is handled
 by services that make up an application. The request may be initiated by a user or
 an application. Distributed tracing is a form of tracing that traverses process, network
 and security boundaries. Each unit of work in a trace is called a span; a trace is a tree of spans.
 Spans are objects that represent the work being done by individual services or components involved in a request as it flows through a system. A span contains a span context, which is a set of globally unique identifiers that represent the unique request that each span is a part of.
 A span provides Request, Error and Duration (RED) metrics that can be used to debug availability as well as performance issues.

 Here is a visualization of the relationship between traces and spans:

 <<docs/img/traces_spans.png>>

 A trace contains a single root span which encapsulates the end-to-end latency for the entire request. You can think of this as a single logical operation, such as clicking a button in a web application to add a product to a shopping cart. The root span would measure the time it took from an end-user clicking that button to the operation being completed or failing (so, the item is added to the cart or some error occurs) and the result being displayed to the user. A trace is comprised of the single root span and any number of child spans, which represent operations taking place as part of the request. Each span contains metadata about the operation, such as its name, start and end timestamps, attributes (which represent additonal user-defined metadata about a span), events, and status.

 To create and manage spans in OpenTelemetry, the OpenTelemetry API provides the tracer interface. This object is responsible for tracking the active span in your process, and allows you to access the current span in order to perform operations on it such as adding attributes, events, and finishing it when the work it tracks is complete. One or more tracer objects can be created in a process through the tracer provider, a factory interface that allows for multiple tracers to be instantiated in a single process with different options.

 Generally, the lifecycle of a span resembles the following:

 - A request is received by a service. The span context is extracted from the request headers, if it exists.
 - A new span is created as a child of the extracted span context; if none exists, a new root span is created.
 - The service handles the request. Additional attributes and events are added to the span that are useful for understanding the context of the request, such as the hostname of the machine handling the request, or customer identifiers.
 - New spans may be created to represent work being done by sub-components of the service.
 - When the service makes a remote call to another service, the current span context is serialized and forwarded to the next service by injecting the span context into the headers or message envelope.
 - The work being done by the service completes, successfully or not. The span status is appropriately set, and the span is marked finished.
 - For more information, see the traces specification, which covers concepts including: trace, span, parent/child relationship, span context, attributes, events and links.


 This module implements eveything required to conform to the trace & span public interface described
 by the OpenTelemetry specification.

 See "OpenTelemetry.Trace.Monad" for an implementation of 'inSpan' variants that are
 slightly easier to use in idiomatic Haskell monadic code.
-}
module OpenTelemetry.Trace (
  -- * How to use this library

  -- ** Quick start
  -- $use

  -- ** Configuration

  -- Nearly everything is configurable via environment variables.

  -- *** General configuration variables
  -- $envGeneral

  -- *** Batch span processor configuration variables
  -- $envBsp

  -- *** Attribute limits
  -- $envAttributeLimits

  -- *** Span limits
  -- $envSpanLimits

  -- ** Exporting data

  --
  -- By default, the <https://hackage.haskell.org/package/hs-opentelemetry-exporter-otlp OTLP protocol exporter>
  -- will be used. It supports exporting to the <https://opentelemetry.io/docs/collector/getting-started/ OpenTelemetry collector agent>,
  -- which supports a wide array of 3rd party services, and also provides a wide array of data enrichment abilities.
  --
  -- Additionally, a number of third party services directly support the OTLP protocol, so you can also often directly connect
  -- to their API gateway to send data. See your telemetry vendor's documentation to determine if this is the case.
  --
  -- There are a number of other exporters <https://hackage.haskell.org/packages/search?terms=hs-opentelemetry-exporter available on hackage>, including
  -- an in-memory exporter for testing.

  -- * 'TracerProvider' operations
  -- $tracerProvider
  TracerProvider,
  initializeGlobalTracerProvider,
  initializeTracerProvider,
  getTracerProviderInitializationOptions,
  getTracerProviderInitializationOptions',
  shutdownTracerProvider,

  -- ** Getting / setting the global 'TracerProvider'
  getGlobalTracerProvider,
  setGlobalTracerProvider,

  -- * 'Tracer' operations
  Tracer,
  tracerName,
  getTracer,
  makeTracer,
  TracerOptions (..),
  tracerOptions,
  HasTracer (..),
  InstrumentationLibrary (..),

  -- * 'Span' operations
  Span,
  inSpan,
  defaultSpanArguments,
  SpanArguments (..),
  SpanKind (..),
  NewLink (..),
  inSpan',
  updateName,
  addAttribute,
  addAttributes,
  recordException,
  setStatus,
  SpanStatus (..),
  NewEvent (..),
  addEvent,
  inSpan'',

  -- * Primitive span and tracing operations

  -- ** Alternative 'TracerProvider' initialization
  createTracerProvider,
  TracerProviderOptions (..),
  emptyTracerProviderOptions,
  detectBuiltInResources,
  detectSampler,
  createSpan,
  createSpanWithoutCallStack,
  endSpan,
  spanGetAttributes,
  ToAttribute (..),
  ToPrimitiveAttribute (..),
  Attribute (..),
  PrimitiveAttribute (..),
  Link,
  Event,
  SpanContext (..),
  -- TODO, don't remember if this is okay with the spec or not
  ImmutableSpan (..),
) where

import qualified Data.ByteString.Char8 as B
import Data.Either (partitionEithers)
import qualified Data.HashMap.Strict as H
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Network.HTTP.Types.Header
import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits)
import OpenTelemetry.Baggage (decodeBaggageHeader)
import qualified OpenTelemetry.Baggage as Baggage
import OpenTelemetry.Context (Context)
import OpenTelemetry.Exporter (Exporter)
import OpenTelemetry.Exporter.OTLP (loadExporterEnvironmentVariables, otlpExporter)
import OpenTelemetry.Processor (Processor)
import OpenTelemetry.Processor.Batch (BatchTimeoutConfig (..), batchProcessor, batchTimeoutConfig)
import OpenTelemetry.Propagator (Propagator)
import OpenTelemetry.Propagator.B3 (b3MultiTraceContextPropagator, b3TraceContextPropagator)
import OpenTelemetry.Propagator.W3CBaggage (w3cBaggagePropagator)
import OpenTelemetry.Propagator.W3CTraceContext (w3cTraceContextPropagator)
import OpenTelemetry.Resource
import OpenTelemetry.Resource.Host.Detector (detectHost)
import OpenTelemetry.Resource.OperatingSystem.Detector (detectOperatingSystem)
import OpenTelemetry.Resource.Process.Detector (detectProcess, detectProcessRuntime)
import OpenTelemetry.Resource.Service.Detector (detectService)
import OpenTelemetry.Resource.Telemetry.Detector (detectTelemetry)
import OpenTelemetry.Trace.Core
import OpenTelemetry.Trace.Id.Generator.Default (defaultIdGenerator)
import OpenTelemetry.Trace.Sampler (Sampler, alwaysOff, alwaysOn, parentBased, parentBasedOptions, traceIdRatioBased)
import System.Environment (lookupEnv)
import Text.Read (readMaybe)


{- $use

 1. Initialize a 'TracerProvider'.
 2. Create a 'Tracer' for your system.
 3. Add <https://hackage.haskell.org/packages/search?terms=hs-opentelemetry-instrumentation relevant pre-made instrumentation>
 4. Annotate your internal functions using the 'inSpan' function or one of its variants.
-}


{- $tracerProvider

 A `TracerProvider` is key to using OpenTelemetry tracing. It is the data structure responsible for designating how spans are processed and exported

 You will generally only need to call 'initializeGlobalTracerProvider' on initialization,
 and 'shutdownTracerProvider' when your application exits.

 @

 main :: IO ()
 main = withTracer $ \tracer -> do
   -- your existing code here...
   pure ()
   where
     withTracer f = bracket
       -- Install the SDK, pulling configuration from the environment
       initializeGlobalTracerProvider
       -- Ensure that any spans that haven't been exported yet are flushed
       shutdownTracerProvider
       (\tracerProvider -> do
         -- Get a tracer so you can create spans
         tracer <- getTracer tracerProvider "your-app-name-or-subsystem"
         f tracer
       )

 @
-}


{- $envGeneral

 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | Name                      | Description                                                                                                   | Default                                                                                                                                        | Notes                                                                                                                                                                                                                                                                          |
 +===========================+===============================================================================================================+================================================================================================================================================+================================================================================================================================================================================================================================================================================+
 | OTEL_RESOURCE_ATTRIBUTES  | Key-value pairs to be used as resource attributes                                                             | See [Resource semantic conventions](resource/semantic_conventions/README.md#semantic-attributes-with-sdk-provided-default-value) for details.  | See [Resource SDK](./resource/sdk.md#specifying-resource-information-via-an-environment-variable) for more details.                                                                                                                                                            |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | OTEL_SERVICE_NAME         | Sets the value of the [`service.name`](./resource/semantic_conventions/README.md#service) resource attribute  |                                                                                                                                                | If `service.name` is also provided in `OTEL_RESOURCE_ATTRIBUTES`, then `OTEL_SERVICE_NAME` takes precedence.                                                                                                                                                                   |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | OTEL_LOG_LEVEL            | Log level used by the SDK logger                                                                              | "info"                                                                                                                                         |                                                                                                                                                                                                                                                                                |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | OTEL_PROPAGATORS          | Propagators to be used as a comma-separated list                                                              | "tracecontext,baggage"                                                                                                                         | Values MUST be deduplicated in order to register a `Propagator` only once.                                                                                                                                                                                                     |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | OTEL_TRACES_SAMPLER       | Sampler to be used for traces                                                                                 | "parentbased_always_on"                                                                                                                        | See [Sampling](./trace/sdk.md#sampling)                                                                                                                                                                                                                                        |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
 | OTEL_TRACES_SAMPLER_ARG   | String value to be used as the sampler argument                                                               |                                                                                                                                                | The specified value will only be used if OTEL_TRACES_SAMPLER is set. Each Sampler type defines its own expected input, if any. Invalid or unrecognized input MUST be logged and MUST be otherwise ignored, i.e. the SDK MUST behave as if OTEL_TRACES_SAMPLER_ARG is not set.  |
 +---------------------------+---------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
-}


{- $envBsp
 +---------------------------------+-------------------------------------------------+----------+--------------------------------------------------------+
 | Name                            | Description                                     | Default  | Notes                                                  |
 +=================================+=================================================+==========+========================================================+
 | OTEL_BSP_SCHEDULE_DELAY         | Delay interval between two consecutive exports  | 5000     |                                                        |
 +---------------------------------+-------------------------------------------------+----------+--------------------------------------------------------+
 | OTEL_BSP_EXPORT_TIMEOUT         | Maximum allowed time to export data             | 30000    |                                                        |
 +---------------------------------+-------------------------------------------------+----------+--------------------------------------------------------+
 | OTEL_BSP_MAX_QUEUE_SIZE         | Maximum queue size                              | 2048     |                                                        |
 +---------------------------------+-------------------------------------------------+----------+--------------------------------------------------------+
 | OTEL_BSP_MAX_EXPORT_BATCH_SIZE  | Maximum batch size                              | 512      | Must be less than or equal to OTEL_BSP_MAX_QUEUE_SIZE  |
 +---------------------------------+-------------------------------------------------+----------+--------------------------------------------------------+
-}


{- $envAttributeLimits
 +------------------------------------+---------------------------------------+----------+-----------------------------------------------------------------------------------+
 | Name                               | Description                           | Default  | Notes                                                                             |
 +====================================+=======================================+==========+===================================================================================+
 | OTEL_ATTRIBUTE_VALUE_LENGTH_LIMIT  | Maximum allowed attribute value size  |          | Empty value is treated as infinity. Non-integer and negative values are invalid.  |
 +------------------------------------+---------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_ATTRIBUTE_COUNT_LIMIT         | Maximum allowed span attribute count  | 128      |                                                                                   |
 +------------------------------------+---------------------------------------+----------+-----------------------------------------------------------------------------------+
-}


{- $envSpanLimits
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | Name                                    | Description                                     | Default  | Notes                                                                             |
 +=========================================+=================================================+==========+===================================================================================+
 | OTEL_SPAN_ATTRIBUTE_VALUE_LENGTH_LIMIT  | Maximum allowed attribute value size            |          | Empty value is treated as infinity. Non-integer and negative values are invalid.  |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_SPAN_ATTRIBUTE_COUNT_LIMIT         | Maximum allowed span attribute count            | 128      |                                                                                   |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_SPAN_EVENT_COUNT_LIMIT             | Maximum allowed span event count                | 128      |                                                                                   |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_SPAN_LINK_COUNT_LIMIT              | Maximum allowed span link count                 | 128      |                                                                                   |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_EVENT_ATTRIBUTE_COUNT_LIMIT        | Maximum allowed attribute per span event count  | 128      |                                                                                   |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
 | OTEL_LINK_ATTRIBUTE_COUNT_LIMIT         | Maximum allowed attribute per span link count   | 128      |                                                                                   |
 +-----------------------------------------+-------------------------------------------------+----------+-----------------------------------------------------------------------------------+
-}


knownPropagators :: [(T.Text, Propagator Context RequestHeaders ResponseHeaders)]
knownPropagators :: [(Text, Propagator Context RequestHeaders RequestHeaders)]
knownPropagators =
  [ (Text
"tracecontext", Propagator Context RequestHeaders RequestHeaders
w3cTraceContextPropagator)
  , (Text
"baggage", Propagator Context RequestHeaders RequestHeaders
w3cBaggagePropagator)
  , (Text
"b3", Propagator Context RequestHeaders RequestHeaders
b3TraceContextPropagator)
  , (Text
"b3multi", Propagator Context RequestHeaders RequestHeaders
b3MultiTraceContextPropagator)
  , (Text
"jaeger", forall a. HasCallStack => [Char] -> a
error [Char]
"Jaeger not yet implemented")
  ]


-- TODO, actually implement a registry systme
readRegisteredPropagators :: IO [(T.Text, Propagator Context RequestHeaders ResponseHeaders)]
readRegisteredPropagators :: IO [(Text, Propagator Context RequestHeaders RequestHeaders)]
readRegisteredPropagators = forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text, Propagator Context RequestHeaders RequestHeaders)]
knownPropagators


{- | Create a new 'TracerProvider' and set it as the global
 tracer provider. This pulls all configuration from environment
 variables. The full list of environment variables supported is
 specified in the configuration section of this module's documentation.

 Note however, that 3rd-party span processors, exporters, sampling strategies,
 etc. may have their own set of environment-based configuration values that they
 utilize.
-}
initializeGlobalTracerProvider :: IO TracerProvider
initializeGlobalTracerProvider :: IO TracerProvider
initializeGlobalTracerProvider = do
  TracerProvider
t <- IO TracerProvider
initializeTracerProvider
  forall (m :: * -> *). MonadIO m => TracerProvider -> m ()
setGlobalTracerProvider TracerProvider
t
  forall (f :: * -> *) a. Applicative f => a -> f a
pure TracerProvider
t


initializeTracerProvider :: IO TracerProvider
initializeTracerProvider :: IO TracerProvider
initializeTracerProvider = do
  ([Processor]
processors, TracerProviderOptions
opts) <- IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions
  forall (m :: * -> *).
MonadIO m =>
[Processor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider [Processor]
processors TracerProviderOptions
opts


getTracerProviderInitializationOptions :: IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions :: IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions = forall (any :: Maybe Symbol).
(ResourceMerge 'Nothing any ~ 'Nothing) =>
Resource any -> IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions' (forall a. Monoid a => a
mempty :: Resource 'Nothing)


{- | Detect options for initializing a tracer provider from the app environment, taking additional supported resources as well.

 @since 0.0.3.1
-}
getTracerProviderInitializationOptions' :: (ResourceMerge 'Nothing any ~ 'Nothing) => Resource any -> IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions' :: forall (any :: Maybe Symbol).
(ResourceMerge 'Nothing any ~ 'Nothing) =>
Resource any -> IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions' Resource any
rs = do
  Sampler
sampler <- IO Sampler
detectSampler
  AttributeLimits
attrLimits <- IO AttributeLimits
detectAttributeLimits
  SpanLimits
spanLimits <- IO SpanLimits
detectSpanLimits
  Propagator Context RequestHeaders RequestHeaders
propagators <- IO (Propagator Context RequestHeaders RequestHeaders)
detectPropagators
  BatchTimeoutConfig
processorConf <- IO BatchTimeoutConfig
detectBatchProcessorConfig
  [Exporter ImmutableSpan]
exporters <- IO [Exporter ImmutableSpan]
detectExporters
  Resource 'Nothing
builtInRs <- IO (Resource 'Nothing)
detectBuiltInResources
  Resource 'Nothing
envVarRs <- forall (r :: Maybe Symbol). [Maybe (Text, Attribute)] -> Resource r
mkResource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(Text, Attribute)]
detectResourceAttributes
  let allRs :: Resource (ResourceMerge 'Nothing any)
allRs = forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
mergeResources (Resource 'Nothing
builtInRs forall a. Semigroup a => a -> a -> a
<> Resource 'Nothing
envVarRs) Resource any
rs
  [Processor]
processors <- case [Exporter ImmutableSpan]
exporters of
    [] -> do
      forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Exporter ImmutableSpan
e : [Exporter ImmutableSpan]
_ -> do
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
BatchTimeoutConfig -> Exporter ImmutableSpan -> m Processor
batchProcessor BatchTimeoutConfig
processorConf Exporter ImmutableSpan
e
  let providerOpts :: TracerProviderOptions
providerOpts =
        TracerProviderOptions
emptyTracerProviderOptions
          { tracerProviderOptionsIdGenerator :: IdGenerator
tracerProviderOptionsIdGenerator = IdGenerator
defaultIdGenerator
          , tracerProviderOptionsSampler :: Sampler
tracerProviderOptionsSampler = Sampler
sampler
          , tracerProviderOptionsAttributeLimits :: AttributeLimits
tracerProviderOptionsAttributeLimits = AttributeLimits
attrLimits
          , tracerProviderOptionsSpanLimits :: SpanLimits
tracerProviderOptionsSpanLimits = SpanLimits
spanLimits
          , tracerProviderOptionsPropagators :: Propagator Context RequestHeaders RequestHeaders
tracerProviderOptionsPropagators = Propagator Context RequestHeaders RequestHeaders
propagators
          , tracerProviderOptionsResources :: MaterializedResources
tracerProviderOptionsResources = forall (schema :: Maybe Symbol).
MaterializeResource schema =>
Resource schema -> MaterializedResources
materializeResources Resource (ResourceMerge 'Nothing any)
allRs
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Processor]
processors, TracerProviderOptions
providerOpts)


detectPropagators :: IO (Propagator Context RequestHeaders ResponseHeaders)
detectPropagators :: IO (Propagator Context RequestHeaders RequestHeaders)
detectPropagators = do
  [(Text, Propagator Context RequestHeaders RequestHeaders)]
registeredPropagators <- IO [(Text, Propagator Context RequestHeaders RequestHeaders)]
readRegisteredPropagators
  Maybe [Text]
propagatorsInEnv <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
T.splitOn Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_PROPAGATORS"
  if Maybe [Text]
propagatorsInEnv forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just [Text
"none"]
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    else do
      let envPropagators :: [Text]
envPropagators = forall a. a -> Maybe a -> a
fromMaybe [Text
"tracecontext", Text
"baggage"] Maybe [Text]
propagatorsInEnv
          propagatorsAndRegistryEntry :: [Either Text (Propagator Context RequestHeaders RequestHeaders)]
propagatorsAndRegistryEntry = forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
k) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Propagator Context RequestHeaders RequestHeaders)]
registeredPropagators) [Text]
envPropagators
          ([Text]
_notFound, [Propagator Context RequestHeaders RequestHeaders]
propagators) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Text (Propagator Context RequestHeaders RequestHeaders)]
propagatorsAndRegistryEntry
      -- TODO log warn notFound
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Propagator Context RequestHeaders RequestHeaders]
propagators


knownSamplers :: [(T.Text, Maybe T.Text -> Maybe Sampler)]
knownSamplers :: [(Text, Maybe Text -> Maybe Sampler)]
knownSamplers =
  [ (Text
"always_on", forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
alwaysOn)
  , (Text
"always_off", forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
alwaysOff)
  ,
    ( Text
"traceidratio"
    , \case
        Maybe Text
Nothing -> forall a. Maybe a
Nothing
        Just Text
val -> case forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
val) of
          Maybe Double
Nothing -> forall a. Maybe a
Nothing
          Just Double
ratioVal -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Sampler
traceIdRatioBased Double
ratioVal
    )
  , (Text
"parentbased_always_on", forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOn)
  , (Text
"parentbased_always_off", forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOff)
  ,
    ( Text
"parentbased_traceidratio"
    , \case
        Maybe Text
Nothing -> forall a. Maybe a
Nothing
        Just Text
val -> case forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
val) of
          Maybe Double
Nothing -> forall a. Maybe a
Nothing
          Just Double
ratioVal -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions forall a b. (a -> b) -> a -> b
$ Double -> Sampler
traceIdRatioBased Double
ratioVal
    )
  ]


-- TODO MUST log invalid arg

{- | Detect a sampler from the app environment. If no sampler is specified,
 the parentbased sampler is used.

 @since 0.0.3.3
-}
detectSampler :: IO Sampler
detectSampler :: IO Sampler
detectSampler = do
  Maybe [Char]
envSampler <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_TRACES_SAMPLER"
  Maybe [Char]
envArg <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_TRACES_SAMPLER_ARG"
  let sampler :: Sampler
sampler = forall a. a -> Maybe a -> a
fromMaybe (ParentBasedOptions -> Sampler
parentBased forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOn) forall a b. (a -> b) -> a -> b
$ do
        [Char]
samplerName <- Maybe [Char]
envSampler
        Maybe Text -> Maybe Sampler
samplerConstructor <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Char] -> Text
T.pack [Char]
samplerName) [(Text, Maybe Text -> Maybe Sampler)]
knownSamplers
        Maybe Text -> Maybe Sampler
samplerConstructor ([Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
envArg)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
sampler


detectBatchProcessorConfig :: IO BatchTimeoutConfig
detectBatchProcessorConfig :: IO BatchTimeoutConfig
detectBatchProcessorConfig =
  Int -> Int -> Int -> Int -> BatchTimeoutConfig
BatchTimeoutConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_MAX_QUEUE_SIZE" (BatchTimeoutConfig -> Int
maxQueueSize BatchTimeoutConfig
batchTimeoutConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_SCHEDULE_DELAY" (BatchTimeoutConfig -> Int
scheduledDelayMillis BatchTimeoutConfig
batchTimeoutConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_EXPORT_TIMEOUT" (BatchTimeoutConfig -> Int
exportTimeoutMillis BatchTimeoutConfig
batchTimeoutConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_MAX_EXPORT_BATCH_SIZE" (BatchTimeoutConfig -> Int
maxExportBatchSize BatchTimeoutConfig
batchTimeoutConfig)


detectAttributeLimits :: IO AttributeLimits
detectAttributeLimits :: IO AttributeLimits
detectAttributeLimits =
  Maybe Int -> Maybe Int -> AttributeLimits
AttributeLimits
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_ATTRIBUTE_COUNT_LIMIT" (AttributeLimits -> Maybe Int
attributeCountLimit AttributeLimits
defaultAttributeLimits)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMaybe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_ATTRIBUTE_VALUE_LENGTH_LIMIT")


detectSpanLimits :: IO SpanLimits
detectSpanLimits :: IO SpanLimits
detectSpanLimits =
  Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> SpanLimits
SpanLimits
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_ATTRIBUTE_VALUE_LENGTH_LIMIT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_ATTRIBUTE_COUNT_LIMIT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_EVENT_COUNT_LIMIT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_LINK_COUNT_LIMIT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_EVENT_ATTRIBUTE_COUNT_LIMIT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_LINK_ATTRIBUTE_COUNT_LIMIT"


knownExporters :: [(T.Text, IO (Exporter ImmutableSpan))]
knownExporters :: [(Text, IO (Exporter ImmutableSpan))]
knownExporters =
  [
    ( Text
"otlp"
    , do
        OTLPExporterConfig
otlpConfig <- forall (m :: * -> *). MonadIO m => m OTLPExporterConfig
loadExporterEnvironmentVariables
        forall (m :: * -> *).
MonadIO m =>
OTLPExporterConfig -> m (Exporter ImmutableSpan)
otlpExporter OTLPExporterConfig
otlpConfig
    )
  , (Text
"jaeger", forall a. HasCallStack => [Char] -> a
error [Char]
"Jaeger exporter not implemented")
  , (Text
"zipkin", forall a. HasCallStack => [Char] -> a
error [Char]
"Zipkin exporter not implemented")
  ]


-- TODO, support multiple exporters
detectExporters :: IO [Exporter ImmutableSpan]
detectExporters :: IO [Exporter ImmutableSpan]
detectExporters = do
  Maybe [Text]
exportersInEnv <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
T.splitOn Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_TRACES_EXPORTER"
  if Maybe [Text]
exportersInEnv forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just [Text
"none"]
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else do
      let envExporters :: [Text]
envExporters = forall a. a -> Maybe a -> a
fromMaybe [Text
"otlp"] Maybe [Text]
exportersInEnv
          exportersAndRegistryEntry :: [Either Text (IO (Exporter ImmutableSpan))]
exportersAndRegistryEntry = forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
k) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, IO (Exporter ImmutableSpan))]
knownExporters) [Text]
envExporters
          ([Text]
_notFound, [IO (Exporter ImmutableSpan)]
exporterIntializers) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Text (IO (Exporter ImmutableSpan))]
exportersAndRegistryEntry
      -- TODO, notFound logging
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO (Exporter ImmutableSpan)]
exporterIntializers


-- -- detectMetricsExporterSelection :: _
-- -- TODO other metrics stuff

detectResourceAttributes :: IO [(T.Text, Attribute)]
detectResourceAttributes :: IO [(Text, Attribute)]
detectResourceAttributes = do
  Maybe [Char]
mEnv <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_RESOURCE_ATTRIBUTES"
  case Maybe [Char]
mEnv of
    Maybe [Char]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just [Char]
envVar -> case ByteString -> Either [Char] Baggage
decodeBaggageHeader forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B.pack [Char]
envVar of
      Left [Char]
err -> do
        -- TODO logError
        [Char] -> IO ()
putStrLn [Char]
err
        forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Right Baggage
ok ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map (\(Token
k, Element
v) -> (ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ Token -> ByteString
Baggage.tokenValue Token
k, forall a. ToAttribute a => a -> Attribute
toAttribute forall a b. (a -> b) -> a -> b
$ Element -> Text
Baggage.value Element
v)) forall a b. (a -> b) -> a -> b
$
            forall k v. HashMap k v -> [(k, v)]
H.toList forall a b. (a -> b) -> a -> b
$
              Baggage -> HashMap Token Element
Baggage.values Baggage
ok


readEnvDefault :: forall a. (Read a) => String -> a -> IO a
readEnvDefault :: forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
k a
defaultValue =
  forall a. a -> Maybe a -> a
fromMaybe a
defaultValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMaybe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
k


readEnv :: forall a. (Read a) => String -> IO (Maybe a)
readEnv :: forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
k = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMaybe) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
k


{- | Use all built-in resource detectors to populate resource information.

 Currently used detectors include:

 - 'detectService'
 - 'detectProcess'
 - 'detectOperatingSystem'
 - 'detectHost'
 - 'detectTelemetry'
 - 'detectProcessRuntime'

 This list will grow in the future as more detectors are implemented.

 @since 0.0.1.0
-}
detectBuiltInResources :: IO (Resource 'Nothing)
detectBuiltInResources :: IO (Resource 'Nothing)
detectBuiltInResources = do
  Service
svc <- IO Service
detectService
  Process
processInfo <- IO Process
detectProcess
  OperatingSystem
osInfo <- IO OperatingSystem
detectOperatingSystem
  Host
host <- IO Host
detectHost
  let rs :: Resource
  (ResourceMerge
     (ResourceMerge
        (ResourceMerge
           (ResourceMerge (ResourceMerge 'Nothing 'Nothing) 'Nothing)
           'Nothing)
        'Nothing)
     'Nothing)
rs =
        forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Service
svc
          forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources` forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Telemetry
detectTelemetry
          forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources` forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource ProcessRuntime
detectProcessRuntime
          forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources` forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Process
processInfo
          forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources` forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource OperatingSystem
osInfo
          forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources` forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Host
host
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Resource
  (ResourceMerge
     (ResourceMerge
        (ResourceMerge
           (ResourceMerge (ResourceMerge 'Nothing 'Nothing) 'Nothing)
           'Nothing)
        'Nothing)
     'Nothing)
rs