{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

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

= Overview

This module provides the core tracing API for creating and managing spans.
Most application code should use "OpenTelemetry.Trace" (from the SDK package)
for initialization and "OpenTelemetry.Trace.Monad" for a cleaner monadic
interface. This module is useful when you need direct control or are writing
instrumentation libraries.

= Quick example

> import OpenTelemetry.Trace.Core
>
> -- Wrap any IO action in a span:
> handleRequest :: Tracer -> Request -> IO Response
> handleRequest tracer req =
>   inSpan tracer "handleRequest" defaultSpanArguments $ do
>     result <- processRequest req
>     pure result
>
> -- Access the span to add attributes:
> fetchUser :: Tracer -> UserId -> IO User
> fetchUser tracer uid =
>   inSpan' tracer "fetchUser" defaultSpanArguments $ \span -> do
>     addAttribute span "user.id" (toAttribute uid)
>     user <- db_lookupUser uid
>     addAttribute span "user.name" (toAttribute (userName user))
>     pure user

= Key concepts

[@TracerProvider@] Factory that holds configuration (processors, exporters,
samplers) and creates 'Tracer's. Typically one per application, created at
startup.

[@Tracer@] Obtained from a 'TracerProvider', scoped to an instrumentation
library or application component. Carries the library name and version for
attribution.

[@Span@] Represents a unit of work. Has a name, start\/end timestamps,
attributes, events, links, and status. Created by 'OpenTelemetry.Trace.Core.inSpan'
or 'createSpan'.

= Creating spans

The @inSpan@ family of functions is the primary API:

* @inSpan@: wraps an @IO a@ action (or any 'MonadUnliftIO' action),
  automatically ending the span and recording exceptions. Captures source
  location from the call site.
* @inSpan@′: like @inSpan@, but passes the 'Span' to the callback so you can
  add attributes or events during execution. (In Haskell source the name ends
  with one ASCII prime character.)
* @inSpan@′′: raw variant with no automatic @code.*@ attributes from the call
  site. Preferred for instrumentation libraries where those attributes would
  describe library internals rather than user code. (In Haskell source the
  name ends with two ASCII prime characters.)

For manual span lifecycle management, use 'createSpan' and 'endSpan'.

= Adding metadata

> inSpan' tracer "processOrder" defaultSpanArguments $ \span -> do
>   addAttribute span "order.id" (toAttribute orderId)
>   addAttributes span
>     [ ("order.total", toAttribute total)
>     , ("order.currency", toAttribute "USD")
>     ]
>   addEvent span (newEvent "order.validated")
>   setStatus span Ok

= Error handling

@inSpan@ and @inSpan@′ automatically catch exceptions, record them on the span (as an exception
event with stack trace), set the span status to Error, and re-throw. You
can also manually set error status:

> setStatus span (Error "payment declined")
> recordException span mempty Nothing myException

= Source location

@inSpan@, @inSpan@′, and 'createSpan' automatically add source location
attributes from GHC's 'HasCallStack'. The attribute names depend on the
@OTEL_SEMCONV_STABILITY_OPT_IN@ setting:

* Default (@Old@): @code.function@, @code.namespace@, @code.filepath@, @code.lineno@
* @code@: @code.function.name@, @code.file.path@, @code.line.number@ (stable semconv v1.33+)
* @code\/dup@: both old and stable names emitted

If you provide any @code.*@ attribute yourself in
'SpanArguments', the automatic attributes are suppressed.

= Spec reference

<https://opentelemetry.io/docs/specs/otel/trace/api/>
-}
module OpenTelemetry.Trace.Core (
  -- * @TracerProvider@ operations
  TracerProvider,
  createTracerProvider,
  shutdownTracerProvider,
  ShutdownResult (..),
  worstShutdown,
  forceFlushTracerProvider,
  FlushResult (..),
  getTracerProviderResources,
  getTracerProviderPropagators,
  getGlobalTracerProvider,
  setGlobalTracerProvider,
  emptyTracerProviderOptions,
  TracerProviderOptions (..),

  -- * @Tracer@ operations
  Tracer,
  tracerName,
  tracerIsEnabled,
  HasTracer (..),
  makeTracer,
  getTracer,
  getImmutableSpanTracer,
  getTracerTracerProvider,
  InstrumentationLibrary (..),
  instrumentationLibrary,
  withSchemaUrl,
  withLibraryAttributes,
  detectInstrumentationLibrary,
  TracerOptions (..),
  tracerOptions,

  -- * Span operations
  Span,
  toImmutableSpan,
  FrozenOrDropped (..),
  ImmutableSpan (..),
  SpanHot (..),
  SpanContext (..),
  {- | W3c Trace flags

  https://www.w3.org/TR/trace-context/#trace-flags
  -}
  TraceFlags,
  traceFlagsValue,
  traceFlagsFromWord8,
  defaultTraceFlags,
  isSampled,
  setSampled,
  unsetSampled,
  isRandom,
  setRandom,
  unsetRandom,

  -- ** Creating @Span@s
  inSpan,
  inSpan',
  inSpan'',
  createSpan,
  createSpanWithoutCallStack,
  wrapSpanContext,
  wrapDroppedContext,
  SpanKind (..),
  defaultSpanArguments,
  SpanArguments (..),

  -- ** Recording @Event@s
  Event (..),
  NewEvent (..),
  addEvent,

  -- ** Enriching @Span@s with additional information
  updateName,
  OpenTelemetry.Trace.Core.addAttribute,
  OpenTelemetry.Trace.Core.addAttributes,
  OpenTelemetry.Trace.Core.addAttributes',
  spanGetAttributes,
  Attribute (..),
  ToAttribute (..),
  PrimitiveAttribute (..),
  ToPrimitiveAttribute (..),

  -- *** Attribute builder
  A.AttrsBuilder,
  A.attr,
  A.optAttr,
  (A..@),
  (A..@?),
  A.buildAttrs,
  Link (..),
  NewLink (..),
  addLink,

  -- ** Recording error information
  recordException,
  recordError,
  setStatus,
  SpanStatus (..),

  -- ** Exception handling
  ExceptionClassification (..),
  ExceptionResponse (..),
  ExceptionHandler,
  defaultExceptionResponse,
  resolveException,

  -- ** Completing @Span@s
  endSpan,

  -- ** Accessing other @Span@ information
  getSpanContext,
  isRecording,
  isValid,
  spanIsRemote,

  -- * Active span
  getActiveSpan,
  withActiveSpan,
  getActiveSpanContext,

  -- * Event constructors
  newEvent,
  newEventWith,

  -- * Utilities
  Timestamp,
  getTimestamp,
  timestampNanoseconds,
  unsafeReadSpan,
  whenSpanIsRecording,
  codeAttributes,
  ownCodeAttributes,
  callerAttributes,
  addAttributesToSpanArguments,

  -- * Limits
  SpanLimits (..),
  defaultSpanLimits,
  bracketError,
) where

import Control.Applicative
import Control.Concurrent.Async
import Control.Concurrent.Thread.Storage (getCurrentThreadId)
import Control.Exception (Exception (..), SomeException (..), catch, displayException)
import qualified Control.Exception as EUnsafe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Data.Coerce
import qualified Data.HashMap.Strict as H
import Data.IORef (IORef, atomicModifyIORef', atomicWriteIORef, newIORef, readIORef, writeIORef)


#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
import qualified Data.Vector as V
import Data.Word (Word64)
import GHC.Stack
import OpenTelemetry.Attributes
import qualified OpenTelemetry.Attributes as A
import OpenTelemetry.Common
import OpenTelemetry.Context
import OpenTelemetry.Context.ThreadLocal
import OpenTelemetry.Internal.Common.Types
import OpenTelemetry.Internal.Log.Core (emitOTelLogRecord)
import qualified OpenTelemetry.Internal.Log.Types as SeverityNumber (SeverityNumber (..))
import OpenTelemetry.Internal.Logging (otelLogWarning)
import OpenTelemetry.Internal.Trace.Types
import qualified OpenTelemetry.Internal.Trace.Types as Types
import OpenTelemetry.Propagator (TextMapPropagator)
import OpenTelemetry.Resource
import qualified OpenTelemetry.SemanticConventions as SC
import OpenTelemetry.SemanticsConfig (StabilityOpt (..), codeOption, getSemanticsOptions)
import OpenTelemetry.Trace.Id
import OpenTelemetry.Trace.Id.Generator
import OpenTelemetry.Trace.Id.Generator.Dummy
import OpenTelemetry.Trace.Sampler
import qualified OpenTelemetry.Trace.TraceState as TraceState
import OpenTelemetry.Util
import System.IO.Unsafe
import System.Timeout (timeout)


{- | Create a 'Span'.

 If the provided 'Context' has a span in it (inserted via 'OpenTelemetry.Context.insertSpan'),
 that 'Span' will be used as the parent of the 'Span' created via this API.

 Note: if the @hs-opentelemetry-sdk@ or another SDK is not installed, all actions that use the created
 'Span's produced will be no-ops.

 @since 0.0.1.0
-}
createSpan
  :: (MonadIO m, HasCallStack)
  => Tracer
  {- ^ 'Tracer' to create the span from. Associated 'Processor's and 'Exporter's will be
  used for the lifecycle of the created 'Span'
  -}
  -> Context
  {- ^ Context, potentially containing a parent span. If no existing parent (or context) exists,
  you can use 'OpenTelemetry.Context.empty'.
  -}
  -> Text
  -- ^ Span name
  -> SpanArguments
  -- ^ Additional span information
  -> m Span
  {- ^ The created span.
  Try and infer source code information unless the user has set any of the attributes already, which
  we take as an indication that our automatic strategy won't work well.
  -}
createSpan :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Tracer -> Context -> Text -> SpanArguments -> m Span
createSpan Tracer
t Context
ctxt Text
n SpanArguments
args = Tracer -> Context -> Text -> SpanArguments -> m Span
forall (m :: * -> *).
MonadIO m =>
Tracer -> Context -> Text -> SpanArguments -> m Span
createSpanWithoutCallStack Tracer
t Context
ctxt Text
n (AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArgumentsIfNonePresent AttributeMap
HasCallStack => AttributeMap
callerAttributes SpanArguments
args)
{-# INLINE createSpan #-}


{- | The same thing as 'createSpan', except that it does not have a 'HasCallStack' constraint.

@since 0.0.1.0
-}
createSpanWithoutCallStack
  :: (MonadIO m)
  => Tracer
  {- ^ 'Tracer' to create the span from. Associated 'Processor's and 'Exporter's will be
  used for the lifecycle of the created 'Span'
  -}
  -> Context
  {- ^ Context, potentially containing a parent span. If no existing parent (or context) exists,
  you can use 'OpenTelemetry.Context.empty'.
  -}
  -> Text
  -- ^ Span name
  -> SpanArguments
  -- ^ Additional span information
  -> m Span
  -- ^ The created span.
createSpanWithoutCallStack :: forall (m :: * -> *).
MonadIO m =>
Tracer -> Context -> Text -> SpanArguments -> m Span
createSpanWithoutCallStack Tracer
t Context
ctxt Text
n SpanArguments
args = IO Span -> m Span
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Span -> m Span) -> IO Span -> m Span
forall a b. (a -> b) -> a -> b
$ do
  !tidInt <- IO Int
getCurrentThreadId
  createSpanHelper t ctxt n args H.empty tidInt
{-# INLINE createSpanWithoutCallStack #-}


{- | Like 'createSpanWithoutCallStack' but accepts lazy extra attributes
(e.g. source location info) that are only forced when the span is recorded.
The Int parameter is a pre-computed thread ID for the @thread.id@ span
attribute, avoiding a redundant myThreadId + FFI call when the caller
(e.g. inSpanInternal) already has the value.
-}
createSpanHelper :: Tracer -> Context -> Text -> SpanArguments -> AttributeMap -> Int -> IO Span
createSpanHelper :: Tracer
-> Context
-> Text
-> SpanArguments
-> AttributeMap
-> Int
-> IO Span
createSpanHelper Tracer
t Context
ctxt Text
n args :: SpanArguments
args@SpanArguments {[NewLink]
Maybe Timestamp
AttributeMap
SpanKind
kind :: SpanKind
attributes :: AttributeMap
links :: [NewLink]
startTime :: Maybe Timestamp
attributes :: SpanArguments -> AttributeMap
kind :: SpanArguments -> SpanKind
links :: SpanArguments -> [NewLink]
startTime :: SpanArguments -> Maybe Timestamp
..} AttributeMap
extraAttrs !Int
tidInt = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
otelLogWarning String
"Span created with empty name"
  let !tp :: TracerProvider
tp = Tracer -> TracerProvider
tracerProvider Tracer
t
  isShutdown <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TracerProvider -> IORef Bool
tracerProviderIsShutdown TracerProvider
tp
  if isShutdown || not (tracerProviderHasProcessor tp)
    then do
      let parent = Context -> Maybe Span
lookupSpan Context
ctxt
          parentSc = case Maybe Span
parent of
            Maybe Span
Nothing -> Maybe SpanContext
forall a. Maybe a
Nothing
            Just (Span ImmutableSpan
imm) -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just (ImmutableSpan -> SpanContext
Types.spanContext ImmutableSpan
imm)
            Just (FrozenSpan SpanContext
s') -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just SpanContext
s'
            Just (Dropped SpanContext
s') -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just SpanContext
s'
          (!tId, !parentTs) = case parentSc of
            Maybe SpanContext
Nothing -> (TraceId
nilTraceId, TraceState
TraceState.empty)
            Just SpanContext
sc -> (SpanContext -> TraceId
traceId SpanContext
sc, SpanContext -> TraceState
traceState SpanContext
sc)
      pure $! Dropped $! SpanContext defaultTraceFlags False tId nilSpanId parentTs
    else do
      let parent = Context -> Maybe Span
lookupSpan Context
ctxt
          parentSc = case Maybe Span
parent of
            Maybe Span
Nothing -> Maybe SpanContext
forall a. Maybe a
Nothing
            Just (Span ImmutableSpan
imm) -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just (ImmutableSpan -> SpanContext
Types.spanContext ImmutableSpan
imm)
            Just (FrozenSpan SpanContext
s) -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just SpanContext
s
            Just (Dropped SpanContext
s) -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just SpanContext
s

      -- Dropped parent: propagate trace context, skip all ID generation
      case parent of
        Just (Dropped SpanContext
_) -> do
          let !ts :: TraceState
ts = TraceState
-> (SpanContext -> TraceState) -> Maybe SpanContext -> TraceState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceState
TraceState.empty SpanContext -> TraceState
traceState Maybe SpanContext
parentSc
              !tId :: TraceId
tId = TraceId -> (SpanContext -> TraceId) -> Maybe SpanContext -> TraceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceId
nilTraceId SpanContext -> TraceId
traceId Maybe SpanContext
parentSc
          Span -> IO Span
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span -> IO Span) -> Span -> IO Span
forall a b. (a -> b) -> a -> b
$! SpanContext -> Span
Dropped (SpanContext -> Span) -> SpanContext -> Span
forall a b. (a -> b) -> a -> b
$! TraceFlags
-> Bool -> TraceId -> SpanId -> TraceState -> SpanContext
SpanContext TraceFlags
defaultTraceFlags Bool
False TraceId
tId SpanId
nilSpanId TraceState
ts
        Maybe Span
_ -> do
          let !idGen :: IdGenerator
idGen = TracerProvider -> IdGenerator
tracerProviderIdGenerator TracerProvider
tp

          -- Root spans: generate TraceId + SpanId in one FFI call (3 xoshiro
          -- steps) instead of 3 separate calls. The SpanId bytes are drawn
          -- before sampling but used after — the spec requires the ID to be
          -- fresh regardless of sampling outcome, which this satisfies.
          -- Child spans: inherit TraceId, generate only SpanId (1 call).
          (!tId, !preSpanId) <- case Maybe SpanContext
parentSc of
            Maybe SpanContext
Nothing -> IdGenerator -> IO (TraceId, SpanId)
forall (m :: * -> *).
MonadIO m =>
IdGenerator -> m (TraceId, SpanId)
newTraceAndSpanId IdGenerator
idGen
            Just SpanContext
sc -> do
              !sid <- IdGenerator -> IO SpanId
forall (m :: * -> *). MonadIO m => IdGenerator -> m SpanId
newSpanId IdGenerator
idGen
              pure (traceId sc, sid)

          let !baseFlags = case Maybe SpanContext
parentSc of
                Maybe SpanContext
Nothing -> case IdGenerator
idGen of
                  IdGenerator
DefaultIdGenerator -> TraceFlags -> TraceFlags
setRandom TraceFlags
defaultTraceFlags
                  IdGenerator
_ -> TraceFlags
defaultTraceFlags
                Just SpanContext
sc
                  | TraceFlags -> Bool
isRandom (SpanContext -> TraceFlags
Types.traceFlags SpanContext
sc) -> TraceFlags -> TraceFlags
setRandom TraceFlags
defaultTraceFlags
                  | Bool
otherwise -> TraceFlags
defaultTraceFlags

          -- Spec: shouldSample receives the InstrumentationScope of the Tracer.
          -- https://opentelemetry.io/docs/specs/otel/trace/sdk/#shouldsample
          SamplingDecision {..} <-
            shouldSample
              (tracerProviderSampler tp)
              ctxt
              tId
              n
              args
              (tracerName t)

          let !sId = SpanId
preSpanId

          case samplingOutcome of
            SamplingResult
Drop ->
              Span -> IO Span
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span -> IO Span) -> Span -> IO Span
forall a b. (a -> b) -> a -> b
$! SpanContext -> Span
Dropped (SpanContext -> Span) -> SpanContext -> Span
forall a b. (a -> b) -> a -> b
$! TraceFlags
-> Bool -> TraceId -> SpanId -> TraceState -> SpanContext
SpanContext TraceFlags
baseFlags Bool
False TraceId
tId SpanId
sId TraceState
samplingTraceState
            SamplingResult
_ -> do
              let !ctxtForSpan :: SpanContext
ctxtForSpan =
                    SpanContext
                      { traceFlags :: TraceFlags
traceFlags = case SamplingResult
samplingOutcome of
                          SamplingResult
Drop -> TraceFlags
baseFlags
                          SamplingResult
RecordOnly -> TraceFlags
baseFlags
                          SamplingResult
RecordAndSample -> TraceFlags -> TraceFlags
setSampled TraceFlags
baseFlags
                      , isRemote :: Bool
isRemote = Bool
False
                      , traceState :: TraceState
traceState = TraceState
samplingTraceState
                      , spanId :: SpanId
spanId = SpanId
sId
                      , traceId :: TraceId
traceId = TraceId
tId
                      }
              st <- IO Timestamp
-> (Timestamp -> IO Timestamp) -> Maybe Timestamp -> IO Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Timestamp
getTimestampIO Timestamp -> IO Timestamp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Timestamp
startTime
              let !attrLimits = Tracer -> AttributeLimits
tracerSpanAttributeLimits Tracer
t
                  !tidVal = Int -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Int
tidInt
                  !allAttrs =
                    Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Int64 -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Int64
SC.thread_id) Attribute
tidVal (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
                      case (AttributeMap -> Bool
forall k v. HashMap k v -> Bool
H.null AttributeMap
samplingAttributes, AttributeMap -> Bool
forall k v. HashMap k v -> Bool
H.null AttributeMap
extraAttrs) of
                        (Bool
True, Bool
True) -> AttributeMap
attributes
                        (Bool
True, Bool
False) -> AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union AttributeMap
attributes AttributeMap
extraAttrs
                        (Bool
False, Bool
True) -> AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union AttributeMap
samplingAttributes AttributeMap
attributes
                        (Bool
False, Bool
False) -> AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union AttributeMap
samplingAttributes (AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union AttributeMap
attributes AttributeMap
extraAttrs)
                  !initialAttrs = AttributeLimits -> AttributeMap -> Attributes
A.unsafeAttributesFromMap AttributeLimits
attrLimits AttributeMap
allAttrs
                  !initialLinks =
                    (AppendOnlyBoundedCollection Link
 -> NewLink -> AppendOnlyBoundedCollection Link)
-> AppendOnlyBoundedCollection Link
-> [NewLink]
-> AppendOnlyBoundedCollection Link
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\AppendOnlyBoundedCollection Link
c NewLink
l -> AppendOnlyBoundedCollection Link
-> Link -> AppendOnlyBoundedCollection Link
forall a.
AppendOnlyBoundedCollection a -> a -> AppendOnlyBoundedCollection a
appendToBoundedCollection AppendOnlyBoundedCollection Link
c (Tracer -> NewLink -> Link
freezeLink Tracer
t NewLink
l)) AppendOnlyBoundedCollection Link
emptyLinks [NewLink]
links
                  emptyLinks = Int -> AppendOnlyBoundedCollection Link
forall a. Int -> AppendOnlyBoundedCollection a
emptyAppendOnlyBoundedCollection (Tracer -> Int
tracerLinkCountLimit Tracer
t)
                  emptyEvts = Int -> AppendOnlyBoundedCollection Event
forall a. Int -> AppendOnlyBoundedCollection a
emptyAppendOnlyBoundedCollection (Tracer -> Int
tracerEventCountLimit Tracer
t)

              hotRef <-
                newIORef $!
                  SpanHot
                    { hotName = n
                    , hotEnd = NoTimestamp
                    , hotAttributes = initialAttrs
                    , hotLinks = initialLinks
                    , hotEvents = emptyEvts
                    , hotStatus = Unset
                    }
              let !imm =
                    ImmutableSpan
                      { spanContext :: SpanContext
spanContext = SpanContext
ctxtForSpan
                      , spanKind :: SpanKind
spanKind = SpanKind
kind
                      , spanStart :: Timestamp
spanStart = Timestamp
st
                      , spanParent :: Maybe Span
spanParent = Maybe Span
parent
                      , spanTracer :: Tracer
spanTracer = Tracer
t
                      , spanHot :: IORef SpanHot
spanHot = IORef SpanHot
hotRef
                      }
              tracerProviderOnStart tp imm ctxt
                `catch` \(SomeException
err :: SomeException) -> do
                  String -> IO ()
otelLogWarning (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Span processor onStart failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
err
                  IO ReadWriteLogRecord -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ReadWriteLogRecord -> IO ()) -> IO ReadWriteLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ HashMap Text AnyValue
-> SeverityNumber -> Text -> IO ReadWriteLogRecord
forall (m :: * -> *).
MonadIO m =>
HashMap Text AnyValue
-> SeverityNumber -> Text -> m ReadWriteLogRecord
emitOTelLogRecord HashMap Text AnyValue
forall k v. HashMap k v
H.empty SeverityNumber
SeverityNumber.Error (Text -> IO ReadWriteLogRecord) -> Text -> IO ReadWriteLogRecord
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
err
              pure $! Span imm


{- |
Creates source code attributes describing the caller of the current function. You should use this if you are getting
source code attributes from inside a function that is creating a span.

Respects @OTEL_SEMCONV_STABILITY_OPT_IN=code@ to select stable vs legacy attribute names.

Note: this will return nothing if the call stack is frozen.
-}
ownCodeAttributes :: (HasCallStack) => AttributeMap
ownCodeAttributes :: HasCallStack => AttributeMap
ownCodeAttributes =
  let opt :: StabilityOpt
opt = SemanticsOptions -> StabilityOpt
codeOption (SemanticsOptions -> StabilityOpt)
-> SemanticsOptions -> StabilityOpt
forall a b. (a -> b) -> a -> b
$ IO SemanticsOptions -> SemanticsOptions
forall a. IO a -> a
unsafePerformIO IO SemanticsOptions
getSemanticsOptions
  in case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack of
       ((String
"ownCodeAttributes", SrcLoc
ownCodeCalledAt) : (String
ownFunction, SrcLoc
_ownFunctionCalledAt) : [(String, SrcLoc)]
_) ->
         StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
ownFunction SrcLoc
ownCodeCalledAt
       ((String
"ownCodeAttributes", SrcLoc
ownCodeCalledAt) : [(String, SrcLoc)]
_) ->
         StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
"<unknown>" SrcLoc
ownCodeCalledAt
       [(String, SrcLoc)]
_ -> AttributeMap
forall a. Monoid a => a
mempty


{- |
Creates source code attributes describing where the current function is called. You should use this if
you are getting source code attributes from inside a "span creation" function.

Respects @OTEL_SEMCONV_STABILITY_OPT_IN=code@ to select stable vs legacy attribute names.

Note: this will return nothing if the call stack is frozen.
-}
callerAttributes :: (HasCallStack) => AttributeMap
callerAttributes :: HasCallStack => AttributeMap
callerAttributes =
  let opt :: StabilityOpt
opt = SemanticsOptions -> StabilityOpt
codeOption (SemanticsOptions -> StabilityOpt)
-> SemanticsOptions -> StabilityOpt
forall a b. (a -> b) -> a -> b
$ IO SemanticsOptions -> SemanticsOptions
forall a. IO a -> a
unsafePerformIO IO SemanticsOptions
getSemanticsOptions
  in case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack of
       ((String
"callerAttributes", SrcLoc
_callerAttributesCalledAt) : (String
_ownFunction, SrcLoc
ownFunctionCalledAt) : (String
callerFunction, SrcLoc
_) : [(String, SrcLoc)]
_) ->
         StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
callerFunction SrcLoc
ownFunctionCalledAt
       ((String
"callerAttributes", SrcLoc
_callerAttributesCalledAt) : (String
_ownFunction, SrcLoc
ownFunctionCalledAt) : [(String, SrcLoc)]
_) ->
         StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
"<unknown>" SrcLoc
ownFunctionCalledAt
       [(String, SrcLoc)]
_ -> AttributeMap
forall a. Monoid a => a
mempty


codeAttributes :: StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes :: StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
fn SrcLoc
loc = case StabilityOpt
opt of
  StabilityOpt
Stable -> AttributeMap
stableAttrs
  StabilityOpt
StableAndOld -> AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union AttributeMap
stableAttrs AttributeMap
oldAttrs
  StabilityOpt
Old -> AttributeMap
oldAttrs
  where
    modName :: String
modName = SrcLoc -> String
srcLocModule SrcLoc
loc
    qualifiedName :: Text
qualifiedName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
modName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fn
    stableAttrs :: AttributeMap
stableAttrs =
      Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_function_name) (Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Text
qualifiedName) (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
        Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_file_path) (Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcLocFile SrcLoc
loc) (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
          Text -> Attribute -> AttributeMap
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton (AttributeKey Int64 -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Int64
SC.code_line_number) (Int -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Int -> Attribute) -> Int -> Attribute
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartLine SrcLoc
loc)
    oldAttrs :: AttributeMap
oldAttrs =
      Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_function) (Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fn) (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
        Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_namespace) (Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
modName) (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
          Text -> Attribute -> AttributeMap -> AttributeMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_filepath) (Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcLocFile SrcLoc
loc) (AttributeMap -> AttributeMap) -> AttributeMap -> AttributeMap
forall a b. (a -> b) -> a -> b
$!
            Text -> Attribute -> AttributeMap
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton (AttributeKey Int64 -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Int64
SC.code_lineno) (Int -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Int -> Attribute) -> Int -> Attribute
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartLine SrcLoc
loc)
{-# INLINE codeAttributes #-}


{- | Attributes are added to the end of the span argument list, so will be discarded
 if the number of attributes in the span exceeds the limit.
-}
addAttributesToSpanArguments :: AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArguments :: AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArguments AttributeMap
attrs SpanArguments
args = SpanArguments
args {attributes = H.union (attributes args) attrs}


-- | Add the given attributes to the span arguments, but only if *none* of them are present already.
addAttributesToSpanArgumentsIfNonePresent :: AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArgumentsIfNonePresent :: AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArgumentsIfNonePresent AttributeMap
attrs SpanArguments
args
  | AttributeMap -> Bool
forall k v. HashMap k v -> Bool
H.null AttributeMap
attrs = SpanArguments
args
  | AttributeMap -> Bool
forall k v. HashMap k v -> Bool
H.null AttributeMap
existingAttrs = AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArguments AttributeMap
attrs SpanArguments
args
  | Bool
anyOverlap = SpanArguments
args
  | Bool
otherwise = AttributeMap -> SpanArguments -> SpanArguments
addAttributesToSpanArguments AttributeMap
attrs SpanArguments
args
  where
    existingAttrs :: AttributeMap
existingAttrs = SpanArguments -> AttributeMap
attributes SpanArguments
args
    anyOverlap :: Bool
anyOverlap = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`H.member` AttributeMap
existingAttrs) (AttributeMap -> [Text]
forall k v. HashMap k v -> [k]
H.keys AttributeMap
attrs)


hasCodeAttributes :: AttributeMap -> Bool
hasCodeAttributes :: AttributeMap -> Bool
hasCodeAttributes AttributeMap
m =
  Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_function) AttributeMap
m
    Bool -> Bool -> Bool
|| Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_namespace) AttributeMap
m
    Bool -> Bool -> Bool
|| Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_filepath) AttributeMap
m
    Bool -> Bool -> Bool
|| Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_function_name) AttributeMap
m
    Bool -> Bool -> Bool
|| Text -> AttributeMap -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.code_file_path) AttributeMap
m
{-# INLINE hasCodeAttributes #-}


{- | Extract caller source location from a 'CallStack' and build attributes.
Takes the 'CallStack' directly so the thunk captures only the implicit
parameter, deferring all 'T.pack' / 'H.insert' work until forced.

The call stack from @inSpan@ (HasCallStack) looks like:
  (\"inSpan\", call_site) : (caller_of_inSpan, ...) : ...
We want the call_site (where inSpan was called) and the caller function name.
-}
callerCodeAttrs :: StabilityOpt -> CallStack -> AttributeMap
callerCodeAttrs :: StabilityOpt -> CallStack -> AttributeMap
callerCodeAttrs StabilityOpt
opt CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
  ((String
_inSpanFn, SrcLoc
callSite) : (String
callerFn, SrcLoc
_) : [(String, SrcLoc)]
_) ->
    StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
callerFn SrcLoc
callSite
  ((String
_inSpanFn, SrcLoc
callSite) : [(String, SrcLoc)]
_) ->
    StabilityOpt -> String -> SrcLoc -> AttributeMap
codeAttributes StabilityOpt
opt String
"<unknown>" SrcLoc
callSite
  [(String, SrcLoc)]
_ -> AttributeMap
forall k v. HashMap k v
H.empty
{-# INLINE callerCodeAttrs #-}


{- | The simplest function for annotating code with trace information.

 @since 0.0.1.0
-}
inSpan
  :: (MonadUnliftIO m, HasCallStack)
  => Tracer
  -> Text
  -- ^ The name of the span. This may be updated later via 'updateName'
  -> SpanArguments
  {- ^ Additional options for creating the span, such as 'SpanKind',
  span links, starting attributes, etc.
  -}
  -> m a
  {- ^ The action to perform. 'inSpan' will record the time spent on the
  action without forcing strict evaluation of the result. Any uncaught
  exceptions will be recorded and rethrown.
  -}
  -> m a
inSpan :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> m a -> m a
inSpan Tracer
t Text
n SpanArguments
args m a
m =
  let opt :: StabilityOpt
opt = SemanticsOptions -> StabilityOpt
codeOption (SemanticsOptions -> StabilityOpt)
-> SemanticsOptions -> StabilityOpt
forall a b. (a -> b) -> a -> b
$ IO SemanticsOptions -> SemanticsOptions
forall a. IO a -> a
unsafePerformIO IO SemanticsOptions
getSemanticsOptions
      codeAttrs :: AttributeMap
codeAttrs = if AttributeMap -> Bool
hasCodeAttributes (SpanArguments -> AttributeMap
attributes SpanArguments
args) then AttributeMap
forall k v. HashMap k v
H.empty else StabilityOpt -> CallStack -> AttributeMap
callerCodeAttrs StabilityOpt
opt CallStack
HasCallStack => CallStack
callStack
  in Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
inSpanInternal Tracer
t Text
n SpanArguments
args AttributeMap
codeAttrs (m a -> Span -> m a
forall a b. a -> b -> a
const m a
m)
{-# INLINE inSpan #-}


{- | Like 'inSpan', but passes the created 'Span' to the action.

 @since 0.0.1.0
-}
inSpan'
  :: (MonadUnliftIO m, HasCallStack)
  => Tracer
  -> Text
  -- ^ The name of the span. This may be updated later via 'updateName'
  -> SpanArguments
  -> (Span -> m a)
  -> m a
inSpan' :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan' Tracer
t Text
n SpanArguments
args =
  let opt :: StabilityOpt
opt = SemanticsOptions -> StabilityOpt
codeOption (SemanticsOptions -> StabilityOpt)
-> SemanticsOptions -> StabilityOpt
forall a b. (a -> b) -> a -> b
$ IO SemanticsOptions -> SemanticsOptions
forall a. IO a -> a
unsafePerformIO IO SemanticsOptions
getSemanticsOptions
      codeAttrs :: AttributeMap
codeAttrs = if AttributeMap -> Bool
hasCodeAttributes (SpanArguments -> AttributeMap
attributes SpanArguments
args) then AttributeMap
forall k v. HashMap k v
H.empty else StabilityOpt -> CallStack -> AttributeMap
callerCodeAttrs StabilityOpt
opt CallStack
HasCallStack => CallStack
callStack
  in Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
inSpanInternal Tracer
t Text
n SpanArguments
args AttributeMap
codeAttrs
{-# INLINE inSpan' #-}


{- | Like @inSpan@′ (the Haskell name has one ASCII prime), but does not add
 automatic caller source location attributes.

 @since 0.4.0.0
-}
inSpan''
  :: (MonadUnliftIO m, HasCallStack)
  => Tracer
  -> Text
  -- ^ The name of the span. This may be updated later via 'updateName'
  -> SpanArguments
  -> (Span -> m a)
  -> m a
inSpan'' :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan'' Tracer
t Text
n SpanArguments
args = Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
inSpanInternal Tracer
t Text
n SpanArguments
args AttributeMap
forall k v. HashMap k v
H.empty
{-# INLINE inSpan'' #-}


{- | Internal workhorse: takes lazy extra attributes (e.g. callerAttributes)
that are only evaluated when the span is actually recorded.
-}
inSpanInternal
  :: (MonadUnliftIO m)
  => Tracer
  -> Text
  -> SpanArguments
  -> AttributeMap
  -> (Span -> m a)
  -> m a
inSpanInternal :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Tracer
-> Text -> SpanArguments -> AttributeMap -> (Span -> m a) -> m a
inSpanInternal Tracer
t Text
n SpanArguments
args AttributeMap
extraAttrs Span -> m a
f
  | Bool -> Bool
not (TracerProvider -> Bool
tracerProviderHasProcessor (Tracer -> TracerProvider
tracerProvider Tracer
t)) =
      -- Fast path: no processors means every span is Dropped. Skip mask,
      -- context modification, and exception recording entirely. We still
      -- propagate trace ID via a lightweight Dropped span for context
      -- continuity in case a child uses a different (active) tracer.
      IO Span -> m Span
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context
forall (m :: * -> *). MonadIO m => m Context
getContext IO Context -> (Context -> IO Span) -> IO Span
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Context
ctx -> Tracer
-> Context
-> Text
-> SpanArguments
-> AttributeMap
-> Int
-> IO Span
createSpanHelper Tracer
t Context
ctx Text
n SpanArguments
args AttributeMap
extraAttrs (-Int
1)) m Span -> (Span -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Span -> m a
f
  | Bool
otherwise = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
      -- Fused CMM fast path: reads CurrentTSO.id + probes flat table
      -- in a single CMM call. No ThreadId allocation, no FFI, no Maybe.
      -- On steady state this is one CMM call + one readArray#.
      (!tidInt, ctxRef) <- IO (Int, IORef ContextEntry)
ensureContextRefFast
      entry <- readIORef ctxRef
      let ctx = ContextEntry -> Context
ceContext ContextEntry
entry
      s <- createSpanHelper t ctx n args extraAttrs tidInt
      writeIORef ctxRef $! entry {ceContext = insertSpan s ctx}
      -- User code (unmasked via restore)
      a <-
        restore (run $ f s) `EUnsafe.catch` \someEx :: SomeException
someEx@(SomeException e
inner) -> do
          let ExceptionResponse ExceptionClassification
classification AttributeMap
exAttrs = Tracer -> SomeException -> ExceptionResponse
resolveException Tracer
t SomeException
someEx
          case ExceptionClassification
classification of
            ExceptionClassification
ErrorException -> do
              Span -> SpanStatus -> IO ()
forall (m :: * -> *). MonadIO m => Span -> SpanStatus -> m ()
setStatus Span
s (SpanStatus -> IO ()) -> SpanStatus -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SpanStatus
Error (Text -> SpanStatus) -> Text -> SpanStatus
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
inner
              Span -> AttributeMap -> Maybe Timestamp -> e -> IO ()
forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
recordException Span
s (AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union [(AttributeKey Bool -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Bool
SC.exception_escaped, Bool -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Bool
True)] AttributeMap
exAttrs) Maybe Timestamp
forall a. Maybe a
Nothing e
inner
            ExceptionClassification
RecordedException ->
              Span -> AttributeMap -> Maybe Timestamp -> e -> IO ()
forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
recordException Span
s (AttributeMap -> AttributeMap -> AttributeMap
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union [(AttributeKey Bool -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Bool
SC.exception_escaped, Bool -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Bool
True)] AttributeMap
exAttrs) Maybe Timestamp
forall a. Maybe a
Nothing e
inner
            ExceptionClassification
IgnoredException ->
              () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Span -> Maybe Timestamp -> IO ()
forall (m :: * -> *). MonadIO m => Span -> Maybe Timestamp -> m ()
endSpan Span
s Maybe Timestamp
forall a. Maybe a
Nothing
          IORef ContextEntry -> ContextEntry -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ContextEntry
ctxRef ContextEntry
entry
          SomeException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
EUnsafe.throwIO SomeException
someEx
      -- Success cleanup (runs masked; non-blocking, no uninterruptibleMask_ needed)
      endSpan s Nothing
      writeIORef ctxRef entry
      pure a
{-# INLINEABLE inSpanInternal #-}
{-# SPECIALIZE inSpanInternal :: Tracer -> Text -> SpanArguments -> AttributeMap -> (Span -> IO a) -> IO a #-}


{- | Returns whether the @Span@ is currently recording.

A live 'Span' created by this process returns 'True' until 'endSpan' is
called.  A 'FrozenSpan' (non-recording context-only wrapper, e.g. from
'wrapSpanContext') and a 'Dropped' span always return 'False'.

 @since 0.0.1.0
-}
isRecording :: (MonadIO m) => Span -> m Bool
isRecording :: forall (m :: * -> *). MonadIO m => Span -> m Bool
isRecording (Span ImmutableSpan
imm) = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> Bool
not (Bool -> Bool) -> (SpanHot -> Bool) -> SpanHot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionalTimestamp -> Bool
isEnded (OptionalTimestamp -> Bool)
-> (SpanHot -> OptionalTimestamp) -> SpanHot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanHot -> OptionalTimestamp
hotEnd (SpanHot -> Bool) -> IO SpanHot -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef SpanHot -> IO SpanHot
forall a. IORef a -> IO a
readIORef (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm))
isRecording (FrozenSpan SpanContext
_) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isRecording (Dropped SpanContext
_) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
{-# INLINE isRecording #-}


{- | Add an attribute to a span. Only affects recording spans.

See the [OTel attribute naming conventions](https://opentelemetry.io/docs/specs/otel/common/attribute-naming/)
for guidance on choosing attribute names.

@since 0.0.1.0
-}
addAttribute
  :: (MonadIO m, A.ToAttribute a)
  => Span
  -- ^ Span to add the attribute to
  -> Text
  -- ^ Attribute name
  -> a
  -- ^ Attribute value
  -> m ()
addAttribute :: forall (m :: * -> *) a.
(MonadIO m, ToAttribute a) =>
Span -> Text -> a -> m ()
addAttribute (Span ImmutableSpan
imm) Text
k a
v = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
  if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
    then SpanHot
h
    else
      SpanHot
h
        { hotAttributes =
            OpenTelemetry.Attributes.addAttribute
              (tracerSpanAttributeLimits $ spanTracer imm)
              (hotAttributes h)
              k
              v
        }
addAttribute (FrozenSpan SpanContext
_) Text
_ a
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addAttribute (Dropped SpanContext
_) Text
_ a
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE addAttribute #-}


{-# SPECIALIZE OpenTelemetry.Trace.Core.addAttribute :: (A.ToAttribute a) => Span -> Text -> a -> IO () #-}


{- | A convenience function related to 'addAttribute' that adds multiple attributes to a span at the same time.

 This function may be slightly more performant than repeatedly calling 'addAttribute'.

 @since 0.0.1.0
-}
addAttributes :: (MonadIO m) => Span -> H.HashMap Text A.Attribute -> m ()
addAttributes :: forall (m :: * -> *). MonadIO m => Span -> AttributeMap -> m ()
addAttributes (Span ImmutableSpan
imm) AttributeMap
attrs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
  if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
    then SpanHot
h
    else
      SpanHot
h
        { hotAttributes =
            OpenTelemetry.Attributes.addAttributes
              (tracerSpanAttributeLimits $ spanTracer imm)
              (hotAttributes h)
              attrs
        }
addAttributes (FrozenSpan SpanContext
_) AttributeMap
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addAttributes (Dropped SpanContext
_) AttributeMap
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE addAttributes #-}


{-# SPECIALIZE OpenTelemetry.Trace.Core.addAttributes :: Span -> H.HashMap Text A.Attribute -> IO () #-}


{- | Like 'addAttributes', but takes an 'A.AttrsBuilder' instead of a 'HashMap'.
More efficient when setting many attributes at once.

With typed 'AttributeKey's from semantic conventions:

@
'addAttributes'' span $
    SC.http_request_method '.@' method
 <> SC.url_full '.@' url
 <> SC.server_port '.@?' mPort
@

With plain 'Text' keys:

@
'addAttributes'' span $
    'attr' "custom.key" value
 <> 'optAttr' "custom.optional" mValue
@

@since 0.4.1.0
-}
addAttributes' :: (MonadIO m) => Span -> A.AttrsBuilder -> m ()
addAttributes' :: forall (m :: * -> *). MonadIO m => Span -> AttrsBuilder -> m ()
addAttributes' (Span ImmutableSpan
imm) AttrsBuilder
builder = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
  if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
    then SpanHot
h
    else
      SpanHot
h
        { hotAttributes =
            A.addAttributesFromBuilder
              (tracerSpanAttributeLimits $ spanTracer imm)
              (hotAttributes h)
              builder
        }
addAttributes' (FrozenSpan SpanContext
_) AttrsBuilder
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addAttributes' (Dropped SpanContext
_) AttrsBuilder
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE addAttributes' #-}
{-# SPECIALIZE addAttributes' :: Span -> A.AttrsBuilder -> IO () #-}


-- Skip the CAS entirely when there's nothing to add.
{-# RULES
"addAttributes'/mempty" forall s. addAttributes' s mempty = pure ()
"addAttributes/empty" forall s. OpenTelemetry.Trace.Core.addAttributes s H.empty = pure ()
  #-}


{- | Add an event to a recording span. Events will not be recorded for remote spans and dropped spans.

 @since 0.0.1.0
-}
addEvent :: (MonadIO m) => Span -> NewEvent -> m ()
addEvent :: forall (m :: * -> *). MonadIO m => Span -> NewEvent -> m ()
addEvent (Span ImmutableSpan
imm) NewEvent {Maybe Timestamp
Text
AttributeMap
newEventName :: Text
newEventAttributes :: AttributeMap
newEventTimestamp :: Maybe Timestamp
newEventAttributes :: NewEvent -> AttributeMap
newEventName :: NewEvent -> Text
newEventTimestamp :: NewEvent -> Maybe Timestamp
..} = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  t <- IO Timestamp
-> (Timestamp -> IO Timestamp) -> Maybe Timestamp -> IO Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Timestamp
getTimestampIO Timestamp -> IO Timestamp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Timestamp
newEventTimestamp
  casModifyIORef_ (spanHot imm) $ \(!SpanHot
h) ->
    if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
      then SpanHot
h
      else
        SpanHot
h
          { hotEvents =
              appendToBoundedCollection (hotEvents h) $
                Event
                  { eventName = newEventName
                  , eventAttributes =
                      A.addAttributes
                        (tracerEventAttributeLimits $ spanTracer imm)
                        emptyAttributes
                        newEventAttributes
                  , eventTimestamp = t
                  }
          }
addEvent (FrozenSpan SpanContext
_) NewEvent
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addEvent (Dropped SpanContext
_) NewEvent
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE addEvent #-}
{-# SPECIALIZE addEvent :: Span -> NewEvent -> IO () #-}


{- | Construct a 'NewEvent' with just a name (no attributes, current timestamp).

@
addEvent span (newEvent "cache-miss")
@

@since 0.4.1.0
-}
newEvent :: Text -> NewEvent
newEvent :: Text -> NewEvent
newEvent Text
name = NewEvent {newEventName :: Text
newEventName = Text
name, newEventAttributes :: AttributeMap
newEventAttributes = AttributeMap
forall k v. HashMap k v
H.empty, newEventTimestamp :: Maybe Timestamp
newEventTimestamp = Maybe Timestamp
forall a. Maybe a
Nothing}
{-# INLINE newEvent #-}


{- | Construct a 'NewEvent' with a name and attributes (current timestamp).

@
addEvent span (newEventWith "retry" [("attempt", toAttribute retryCount)])
@

@since 0.4.1.0
-}
newEventWith :: Text -> AttributeMap -> NewEvent
newEventWith :: Text -> AttributeMap -> NewEvent
newEventWith Text
name AttributeMap
attrs = NewEvent {newEventName :: Text
newEventName = Text
name, newEventAttributes :: AttributeMap
newEventAttributes = AttributeMap
attrs, newEventTimestamp :: Maybe Timestamp
newEventTimestamp = Maybe Timestamp
forall a. Maybe a
Nothing}
{-# INLINE newEventWith #-}


{- | Add a link to a recording span.

@since 0.0.1.0
-}
addLink :: (MonadIO m) => Span -> NewLink -> m ()
addLink :: forall (m :: * -> *). MonadIO m => Span -> NewLink -> m ()
addLink (Span ImmutableSpan
imm) NewLink
l = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
    if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
      then SpanHot
h
      else SpanHot
h {hotLinks = appendToBoundedCollection (hotLinks h) (freezeLink (spanTracer imm) l)}
addLink (FrozenSpan SpanContext
_) NewLink
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
addLink (Dropped SpanContext
_) NewLink
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE addLink #-}
{-# SPECIALIZE addLink :: Span -> NewLink -> IO () #-}


freezeLink :: Tracer -> NewLink -> Link
freezeLink :: Tracer -> NewLink -> Link
freezeLink Tracer
t NewLink {AttributeMap
SpanContext
linkContext :: SpanContext
linkAttributes :: AttributeMap
linkAttributes :: NewLink -> AttributeMap
linkContext :: NewLink -> SpanContext
..} =
  Link
    { frozenLinkContext :: SpanContext
frozenLinkContext = SpanContext
linkContext
    , frozenLinkAttributes :: Attributes
frozenLinkAttributes = AttributeLimits -> Attributes -> AttributeMap -> Attributes
forall a.
ToAttribute a =>
AttributeLimits -> Attributes -> HashMap Text a -> Attributes
A.addAttributes (Tracer -> AttributeLimits
tracerLinkAttributeLimits Tracer
t) Attributes
A.emptyAttributes AttributeMap
linkAttributes
    }


{- | Sets the Status of the Span. If used, this will override the default @Span@ status, which is @Unset@.

 These values form a total order: Ok > Error > Unset. This means that setting Status with StatusCode=Ok will override any prior or future attempts to set span Status with StatusCode=Error or StatusCode=Unset.

 @since 0.0.1.0
-}
setStatus :: (MonadIO m) => Span -> SpanStatus -> m ()
setStatus :: forall (m :: * -> *). MonadIO m => Span -> SpanStatus -> m ()
setStatus (Span ImmutableSpan
imm) SpanStatus
st = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
  if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
    then SpanHot
h
    else SpanHot
h {hotStatus = mergeStatus st (hotStatus h)}
setStatus (FrozenSpan SpanContext
_) SpanStatus
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
setStatus (Dropped SpanContext
_) SpanStatus
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE setStatus #-}
{-# SPECIALIZE setStatus :: Span -> SpanStatus -> IO () #-}


{- | Merge a new status into the existing status per the OTel spec.

The spec defines a total order: @Ok > Error > Unset@. Setting @Ok@
overrides any prior status. Setting @Error@ overrides @Unset@ but not
@Ok@. Setting @Unset@ is always a no-op.

@since 0.0.1.0
-}
mergeStatus :: SpanStatus -> SpanStatus -> SpanStatus
mergeStatus :: SpanStatus -> SpanStatus -> SpanStatus
mergeStatus SpanStatus
_ SpanStatus
Ok = SpanStatus
Ok
mergeStatus SpanStatus
Ok SpanStatus
_ = SpanStatus
Ok
mergeStatus SpanStatus
new SpanStatus
Unset = SpanStatus
new
mergeStatus SpanStatus
_new SpanStatus
current = SpanStatus
current


{- |
Updates the Span name. Upon this update, any sampling behavior based on Span name will depend on the implementation.

Note that @Sampler@s can only consider information already present during span creation. Any changes done later, including updated span name, cannot change their decisions.

Alternatives for the name update may be late Span creation, when Span is started with the explicit timestamp from the past at the moment where the final Span name is known, or reporting a Span with the desired name as a child Span.

@since 0.0.1.0
-}
updateName
  :: (MonadIO m)
  => Span
  -> Text
  -- ^ The new span name, which supersedes whatever was passed in when the Span was started
  -> m ()
updateName :: forall (m :: * -> *). MonadIO m => Span -> Text -> m ()
updateName (Span ImmutableSpan
imm) Text
n = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> (SpanHot -> SpanHot) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
casModifyIORef_ (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm) ((SpanHot -> SpanHot) -> IO ()) -> (SpanHot -> SpanHot) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(!SpanHot
h) ->
  if OptionalTimestamp -> Bool
isEnded (SpanHot -> OptionalTimestamp
hotEnd SpanHot
h)
    then SpanHot
h
    else SpanHot
h {hotName = n}
updateName (FrozenSpan SpanContext
_) Text
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
updateName (Dropped SpanContext
_) Text
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE updateName #-}
{-# SPECIALIZE updateName :: Span -> Text -> IO () #-}


{- |
Signals that the operation described by this span has now (or at the time optionally specified) ended.

This does have any effects on child spans. Those may still be running and can be ended later.

This also does not inactivate the Span in any Context it is active in. It is still possible to use an ended span as
parent via a Context it is contained in. Also, putting the Span into a Context will still work after the Span was ended.

@since 0.0.1.0
-}
endSpan
  :: (MonadIO m)
  => Span
  -> Maybe Timestamp
  -- ^ Optional @Timestamp@ signalling the end time of the span. If not provided, the current time will be used.
  -> m ()
endSpan :: forall (m :: * -> *). MonadIO m => Span -> Maybe Timestamp -> m ()
endSpan (Span ImmutableSpan
imm) Maybe Timestamp
mts = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  ts <- IO Timestamp
-> (Timestamp -> IO Timestamp) -> Maybe Timestamp -> IO Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Timestamp
getTimestampIO Timestamp -> IO Timestamp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Timestamp
mts
  let !optTs = Timestamp -> OptionalTimestamp
timestampToOptional Timestamp
ts
  old <- casReadModifyIORef_ (spanHot imm) $ \(!SpanHot
h) ->
    case SpanHot -> OptionalTimestamp
hotEnd SpanHot
h of
      SomeTimestamp Word64
_ -> SpanHot
h
      OptionalTimestamp
NoTimestamp -> SpanHot
h {hotEnd = optTs}
  case hotEnd old of
    SomeTimestamp Word64
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    OptionalTimestamp
NoTimestamp -> do
      let !spanName :: Text
spanName = SpanHot -> Text
hotName SpanHot
old
          !droppedAttributeCount :: Int
droppedAttributeCount =
            Attributes -> Int
A.getDropped (SpanHot -> Attributes
hotAttributes SpanHot
old)
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Event -> Int) -> Int -> Vector Event -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Int
acc Event
e -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Attributes -> Int
A.getDropped (Event -> Attributes
eventAttributes Event
e)) Int
0 (AppendOnlyBoundedCollection Event -> Vector Event
forall a. AppendOnlyBoundedCollection a -> Vector a
appendOnlyBoundedCollectionValues (SpanHot -> AppendOnlyBoundedCollection Event
hotEvents SpanHot
old))
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Link -> Int) -> Int -> Vector Link -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Int
acc Link
l -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Attributes -> Int
A.getDropped (Link -> Attributes
frozenLinkAttributes Link
l)) Int
0 (AppendOnlyBoundedCollection Link -> Vector Link
forall a. AppendOnlyBoundedCollection a -> Vector a
appendOnlyBoundedCollectionValues (SpanHot -> AppendOnlyBoundedCollection Link
hotLinks SpanHot
old))
          !droppedEventsCount :: Int
droppedEventsCount = AppendOnlyBoundedCollection Event -> Int
forall a. AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionDroppedElementCount (SpanHot -> AppendOnlyBoundedCollection Event
hotEvents SpanHot
old)
          !droppedLinksCount :: Int
droppedLinksCount = AppendOnlyBoundedCollection Link -> Int
forall a. AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionDroppedElementCount (SpanHot -> AppendOnlyBoundedCollection Link
hotLinks SpanHot
old)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
droppedAttributeCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
droppedEventsCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Int
droppedLinksCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
otelLogWarning (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String
"Span '"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
spanName
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' dropped data due to limits: "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
droppedAttributeCount
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" attribute(s), "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
droppedEventsCount
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" event(s), "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
droppedLinksCount
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" link(s)"
      TracerProvider -> ImmutableSpan -> IO ()
tracerProviderOnEnd (Tracer -> TracerProvider
tracerProvider (ImmutableSpan -> Tracer
spanTracer ImmutableSpan
imm)) ImmutableSpan
imm
        IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
ex :: SomeException) -> String -> IO ()
otelLogWarning (String
"Span processor onEnd failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
ex)
endSpan (FrozenSpan SpanContext
_) Maybe Timestamp
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
endSpan (Dropped SpanContext
_) Maybe Timestamp
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINEABLE endSpan #-}
{-# SPECIALIZE endSpan :: Span -> Maybe Timestamp -> IO () #-}


{- | A specialized variant of @addEvent@ that records attributes conforming to
 the OpenTelemetry specification's
 <https://github.com/open-telemetry/opentelemetry-specification/blob/49c2f56f3c0468ceb2b69518bcadadd96e0a5a8b/specification/trace/semantic_conventions/exceptions.md semantic conventions>

 @since 0.0.1.0
-}
recordException :: (MonadIO m, Exception e) => Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
recordException :: forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
recordException Span
s AttributeMap
attrs Maybe Timestamp
ts e
e = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  cs <- e -> IO [String]
forall a. a -> IO [String]
whoCreated e
e
  let message = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
e
  addEvent s $
    NewEvent
      { newEventName = "exception"
      , newEventAttributes =
          H.union
            attrs
            [ (unkey SC.exception_type, A.toAttribute $ T.pack $ show $ typeOf e)
            , (unkey SC.exception_message, A.toAttribute message)
            , (unkey SC.exception_stacktrace, A.toAttribute $ T.unlines $ map T.pack cs)
            ]
      , newEventTimestamp = ts
      }
{-# INLINEABLE recordException #-}
{-# SPECIALIZE recordException :: (Exception e) => Span -> AttributeMap -> Maybe Timestamp -> e -> IO () #-}


{- | Record an error and set the span status in one call.

Combines 'setStatus' with 'Error' and 'recordException'. This is a common
pattern when handling errors outside of 'inSpan' (which does this
automatically for uncaught exceptions).

@
case result of
  Left err -> recordError span err
  Right _  -> setStatus span Ok
@

@since 0.4.1.0
-}
recordError :: (MonadIO m, Exception e) => Span -> e -> m ()
recordError :: forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> e -> m ()
recordError Span
s e
e = do
  Span -> SpanStatus -> m ()
forall (m :: * -> *). MonadIO m => Span -> SpanStatus -> m ()
setStatus Span
s (SpanStatus -> m ()) -> SpanStatus -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> SpanStatus
Error (Text -> SpanStatus) -> Text -> SpanStatus
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
e
  Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
forall (m :: * -> *) e.
(MonadIO m, Exception e) =>
Span -> AttributeMap -> Maybe Timestamp -> e -> m ()
recordException Span
s AttributeMap
forall k v. HashMap k v
H.empty Maybe Timestamp
forall a. Maybe a
Nothing e
e
{-# INLINE recordError #-}


{- | Returns @True@ if the @SpanContext@ has a non-zero @TraceID@ and a non-zero @SpanID@.
Spec: "true if the SpanContext has a non-zero TraceID and a non-zero SpanID".

 @since 0.0.1.0
-}
isValid :: SpanContext -> Bool
isValid :: SpanContext -> Bool
isValid SpanContext
sc =
  Bool -> Bool
not (TraceId -> Bool
isEmptyTraceId (SpanContext -> TraceId
traceId SpanContext
sc)) Bool -> Bool -> Bool
&& Bool -> Bool
not (SpanId -> Bool
isEmptySpanId (SpanContext -> SpanId
spanId SpanContext
sc))


{- |
Returns @True@ if the @SpanContext@ was propagated from a remote parent,

When extracting a SpanContext through the Propagators API, isRemote MUST return @True@,
whereas for the SpanContext of any child spans it MUST return @False@.

 @since 0.0.1.0
-}
spanIsRemote :: (MonadIO m) => Span -> m Bool
spanIsRemote :: forall (m :: * -> *). MonadIO m => Span -> m Bool
spanIsRemote (Span ImmutableSpan
imm) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ SpanContext -> Bool
Types.isRemote (SpanContext -> Bool) -> SpanContext -> Bool
forall a b. (a -> b) -> a -> b
$ ImmutableSpan -> SpanContext
Types.spanContext ImmutableSpan
imm
spanIsRemote (FrozenSpan SpanContext
c) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ SpanContext -> Bool
Types.isRemote SpanContext
c
spanIsRemote (Dropped SpanContext
_) = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


{- | Really only intended for tests, this function does not conform
 to semantic versioning .

 @since 0.0.1.0
-}
unsafeReadSpan :: (MonadIO m) => Span -> m ImmutableSpan
unsafeReadSpan :: forall (m :: * -> *). MonadIO m => Span -> m ImmutableSpan
unsafeReadSpan Span
s =
  Span -> m (Either FrozenOrDropped ImmutableSpan)
forall (m :: * -> *).
MonadIO m =>
Span -> m (Either FrozenOrDropped ImmutableSpan)
toImmutableSpan Span
s m (Either FrozenOrDropped ImmutableSpan)
-> (Either FrozenOrDropped ImmutableSpan -> m ImmutableSpan)
-> m ImmutableSpan
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right ImmutableSpan
span -> ImmutableSpan -> m ImmutableSpan
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImmutableSpan
span
    Left FrozenOrDropped
frozenOrDropped -> case FrozenOrDropped
frozenOrDropped of
      FrozenOrDropped
SpanFrozen -> String -> m ImmutableSpan
forall a. HasCallStack => String -> a
error String
"This span is from another process"
      FrozenOrDropped
SpanDropped -> String -> m ImmutableSpan
forall a. HasCallStack => String -> a
error String
"This span was dropped"


{- | Wrap a 'SpanContext' as a non-recording 'Span' ('FrozenSpan').

@since 0.0.1.0
-}
wrapSpanContext :: SpanContext -> Span
wrapSpanContext :: SpanContext -> Span
wrapSpanContext = SpanContext -> Span
FrozenSpan


{- | Construct a non-recording parent span representing a dropped (not sampled) trace,
e.g. for tests or when continuing a trace whose parent was not recorded.

@since 0.4.0.0
-}
wrapDroppedContext :: SpanContext -> Span
wrapDroppedContext :: SpanContext -> Span
wrapDroppedContext = SpanContext -> Span
Dropped


{- | This can be useful for pulling data for attributes and
 using it to copy / otherwise use the data to further enrich
 instrumentation.

 @since 0.0.1.0
-}
spanGetAttributes :: (MonadIO m) => Span -> m A.Attributes
spanGetAttributes :: forall (m :: * -> *). MonadIO m => Span -> m Attributes
spanGetAttributes = \case
  Span ImmutableSpan
imm -> IO Attributes -> m Attributes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Attributes -> m Attributes) -> IO Attributes -> m Attributes
forall a b. (a -> b) -> a -> b
$ SpanHot -> Attributes
hotAttributes (SpanHot -> Attributes) -> IO SpanHot -> IO Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef SpanHot -> IO SpanHot
forall a. IORef a -> IO a
readIORef (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm)
  FrozenSpan SpanContext
_ -> Attributes -> m Attributes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attributes
A.emptyAttributes
  Dropped SpanContext
_ -> Attributes -> m Attributes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attributes
A.emptyAttributes


{- | Sometimes, you may have a more accurate notion of when a traced
 operation has ended. In this case you may call 'getTimestamp', and then
 supply 'endSpan' with the more accurate timestamp you have acquired.

 When using the monadic interface, (such as 'OpenTelemetry.Trace.Monad.inSpan', you may call
 'endSpan' early to record the information, and the first call to 'endSpan' will be honored.

 @since 0.0.1.0
-}
getTimestamp :: (MonadIO m) => m Timestamp
getTimestamp :: forall (m :: * -> *). MonadIO m => m Timestamp
getTimestamp = IO Timestamp -> m Timestamp
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Timestamp
getTimestampIO
{-# INLINE getTimestamp #-}


foreign import ccall unsafe "hs_otel_gettime_ns"
  getTimestampIO :: IO Timestamp


globalTracer :: IORef TracerProvider
globalTracer :: IORef TracerProvider
globalTracer = IO (IORef TracerProvider) -> IORef TracerProvider
forall a. IO a -> a
unsafePerformIO (IO (IORef TracerProvider) -> IORef TracerProvider)
-> IO (IORef TracerProvider) -> IORef TracerProvider
forall a b. (a -> b) -> a -> b
$ do
  p <-
    [SpanProcessor] -> TracerProviderOptions -> IO TracerProvider
forall (m :: * -> *).
MonadIO m =>
[SpanProcessor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider
      []
      TracerProviderOptions
emptyTracerProviderOptions
  newIORef p
{-# NOINLINE globalTracer #-}


{- | Options used when creating a 'TracerProvider'.

@since 0.0.1.0
-}
data TracerProviderOptions = TracerProviderOptions
  { TracerProviderOptions -> IdGenerator
tracerProviderOptionsIdGenerator :: IdGenerator
  , TracerProviderOptions -> Sampler
tracerProviderOptionsSampler :: Sampler
  , TracerProviderOptions -> MaterializedResources
tracerProviderOptionsResources :: MaterializedResources
  , TracerProviderOptions -> AttributeLimits
tracerProviderOptionsAttributeLimits :: AttributeLimits
  , TracerProviderOptions -> SpanLimits
tracerProviderOptionsSpanLimits :: SpanLimits
  , TracerProviderOptions -> TextMapPropagator
tracerProviderOptionsPropagators :: TextMapPropagator
  , TracerProviderOptions -> [ExceptionHandler]
tracerProviderOptionsExceptionHandlers :: [ExceptionHandler]
  {- ^ Exception handlers consulted (after any tracer-level handlers) when
  'inSpan' catches an exception. Defaults to @[]@ (all exceptions are errors).

  @since 0.4.0.0
  -}
  }


{- | Options for creating a 'TracerProvider' with invalid ids, no resources, default limits, and no propagators.

 In effect, tracing is a no-op when using this configuration.

 @since 0.0.1.0
-}
emptyTracerProviderOptions :: TracerProviderOptions
emptyTracerProviderOptions :: TracerProviderOptions
emptyTracerProviderOptions =
  TracerProviderOptions
    { tracerProviderOptionsIdGenerator :: IdGenerator
tracerProviderOptionsIdGenerator = IdGenerator
dummyIdGenerator
    , tracerProviderOptionsSampler :: Sampler
tracerProviderOptionsSampler = ParentBasedOptions -> Sampler
parentBased (ParentBasedOptions -> Sampler) -> ParentBasedOptions -> Sampler
forall a b. (a -> b) -> a -> b
$ Sampler -> ParentBasedOptions
parentBasedOptions Sampler
alwaysOn
    , tracerProviderOptionsResources :: MaterializedResources
tracerProviderOptionsResources = MaterializedResources
emptyMaterializedResources
    , tracerProviderOptionsAttributeLimits :: AttributeLimits
tracerProviderOptionsAttributeLimits = AttributeLimits
defaultAttributeLimits
    , tracerProviderOptionsSpanLimits :: SpanLimits
tracerProviderOptionsSpanLimits = SpanLimits
defaultSpanLimits
    , tracerProviderOptionsPropagators :: TextMapPropagator
tracerProviderOptionsPropagators = TextMapPropagator
forall a. Monoid a => a
mempty
    , tracerProviderOptionsExceptionHandlers :: [ExceptionHandler]
tracerProviderOptionsExceptionHandlers = []
    }


{- | Initialize a new tracer provider

 You should generally use 'getGlobalTracerProvider' for most applications.

 @since 0.0.1.0
-}
createTracerProvider :: (MonadIO m) => [SpanProcessor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider :: forall (m :: * -> *).
MonadIO m =>
[SpanProcessor] -> TracerProviderOptions -> m TracerProvider
createTracerProvider [SpanProcessor]
ps TracerProviderOptions
opts = IO TracerProvider -> m TracerProvider
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TracerProvider -> m TracerProvider)
-> IO TracerProvider -> m TracerProvider
forall a b. (a -> b) -> a -> b
$ do
  let g :: IdGenerator
g = TracerProviderOptions -> IdGenerator
tracerProviderOptionsIdGenerator TracerProviderOptions
opts
      !procsVec :: Vector SpanProcessor
procsVec = [SpanProcessor] -> Vector SpanProcessor
forall a. [a] -> Vector a
V.fromList [SpanProcessor]
ps
      !hasProc :: Bool
hasProc = Bool -> Bool
not (Vector SpanProcessor -> Bool
forall a. Vector a -> Bool
V.null Vector SpanProcessor
procsVec)
      !onStart :: ImmutableSpan -> Context -> IO ()
onStart = case Vector SpanProcessor -> Int
forall a. Vector a -> Int
V.length Vector SpanProcessor
procsVec of
        Int
0 -> \ImmutableSpan
_ Context
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Int
1 -> SpanProcessor -> ImmutableSpan -> Context -> IO ()
spanProcessorOnStart (Vector SpanProcessor -> SpanProcessor
forall a. Vector a -> a
V.unsafeHead Vector SpanProcessor
procsVec)
        Int
_ -> \ImmutableSpan
imm Context
ctx -> (SpanProcessor -> IO ()) -> Vector SpanProcessor -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (\SpanProcessor
p -> SpanProcessor -> ImmutableSpan -> Context -> IO ()
spanProcessorOnStart SpanProcessor
p ImmutableSpan
imm Context
ctx) Vector SpanProcessor
procsVec
      !onEnd :: ImmutableSpan -> IO ()
onEnd = case Vector SpanProcessor -> Int
forall a. Vector a -> Int
V.length Vector SpanProcessor
procsVec of
        Int
0 -> \ImmutableSpan
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Int
1 -> SpanProcessor -> ImmutableSpan -> IO ()
spanProcessorOnEnd (Vector SpanProcessor -> SpanProcessor
forall a. Vector a -> a
V.unsafeHead Vector SpanProcessor
procsVec)
        Int
_ -> \ImmutableSpan
imm -> (SpanProcessor -> IO ()) -> Vector SpanProcessor -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (\SpanProcessor
p -> SpanProcessor -> ImmutableSpan -> IO ()
spanProcessorOnEnd SpanProcessor
p ImmutableSpan
imm) Vector SpanProcessor
procsVec
  shutRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  cacheRef <- newIORef H.empty
  pure $
    TracerProvider
      { tracerProviderOnStart = onStart
      , tracerProviderOnEnd = onEnd
      , tracerProviderProcessors = procsVec
      , tracerProviderHasProcessor = hasProc
      , tracerProviderIdGenerator = g
      , tracerProviderSampler = tracerProviderOptionsSampler opts
      , tracerProviderResources = tracerProviderOptionsResources opts
      , tracerProviderAttributeLimits = tracerProviderOptionsAttributeLimits opts
      , tracerProviderSpanLimits = tracerProviderOptionsSpanLimits opts
      , tracerProviderPropagators = tracerProviderOptionsPropagators opts
      , tracerProviderExceptionHandlers = tracerProviderOptionsExceptionHandlers opts
      , tracerProviderIsShutdown = shutRef
      , tracerProviderTracerCache = cacheRef
      }


{- | Access the globally configured 'TracerProvider'. Once the
 the global tracer provider is initialized via the OpenTelemetry SDK,
 'Tracer's created from this 'TracerProvider' will export spans to their
 configured exporters. Prior to that, any 'Tracer's acquired from the
 uninitialized 'TracerProvider' will create no-op spans.

 @since 0.0.1.0
-}
getGlobalTracerProvider :: (MonadIO m) => m TracerProvider
getGlobalTracerProvider :: forall (m :: * -> *). MonadIO m => m TracerProvider
getGlobalTracerProvider = IO TracerProvider -> m TracerProvider
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TracerProvider -> m TracerProvider)
-> IO TracerProvider -> m TracerProvider
forall a b. (a -> b) -> a -> b
$ IORef TracerProvider -> IO TracerProvider
forall a. IORef a -> IO a
readIORef IORef TracerProvider
globalTracer


{- | Overwrite the globally configured 'TracerProvider'.

 'Tracer's acquired from the previously installed 'TracerProvider'
 will continue to use that 'TracerProvider's configured span processors,
 exporters, and other settings.

 @since 0.0.1.0
-}
setGlobalTracerProvider :: (MonadIO m) => TracerProvider -> m ()
setGlobalTracerProvider :: forall (m :: * -> *). MonadIO m => TracerProvider -> m ()
setGlobalTracerProvider = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (TracerProvider -> IO ()) -> TracerProvider -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef TracerProvider -> TracerProvider -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef TracerProvider
globalTracer


-- | @since 0.0.1.0
getTracerProviderResources :: TracerProvider -> MaterializedResources
getTracerProviderResources :: TracerProvider -> MaterializedResources
getTracerProviderResources = TracerProvider -> MaterializedResources
tracerProviderResources


-- | @since 0.0.1.0
getTracerProviderPropagators :: TracerProvider -> TextMapPropagator
getTracerProviderPropagators :: TracerProvider -> TextMapPropagator
getTracerProviderPropagators = TracerProvider -> TextMapPropagator
tracerProviderPropagators


{- | Tracer configuration options.

@since 0.0.1.0
-}
data TracerOptions = TracerOptions
  { TracerOptions -> Maybe Text
tracerSchema :: Maybe Text
  {- ^ OpenTelemetry provides a schema for describing common attributes so that backends can easily parse and identify relevant information.
  It is important to understand these conventions when writing instrumentation, in order to normalize your data and increase its utility.

  In particular, this option is valuable to set when possible, because it allows vendors to normalize data accross releases in order to account
  for attribute name changes.
  -}
  , TracerOptions -> [ExceptionHandler]
tracerExceptionHandlerOptions :: [ExceptionHandler]
  {- ^ Exception handlers specific to this tracer, consulted before
  provider-level handlers. Defaults to @[]@.

  @since 0.4.0.0
  -}
  }


{- | Default Tracer options

@since 0.0.1.0
-}
tracerOptions :: TracerOptions
tracerOptions :: TracerOptions
tracerOptions = Maybe Text -> [ExceptionHandler] -> TracerOptions
TracerOptions Maybe Text
forall a. Maybe a
Nothing []


{- | A small utility lens for extracting a 'Tracer' from a larger data type

 This will generally be most useful as a means of implementing 'OpenTelemetry.Trace.Monad.getTracer'

 @since 0.0.1.0
-}
class HasTracer s where
  tracerL :: Lens' s Tracer


{- | Construct a 'Tracer' from a provider, library, and options.

Prefer a non-empty 'libraryName' per the OpenTelemetry specification; use 'getTracer'
if you want a warning when the name is empty.

@since 0.0.1.0
-}
makeTracer :: TracerProvider -> InstrumentationLibrary -> TracerOptions -> Tracer
makeTracer :: TracerProvider -> InstrumentationLibrary -> TracerOptions -> Tracer
makeTracer TracerProvider
tp InstrumentationLibrary
n TracerOptions
opts =
  let n' :: InstrumentationLibrary
n' = case TracerOptions -> Maybe Text
tracerSchema TracerOptions
opts of
        Maybe Text
Nothing -> InstrumentationLibrary
n
        Just Text
s -> InstrumentationLibrary
n {librarySchemaUrl = s}
      resolveLimits :: (SpanLimits -> Maybe Int) -> AttributeLimits
resolveLimits SpanLimits -> Maybe Int
countF =
        AttributeLimits
          { attributeCountLimit :: Maybe Int
attributeCountLimit =
              SpanLimits -> Maybe Int
countF (TracerProvider -> SpanLimits
tracerProviderSpanLimits TracerProvider
tp)
                Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AttributeLimits -> Maybe Int
attributeCountLimit (TracerProvider -> AttributeLimits
tracerProviderAttributeLimits TracerProvider
tp)
          , attributeLengthLimit :: Maybe Int
attributeLengthLimit =
              SpanLimits -> Maybe Int
spanAttributeValueLengthLimit (TracerProvider -> SpanLimits
tracerProviderSpanLimits TracerProvider
tp)
                Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AttributeLimits -> Maybe Int
attributeLengthLimit (TracerProvider -> AttributeLimits
tracerProviderAttributeLimits TracerProvider
tp)
          }
      !sl :: SpanLimits
sl = TracerProvider -> SpanLimits
tracerProviderSpanLimits TracerProvider
tp
  in Tracer
       { tracerName :: InstrumentationLibrary
tracerName = InstrumentationLibrary
n'
       , tracerProvider :: TracerProvider
tracerProvider = TracerProvider
tp
       , tracerExceptionHandlers :: [ExceptionHandler]
tracerExceptionHandlers = TracerOptions -> [ExceptionHandler]
tracerExceptionHandlerOptions TracerOptions
opts
       , tracerSpanAttributeLimits :: AttributeLimits
tracerSpanAttributeLimits = (SpanLimits -> Maybe Int) -> AttributeLimits
resolveLimits SpanLimits -> Maybe Int
spanAttributeCountLimit
       , tracerEventAttributeLimits :: AttributeLimits
tracerEventAttributeLimits = (SpanLimits -> Maybe Int) -> AttributeLimits
resolveLimits SpanLimits -> Maybe Int
eventAttributeCountLimit
       , tracerLinkAttributeLimits :: AttributeLimits
tracerLinkAttributeLimits = (SpanLimits -> Maybe Int) -> AttributeLimits
resolveLimits SpanLimits -> Maybe Int
linkAttributeCountLimit
       , tracerEventCountLimit :: Int
tracerEventCountLimit = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
128 (SpanLimits -> Maybe Int
eventCountLimit SpanLimits
sl)
       , tracerLinkCountLimit :: Int
tracerLinkCountLimit = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
128 (SpanLimits -> Maybe Int
linkCountLimit SpanLimits
sl)
       }


{- | Like 'makeTracer' but caches by 'InstrumentationLibrary', so repeated
calls with the same scope return the same 'Tracer' instance.
Spec: implementations SHOULD return a single Tracer per InstrumentationScope.

@since 0.0.1.0
-}
getTracer :: (MonadIO m) => TracerProvider -> InstrumentationLibrary -> TracerOptions -> m Tracer
getTracer :: forall (m :: * -> *).
MonadIO m =>
TracerProvider
-> InstrumentationLibrary -> TracerOptions -> m Tracer
getTracer TracerProvider
tp InstrumentationLibrary
n TracerOptions
opts = IO Tracer -> m Tracer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Tracer -> m Tracer) -> IO Tracer -> m Tracer
forall a b. (a -> b) -> a -> b
$ do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null (InstrumentationLibrary -> Text
libraryName InstrumentationLibrary
n)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
otelLogWarning String
"Tracer created with empty name; returning working Tracer with empty name per spec"
  let !t :: Tracer
t = TracerProvider -> InstrumentationLibrary -> TracerOptions -> Tracer
makeTracer TracerProvider
tp InstrumentationLibrary
n TracerOptions
opts
      !key :: InstrumentationLibrary
key = Tracer -> InstrumentationLibrary
tracerName Tracer
t
  IORef (HashMap InstrumentationLibrary Tracer)
-> (HashMap InstrumentationLibrary Tracer
    -> (HashMap InstrumentationLibrary Tracer, Tracer))
-> IO Tracer
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (TracerProvider -> IORef (HashMap InstrumentationLibrary Tracer)
tracerProviderTracerCache TracerProvider
tp) ((HashMap InstrumentationLibrary Tracer
  -> (HashMap InstrumentationLibrary Tracer, Tracer))
 -> IO Tracer)
-> (HashMap InstrumentationLibrary Tracer
    -> (HashMap InstrumentationLibrary Tracer, Tracer))
-> IO Tracer
forall a b. (a -> b) -> a -> b
$ \HashMap InstrumentationLibrary Tracer
cache ->
    case InstrumentationLibrary
-> HashMap InstrumentationLibrary Tracer -> Maybe Tracer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup InstrumentationLibrary
key HashMap InstrumentationLibrary Tracer
cache of
      Just Tracer
cached -> (HashMap InstrumentationLibrary Tracer
cache, Tracer
cached)
      Maybe Tracer
Nothing -> (InstrumentationLibrary
-> Tracer
-> HashMap InstrumentationLibrary Tracer
-> HashMap InstrumentationLibrary Tracer
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert InstrumentationLibrary
key Tracer
t HashMap InstrumentationLibrary Tracer
cache, Tracer
t)


-- | @since 0.0.1.0
getImmutableSpanTracer :: ImmutableSpan -> Tracer
getImmutableSpanTracer :: ImmutableSpan -> Tracer
getImmutableSpanTracer = ImmutableSpan -> Tracer
spanTracer


-- | @since 0.0.1.0
getTracerTracerProvider :: Tracer -> TracerProvider
getTracerTracerProvider :: Tracer -> TracerProvider
getTracerTracerProvider = Tracer -> TracerProvider
tracerProvider


{- | Check if the 'Tracer' is enabled.

 This function helps users avoid performing computationally expensive operations
 when creating 'Span's if the tracer is not enabled.

 A 'Tracer' is considered enabled if it has at least one configured processor.
 If the 'TracerProvider' has no processors, all spans will be dropped, so the
 tracer is disabled.

 Callers SHOULD invoke this before each span creation to get the most up-to-date
 response, as the result may change over time.

 @since 0.3.1.0
-}
tracerIsEnabled :: Tracer -> Bool
tracerIsEnabled :: Tracer -> Bool
tracerIsEnabled Tracer
t = TracerProvider -> Bool
tracerProviderHasProcessor (TracerProvider -> Bool) -> TracerProvider -> Bool
forall a b. (a -> b) -> a -> b
$ Tracer -> TracerProvider
tracerProvider Tracer
t


{- | Smart constructor for 'SpanArguments' providing reasonable values for most 'Span's created
 that are internal to an application.

 Defaults:

 - `kind`: `Internal`
 - `attributes`: @[]@
 - `links`: @[]@
 - `startTime`: `Nothing` (`getTimestamp` will be called upon `Span` creation)

 @since 0.0.1.0
-}
defaultSpanArguments :: SpanArguments
defaultSpanArguments :: SpanArguments
defaultSpanArguments =
  SpanArguments
    { kind :: SpanKind
kind = SpanKind
Internal
    , attributes :: AttributeMap
attributes = []
    , links :: [NewLink]
links = []
    , startTime :: Maybe Timestamp
startTime = Maybe Timestamp
forall a. Maybe a
Nothing
    }


{- | This method provides a way for provider to do any cleanup required.

 This will also trigger shutdowns on all internal processors.

 @since 0.0.1.0
-}
shutdownTracerProvider
  :: (MonadIO m)
  => TracerProvider
  -> Maybe Int
  -- ^ Optional timeout in microseconds, defaults to 5,000,000 (5s)
  -> m ShutdownResult
shutdownTracerProvider :: forall (m :: * -> *).
MonadIO m =>
TracerProvider -> Maybe Int -> m ShutdownResult
shutdownTracerProvider TracerProvider {Bool
[ExceptionHandler]
IORef Bool
IORef (HashMap InstrumentationLibrary Tracer)
AttributeLimits
Vector SpanProcessor
TextMapPropagator
MaterializedResources
IdGenerator
Sampler
SpanLimits
ImmutableSpan -> IO ()
ImmutableSpan -> Context -> IO ()
tracerProviderIsShutdown :: TracerProvider -> IORef Bool
tracerProviderHasProcessor :: TracerProvider -> Bool
tracerProviderIdGenerator :: TracerProvider -> IdGenerator
tracerProviderSampler :: TracerProvider -> Sampler
tracerProviderOnStart :: TracerProvider -> ImmutableSpan -> Context -> IO ()
tracerProviderOnEnd :: TracerProvider -> ImmutableSpan -> IO ()
tracerProviderProcessors :: TracerProvider -> Vector SpanProcessor
tracerProviderResources :: TracerProvider -> MaterializedResources
tracerProviderAttributeLimits :: TracerProvider -> AttributeLimits
tracerProviderSpanLimits :: TracerProvider -> SpanLimits
tracerProviderPropagators :: TracerProvider -> TextMapPropagator
tracerProviderExceptionHandlers :: TracerProvider -> [ExceptionHandler]
tracerProviderTracerCache :: TracerProvider -> IORef (HashMap InstrumentationLibrary Tracer)
tracerProviderOnStart :: ImmutableSpan -> Context -> IO ()
tracerProviderOnEnd :: ImmutableSpan -> IO ()
tracerProviderProcessors :: Vector SpanProcessor
tracerProviderHasProcessor :: Bool
tracerProviderIdGenerator :: IdGenerator
tracerProviderSampler :: Sampler
tracerProviderResources :: MaterializedResources
tracerProviderAttributeLimits :: AttributeLimits
tracerProviderSpanLimits :: SpanLimits
tracerProviderPropagators :: TextMapPropagator
tracerProviderExceptionHandlers :: [ExceptionHandler]
tracerProviderIsShutdown :: IORef Bool
tracerProviderTracerCache :: IORef (HashMap InstrumentationLibrary Tracer)
..} Maybe Int
mtimeout = IO ShutdownResult -> m ShutdownResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShutdownResult -> m ShutdownResult)
-> IO ShutdownResult -> m ShutdownResult
forall a b. (a -> b) -> a -> b
$ do
  alreadyShut <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Bool
tracerProviderIsShutdown ((Bool -> (Bool, Bool)) -> IO Bool)
-> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Bool
s -> (Bool
True, Bool
s)
  if alreadyShut
    then pure ShutdownFailure
    else do
      jobs <- V.mapM (async . spanProcessorShutdown) tracerProviderProcessors
      mresult <-
        timeout (fromMaybe 5_000_000 mtimeout) $
          V.foldM'
            ( \ShutdownResult
status Async ShutdownResult
action -> do
                res <- Async ShutdownResult -> IO (Either SomeException ShutdownResult)
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ShutdownResult
action
                pure $! case res of
                  Left SomeException
_err -> ShutdownResult -> ShutdownResult -> ShutdownResult
worstShutdown ShutdownResult
status ShutdownResult
ShutdownFailure
                  Right ShutdownResult
sr -> ShutdownResult -> ShutdownResult -> ShutdownResult
worstShutdown ShutdownResult
status ShutdownResult
sr
            )
            ShutdownSuccess
            jobs
      case mresult of
        Maybe ShutdownResult
Nothing -> do
          (Async ShutdownResult -> IO ())
-> Vector (Async ShutdownResult) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ Async ShutdownResult -> IO ()
forall a. Async a -> IO ()
cancel Vector (Async ShutdownResult)
jobs
          ShutdownResult -> IO ShutdownResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownTimeout
        Just ShutdownResult
res -> ShutdownResult -> IO ShutdownResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
res


{- | This method provides a way for provider to immediately export all spans that have not yet
 been exported for all the internal processors.

 @since 0.0.1.0
-}
forceFlushTracerProvider
  :: (MonadIO m)
  => TracerProvider
  -> Maybe Int
  -- ^ Optional timeout in microseconds, defaults to 5,000,000 (5s)
  -> m FlushResult
  -- ^ Result that denotes whether the flush action succeeded, failed, or timed out.
forceFlushTracerProvider :: forall (m :: * -> *).
MonadIO m =>
TracerProvider -> Maybe Int -> m FlushResult
forceFlushTracerProvider TracerProvider {Bool
[ExceptionHandler]
IORef Bool
IORef (HashMap InstrumentationLibrary Tracer)
AttributeLimits
Vector SpanProcessor
TextMapPropagator
MaterializedResources
IdGenerator
Sampler
SpanLimits
ImmutableSpan -> IO ()
ImmutableSpan -> Context -> IO ()
tracerProviderIsShutdown :: TracerProvider -> IORef Bool
tracerProviderHasProcessor :: TracerProvider -> Bool
tracerProviderIdGenerator :: TracerProvider -> IdGenerator
tracerProviderSampler :: TracerProvider -> Sampler
tracerProviderOnStart :: TracerProvider -> ImmutableSpan -> Context -> IO ()
tracerProviderOnEnd :: TracerProvider -> ImmutableSpan -> IO ()
tracerProviderProcessors :: TracerProvider -> Vector SpanProcessor
tracerProviderResources :: TracerProvider -> MaterializedResources
tracerProviderAttributeLimits :: TracerProvider -> AttributeLimits
tracerProviderSpanLimits :: TracerProvider -> SpanLimits
tracerProviderPropagators :: TracerProvider -> TextMapPropagator
tracerProviderExceptionHandlers :: TracerProvider -> [ExceptionHandler]
tracerProviderTracerCache :: TracerProvider -> IORef (HashMap InstrumentationLibrary Tracer)
tracerProviderOnStart :: ImmutableSpan -> Context -> IO ()
tracerProviderOnEnd :: ImmutableSpan -> IO ()
tracerProviderProcessors :: Vector SpanProcessor
tracerProviderHasProcessor :: Bool
tracerProviderIdGenerator :: IdGenerator
tracerProviderSampler :: Sampler
tracerProviderResources :: MaterializedResources
tracerProviderAttributeLimits :: AttributeLimits
tracerProviderSpanLimits :: SpanLimits
tracerProviderPropagators :: TextMapPropagator
tracerProviderExceptionHandlers :: [ExceptionHandler]
tracerProviderIsShutdown :: IORef Bool
tracerProviderTracerCache :: IORef (HashMap InstrumentationLibrary Tracer)
..} Maybe Int
mtimeout = IO FlushResult -> m FlushResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlushResult -> m FlushResult)
-> IO FlushResult -> m FlushResult
forall a b. (a -> b) -> a -> b
$ do
  isShut <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
tracerProviderIsShutdown
  if isShut
    then pure FlushError
    else do
      jobs <- V.forM tracerProviderProcessors $ \SpanProcessor
processor ->
        IO FlushResult -> IO (Async FlushResult)
forall a. IO a -> IO (Async a)
async (IO FlushResult -> IO (Async FlushResult))
-> IO FlushResult -> IO (Async FlushResult)
forall a b. (a -> b) -> a -> b
$
          SpanProcessor -> IO FlushResult
spanProcessorForceFlush SpanProcessor
processor
      mresult <-
        timeout (fromMaybe 5_000_000 mtimeout) $
          V.foldM'
            ( \FlushResult
status Async FlushResult
action -> do
                res <- Async FlushResult -> IO (Either SomeException FlushResult)
forall a. Async a -> IO (Either SomeException a)
waitCatch Async FlushResult
action
                pure $! case res of
                  Left SomeException
_err -> FlushResult
FlushError
                  Right FlushResult
fr -> FlushResult -> FlushResult -> FlushResult
worstFlush FlushResult
status FlushResult
fr
            )
            FlushSuccess
            jobs
      case mresult of
        Maybe FlushResult
Nothing -> do
          (Async FlushResult -> IO ()) -> Vector (Async FlushResult) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ Async FlushResult -> IO ()
forall a. Async a -> IO ()
cancel Vector (Async FlushResult)
jobs
          FlushResult -> IO FlushResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlushResult
FlushTimeout
        Just FlushResult
res -> FlushResult -> IO FlushResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlushResult
res


{- | Run an action only when the span is recording. Use this to guard
expensive attribute computation that would be wasted on non-recording spans.

 @since 0.0.1.0
-}
whenSpanIsRecording :: (MonadIO m) => Span -> m () -> m ()
whenSpanIsRecording :: forall (m :: * -> *). MonadIO m => Span -> m () -> m ()
whenSpanIsRecording (Span ImmutableSpan
imm) m ()
m = do
  hot <- IO SpanHot -> m SpanHot
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpanHot -> m SpanHot) -> IO SpanHot -> m SpanHot
forall a b. (a -> b) -> a -> b
$ IORef SpanHot -> IO SpanHot
forall a. IORef a -> IO a
readIORef (ImmutableSpan -> IORef SpanHot
spanHot ImmutableSpan
imm)
  case hotEnd hot of
    OptionalTimestamp
NoTimestamp -> m ()
m
    OptionalTimestamp
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
whenSpanIsRecording (FrozenSpan SpanContext
_) m ()
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
whenSpanIsRecording (Dropped SpanContext
_) m ()
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- | Retrieve the active 'Span' from the current thread's context.

Returns 'Nothing' if there is no span in the current context (e.g. at
the top level, before any tracing has started).

This is the Haskell equivalent of Go's @trace.SpanFromContext(ctx)@ and
Rust's @get_active_span@.

@since 0.4.1.0
-}
getActiveSpan :: (MonadIO m) => m (Maybe Span)
getActiveSpan :: forall (m :: * -> *). MonadIO m => m (Maybe Span)
getActiveSpan = Context -> Maybe Span
lookupSpan (Context -> Maybe Span) -> m Context -> m (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Context
forall (m :: * -> *). MonadIO m => m Context
getContext
{-# INLINE getActiveSpan #-}


{- | Run an action on the active span. If there is no active span in the
current context, the action is silently skipped.

@
withActiveSpan $ \\span -> do
  addAttribute span "user.id" (toAttribute userId)
  addEvent span (newEvent "cache-miss")
@

@since 0.4.1.0
-}
withActiveSpan :: (MonadIO m) => (Span -> m ()) -> m ()
withActiveSpan :: forall (m :: * -> *). MonadIO m => (Span -> m ()) -> m ()
withActiveSpan Span -> m ()
f = do
  mSpan <- m (Maybe Span)
forall (m :: * -> *). MonadIO m => m (Maybe Span)
getActiveSpan
  forM_ mSpan f
{-# INLINE withActiveSpan #-}


{- | Retrieve the 'SpanContext' of the active span, useful for log
correlation (extracting trace\/span IDs) without needing the full 'Span'
handle.

@since 0.4.1.0
-}
getActiveSpanContext :: (MonadIO m) => m (Maybe SpanContext)
getActiveSpanContext :: forall (m :: * -> *). MonadIO m => m (Maybe SpanContext)
getActiveSpanContext = do
  mSpan <- m (Maybe Span)
forall (m :: * -> *). MonadIO m => m (Maybe Span)
getActiveSpan
  case mSpan of
    Maybe Span
Nothing -> Maybe SpanContext -> m (Maybe SpanContext)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SpanContext
forall a. Maybe a
Nothing
    Just Span
s -> SpanContext -> Maybe SpanContext
forall a. a -> Maybe a
Just (SpanContext -> Maybe SpanContext)
-> m SpanContext -> m (Maybe SpanContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span -> m SpanContext
forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext Span
s
{-# INLINE getActiveSpanContext #-}


{- | Nanoseconds since the Unix epoch.

@since 0.0.1.0
-}
timestampNanoseconds :: Timestamp -> Word64
timestampNanoseconds :: Timestamp -> Word64
timestampNanoseconds = Timestamp -> Word64
forall a b. Coercible a b => a -> b
coerce
{-# INLINE timestampNanoseconds #-}