{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
module OpenTelemetry.Trace
(
TracerProvider
, initializeGlobalTracerProvider
, initializeTracerProvider
, getTracerProviderInitializationOptions
, shutdownTracerProvider
, getGlobalTracerProvider
, setGlobalTracerProvider
, Tracer
, tracerName
, getTracer
, makeTracer
, TracerOptions(..)
, tracerOptions
, HasTracer(..)
, InstrumentationLibrary(..)
, Span
, inSpan
, defaultSpanArguments
, SpanArguments(..)
, SpanKind(..)
, NewLink(..)
, inSpan'
, updateName
, addAttribute
, addAttributes
, recordException
, setStatus
, SpanStatus(..)
, NewEvent(..)
, addEvent
, inSpan''
, createTracerProvider
, TracerProviderOptions(..)
, emptyTracerProviderOptions
, detectBuiltInResources
, createSpan
, createSpanWithoutCallStack
, endSpan
, spanGetAttributes
, ToAttribute(..)
, ToPrimitiveAttribute(..)
, Attribute(..)
, PrimitiveAttribute(..)
, Link
, Event
, SpanContext(..)
, ImmutableSpan(..)
) where
import OpenTelemetry.Trace.Core
import OpenTelemetry.Resource
import Data.Maybe (fromMaybe)
import Data.Either (partitionEithers)
import qualified Data.Text as T
import OpenTelemetry.Context (Context)
import Network.HTTP.Types.Header
import OpenTelemetry.Propagator.W3CTraceContext (w3cTraceContextPropagator)
import OpenTelemetry.Propagator.W3CBaggage (w3cBaggagePropagator)
import OpenTelemetry.Propagator (Propagator)
import System.Environment (lookupEnv)
import OpenTelemetry.Trace.Sampler (Sampler, alwaysOn, alwaysOff, traceIdRatioBased, parentBased, parentBasedOptions)
import Text.Read (readMaybe)
import OpenTelemetry.Exporter (Exporter)
import OpenTelemetry.Processor.Batch (BatchTimeoutConfig (..), batchTimeoutConfig, batchProcessor)
import OpenTelemetry.Attributes (AttributeLimits(..), defaultAttributeLimits)
import OpenTelemetry.Baggage (decodeBaggageHeader)
import qualified Data.ByteString.Char8 as B
import qualified OpenTelemetry.Baggage as Baggage
import qualified Data.HashMap.Strict as H
import Data.Text.Encoding (decodeUtf8)
import OpenTelemetry.Exporter.OTLP (loadExporterEnvironmentVariables, otlpExporter)
import OpenTelemetry.Processor (Processor)
import OpenTelemetry.Resource.Service.Detector (detectService)
import OpenTelemetry.Resource.Process.Detector (detectProcess, detectProcessRuntime)
import OpenTelemetry.Resource.OperatingSystem.Detector (detectOperatingSystem)
import OpenTelemetry.Resource.Host.Detector (detectHost)
import OpenTelemetry.Resource.Telemetry.Detector (detectTelemetry)
import OpenTelemetry.Trace.Id.Generator.Default (defaultIdGenerator)
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", [Char] -> Propagator Context RequestHeaders RequestHeaders
forall a. HasCallStack => [Char] -> a
error [Char]
"B3 not yet implemented")
, (Text
"b3multi", [Char] -> Propagator Context RequestHeaders RequestHeaders
forall a. HasCallStack => [Char] -> a
error [Char]
"B3 multi not yet implemented")
, (Text
"jaeger", [Char] -> Propagator Context RequestHeaders RequestHeaders
forall a. HasCallStack => [Char] -> a
error [Char]
"Jaeger not yet implemented")
]
readRegisteredPropagators :: IO [(T.Text, Propagator Context RequestHeaders ResponseHeaders)]
readRegisteredPropagators :: IO [(Text, Propagator Context RequestHeaders RequestHeaders)]
readRegisteredPropagators = [(Text, Propagator Context RequestHeaders RequestHeaders)]
-> IO [(Text, Propagator Context RequestHeaders RequestHeaders)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text, Propagator Context RequestHeaders RequestHeaders)]
knownPropagators
initializeGlobalTracerProvider :: IO TracerProvider
initializeGlobalTracerProvider :: IO TracerProvider
initializeGlobalTracerProvider = do
TracerProvider
t <- IO TracerProvider
initializeTracerProvider
TracerProvider -> IO ()
forall (m :: * -> *). MonadIO m => TracerProvider -> m ()
setGlobalTracerProvider TracerProvider
t
TracerProvider -> IO TracerProvider
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
[Processor] -> TracerProviderOptions -> IO TracerProvider
forall (m :: * -> *).
MonadIO m =>
[Processor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider [Processor]
processors TracerProviderOptions
opts
getTracerProviderInitializationOptions :: IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions :: IO ([Processor], TracerProviderOptions)
getTracerProviderInitializationOptions = 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 <- ([Maybe (Text, Attribute)] -> Resource 'Nothing
forall (r :: Maybe Symbol). [Maybe (Text, Attribute)] -> Resource r
mkResource ([Maybe (Text, Attribute)] -> Resource 'Nothing)
-> ([(Text, Attribute)] -> [Maybe (Text, Attribute)])
-> [(Text, Attribute)]
-> Resource 'Nothing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Attribute) -> Maybe (Text, Attribute))
-> [(Text, Attribute)] -> [Maybe (Text, Attribute)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Attribute) -> Maybe (Text, Attribute)
forall a. a -> Maybe a
Just) ([(Text, Attribute)] -> Resource 'Nothing)
-> IO [(Text, Attribute)] -> IO (Resource 'Nothing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(Text, Attribute)]
detectResourceAttributes
let allRs :: Resource 'Nothing
allRs = Resource 'Nothing
builtInRs Resource 'Nothing -> Resource 'Nothing -> Resource 'Nothing
forall a. Semigroup a => a -> a -> a
<> Resource 'Nothing
envVarRs
[Processor]
processors <- case [Exporter ImmutableSpan]
exporters of
[] -> do
[Processor] -> IO [Processor]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Exporter ImmutableSpan
e:[Exporter ImmutableSpan]
_ -> do
Processor -> [Processor]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Processor -> [Processor]) -> IO Processor -> IO [Processor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BatchTimeoutConfig -> Exporter ImmutableSpan -> IO Processor
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 = Resource 'Nothing -> MaterializedResources
forall (schema :: Maybe Symbol).
MaterializeResource schema =>
Resource schema -> MaterializedResources
materializeResources Resource 'Nothing
allRs
}
([Processor], TracerProviderOptions)
-> IO ([Processor], TracerProviderOptions)
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 <- ([Char] -> [Text]) -> Maybe [Char] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) (Maybe [Char] -> Maybe [Text])
-> IO (Maybe [Char]) -> IO (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_PROPAGATORS"
if Maybe [Text]
propagatorsInEnv Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"none"]
then Propagator Context RequestHeaders RequestHeaders
-> IO (Propagator Context RequestHeaders RequestHeaders)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Propagator Context RequestHeaders RequestHeaders
forall a. Monoid a => a
mempty
else do
let envPropagators :: [Text]
envPropagators = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text
"tracecontext", Text
"baggage"] Maybe [Text]
propagatorsInEnv
propagatorsAndRegistryEntry :: [Either Text (Propagator Context RequestHeaders RequestHeaders)]
propagatorsAndRegistryEntry = (Text
-> Either Text (Propagator Context RequestHeaders RequestHeaders))
-> [Text]
-> [Either Text (Propagator Context RequestHeaders RequestHeaders)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> Either Text (Propagator Context RequestHeaders RequestHeaders)
-> (Propagator Context RequestHeaders RequestHeaders
-> Either Text (Propagator Context RequestHeaders RequestHeaders))
-> Maybe (Propagator Context RequestHeaders RequestHeaders)
-> Either Text (Propagator Context RequestHeaders RequestHeaders)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
-> Either Text (Propagator Context RequestHeaders RequestHeaders)
forall a b. a -> Either a b
Left Text
k) Propagator Context RequestHeaders RequestHeaders
-> Either Text (Propagator Context RequestHeaders RequestHeaders)
forall a b. b -> Either a b
Right (Maybe (Propagator Context RequestHeaders RequestHeaders)
-> Either Text (Propagator Context RequestHeaders RequestHeaders))
-> Maybe (Propagator Context RequestHeaders RequestHeaders)
-> Either Text (Propagator Context RequestHeaders RequestHeaders)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Propagator Context RequestHeaders RequestHeaders)]
-> Maybe (Propagator Context RequestHeaders RequestHeaders)
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) = [Either Text (Propagator Context RequestHeaders RequestHeaders)]
-> ([Text], [Propagator Context RequestHeaders RequestHeaders])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Text (Propagator Context RequestHeaders RequestHeaders)]
propagatorsAndRegistryEntry
Propagator Context RequestHeaders RequestHeaders
-> IO (Propagator Context RequestHeaders RequestHeaders)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Propagator Context RequestHeaders RequestHeaders
-> IO (Propagator Context RequestHeaders RequestHeaders))
-> Propagator Context RequestHeaders RequestHeaders
-> IO (Propagator Context RequestHeaders RequestHeaders)
forall a b. (a -> b) -> a -> b
$ [Propagator Context RequestHeaders RequestHeaders]
-> Propagator Context RequestHeaders RequestHeaders
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", Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. a -> b -> a
const (Maybe Sampler -> Maybe Text -> Maybe Sampler)
-> Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
alwaysOn)
, (Text
"always_off", Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. a -> b -> a
const (Maybe Sampler -> Maybe Text -> Maybe Sampler)
-> Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
alwaysOff)
, (Text
"traceidratio", \case
Maybe Text
Nothing -> Maybe Sampler
forall a. Maybe a
Nothing
Just Text
val -> case [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
val) of
Maybe Double
Nothing -> Maybe Sampler
forall a. Maybe a
Nothing
Just Double
ratioVal -> Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sampler -> Maybe Sampler) -> Sampler -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ Double -> Sampler
traceIdRatioBased Double
ratioVal
)
, (Text
"parentbased_always_on", Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. a -> b -> a
const (Maybe Sampler -> Maybe Text -> Maybe Sampler)
-> Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sampler -> Maybe Sampler) -> Sampler -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased (ParentBasedOptions -> Sampler) -> ParentBasedOptions -> Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOn)
, (Text
"parentbased_always_off", Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. a -> b -> a
const (Maybe Sampler -> Maybe Text -> Maybe Sampler)
-> Maybe Sampler -> Maybe Text -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sampler -> Maybe Sampler) -> Sampler -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased (ParentBasedOptions -> Sampler) -> ParentBasedOptions -> Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOff)
, (Text
"parentbased_traceidratio", \case
Maybe Text
Nothing -> Maybe Sampler
forall a. Maybe a
Nothing
Just Text
val -> case [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
val) of
Maybe Double
Nothing -> Maybe Sampler
forall a. Maybe a
Nothing
Just Double
ratioVal -> Sampler -> Maybe Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sampler -> Maybe Sampler) -> Sampler -> Maybe Sampler
forall a b. (a -> b) -> a -> b
$ ParentBasedOptions -> Sampler
parentBased (ParentBasedOptions -> Sampler) -> ParentBasedOptions -> Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions (Sampler -> ParentBasedOptions) -> Sampler -> ParentBasedOptions
forall a b. (a -> b) -> a -> b
$ Double -> Sampler
traceIdRatioBased Double
ratioVal
)
]
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 = Sampler -> Maybe Sampler -> Sampler
forall a. a -> Maybe a -> a
fromMaybe (ParentBasedOptions -> Sampler
parentBased (ParentBasedOptions -> Sampler) -> ParentBasedOptions -> Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOn) (Maybe Sampler -> Sampler) -> Maybe Sampler -> Sampler
forall a b. (a -> b) -> a -> b
$ do
[Char]
samplerName <- Maybe [Char]
envSampler
Maybe Text -> Maybe Sampler
samplerConstructor <- Text
-> [(Text, Maybe Text -> Maybe Sampler)]
-> Maybe (Maybe Text -> Maybe Sampler)
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 ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
envArg)
Sampler -> IO Sampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sampler
sampler
detectBatchProcessorConfig :: IO BatchTimeoutConfig
detectBatchProcessorConfig :: IO BatchTimeoutConfig
detectBatchProcessorConfig = Int -> Int -> Int -> Int -> BatchTimeoutConfig
BatchTimeoutConfig
(Int -> Int -> Int -> Int -> BatchTimeoutConfig)
-> IO Int -> IO (Int -> Int -> Int -> BatchTimeoutConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Int -> IO Int
forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_MAX_QUEUE_SIZE" (BatchTimeoutConfig -> Int
maxQueueSize BatchTimeoutConfig
batchTimeoutConfig)
IO (Int -> Int -> Int -> BatchTimeoutConfig)
-> IO Int -> IO (Int -> Int -> BatchTimeoutConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Int -> IO Int
forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_SCHEDULE_DELAY" (BatchTimeoutConfig -> Int
scheduledDelayMillis BatchTimeoutConfig
batchTimeoutConfig)
IO (Int -> Int -> BatchTimeoutConfig)
-> IO Int -> IO (Int -> BatchTimeoutConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Int -> IO Int
forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_BSP_EXPORT_TIMEOUT" (BatchTimeoutConfig -> Int
exportTimeoutMillis BatchTimeoutConfig
batchTimeoutConfig)
IO (Int -> BatchTimeoutConfig) -> IO Int -> IO BatchTimeoutConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Int -> IO Int
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
(Maybe Int -> Maybe Int -> AttributeLimits)
-> IO (Maybe Int) -> IO (Maybe Int -> AttributeLimits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int -> IO (Maybe Int)
forall a. Read a => [Char] -> a -> IO a
readEnvDefault [Char]
"OTEL_ATTRIBUTE_COUNT_LIMIT" (AttributeLimits -> Maybe Int
attributeCountLimit AttributeLimits
defaultAttributeLimits)
IO (Maybe Int -> AttributeLimits)
-> IO (Maybe Int) -> IO AttributeLimits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe) (Maybe [Char] -> Maybe Int) -> IO (Maybe [Char]) -> IO (Maybe Int)
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
(Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> SpanLimits)
-> IO (Maybe Int)
-> IO
(Maybe Int
-> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe Int)
forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_ATTRIBUTE_VALUE_LENGTH_LIMIT"
IO
(Maybe Int
-> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
-> IO (Maybe Int)
-> IO
(Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Int)
forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_ATTRIBUTE_COUNT_LIMIT"
IO (Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
-> IO (Maybe Int)
-> IO (Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Int)
forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_EVENT_COUNT_LIMIT"
IO (Maybe Int -> Maybe Int -> Maybe Int -> SpanLimits)
-> IO (Maybe Int) -> IO (Maybe Int -> Maybe Int -> SpanLimits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Int)
forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_SPAN_LINK_COUNT_LIMIT"
IO (Maybe Int -> Maybe Int -> SpanLimits)
-> IO (Maybe Int) -> IO (Maybe Int -> SpanLimits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Int)
forall a. Read a => [Char] -> IO (Maybe a)
readEnv [Char]
"OTEL_EVENT_ATTRIBUTE_COUNT_LIMIT"
IO (Maybe Int -> SpanLimits) -> IO (Maybe Int) -> IO SpanLimits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Int)
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 <- IO OTLPExporterConfig
forall (m :: * -> *). MonadIO m => m OTLPExporterConfig
loadExporterEnvironmentVariables
OTLPExporterConfig -> IO (Exporter ImmutableSpan)
forall (m :: * -> *).
MonadIO m =>
OTLPExporterConfig -> m (Exporter ImmutableSpan)
otlpExporter OTLPExporterConfig
otlpConfig
)
, (Text
"jaeger", [Char] -> IO (Exporter ImmutableSpan)
forall a. HasCallStack => [Char] -> a
error [Char]
"Jaeger exporter not implemented")
, (Text
"zipkin", [Char] -> IO (Exporter ImmutableSpan)
forall a. HasCallStack => [Char] -> a
error [Char]
"Zipkin exporter not implemented")
]
detectExporters :: IO [Exporter ImmutableSpan]
detectExporters :: IO [Exporter ImmutableSpan]
detectExporters = do
Maybe [Text]
exportersInEnv <- ([Char] -> [Text]) -> Maybe [Char] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) (Maybe [Char] -> Maybe [Text])
-> IO (Maybe [Char]) -> IO (Maybe [Text])
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 Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"none"]
then [Exporter ImmutableSpan] -> IO [Exporter ImmutableSpan]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else do
let envExporters :: [Text]
envExporters = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text
"otlp"] Maybe [Text]
exportersInEnv
exportersAndRegistryEntry :: [Either Text (IO (Exporter ImmutableSpan))]
exportersAndRegistryEntry = (Text -> Either Text (IO (Exporter ImmutableSpan)))
-> [Text] -> [Either Text (IO (Exporter ImmutableSpan))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> Either Text (IO (Exporter ImmutableSpan))
-> (IO (Exporter ImmutableSpan)
-> Either Text (IO (Exporter ImmutableSpan)))
-> Maybe (IO (Exporter ImmutableSpan))
-> Either Text (IO (Exporter ImmutableSpan))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (IO (Exporter ImmutableSpan))
forall a b. a -> Either a b
Left Text
k) IO (Exporter ImmutableSpan)
-> Either Text (IO (Exporter ImmutableSpan))
forall a b. b -> Either a b
Right (Maybe (IO (Exporter ImmutableSpan))
-> Either Text (IO (Exporter ImmutableSpan)))
-> Maybe (IO (Exporter ImmutableSpan))
-> Either Text (IO (Exporter ImmutableSpan))
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, IO (Exporter ImmutableSpan))]
-> Maybe (IO (Exporter ImmutableSpan))
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) = [Either Text (IO (Exporter ImmutableSpan))]
-> ([Text], [IO (Exporter ImmutableSpan)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Text (IO (Exporter ImmutableSpan))]
exportersAndRegistryEntry
[IO (Exporter ImmutableSpan)] -> IO [Exporter ImmutableSpan]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO (Exporter ImmutableSpan)]
exporterIntializers
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 -> [(Text, Attribute)] -> IO [(Text, Attribute)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just [Char]
envVar -> case ByteString -> Either [Char] Baggage
decodeBaggageHeader (ByteString -> Either [Char] Baggage)
-> ByteString -> Either [Char] Baggage
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B.pack [Char]
envVar of
Left [Char]
err -> do
[Char] -> IO ()
putStrLn [Char]
err
[(Text, Attribute)] -> IO [(Text, Attribute)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Right Baggage
ok ->
[(Text, Attribute)] -> IO [(Text, Attribute)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
([(Text, Attribute)] -> IO [(Text, Attribute)])
-> [(Text, Attribute)] -> IO [(Text, Attribute)]
forall a b. (a -> b) -> a -> b
$ ((Token, Element) -> (Text, Attribute))
-> [(Token, Element)] -> [(Text, Attribute)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Token
k, Element
v) -> (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Token -> ByteString
Baggage.tokenValue Token
k, Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Element -> Text
Baggage.value Element
v))
([(Token, Element)] -> [(Text, Attribute)])
-> [(Token, Element)] -> [(Text, Attribute)]
forall a b. (a -> b) -> a -> b
$ HashMap Token Element -> [(Token, Element)]
forall k v. HashMap k v -> [(k, v)]
H.toList
(HashMap Token Element -> [(Token, Element)])
-> HashMap Token Element -> [(Token, Element)]
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 :: [Char] -> a -> IO a
readEnvDefault [Char]
k a
defaultValue =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
defaultValue (Maybe a -> a) -> (Maybe [Char] -> Maybe a) -> Maybe [Char] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Char] -> ([Char] -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe) (Maybe [Char] -> a) -> IO (Maybe [Char]) -> IO a
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 :: [Char] -> IO (Maybe a)
readEnv [Char]
k = (Maybe [Char] -> ([Char] -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe) (Maybe [Char] -> Maybe a) -> IO (Maybe [Char]) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
k
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 'Nothing 'Nothing)
rs =
Service -> Resource (ResourceSchema Service)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Service
svc Resource 'Nothing
-> Resource 'Nothing -> Resource (ResourceMerge 'Nothing 'Nothing)
forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources`
Telemetry -> Resource (ResourceSchema Telemetry)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Telemetry
detectTelemetry Resource 'Nothing
-> Resource 'Nothing -> Resource (ResourceMerge 'Nothing 'Nothing)
forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources`
ProcessRuntime -> Resource (ResourceSchema ProcessRuntime)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource ProcessRuntime
detectProcessRuntime Resource 'Nothing
-> Resource 'Nothing -> Resource (ResourceMerge 'Nothing 'Nothing)
forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources`
Process -> Resource (ResourceSchema Process)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Process
processInfo Resource 'Nothing
-> Resource 'Nothing -> Resource (ResourceMerge 'Nothing 'Nothing)
forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources`
OperatingSystem -> Resource (ResourceSchema OperatingSystem)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource OperatingSystem
osInfo Resource 'Nothing
-> Resource 'Nothing -> Resource (ResourceMerge 'Nothing 'Nothing)
forall (old :: Maybe Symbol) (new :: Maybe Symbol).
Resource old -> Resource new -> Resource (ResourceMerge old new)
`mergeResources`
Host -> Resource (ResourceSchema Host)
forall a. ToResource a => a -> Resource (ResourceSchema a)
toResource Host
host
Resource 'Nothing -> IO (Resource 'Nothing)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Resource 'Nothing
rs