diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/hs-opentelemetry-api.cabal b/hs-opentelemetry-api.cabal --- a/hs-opentelemetry-api.cabal +++ b/hs-opentelemetry-api.cabal @@ -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 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 diff --git a/src/OpenTelemetry/Internal/Trace/Types.hs b/src/OpenTelemetry/Internal/Trace/Types.hs --- a/src/OpenTelemetry/Internal/Trace/Types.hs +++ b/src/OpenTelemetry/Internal/Trace/Types.hs @@ -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. diff --git a/src/OpenTelemetry/Trace/Core.hs b/src/OpenTelemetry/Trace/Core.hs --- a/src/OpenTelemetry/Trace/Core.hs +++ b/src/OpenTelemetry/Trace/Core.hs @@ -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