hs-opentelemetry-api 0.0.1.0 → 0.0.2.0

raw patch · 4 files changed

+100/−65 lines, 4 filesdep ~thread-utils-contextPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: thread-utils-context

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• hs-opentelemetry-api.cabal +3/−3
• src/OpenTelemetry/Internal/Trace/Types.hs +25/−18
• src/OpenTelemetry/Trace/Core.hs +61/−44

@@ -1,3 +1,14 @@ # Changelog for hs-opentelemetry-api +## 0.0.2.0++- Separate `Link` and `NewLink` into two different datatypes to improve Link creation interface.+- Add some version bounds+- Catch & print all synchronous exceptions when calling span processor+  start and end hooks++## 0.0.1.0++- Initial release+ ## Unreleased changes

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hs-opentelemetry-api-version:        0.0.1.0+version:        0.0.2.0 synopsis:       OpenTelemetry API for use by libraries for direct instrumentation or wrapper packages. description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/api#readme> category:       OpenTelemetry, Telemetry, Monitoring, Observability, Metrics@@ -80,7 +80,7 @@     , mtl     , template-haskell     , text-    , thread-utils-context+    , thread-utils-context ==0.2.*     , unliftio-core     , unordered-containers     , vault@@ -119,7 +119,7 @@     , mtl     , template-haskell     , text-    , thread-utils-context+    , thread-utils-context ==0.2.*     , unliftio-core     , unordered-containers     , vault

@@ -1,5 +1,4 @@ {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DataKinds #-}@@ -80,7 +79,7 @@ {- |  'Tracer's can be create from a 'TracerProvider'. -}-data TracerProvider = TracerProvider +data TracerProvider = TracerProvider   { tracerProviderProcessors :: !(Vector Processor)   , tracerProviderIdGenerator :: !IdGenerator   , tracerProviderSampler :: !Sampler@@ -121,14 +120,22 @@ represents a single parent scenario, in many cases the parent Span fully encloses the child Span.  This is not the case in scatter/gather and batch scenarios. -}-data Link = Link+data NewLink = NewLink   { linkContext :: !SpanContext   -- ^ @SpanContext@ of the @Span@ to link to.-  , linkAttributes :: Attributes+  , linkAttributes :: [(Text, Attribute)]   -- ^ Zero or more Attributes further describing the link.   }   deriving (Show) +data Link = Link+  { frozenLinkContext :: !SpanContext+  -- ^ @SpanContext@ of the @Span@ to link to.+  , frozenLinkAttributes :: Attributes+  -- ^ Zero or more Attributes further describing the link.+  }+  deriving (Show)+ -- | Non-name fields that may be set on initial creation of a 'Span'. data SpanArguments = SpanArguments   { kind :: SpanKind@@ -138,18 +145,18 @@   -- ^ An initial set of attributes that may be set on initial 'Span' creation.   -- These attributes are provided to 'Processor's, so they may be useful in some   -- scenarios where calling `addAttribute` or `addAttributes` is too late.-  , links :: [Link]+  , links :: [NewLink]   -- ^ A collection of `Link`s that point to causally related 'Span's.   , startTime :: Maybe Timestamp   -- ^ An explicit start time, if the span has already begun.   }  -- | The outcome of a call to 'OpenTelemetry.Trace.forceFlush'-data FlushResult -  = FlushTimeout +data FlushResult+  = FlushTimeout   -- ^ One or more spans did not export from all associated exporters   -- within the alotted timeframe.-  | FlushSuccess +  | FlushSuccess   -- ^ Flushing spans to all associated exporters succeeded.   | FlushError   -- ^ One or more exporters failed to successfully export one or more @@ -182,19 +189,19 @@ +-------------+--------------+---------------+------------------+------------------+  -}-data SpanKind +data SpanKind   = Server   -- ^ Indicates that the span covers server-side handling of a synchronous RPC or other remote request.    -- This span is the child of a remote @Client@ span that was expected to wait for a response.-  | Client +  | Client   -- ^ Indicates that the span describes a synchronous request to some remote service.    -- This span is the parent of a remote @Server@ span and waits for its response.-  | Producer +  | Producer   -- ^ Indicates that the span describes the parent of an asynchronous request.    -- This parent span is expected to end before the corresponding child @Producer@ span,    -- possibly even before the child span starts. In messaging scenarios with batching,    -- tracing individual messages requires a new @Producer@ span per message to be created.-  | Consumer +  | Consumer   -- ^ Indicates that the span describes the child of an asynchronous @Producer@ request.    | Internal   -- ^  Default value. Indicates that the span represents an internal operation within an application, @@ -206,10 +213,10 @@ -- The default 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.-data SpanStatus +data SpanStatus   = Unset   -- ^ The default status.-  | Error Text +  | Error Text   -- ^ The operation contains an error. The text field may be empty, or else provide a description of the error.   | Ok   -- ^ The operation has been validated by an Application developer or Operator to have completed successfully.@@ -225,7 +232,7 @@   compare Ok Unset = GT   compare Ok (Error _) = GT   compare Ok Ok = EQ-  + data ImmutableSpan = ImmutableSpan   { spanName :: Text   , spanParent :: Maybe Span@@ -241,7 +248,7 @@   -- ^ Creator of the span   } -data Span +data Span   = Span (IORef ImmutableSpan)   | FrozenSpan SpanContext   | Dropped SpanContext@@ -350,9 +357,9 @@ -- | The outcome of a call to 'Sampler' indicating -- whether the 'Tracer' should sample a 'Span'. data SamplingResult-  = Drop +  = Drop   -- ^ isRecording == false. Span will not be recorded and all events and attributes will be dropped.-  | RecordOnly +  | RecordOnly   -- ^ isRecording == true, but Sampled flag MUST NOT be set.   | RecordAndSample   -- ^ isRecording == true, AND Sampled flag MUST be set.

@@ -84,6 +84,7 @@   , SpanKind(..)   , defaultSpanArguments   , SpanArguments(..)+  , NewLink(..)   , Link(..)   -- ** Recording @Event@s   , Event(..)@@ -123,7 +124,7 @@ import Control.Applicative import Control.Concurrent.Async import Control.Concurrent (myThreadId)-import Control.Exception (Exception(..))+import Control.Exception (Exception(..), try) import Control.Monad import Control.Monad.IO.Class import Data.Coerce@@ -180,15 +181,19 @@ createSpan t c n args = do   createSpanWithoutCallStack t c n $ case getCallStack callStack of     [] -> args-    (fn, loc):_ -> args-      { attributes = -            ("code.function", toAttribute $ T.pack fn)-          : ("code.namespace", toAttribute $ T.pack $ srcLocModule loc)-          : ("code.filepath", toAttribute $ T.pack $ srcLocFile loc)-          : ("code.lineno", toAttribute $ srcLocStartLine loc)-          : ("code.package", toAttribute $ T.pack $ srcLocPackage loc)-          : attributes args-      }+    (_, loc):rest ->+      let addFunction = case rest of+            (fn, _):_ -> (("code.function", toAttribute $ T.pack fn) :)+            [] -> id+      in args+          { attributes =+                addFunction+              $ ("code.namespace", toAttribute $ T.pack $ srcLocModule loc)+              : ("code.filepath", toAttribute $ T.pack $ srcLocFile loc)+              : ("code.lineno", toAttribute $ srcLocStartLine loc)+              : ("code.package", toAttribute $ T.pack $ srcLocPackage loc)+              : attributes args+          }  -- | The same thing as 'createSpan', except that it does not have a 'HasCallStack' constraint. createSpanWithoutCallStack@@ -249,13 +254,13 @@                   , spanParent = parent                   , spanKind = kind                   , spanAttributes =-                      A.addAttributes -                        (limitBy t spanAttributeCountLimit) -                        emptyAttributes +                      A.addAttributes+                        (limitBy t spanAttributeCountLimit)+                        emptyAttributes                         (concat [additionalInfo, attrs, attributes])-                  , spanLinks = +                  , spanLinks =                       let limitedLinks = fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t)-                       in frozenBoundedCollection limitedLinks links+                       in frozenBoundedCollection limitedLinks $ fmap freezeLink links                   , spanEvents = emptyAppendOnlyBoundedCollection $ fromMaybe 128 (eventCountLimit $ tracerProviderSpanLimits $ tracerProvider t)                   , spanStatus = Unset                   , spanStart = st@@ -263,13 +268,22 @@                   , spanTracer = t                   }             s <- newIORef is-            mapM_ (\processor -> processorOnStart processor s ctxt) $ tracerProviderProcessors $ tracerProvider t+            eResult <- try $ mapM_ (\processor -> processorOnStart processor s ctxt) $ tracerProviderProcessors $ tracerProvider t+            case eResult of+              Left err -> print (err :: SomeException)+              Right _ -> pure ()             pure $ Span s        case samplingOutcome of         Drop -> pure $ Dropped ctxtForSpan         RecordOnly -> mkRecordingSpan         RecordAndSample -> mkRecordingSpan+  where+    freezeLink :: NewLink -> Link+    freezeLink NewLink{..} = Link+      { frozenLinkContext = linkContext+      , frozenLinkAttributes = A.addAttributes (limitBy t linkAttributeCountLimit) A.emptyAttributes linkAttributes+      }  inSpan   :: (MonadUnliftIO m, HasCallStack)@@ -322,7 +336,7 @@         recordException s [] Nothing inner       endSpan s Nothing       adjustContext $ \ctx ->-        maybe ctx (\p -> insertSpan p ctx) parent+        maybe ctx (`insertSpan` ctx) parent     )     (\(_, s) -> f s) @@ -356,11 +370,11 @@ -} addAttribute :: MonadIO m => A.ToAttribute a => Span -> Text -> a -> m () addAttribute (Span s) k v = liftIO $ modifyIORef s $ \i -> i-  { spanAttributes = -      OpenTelemetry.Attributes.addAttribute -        (limitBy (spanTracer i) spanAttributeCountLimit) -        (spanAttributes i) -        k +  { spanAttributes =+      OpenTelemetry.Attributes.addAttribute+        (limitBy (spanTracer i) spanAttributeCountLimit)+        (spanAttributes i)+        k         v   } addAttribute (FrozenSpan _) _ _ = pure ()@@ -368,10 +382,10 @@  addAttributes :: MonadIO m => Span -> [(Text, A.Attribute)] -> m () addAttributes (Span s) attrs = liftIO $ modifyIORef s $ \i -> i-  { spanAttributes = -      OpenTelemetry.Attributes.addAttributes -      (limitBy (spanTracer i) spanAttributeCountLimit) -      (spanAttributes i) +  { spanAttributes =+      OpenTelemetry.Attributes.addAttributes+      (limitBy (spanTracer i) spanAttributeCountLimit)+      (spanAttributes i)       attrs   } addAttributes (FrozenSpan _) _ = pure ()@@ -381,12 +395,12 @@ addEvent (Span s) NewEvent{..} = liftIO $ do   t <- maybe getTimestamp pure newEventTimestamp   modifyIORef s $ \i -> i-    { spanEvents = appendToBoundedCollection (spanEvents i) $ +    { spanEvents = appendToBoundedCollection (spanEvents i) $         Event           { eventName = newEventName-          , eventAttributes = A.addAttributes -              (limitBy (spanTracer i) eventAttributeCountLimit) -              emptyAttributes +          , eventAttributes = A.addAttributes+              (limitBy (spanTracer i) eventAttributeCountLimit)+              emptyAttributes               newEventAttributes           , eventTimestamp = t           }@@ -445,7 +459,10 @@     let ref = i { spanEnd = spanEnd i <|> Just ts }     in (ref, (isJust $ spanEnd i, ref))   unless alreadyFinished $ do-    mapM_ (`processorOnEnd` s) $ tracerProviderProcessors $ tracerProvider $ spanTracer frozenS+    eResult <- try $ mapM_ (`processorOnEnd` s) $ tracerProviderProcessors $ tracerProvider $ spanTracer frozenS+    case eResult of+      Left err -> print (err :: SomeException)+      Right _ -> pure () endSpan (FrozenSpan _) _ = pure () endSpan (Dropped _) _ = pure () @@ -460,7 +477,7 @@   let message = T.pack $ show e   addEvent s $ NewEvent     { newEventName = "exception"-    , newEventAttributes = +    , newEventAttributes =         attrs ++         [ ("exception.type", A.toAttribute $ T.pack $ show $ typeOf e)         , ("exception.message", A.toAttribute message)@@ -520,9 +537,9 @@ getTimestamp :: MonadIO m => m Timestamp getTimestamp = liftIO $ coerce @(IO TimeSpec) @(IO Timestamp) $ getTime Realtime -limitBy :: -     Tracer -  -> (SpanLimits -> Maybe Int) +limitBy ::+     Tracer+  -> (SpanLimits -> Maybe Int)   -- ^ Attribute count   -> AttributeLimits limitBy t countF = AttributeLimits@@ -530,13 +547,13 @@   , attributeLengthLimit = lengthLimit   }   where-    countLimit = +    countLimit =       countF (tracerProviderSpanLimits $ tracerProvider t) <|>-      attributeCountLimit +      attributeCountLimit         (tracerProviderAttributeLimits $ tracerProvider t)-    lengthLimit = +    lengthLimit =       spanAttributeValueLengthLimit (tracerProviderSpanLimits $ tracerProvider t) <|>-      attributeLengthLimit +      attributeLengthLimit         (tracerProviderAttributeLimits $ tracerProvider t)  globalTracer :: IORef TracerProvider@@ -557,11 +574,11 @@   }  emptyTracerProviderOptions :: TracerProviderOptions-emptyTracerProviderOptions = TracerProviderOptions -  dummyIdGenerator -  (parentBased $ parentBasedOptions alwaysOn) -  emptyMaterializedResources -  defaultAttributeLimits +emptyTracerProviderOptions = TracerProviderOptions+  dummyIdGenerator+  (parentBased $ parentBasedOptions alwaysOn)+  emptyMaterializedResources+  defaultAttributeLimits   defaultSpanLimits   mempty