{-# LANGUAGE DataKinds #-}

{- |
 Module      :  OpenTelemetry.Registry
 Copyright   :  (c) Ian Duncan, 2021
 License     :  BSD-3
 Description :  Global registry for exporters and propagators
 Maintainer  :  Ian Duncan
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)

 A global, process-wide registry that allows exporter and propagator
 libraries to make themselves discoverable by the SDK at
 initialization time.

 This follows the same pattern as Go's
 [@autoexport@](https://pkg.go.dev/go.opentelemetry.io/contrib/exporters/autoexport)
 and
 [@autoprop@](https://pkg.go.dev/go.opentelemetry.io/contrib/propagators/autoprop)
 packages: the registry is the single source of truth for resolving
 @OTEL_TRACES_EXPORTER@, @OTEL_PROPAGATORS@, and similar environment
 variables.

 == How it works

 * The SDK registers its known defaults (otlp, tracecontext, baggage,
   b3, datadog) using the @IfAbsent@ variants during initialization.
 * Third-party packages that call the plain @register@ variants
   /before/ SDK init will therefore take precedence over built-in
   defaults.
 * After SDK init, the registry is no longer consulted; changes have
   no retroactive effect on an already-initialized 'TracerProvider'.

 == Usage example

 @
 import OpenTelemetry.Registry ('registerSpanExporterFactory', 'registerTextMapPropagator')
 import OpenTelemetry.Trace ('initializeGlobalTracerProvider')

 main :: IO ()
 main = do
   -- Register a custom exporter before SDK init.
   -- When OTEL_TRACES_EXPORTER=\"zipkin\", the SDK will use this factory.
   'registerSpanExporterFactory' \"zipkin\" myZipkinExporterFactory

   -- Register a custom propagator.
   -- When OTEL_PROPAGATORS=\"xray\", the SDK will use this propagator.
   'registerTextMapPropagator' \"xray\" myXRayPropagator

   -- The SDK now resolves exporter\/propagator names from the registry.
   'initializeGlobalTracerProvider'
   ...
 @

 @since 0.4.0.0
-}
module OpenTelemetry.Registry (
  -- * Span Exporter Registry
  registerSpanExporterFactory,
  registerSpanExporterFactoryIfAbsent,
  lookupSpanExporterFactory,
  registeredSpanExporterFactories,

  -- * Metric Exporter Registry
  registerMetricExporterFactory,
  registerMetricExporterFactoryIfAbsent,
  lookupMetricExporterFactory,
  registeredMetricExporterFactories,

  -- * Log Record Exporter Registry
  registerLogRecordExporterFactory,
  registerLogRecordExporterFactoryIfAbsent,
  lookupLogRecordExporterFactory,
  registeredLogRecordExporterFactories,

  -- * Text Map Propagator Registry
  registerTextMapPropagator,
  registerTextMapPropagatorIfAbsent,
  lookupRegisteredTextMapPropagator,
  registeredTextMapPropagators,

  -- * Resource Detector Registry
  ResourceDetector,
  registerResourceDetector,
  registerResourceDetectorIfAbsent,
  lookupResourceDetector,
  registeredResourceDetectors,
) where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Text (Text)
import OpenTelemetry.Internal.Log.Types (LogRecordExporter)
import OpenTelemetry.Internal.Metric.Export (MetricExporter)
import OpenTelemetry.Internal.Trace.Types (SpanExporter)
import OpenTelemetry.Propagator (TextMapPropagator)
import OpenTelemetry.Resource (Resource)
import System.IO.Unsafe (unsafePerformIO)


-- Internal: insert-or-replace into an IORef HashMap.
insertRegistry :: IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry :: forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text v)
ref Text
name v
val =
  IORef (HashMap Text v)
-> (HashMap Text v -> (HashMap Text v, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap Text v)
ref ((HashMap Text v -> (HashMap Text v, ())) -> IO ())
-> (HashMap Text v -> (HashMap Text v, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HashMap Text v
m -> (Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
name v
val HashMap Text v
m, ())
{-# INLINE insertRegistry #-}


-- Internal: insert only if the key is absent.  Returns True when a
-- new entry was actually inserted.
insertRegistryIfAbsent :: IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent :: forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text v)
ref Text
name v
val =
  IORef (HashMap Text v)
-> (HashMap Text v -> (HashMap Text v, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap Text v)
ref ((HashMap Text v -> (HashMap Text v, Bool)) -> IO Bool)
-> (HashMap Text v -> (HashMap Text v, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \HashMap Text v
m ->
    if Text -> HashMap Text v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Text
name HashMap Text v
m
      then (HashMap Text v
m, Bool
False)
      else (Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
name v
val HashMap Text v
m, Bool
True)
{-# INLINE insertRegistryIfAbsent #-}


lookupRegistry :: IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry :: forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text v)
ref Text
name = Text -> HashMap Text v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
name (HashMap Text v -> Maybe v) -> IO (HashMap Text v) -> IO (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (HashMap Text v) -> IO (HashMap Text v)
forall a. IORef a -> IO a
readIORef IORef (HashMap Text v)
ref
{-# INLINE lookupRegistry #-}


readRegistry :: IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry :: forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry = IORef (HashMap Text v) -> IO (HashMap Text v)
forall a. IORef a -> IO a
readIORef
{-# INLINE readRegistry #-}


-- Span Exporters --------------------------------------------------------------

spanExporterRegistry :: IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry :: IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry = IO (IORef (HashMap Text (IO SpanExporter)))
-> IORef (HashMap Text (IO SpanExporter))
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Text (IO SpanExporter)))
 -> IORef (HashMap Text (IO SpanExporter)))
-> IO (IORef (HashMap Text (IO SpanExporter)))
-> IORef (HashMap Text (IO SpanExporter))
forall a b. (a -> b) -> a -> b
$ HashMap Text (IO SpanExporter)
-> IO (IORef (HashMap Text (IO SpanExporter)))
forall a. a -> IO (IORef a)
newIORef HashMap Text (IO SpanExporter)
forall k v. HashMap k v
H.empty
{-# NOINLINE spanExporterRegistry #-}


{- | Register a span exporter factory, replacing any existing entry
with the same name.

Use this from third-party exporter packages to override or extend the
set of exporters available to the SDK.

@since 0.4.0.0
-}
registerSpanExporterFactory :: Text -> IO SpanExporter -> IO ()
registerSpanExporterFactory :: Text -> IO SpanExporter -> IO ()
registerSpanExporterFactory = IORef (HashMap Text (IO SpanExporter))
-> Text -> IO SpanExporter -> IO ()
forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry


{- | Register a span exporter factory only if no factory is already
registered under the given name.  Returns 'True' if the factory was
registered, 'False' if an entry already existed.

The SDK uses this for built-in defaults so that user registrations
(made before SDK initialization) take precedence.

@since 0.4.0.0
-}
registerSpanExporterFactoryIfAbsent :: Text -> IO SpanExporter -> IO Bool
registerSpanExporterFactoryIfAbsent :: Text -> IO SpanExporter -> IO Bool
registerSpanExporterFactoryIfAbsent = IORef (HashMap Text (IO SpanExporter))
-> Text -> IO SpanExporter -> IO Bool
forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry


{- | Look up a span exporter factory by name.

@since 0.4.0.0
-}
lookupSpanExporterFactory :: Text -> IO (Maybe (IO SpanExporter))
lookupSpanExporterFactory :: Text -> IO (Maybe (IO SpanExporter))
lookupSpanExporterFactory = IORef (HashMap Text (IO SpanExporter))
-> Text -> IO (Maybe (IO SpanExporter))
forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry


{- | Return all registered span exporter factories.

@since 0.4.0.0
-}
registeredSpanExporterFactories :: IO (HashMap Text (IO SpanExporter))
registeredSpanExporterFactories :: IO (HashMap Text (IO SpanExporter))
registeredSpanExporterFactories = IORef (HashMap Text (IO SpanExporter))
-> IO (HashMap Text (IO SpanExporter))
forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry IORef (HashMap Text (IO SpanExporter))
spanExporterRegistry


-- Metric Exporters ------------------------------------------------------------

metricExporterRegistry :: IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry :: IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry = IO (IORef (HashMap Text (IO MetricExporter)))
-> IORef (HashMap Text (IO MetricExporter))
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Text (IO MetricExporter)))
 -> IORef (HashMap Text (IO MetricExporter)))
-> IO (IORef (HashMap Text (IO MetricExporter)))
-> IORef (HashMap Text (IO MetricExporter))
forall a b. (a -> b) -> a -> b
$ HashMap Text (IO MetricExporter)
-> IO (IORef (HashMap Text (IO MetricExporter)))
forall a. a -> IO (IORef a)
newIORef HashMap Text (IO MetricExporter)
forall k v. HashMap k v
H.empty
{-# NOINLINE metricExporterRegistry #-}


{- | Register a metric exporter factory, replacing any existing entry.

@since 0.4.0.0
-}
registerMetricExporterFactory :: Text -> IO MetricExporter -> IO ()
registerMetricExporterFactory :: Text -> IO MetricExporter -> IO ()
registerMetricExporterFactory = IORef (HashMap Text (IO MetricExporter))
-> Text -> IO MetricExporter -> IO ()
forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry


{- | Register a metric exporter factory only if absent.

@since 0.4.0.0
-}
registerMetricExporterFactoryIfAbsent :: Text -> IO MetricExporter -> IO Bool
registerMetricExporterFactoryIfAbsent :: Text -> IO MetricExporter -> IO Bool
registerMetricExporterFactoryIfAbsent = IORef (HashMap Text (IO MetricExporter))
-> Text -> IO MetricExporter -> IO Bool
forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry


{- | Look up a metric exporter factory by name.

@since 0.4.0.0
-}
lookupMetricExporterFactory :: Text -> IO (Maybe (IO MetricExporter))
lookupMetricExporterFactory :: Text -> IO (Maybe (IO MetricExporter))
lookupMetricExporterFactory = IORef (HashMap Text (IO MetricExporter))
-> Text -> IO (Maybe (IO MetricExporter))
forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry


{- | Return all registered metric exporter factories.

@since 0.4.0.0
-}
registeredMetricExporterFactories :: IO (HashMap Text (IO MetricExporter))
registeredMetricExporterFactories :: IO (HashMap Text (IO MetricExporter))
registeredMetricExporterFactories = IORef (HashMap Text (IO MetricExporter))
-> IO (HashMap Text (IO MetricExporter))
forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry IORef (HashMap Text (IO MetricExporter))
metricExporterRegistry


-- Log Record Exporters --------------------------------------------------------

logRecordExporterRegistry :: IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry :: IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry = IO (IORef (HashMap Text (IO LogRecordExporter)))
-> IORef (HashMap Text (IO LogRecordExporter))
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Text (IO LogRecordExporter)))
 -> IORef (HashMap Text (IO LogRecordExporter)))
-> IO (IORef (HashMap Text (IO LogRecordExporter)))
-> IORef (HashMap Text (IO LogRecordExporter))
forall a b. (a -> b) -> a -> b
$ HashMap Text (IO LogRecordExporter)
-> IO (IORef (HashMap Text (IO LogRecordExporter)))
forall a. a -> IO (IORef a)
newIORef HashMap Text (IO LogRecordExporter)
forall k v. HashMap k v
H.empty
{-# NOINLINE logRecordExporterRegistry #-}


{- | Register a log record exporter factory, replacing any existing entry.

@since 0.4.0.0
-}
registerLogRecordExporterFactory :: Text -> IO LogRecordExporter -> IO ()
registerLogRecordExporterFactory :: Text -> IO LogRecordExporter -> IO ()
registerLogRecordExporterFactory = IORef (HashMap Text (IO LogRecordExporter))
-> Text -> IO LogRecordExporter -> IO ()
forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry


{- | Register a log record exporter factory only if absent.

@since 0.4.0.0
-}
registerLogRecordExporterFactoryIfAbsent :: Text -> IO LogRecordExporter -> IO Bool
registerLogRecordExporterFactoryIfAbsent :: Text -> IO LogRecordExporter -> IO Bool
registerLogRecordExporterFactoryIfAbsent = IORef (HashMap Text (IO LogRecordExporter))
-> Text -> IO LogRecordExporter -> IO Bool
forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry


{- | Look up a log record exporter factory by name.

@since 0.4.0.0
-}
lookupLogRecordExporterFactory :: Text -> IO (Maybe (IO LogRecordExporter))
lookupLogRecordExporterFactory :: Text -> IO (Maybe (IO LogRecordExporter))
lookupLogRecordExporterFactory = IORef (HashMap Text (IO LogRecordExporter))
-> Text -> IO (Maybe (IO LogRecordExporter))
forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry


{- | Return all registered log record exporter factories.

@since 0.4.0.0
-}
registeredLogRecordExporterFactories :: IO (HashMap Text (IO LogRecordExporter))
registeredLogRecordExporterFactories :: IO (HashMap Text (IO LogRecordExporter))
registeredLogRecordExporterFactories = IORef (HashMap Text (IO LogRecordExporter))
-> IO (HashMap Text (IO LogRecordExporter))
forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry IORef (HashMap Text (IO LogRecordExporter))
logRecordExporterRegistry


-- Text Map Propagators --------------------------------------------------------

propagatorRegistry :: IORef (HashMap Text TextMapPropagator)
propagatorRegistry :: IORef (HashMap Text TextMapPropagator)
propagatorRegistry = IO (IORef (HashMap Text TextMapPropagator))
-> IORef (HashMap Text TextMapPropagator)
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Text TextMapPropagator))
 -> IORef (HashMap Text TextMapPropagator))
-> IO (IORef (HashMap Text TextMapPropagator))
-> IORef (HashMap Text TextMapPropagator)
forall a b. (a -> b) -> a -> b
$ HashMap Text TextMapPropagator
-> IO (IORef (HashMap Text TextMapPropagator))
forall a. a -> IO (IORef a)
newIORef HashMap Text TextMapPropagator
forall k v. HashMap k v
H.empty
{-# NOINLINE propagatorRegistry #-}


{- | Register a text map propagator, replacing any existing entry with
the same name.

@since 0.4.0.0
-}
registerTextMapPropagator :: Text -> TextMapPropagator -> IO ()
registerTextMapPropagator :: Text -> TextMapPropagator -> IO ()
registerTextMapPropagator = IORef (HashMap Text TextMapPropagator)
-> Text -> TextMapPropagator -> IO ()
forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text TextMapPropagator)
propagatorRegistry


{- | Register a text map propagator only if absent.  Returns 'True'
when a new entry was inserted.

@since 0.4.0.0
-}
registerTextMapPropagatorIfAbsent :: Text -> TextMapPropagator -> IO Bool
registerTextMapPropagatorIfAbsent :: Text -> TextMapPropagator -> IO Bool
registerTextMapPropagatorIfAbsent = IORef (HashMap Text TextMapPropagator)
-> Text -> TextMapPropagator -> IO Bool
forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text TextMapPropagator)
propagatorRegistry


{- | Look up a text map propagator by name.

@since 0.4.0.0
-}
lookupRegisteredTextMapPropagator :: Text -> IO (Maybe TextMapPropagator)
lookupRegisteredTextMapPropagator :: Text -> IO (Maybe TextMapPropagator)
lookupRegisteredTextMapPropagator = IORef (HashMap Text TextMapPropagator)
-> Text -> IO (Maybe TextMapPropagator)
forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text TextMapPropagator)
propagatorRegistry


{- | Return all registered text map propagators.

@since 0.4.0.0
-}
registeredTextMapPropagators :: IO (HashMap Text TextMapPropagator)
registeredTextMapPropagators :: IO (HashMap Text TextMapPropagator)
registeredTextMapPropagators = IORef (HashMap Text TextMapPropagator)
-> IO (HashMap Text TextMapPropagator)
forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry IORef (HashMap Text TextMapPropagator)
propagatorRegistry


-- Resource Detectors ----------------------------------------------------------

{- | A resource detector is an IO action that produces a 'Resource'.
Detectors that do not apply to the current environment should return
@'mkResource' []@ (an empty resource).

@since 0.4.0.0
-}
type ResourceDetector = IO Resource


resourceDetectorRegistry :: IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry :: IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry = IO (IORef (HashMap Text ResourceDetector))
-> IORef (HashMap Text ResourceDetector)
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap Text ResourceDetector))
 -> IORef (HashMap Text ResourceDetector))
-> IO (IORef (HashMap Text ResourceDetector))
-> IORef (HashMap Text ResourceDetector)
forall a b. (a -> b) -> a -> b
$ HashMap Text ResourceDetector
-> IO (IORef (HashMap Text ResourceDetector))
forall a. a -> IO (IORef a)
newIORef HashMap Text ResourceDetector
forall k v. HashMap k v
H.empty
{-# NOINLINE resourceDetectorRegistry #-}


{- | Register a resource detector, replacing any existing entry with
the same name.

Use this from application code or third-party packages to make a
custom detector available to the SDK.

@since 0.4.0.0
-}
registerResourceDetector :: Text -> ResourceDetector -> IO ()
registerResourceDetector :: Text -> ResourceDetector -> IO ()
registerResourceDetector = IORef (HashMap Text ResourceDetector)
-> Text -> ResourceDetector -> IO ()
forall v. IORef (HashMap Text v) -> Text -> v -> IO ()
insertRegistry IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry


{- | Register a resource detector only if absent.  Returns 'True'
when a new entry was inserted.

The SDK uses this for built-in detectors so that user registrations
(made before SDK initialization) take precedence.

@since 0.4.0.0
-}
registerResourceDetectorIfAbsent :: Text -> ResourceDetector -> IO Bool
registerResourceDetectorIfAbsent :: Text -> ResourceDetector -> IO Bool
registerResourceDetectorIfAbsent = IORef (HashMap Text ResourceDetector)
-> Text -> ResourceDetector -> IO Bool
forall v. IORef (HashMap Text v) -> Text -> v -> IO Bool
insertRegistryIfAbsent IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry


{- | Look up a resource detector by name.

@since 0.4.0.0
-}
lookupResourceDetector :: Text -> IO (Maybe ResourceDetector)
lookupResourceDetector :: Text -> IO (Maybe ResourceDetector)
lookupResourceDetector = IORef (HashMap Text ResourceDetector)
-> Text -> IO (Maybe ResourceDetector)
forall v. IORef (HashMap Text v) -> Text -> IO (Maybe v)
lookupRegistry IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry


{- | Return all registered resource detectors.

@since 0.4.0.0
-}
registeredResourceDetectors :: IO (HashMap Text ResourceDetector)
registeredResourceDetectors :: IO (HashMap Text ResourceDetector)
registeredResourceDetectors = IORef (HashMap Text ResourceDetector)
-> IO (HashMap Text ResourceDetector)
forall v. IORef (HashMap Text v) -> IO (HashMap Text v)
readRegistry IORef (HashMap Text ResourceDetector)
resourceDetectorRegistry