{-# LANGUAGE OverloadedStrings #-}

-- | OpenTelemetry setup: traces, metrics and logs pushed over OTLP. The SDK resolves
-- each signal's endpoint and exporter from the standard @OTEL_@ variables.
module Arbiter.Otel.Telemetry
  ( Telemetry (..)
  , withTelemetry
  , withTelemetryIf
  , withTelemetryFromEnv
  , withExternalTelemetry
  , telemetryLogConfig
  ) where

import Arbiter.Core.Exceptions (displayEx)
import Arbiter.Core.Trace (resolveTracer)
import Arbiter.Worker.Logger (LogConfig, LogDestination)
import Control.Exception (SomeException, bracket)
import Control.Monad (void)
import Control.Monad.Trans.Cont (ContT (..), evalContT)
import Data.Bifunctor (first)
import Data.Either (fromRight)
import Data.Foldable (traverse_)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime)
import OpenTelemetry.Attributes (lookupAttributeByKey)
import OpenTelemetry.Attributes.Key (AttributeKey)
import OpenTelemetry.Environment (MetricsExporterSelection (..), lookupBooleanEnv, lookupMetricsExporterSelection)
import OpenTelemetry.Log
  ( LoggerProvider
  , getGlobalLoggerProvider
  , initializeGlobalLoggerProvider
  , setGlobalLoggerProvider
  , shutdownLoggerProvider
  )
import OpenTelemetry.Metric
  ( PeriodicMetricReaderOptions (..)
  , createMeterProvider
  , defaultPeriodicMetricReaderOptions
  , defaultSdkMeterProviderOptions
  , forkPeriodicMetricReader
  , periodicMetricReaderOptionsFromEnv
  , resolveMetricExporter
  , shutdownMeterProvider
  , stopPeriodicMetricReader
  )
import OpenTelemetry.Metric.Core (MeterProvider, getGlobalMeterProvider, noopMeterProvider, setGlobalMeterProvider)
import OpenTelemetry.Processor.Span (SpanProcessor)
import OpenTelemetry.Propagator (getGlobalTextMapPropagator, setGlobalTextMapPropagator)
import OpenTelemetry.Resource
  ( MaterializedResources
  , emptyMaterializedResources
  , getMaterializedResourcesAttributes
  , materializeResources
  , mergeResources
  , mkResource
  , (.=)
  )
import OpenTelemetry.Resource.Detect (detectBuiltInResources, detectResourceAttributes)
import OpenTelemetry.Trace
  ( TracerProvider
  , TracerProviderOptions (..)
  , createTracerProvider
  , emptyTracerProviderOptions
  , getGlobalTracerProvider
  , getTracerProviderInitializationOptions
  , setGlobalTracerProvider
  , shutdownTracerProvider
  )
import System.Environment (lookupEnv)
import UnliftIO (liftIO, tryAny)

import Arbiter.Otel.Logs (loggerDestination, otelLogs)
import Arbiter.Otel.Metrics (ArbiterMeters, newArbiterMeters)

-- | A running telemetry handle: instruments, provider, and resolved settings.
data Telemetry = Telemetry
  { Telemetry -> Maybe ArbiterMeters
meters :: Maybe ArbiterMeters
  -- ^ 'Nothing' when nothing is exporting metrics. Then there are no job instruments and no gauge scan.
  , Telemetry -> MeterProvider
provider :: MeterProvider
  , Telemetry -> Maybe LogDestination
logDestination :: Maybe LogDestination
  -- ^ Where the pools' logs go. 'Nothing' leaves the caller's own destination.
  , Telemetry -> NominalDiffTime
gaugeRefresh :: NominalDiffTime
  -- ^ The metric export interval this handle resolved.
  , Telemetry -> Text
telemetrySummary :: Text
  -- ^ What this handle exports and where, for the caller to log at startup.
  }

-- | Bracketed OpenTelemetry init/shutdown. Nested brackets unwind partial setup. Every
-- signal is the SDK's, resolved from its own @OTEL_@ variables.
-- 'withTelemetryFromEnv' is the gated form.
withTelemetry :: (Telemetry -> IO a) -> IO a
withTelemetry :: forall a. (Telemetry -> IO a) -> IO a
withTelemetry Telemetry -> IO a
action = do
  previousMeters <- IO MeterProvider
forall (m :: * -> *). MonadIO m => m MeterProvider
getGlobalMeterProvider
  readerOpts <- periodicMetricReaderOptionsFromEnv
  detected <- tryAny getTracerProviderInitializationOptions
  let (processors, traceOpts) = fromRight ([], emptyTracerProviderOptions) detected
      detectNote = (SomeException -> Maybe Text)
-> (([SpanProcessor], TracerProviderOptions) -> Maybe Text)
-> Either SomeException ([SpanProcessor], TracerProviderOptions)
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (SomeException -> Text) -> SomeException -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SomeException -> Text
signalFailed Text
"traces") (Maybe Text
-> ([SpanProcessor], TracerProviderOptions) -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Either SomeException ([SpanProcessor], TracerProviderOptions)
detected
  resources <- either (const detectResources) (pure . tracerProviderOptionsResources . snd) detected
  evalContT $ do
    traces <- ContT (withTraces processors traceOpts)
    metrics <- ContT (withMeterProvider resources previousMeters)
    reader <- ContT (withReader readerOpts (snd <$> metrics))
    logs <- ContT withLogs
    liftIO $ do
      let meterProvider = (Text -> MeterProvider)
-> ((MeterProvider, SdkMeterEnv) -> MeterProvider)
-> Either Text (MeterProvider, SdkMeterEnv)
-> MeterProvider
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MeterProvider -> Text -> MeterProvider
forall a b. a -> b -> a
const MeterProvider
noopMeterProvider) (MeterProvider, SdkMeterEnv) -> MeterProvider
forall a b. (a, b) -> a
fst Either Text (MeterProvider, SdkMeterEnv)
metrics
      instruments <- either (pure . Left) (const (arbiterInstruments meterProvider)) reader
      action
        (baseTelemetry meterProvider)
          { meters = either (const Nothing) Just instruments
          , logDestination = either (const Nothing) (Just . loggerDestination) logs
          , gaugeRefresh = refreshFor readerOpts
          , telemetrySummary =
              summarize (serviceName resources) (catMaybes [detectNote, noteOf traces, noteOf instruments, noteOf logs])
          }
  where
    withTraces :: [SpanProcessor] -> TracerProviderOptions -> (Either Text TracerProvider -> IO a) -> IO a
    withTraces :: forall a.
[SpanProcessor]
-> TracerProviderOptions
-> (Either Text TracerProvider -> IO a)
-> IO a
withTraces [SpanProcessor]
processors TracerProviderOptions
opts Either Text TracerProvider -> IO a
inner =
      IO TextMapPropagator
-> (TextMapPropagator -> IO ())
-> (TextMapPropagator -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO TextMapPropagator
getGlobalTextMapPropagator TextMapPropagator -> IO ()
setGlobalTextMapPropagator ((TextMapPropagator -> IO a) -> IO a)
-> (TextMapPropagator -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \TextMapPropagator
_ ->
        Text
-> IO TracerProvider
-> (TracerProvider -> IO ())
-> IO TracerProvider
-> (TracerProvider -> IO ())
-> (Either Text TracerProvider -> IO a)
-> IO a
forall p a.
Text
-> IO p
-> (p -> IO ())
-> IO p
-> (p -> IO ())
-> (Either Text p -> IO a)
-> IO a
withGlobalProvider
          Text
"traces"
          IO TracerProvider
forall (m :: * -> *). MonadIO m => m TracerProvider
getGlobalTracerProvider
          TracerProvider -> IO ()
forall (m :: * -> *). MonadIO m => TracerProvider -> m ()
setGlobalTracerProvider
          IO TracerProvider
initialize
          (\TracerProvider
tracerProvider -> IO ShutdownResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TracerProvider -> Maybe Int -> IO ShutdownResult
forall (m :: * -> *).
MonadIO m =>
TracerProvider -> Maybe Int -> m ShutdownResult
shutdownTracerProvider TracerProvider
tracerProvider Maybe Int
forall a. Maybe a
Nothing))
          Either Text TracerProvider -> IO a
inner
      where
        initialize :: IO TracerProvider
initialize = do
          TextMapPropagator -> IO ()
setGlobalTextMapPropagator (TracerProviderOptions -> TextMapPropagator
tracerProviderOptionsPropagators TracerProviderOptions
opts)
          [SpanProcessor] -> TracerProviderOptions -> IO TracerProvider
forall (m :: * -> *).
MonadIO m =>
[SpanProcessor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider [SpanProcessor]
processors TracerProviderOptions
opts
    withMeterProvider :: MaterializedResources
-> MeterProvider
-> (Either Text (MeterProvider, SdkMeterEnv) -> IO a)
-> IO a
withMeterProvider MaterializedResources
resources MeterProvider
previous =
      Text
-> IO (MeterProvider, SdkMeterEnv)
-> ((MeterProvider, SdkMeterEnv) -> IO ())
-> (Either Text (MeterProvider, SdkMeterEnv) -> IO a)
-> IO a
forall r a.
Text -> IO r -> (r -> IO ()) -> (Either Text r -> IO a) -> IO a
bracketSignal
        Text
"metrics"
        ( MaterializedResources
-> SdkMeterProviderOptions -> IO (MeterProvider, SdkMeterEnv)
createMeterProvider MaterializedResources
resources SdkMeterProviderOptions
defaultSdkMeterProviderOptions IO (MeterProvider, SdkMeterEnv)
-> ((MeterProvider, SdkMeterEnv)
    -> IO (MeterProvider, SdkMeterEnv))
-> IO (MeterProvider, SdkMeterEnv)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(MeterProvider, SdkMeterEnv)
created -> (MeterProvider, SdkMeterEnv)
created (MeterProvider, SdkMeterEnv)
-> IO () -> IO (MeterProvider, SdkMeterEnv)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MeterProvider -> IO ()
forall (m :: * -> *). MonadIO m => MeterProvider -> m ()
setGlobalMeterProvider ((MeterProvider, SdkMeterEnv) -> MeterProvider
forall a b. (a, b) -> a
fst (MeterProvider, SdkMeterEnv)
created)
        )
        (\(MeterProvider
meterProvider, SdkMeterEnv
_) -> MeterProvider -> IO ()
forall (m :: * -> *). MonadIO m => MeterProvider -> m ()
setGlobalMeterProvider MeterProvider
previous IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ShutdownResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MeterProvider -> Maybe Int -> IO ShutdownResult
shutdownMeterProvider MeterProvider
meterProvider Maybe Int
forall a. Maybe a
Nothing))
    withReader :: PeriodicMetricReaderOptions
-> Either Text SdkMeterEnv
-> (Either Text PeriodicMetricReaderHandle -> IO b)
-> IO b
withReader PeriodicMetricReaderOptions
readerOpts Either Text SdkMeterEnv
env Either Text PeriodicMetricReaderHandle -> IO b
inner = do
      selection <- IO (Maybe MetricsExporterSelection)
lookupMetricsExporterSelection
      maybe (either (inner . Left) forked env) (inner . Left) (metricsOffNote selection)
      where
        forked :: SdkMeterEnv -> IO b
forked SdkMeterEnv
meterEnv = Text
-> IO PeriodicMetricReaderHandle
-> (PeriodicMetricReaderHandle -> IO ())
-> (Either Text PeriodicMetricReaderHandle -> IO b)
-> IO b
forall r a.
Text -> IO r -> (r -> IO ()) -> (Either Text r -> IO a) -> IO a
bracketSignal Text
"metrics" (SdkMeterEnv -> IO PeriodicMetricReaderHandle
forkReader SdkMeterEnv
meterEnv) PeriodicMetricReaderHandle -> IO ()
stopPeriodicMetricReader Either Text PeriodicMetricReaderHandle -> IO b
inner
        forkReader :: SdkMeterEnv -> IO PeriodicMetricReaderHandle
forkReader SdkMeterEnv
meterEnv = IO MetricExporter
resolveMetricExporter IO MetricExporter
-> (MetricExporter -> IO PeriodicMetricReaderHandle)
-> IO PeriodicMetricReaderHandle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MetricExporter
exporter -> SdkMeterEnv
-> MetricExporter
-> PeriodicMetricReaderOptions
-> IO PeriodicMetricReaderHandle
forkPeriodicMetricReader SdkMeterEnv
meterEnv MetricExporter
exporter PeriodicMetricReaderOptions
readerOpts
    withLogs :: (Either Text LoggerProvider -> IO a) -> IO a
withLogs =
      Text
-> IO LoggerProvider
-> (LoggerProvider -> IO ())
-> IO LoggerProvider
-> (LoggerProvider -> IO ())
-> (Either Text LoggerProvider -> IO a)
-> IO a
forall p a.
Text
-> IO p
-> (p -> IO ())
-> IO p
-> (p -> IO ())
-> (Either Text p -> IO a)
-> IO a
withGlobalProvider
        Text
"logs"
        IO LoggerProvider
forall (m :: * -> *). MonadIO m => m LoggerProvider
getGlobalLoggerProvider
        LoggerProvider -> IO ()
forall (m :: * -> *). MonadIO m => LoggerProvider -> m ()
setGlobalLoggerProvider
        IO LoggerProvider
initializeGlobalLoggerProvider
        (\LoggerProvider
loggerProvider -> IO ShutdownResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LoggerProvider -> Maybe Int -> IO ShutdownResult
forall (m :: * -> *).
MonadIO m =>
LoggerProvider -> Maybe Int -> m ShutdownResult
shutdownLoggerProvider LoggerProvider
loggerProvider Maybe Int
forall a. Maybe a
Nothing))

-- | Install a signal's SDK provider as the global one for the duration, restoring the
-- previous provider and shutting the new one down afterwards.
withGlobalProvider
  :: Text -> IO p -> (p -> IO ()) -> IO p -> (p -> IO ()) -> (Either Text p -> IO a) -> IO a
withGlobalProvider :: forall p a.
Text
-> IO p
-> (p -> IO ())
-> IO p
-> (p -> IO ())
-> (Either Text p -> IO a)
-> IO a
withGlobalProvider Text
signal IO p
getGlobal p -> IO ()
setGlobal IO p
initialize p -> IO ()
shutdown Either Text p -> IO a
inner = do
  previous <- IO p
getGlobal
  bracketSignal
    signal
    (initialize >>= \p
installed -> p
installed p -> IO () -> IO p
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p -> IO ()
setGlobal p
installed)
    (\p
installed -> p -> IO ()
setGlobal p
previous IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> p -> IO ()
shutdown p
installed)
    inner

-- | Set a signal up and run @inner@ over it, or over the failure that left it off.
bracketSignal :: Text -> IO r -> (r -> IO ()) -> (Either Text r -> IO a) -> IO a
bracketSignal :: forall r a.
Text -> IO r -> (r -> IO ()) -> (Either Text r -> IO a) -> IO a
bracketSignal Text
signal IO r
acquire r -> IO ()
release Either Text r -> IO a
inner =
  IO (Either SomeException r)
-> (Either SomeException r -> IO ())
-> (Either SomeException r -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO r -> IO (Either SomeException r)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny IO r
acquire) ((r -> IO ()) -> Either SomeException r -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ r -> IO ()
release) (Either Text r -> IO a
inner (Either Text r -> IO a)
-> (Either SomeException r -> Either Text r)
-> Either SomeException r
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> Text) -> Either SomeException r -> Either Text r
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SomeException -> Text
signalFailed Text
signal))

-- | Why a selection leaves metrics off, for the selections that do.
metricsOffNote :: Maybe MetricsExporterSelection -> Maybe Text
metricsOffNote :: Maybe MetricsExporterSelection -> Maybe Text
metricsOffNote = \case
  Just MetricsExporterSelection
MetricsExporterNone -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"metrics off, OTEL_METRICS_EXPORTER=none"
  Just MetricsExporterSelection
MetricsExporterPrometheus -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"metrics off, no Prometheus endpoint is served, point OTEL_EXPORTER_OTLP_ENDPOINT at a collector"
  -- The SDK's exporter resolution has no case for this one.
  Just (MetricsExporterCustom String
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"metrics off, unrecognized OTEL_METRICS_EXPORTER=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
name)
  Maybe MetricsExporterSelection
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | The resource every signal exports under, detected the way "OpenTelemetry.Trace" does.
detectResources :: IO MaterializedResources
detectResources :: IO MaterializedResources
detectResources = MaterializedResources
-> Either SomeException MaterializedResources
-> MaterializedResources
forall b a. b -> Either a b -> b
fromRight MaterializedResources
emptyMaterializedResources (Either SomeException MaterializedResources
 -> MaterializedResources)
-> IO (Either SomeException MaterializedResources)
-> IO MaterializedResources
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO MaterializedResources
-> IO (Either SomeException MaterializedResources)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny IO MaterializedResources
detect
  where
    detect :: IO MaterializedResources
detect = do
      builtIn <- IO Resource
detectBuiltInResources
      fromEnv <- mkResource . map Just <$> detectResourceAttributes
      service <- fmap (mkResource . foldMap (\String
name -> [Text
"service.name" Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack String
name])) (lookupEnv "OTEL_SERVICE_NAME")
      pure (materializeResources (mergeResources service (mergeResources fromEnv builtIn)))

-- | The note a signal that could not start leaves in the summary.
signalFailed :: Text -> SomeException -> Text
signalFailed :: Text -> SomeException -> Text
signalFailed Text
signal SomeException
exception = Text
signal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exporter did not start: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
displayEx SomeException
exception

-- | Why a signal is off, for the ones that are.
noteOf :: Either Text r -> Maybe Text
noteOf :: forall r. Either Text r -> Maybe Text
noteOf = (Text -> Maybe Text)
-> (r -> Maybe Text) -> Either Text r -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Maybe Text
forall a. a -> Maybe a
Just (Maybe Text -> r -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing)

-- | The lifecycle instruments over a provider, or why they could not be built.
arbiterInstruments :: MeterProvider -> IO (Either Text ArbiterMeters)
arbiterInstruments :: MeterProvider -> IO (Either Text ArbiterMeters)
arbiterInstruments MeterProvider
meterProvider = (SomeException -> Text)
-> Either SomeException ArbiterMeters -> Either Text ArbiterMeters
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SomeException -> Text
signalFailed Text
"metrics") (Either SomeException ArbiterMeters -> Either Text ArbiterMeters)
-> IO (Either SomeException ArbiterMeters)
-> IO (Either Text ArbiterMeters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ArbiterMeters -> IO (Either SomeException ArbiterMeters)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (MeterProvider -> IO ArbiterMeters
newArbiterMeters MeterProvider
meterProvider)

-- | One line for the caller to log at startup, with whatever could not be started.
summarize :: Maybe Text -> [Text] -> Text
summarize :: Maybe Text -> [Text] -> Text
summarize Maybe Text
service [Text]
notes =
  Text -> [Text] -> Text
T.intercalate Text
", " ((Text
"telemetry on, service.name=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"unset" Maybe Text
service) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
notes)

-- | Service name in the detected resource. All signals use this name.
serviceName :: MaterializedResources -> Maybe Text
serviceName :: MaterializedResources -> Maybe Text
serviceName MaterializedResources
res = Attributes -> AttributeKey Text -> Maybe Text
forall a.
FromAttribute a =>
Attributes -> AttributeKey a -> Maybe a
lookupAttributeByKey (MaterializedResources -> Attributes
getMaterializedResourcesAttributes MaterializedResources
res) (AttributeKey Text
"service.name" :: AttributeKey Text)

-- | 'withTelemetry' when the flag is set. An inert handle when the flag is off.
withTelemetryIf :: Bool -> (Telemetry -> IO a) -> IO a
withTelemetryIf :: forall a. Bool -> (Telemetry -> IO a) -> IO a
withTelemetryIf Bool
True Telemetry -> IO a
action = (Telemetry -> IO a) -> IO a
forall a. (Telemetry -> IO a) -> IO a
withTelemetry Telemetry -> IO a
action
withTelemetryIf Bool
False Telemetry -> IO a
action = Telemetry -> IO a
action Telemetry
inertTelemetry

-- | A handle that uses the API no-op providers.
inertTelemetry :: Telemetry
inertTelemetry :: Telemetry
inertTelemetry = MeterProvider -> Telemetry
baseTelemetry MeterProvider
noopMeterProvider

-- | A non-exporting handle over @meterProvider@. The installers update the fields they set.
baseTelemetry :: MeterProvider -> Telemetry
baseTelemetry :: MeterProvider -> Telemetry
baseTelemetry MeterProvider
meterProvider =
  Telemetry
    { meters :: Maybe ArbiterMeters
meters = Maybe ArbiterMeters
forall a. Maybe a
Nothing
    , provider :: MeterProvider
provider = MeterProvider
meterProvider
    , logDestination :: Maybe LogDestination
logDestination = Maybe LogDestination
forall a. Maybe a
Nothing
    , gaugeRefresh :: NominalDiffTime
gaugeRefresh = PeriodicMetricReaderOptions -> NominalDiffTime
refreshFor PeriodicMetricReaderOptions
defaultPeriodicMetricReaderOptions
    , telemetrySummary :: Text
telemetrySummary = Text
"telemetry off"
    }

-- | A metric reader's export interval.
refreshFor :: PeriodicMetricReaderOptions -> NominalDiffTime
refreshFor :: PeriodicMetricReaderOptions -> NominalDiffTime
refreshFor PeriodicMetricReaderOptions
opts = Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PeriodicMetricReaderOptions -> Int
periodicIntervalMicros PeriodicMetricReaderOptions
opts) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
1_000_000

-- | 'withTelemetryIf' on @OTEL_SDK_DISABLED@, the spec's own switch.
withTelemetryFromEnv :: (Telemetry -> IO a) -> IO a
withTelemetryFromEnv :: forall a. (Telemetry -> IO a) -> IO a
withTelemetryFromEnv Telemetry -> IO a
action = do
  disabled <- String -> IO Bool
lookupBooleanEnv String
"OTEL_SDK_DISABLED"
  withTelemetryIf (not disabled) action

-- | Send log output to the configured destination and this handle's destination.
telemetryLogConfig :: Telemetry -> LogConfig -> LogConfig
telemetryLogConfig :: Telemetry -> LogConfig -> LogConfig
telemetryLogConfig = Maybe LogDestination -> LogConfig -> LogConfig
otelLogs (Maybe LogDestination -> LogConfig -> LogConfig)
-> (Telemetry -> Maybe LogDestination)
-> Telemetry
-> LogConfig
-> LogConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telemetry -> Maybe LogDestination
logDestination

-- | Run an action with application-owned providers. Missing providers disable
-- their applicable signals.
withExternalTelemetry :: Maybe MeterProvider -> Maybe LoggerProvider -> (Telemetry -> IO a) -> IO a
withExternalTelemetry :: forall a.
Maybe MeterProvider
-> Maybe LoggerProvider -> (Telemetry -> IO a) -> IO a
withExternalTelemetry Maybe MeterProvider
mmp Maybe LoggerProvider
mlp Telemetry -> IO a
action = do
  tracing <- Maybe Tracer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Tracer -> Bool) -> IO (Maybe Tracer) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Tracer)
forall (m :: * -> *). MonadIO m => m (Maybe Tracer)
resolveTracer
  instruments <- traverse arbiterInstruments mmp
  readerOpts <- periodicMetricReaderOptionsFromEnv
  action
    (baseTelemetry (fromMaybe noopMeterProvider mmp))
      { meters = either (const Nothing) Just =<< instruments
      , logDestination = loggerDestination <$> mlp
      , gaugeRefresh = refreshFor readerOpts
      , telemetrySummary =
          T.intercalate ", " $
            "telemetry on, caller's providers"
              : catMaybes
                [ if tracing then Nothing else Just "no global tracer provider installed"
                , noteOf =<< instruments
                ]
      }