packages feed

hs-opentelemetry-api 0.1.0.0 → 0.2.0.0

raw patch · 29 files changed

+1756/−385 lines, 29 filesdep +regex-tdfadep +safe-exceptionsdep −containersdep −ghc-primnew-uploader

Dependencies added: regex-tdfa, safe-exceptions

Dependencies removed: containers, ghc-prim

Files

ChangeLog.md view
@@ -1,10 +1,18 @@ # Changelog for hs-opentelemetry-api -## Unreleased changes--## 0.1.0.0+## 0.2.0.0 +- `callerAttributes` and `ownCodeAttributes` now work properly if the call stack has been frozen. Hence most+  span-construction functions should now get correct source code attributes in this situation also (#137.+- Added `detectInstrumentationLibrary` for producing `InstrumentationLibrary`s with TH (#2).+- Fixed precedence order of resource merge (#156).+- Added the ability to add links to spans after creation (#152).+- Correctly compute attribute length limits (#151).+- Add helper for reading boolean environment variables correctly (#11).+- Initial scaffolding for logging support. Renamed `Processor` to `SpanProcessor`.+- Export `FlushResult` (#960 - Use `HashMap Text Attribute` instead of `[(Text, Attribute)]` as attributes+- Improved conformance with semantic conventions.  ## 0.0.3.6
hs-opentelemetry-api.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:               hs-opentelemetry-api-version:            0.1.0.0+version:            0.2.0.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@@ -13,7 +13,7 @@ bug-reports:        https://github.com/iand675/hs-opentelemetry/issues author:             Ian Duncan, Jade Lovelace maintainer:         ian@iankduncan.com-copyright:          2023 Ian Duncan, Mercury Technologies+copyright:          2024 Ian Duncan, Mercury Technologies license:            BSD3 license-file:       LICENSE build-type:         Simple@@ -34,10 +34,19 @@       OpenTelemetry.Context.ThreadLocal       OpenTelemetry.Contrib.CarryOns       OpenTelemetry.Contrib.SpanTraversals+      OpenTelemetry.Environment       OpenTelemetry.Exporter+      OpenTelemetry.Exporter.LogRecord+      OpenTelemetry.Exporter.Span+      OpenTelemetry.Internal.Common.Types+      OpenTelemetry.Internal.Logs.Core+      OpenTelemetry.Internal.Logs.Types       OpenTelemetry.Internal.Trace.Id-      OpenTelemetry.Logging.Core+      OpenTelemetry.LogAttributes+      OpenTelemetry.Logs.Core       OpenTelemetry.Processor+      OpenTelemetry.Processor.LogRecord+      OpenTelemetry.Processor.Span       OpenTelemetry.Propagator       OpenTelemetry.Resource       OpenTelemetry.Resource.Cloud@@ -52,6 +61,7 @@       OpenTelemetry.Resource.Service       OpenTelemetry.Resource.Telemetry       OpenTelemetry.Resource.Webengine+      OpenTelemetry.SemanticsConfig       OpenTelemetry.Trace.Core       OpenTelemetry.Trace.Id       OpenTelemetry.Trace.Id.Generator@@ -63,6 +73,7 @@   other-modules:       OpenTelemetry.Context.Types       OpenTelemetry.Internal.Trace.Types+      Paths_hs_opentelemetry_api   hs-source-dirs:       src   default-extensions:@@ -77,12 +88,12 @@     , bytestring     , charset     , clock-    , containers-    , ghc-prim     , hashable     , http-types     , memory     , mtl+    , regex-tdfa+    , safe-exceptions     , template-haskell     , text     , thread-utils-context ==0.3.*@@ -98,7 +109,12 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      OpenTelemetry.AttributesSpec       OpenTelemetry.BaggageSpec+      OpenTelemetry.InstrumentationLibrarySpec+      OpenTelemetry.Logs.CoreSpec+      OpenTelemetry.ResourceSpec+      OpenTelemetry.SemanticsConfigSpec       OpenTelemetry.Trace.SamplerSpec       OpenTelemetry.Trace.TraceFlagsSpec       Paths_hs_opentelemetry_api@@ -109,28 +125,13 @@       RecordWildCards   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      async-    , attoparsec-    , base >=4.7 && <5-    , binary-    , bytestring-    , charset-    , clock-    , containers-    , ghc-prim-    , hashable+      base >=4.7 && <5     , hs-opentelemetry-api     , hspec-    , http-types-    , memory     , mtl-    , template-haskell     , text-    , thread-utils-context ==0.3.*-    , transformers     , unliftio-core     , unordered-containers-    , vault     , vector     , vector-builder   default-language: Haskell2010
src/OpenTelemetry/Attributes.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE StrictData #-}  {- |@@ -25,7 +25,7 @@  - Attribute values expressing a numerical value of zero, an empty string, or an empty array are considered meaningful and MUST be stored and passed on to processors / exporters. -} module OpenTelemetry.Attributes (-  Attributes,+  Attributes (attributesDropped),   emptyAttributes,   addAttribute,   addAttributes,@@ -53,6 +53,7 @@ import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic)+import qualified Language.Haskell.TH.Syntax as TH   {- | Default attribute limits used in the global attribute limit configuration if no environment variables are set.@@ -75,9 +76,12 @@   , attributesCount :: {-# UNPACK #-} !Int   , attributesDropped :: {-# UNPACK #-} !Int   }-  deriving stock (Show, Eq)+  deriving stock (Show, Generic, Eq, Ord, TH.Lift)  +instance Hashable Attributes++ emptyAttributes :: Attributes emptyAttributes = Attributes mempty 0 0 @@ -90,7 +94,7 @@       then Attributes attributes attributesCount (attributesDropped + 1)       else Attributes newAttrs newCount attributesDropped   where-    newAttrs = H.insert k (maybe id limitLengths attributeCountLimit $ toAttribute v) attributes+    newAttrs = H.insert k (maybe id limitLengths attributeLengthLimit $ toAttribute v) attributes     newCount = H.size newAttrs {-# INLINE addAttribute #-} @@ -103,7 +107,7 @@       then Attributes attributes attributesCount (attributesDropped + H.size attrs)       else Attributes newAttrs newCount attributesDropped   where-    newAttrs = H.union attributes $ H.map toAttribute attrs+    newAttrs = H.union attributes $ H.map (maybe id limitLengths attributeLengthLimit . toAttribute) attrs     newCount = H.size newAttrs {-# INLINE addAttributes #-} @@ -158,7 +162,7 @@     --     -- All values in the array MUST be of the same primitive attribute type.     AttributeArray [PrimitiveAttribute]-  deriving stock (Read, Show, Eq, Ord, Data, Generic)+  deriving stock (Read, Show, Eq, Ord, Data, Generic, TH.Lift)   deriving anyclass (Hashable)  @@ -183,7 +187,7 @@   | BoolAttribute Bool   | DoubleAttribute Double   | IntAttribute Int64-  deriving stock (Read, Show, Eq, Ord, Data, Generic)+  deriving stock (Read, Show, Eq, Ord, Data, Generic, TH.Lift)   deriving anyclass (Hashable)  @@ -258,8 +262,13 @@   toAttribute = AttributeArray . map toPrimitiveAttribute  +-- | Left-biased merge. unsafeMergeAttributesIgnoringLimits :: Attributes -> Attributes -> Attributes-unsafeMergeAttributesIgnoringLimits (Attributes l lc ld) (Attributes r rc rd) = Attributes (l <> r) (lc + rc) (ld + rd)+unsafeMergeAttributesIgnoringLimits left right = Attributes hm c d+  where+    hm = attributes left <> attributes right+    c = H.size hm+    d = attributesDropped left + attributesDropped right   unsafeAttributesFromListIgnoringLimits :: [(Text, Attribute)] -> Attributes
src/OpenTelemetry/Context/ThreadLocal.hs view
@@ -54,11 +54,7 @@ ) where  import Control.Concurrent--- import Control.Concurrent.Async import Control.Concurrent.Thread.Storage--- import Control.Monad--import Control.Monad (void) import Control.Monad.IO.Class import Data.Maybe (fromMaybe) import OpenTelemetry.Context (Context, empty)
src/OpenTelemetry/Contrib/CarryOns.hs view
@@ -13,7 +13,6 @@ import qualified OpenTelemetry.Context as Context import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Internal.Trace.Types-import OpenTelemetry.Trace.Core import System.IO.Unsafe (unsafePerformIO)  @@ -35,11 +34,11 @@ and will be discarded if the span has attributes that exceed the configured attribute limits for the configured 'TracerProvider'. -}-withCarryOnProcessor :: Processor -> Processor+withCarryOnProcessor :: SpanProcessor -> SpanProcessor withCarryOnProcessor p =-  Processor-    { processorOnStart = processorOnStart p-    , processorOnEnd = \spanRef -> do+  SpanProcessor+    { spanProcessorOnStart = spanProcessorOnStart p+    , spanProcessorOnEnd = \spanRef -> do         ctxt <- getContext         let carryOns = fromMaybe mempty $ Context.lookup carryOnKey ctxt         if H.null carryOns@@ -54,7 +53,7 @@                       (spanAttributes is)                       carryOns                 }-        processorOnEnd p spanRef-    , processorShutdown = processorShutdown p-    , processorForceFlush = processorForceFlush p+        spanProcessorOnEnd p spanRef+    , spanProcessorShutdown = spanProcessorShutdown p+    , spanProcessorForceFlush = spanProcessorForceFlush p     }
+ src/OpenTelemetry/Environment.hs view
@@ -0,0 +1,17 @@+module OpenTelemetry.Environment (+  lookupBooleanEnv,+) where++import qualified Data.Char as C+import System.Environment (lookupEnv)+++{- | Does the given value of an environment variable correspond to "true" according+to [the OpenTelemetry specification](https://opentelemetry.io/docs/specs/otel/configuration/sdk-environment-variables/#boolean-value)?+-}+isTrue :: String -> Bool+isTrue = ("true" ==) . map C.toLower+++lookupBooleanEnv :: String -> IO Bool+lookupBooleanEnv = fmap (maybe False isTrue) . lookupEnv
src/OpenTelemetry/Exporter.hs view
@@ -1,24 +1,28 @@------------------------------------------------------------------------------+{-# LANGUAGE PatternSynonyms #-} ------------------------------------------------------------------------------+module OpenTelemetry.Exporter+  {-# DEPRECATED "use OpenTelemetry.Exporter.Span instead" #-} (+  Exporter,+  SpanExporter (Exporter, exporterExport, exporterShutdown),+  ExportResult (..),+) where -{- |- Module      :  OpenTelemetry.Exporter- Copyright   :  (c) Ian Duncan, 2021- License     :  BSD-3- Description :  Encode and transmit telemetry to external systems- Maintainer  :  Ian Duncan- Stability   :  experimental- Portability :  non-portable (GHC extensions)+import Data.HashMap.Strict (HashMap)+import Data.Vector (Vector)+import OpenTelemetry.Exporter.Span+import OpenTelemetry.Internal.Common.Types (InstrumentationLibrary)+import OpenTelemetry.Internal.Trace.Types (ImmutableSpan) - Span Exporter defines the interface that protocol-specific exporters must implement so that they can be plugged into OpenTelemetry SDK and support sending of telemetry data. - The goal of the interface is to minimize burden of implementation for protocol-dependent telemetry exporters. The protocol exporter is expected to be primarily a simple telemetry data encoder and transmitter.--}-module OpenTelemetry.Exporter (-  Exporter (..),-  ExportResult (..),-) where+{-# DEPRECATED Exporter "use SpanExporter instead" #-} -import OpenTelemetry.Internal.Trace.Types +type Exporter a = SpanExporter+++pattern Exporter :: (HashMap InstrumentationLibrary (Vector ImmutableSpan) -> IO ExportResult) -> IO () -> Exporter ImmutableSpan+pattern Exporter {exporterExport, exporterShutdown} =+  SpanExporter+    { spanExporterExport = exporterExport+    , spanExporterShutdown = exporterShutdown+    }
+ src/OpenTelemetry/Exporter/LogRecord.hs view
@@ -0,0 +1,20 @@+module OpenTelemetry.Exporter.LogRecord (+  LogRecordExporter,+  LogRecordExporterArguments (..),+  mkLogRecordExporter,+  logRecordExporterExport,+  logRecordExporterForceFlush,+  logRecordExporterShutdown,+  ShutdownResult (..),+) where++import OpenTelemetry.Internal.Logs.Types (+  LogRecordExporter,+  LogRecordExporterArguments (..),+  logRecordExporterExport,+  logRecordExporterForceFlush,+  logRecordExporterShutdown,+  mkLogRecordExporter,+ )+import OpenTelemetry.Processor.LogRecord (ShutdownResult (..))+
+ src/OpenTelemetry/Exporter/Span.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++{- |+ Module      :  OpenTelemetry.Exporter.Span+ Copyright   :  (c) Ian Duncan, 2021+ License     :  BSD-3+ Description :  Encode and transmit telemetry to external systems+ Maintainer  :  Ian Duncan+ Stability   :  experimental+ Portability :  non-portable (GHC extensions)++ Span Exporter defines the interface that protocol-specific exporters must implement so that they can be plugged into OpenTelemetry SDK and support sending of telemetry data.++ The goal of the interface is to minimize burden of implementation for protocol-dependent telemetry exporters. The protocol exporter is expected to be primarily a simple telemetry data encoder and transmitter.+-}+module OpenTelemetry.Exporter.Span (+  SpanExporter (..),+  ExportResult (..),+) where++import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Trace.Types+
+ src/OpenTelemetry/Internal/Common/Types.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module OpenTelemetry.Internal.Common.Types (+  InstrumentationLibrary (..),+  AnyValue (..),+  ToValue (..),+  ShutdownResult (..),+  FlushResult (..),+  ExportResult (..),+  parseInstrumentationLibrary,+  detectInstrumentationLibrary,+) where++import Control.Exception (SomeException)+import Data.ByteString (ByteString)+import Data.Data (Data)+import qualified Data.HashMap.Strict as H+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.String (IsString (fromString))+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics (Generic)+import qualified Language.Haskell.TH as TH+import qualified Language.Haskell.TH.Syntax as TH+import OpenTelemetry.Attributes (Attributes, emptyAttributes)+import Text.Regex.TDFA ((=~~))+++{- | An identifier for the library that provides the instrumentation for a given Instrumented Library.+ Instrumented Library and Instrumentation Library may be the same library if it has built-in OpenTelemetry instrumentation.++ The inspiration of the OpenTelemetry project is to make every library and application observable out of the box by having them call OpenTelemetry API directly.+ However, many libraries will not have such integration, and as such there is a need for a separate library which would inject such calls, using mechanisms such as wrapping interfaces,+ subscribing to library-specific callbacks, or translating existing telemetry into the OpenTelemetry model.++ A library that enables OpenTelemetry observability for another library is called an Instrumentation Library.++ An instrumentation library should be named to follow any naming conventions of the instrumented library (e.g. 'middleware' for a web framework).++ If there is no established name, the recommendation is to prefix packages with "hs-opentelemetry-instrumentation", followed by the instrumented library name itself.++ In general, the simplest way to get the instrumentation library is to use 'detectInstrumentationLibrary', which uses the Haskell package name and version.+-}+data InstrumentationLibrary = InstrumentationLibrary+  { libraryName :: {-# UNPACK #-} !Text+  -- ^ The name of the instrumentation library+  , libraryVersion :: {-# UNPACK #-} !Text+  -- ^ The version of the instrumented library+  , librarySchemaUrl :: {-# UNPACK #-} !Text+  , libraryAttributes :: Attributes+  }+  deriving (Ord, Eq, Generic, Show, TH.Lift)+++instance Hashable InstrumentationLibrary+++instance IsString InstrumentationLibrary where+  fromString :: String -> InstrumentationLibrary+  fromString str = InstrumentationLibrary (fromString str) "" "" emptyAttributes+++{- | An attribute represents user-provided metadata about a span, link, or event.++ 'Any' values are used in place of 'Standard Attributes' in logs because third-party+ logs may not conform to the 'Standard Attribute' format.++ Telemetry tools may use this data to support high-cardinality querying, visualization+ in waterfall diagrams, trace sampling decisions, and more.+-}+data AnyValue+  = TextValue Text+  | BoolValue Bool+  | DoubleValue Double+  | IntValue Int64+  | ByteStringValue ByteString+  | ArrayValue [AnyValue]+  | HashMapValue (H.HashMap Text AnyValue)+  | NullValue+  deriving stock (Read, Show, Eq, Ord, Data, Generic)+  deriving anyclass (Hashable)+++-- | Create a `TextAttribute` from the string value.+instance IsString AnyValue where+  fromString :: String -> AnyValue+  fromString = TextValue . fromString+++{- | Convert a Haskell value to an 'Any' value.++ @++ data Foo = Foo++ instance ToValue Foo where+   toValue Foo = TextValue "Foo"++ @+-}+class ToValue a where+  toValue :: a -> AnyValue+++instance ToValue Text where+  toValue :: Text -> AnyValue+  toValue = TextValue+++instance ToValue Bool where+  toValue :: Bool -> AnyValue+  toValue = BoolValue+++instance ToValue Double where+  toValue :: Double -> AnyValue+  toValue = DoubleValue+++instance ToValue Int64 where+  toValue :: Int64 -> AnyValue+  toValue = IntValue+++instance ToValue ByteString where+  toValue :: ByteString -> AnyValue+  toValue = ByteStringValue+++instance (ToValue a) => ToValue [a] where+  toValue :: (ToValue a) => [a] -> AnyValue+  toValue = ArrayValue . fmap toValue+++instance (ToValue a) => ToValue (H.HashMap Text a) where+  toValue :: (ToValue a) => H.HashMap Text a -> AnyValue+  toValue = HashMapValue . fmap toValue+++instance ToValue AnyValue where+  toValue :: AnyValue -> AnyValue+  toValue = id+++data ShutdownResult = ShutdownSuccess | ShutdownFailure | ShutdownTimeout+++-- | The outcome of a call to @OpenTelemetry.Trace.forceFlush@ or @OpenTelemetry.Logs.forceFlush@+data FlushResult+  = -- | One or more spans or @LogRecord@s did not export from all associated exporters+    -- within the alotted timeframe.+    FlushTimeout+  | -- | Flushing spans or @LogRecord@s to all associated exporters succeeded.+    FlushSuccess+  | -- | One or more exporters failed to successfully export one or more+    -- unexported spans or @LogRecord@s.+    FlushError+  deriving (Show)+++data ExportResult+  = Success+  | Failure (Maybe SomeException)+++-- | Parses a package-version string into an InstrumentationLibrary'.+parseInstrumentationLibrary :: (MonadFail m) => String -> m InstrumentationLibrary+parseInstrumentationLibrary packageString = do+  let packageNameRegex :: String = "([a-zA-Z0-9-]+[a-zA-Z0-9]+)"+  let versionRegex :: String = "([0-9\\.]+)"+  -- First try and parse with a mandatory version string on the end. If that fails, try+  -- to parse just a package name+  let fullRegex :: String = "(" <> packageNameRegex <> "-" <> versionRegex <> ")|" <> packageNameRegex+  (_ :: String, _ :: String, _ :: String, groups :: [String]) <- packageString =~~ fullRegex+  -- We end up with 5 groups overall+  (name, version) <- case groups of+    [_, name, version, ""] -> pure (name, version)+    [_, _, _, name] -> pure (name, "")+    _ -> fail $ "could not parse package string: " <> packageString+  pure $ InstrumentationLibrary {libraryName = T.pack name, libraryVersion = T.pack version, librarySchemaUrl = "", libraryAttributes = emptyAttributes}+++-- | Works out the instrumentation library for your package.+detectInstrumentationLibrary :: forall m. (TH.Quasi m, TH.Quote m) => m TH.Exp+detectInstrumentationLibrary = do+  TH.Loc {loc_package} <- TH.qLocation+  lib <- parseInstrumentationLibrary loc_package+  TH.lift lib
+ src/OpenTelemetry/Internal/Logs/Core.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE TypeApplications #-}++module OpenTelemetry.Internal.Logs.Core (+  LoggerProviderOptions (..),+  emptyLoggerProviderOptions,+  createLoggerProvider,+  setGlobalLoggerProvider,+  getGlobalLoggerProvider,+  shutdownLoggerProvider,+  forceFlushLoggerProvider,+  makeLogger,+  emitLogRecord,+  addAttribute,+  addAttributes,+  logRecordGetAttributes,+  logDroppedAttributes,+  emitOTelLogRecord,+) where++import Control.Applicative+import Control.Concurrent.Async+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.Maybe+import Data.Coerce+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import Data.IORef+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Data.Version (showVersion)+import GHC.IO (unsafePerformIO)+import qualified OpenTelemetry.Attributes as A+import OpenTelemetry.Common+import OpenTelemetry.Context+import OpenTelemetry.Context.ThreadLocal+import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Logs.Types+import OpenTelemetry.Internal.Trace.Types (SpanContext (..), getSpanContext)+import OpenTelemetry.LogAttributes (LogAttributes)+import qualified OpenTelemetry.LogAttributes as LA+import OpenTelemetry.Resource (MaterializedResources, emptyMaterializedResources)+import Paths_hs_opentelemetry_api (version)+import System.Clock+import System.Timeout (timeout)+++getCurrentTimestamp :: (MonadIO m) => m Timestamp+getCurrentTimestamp = liftIO $ coerce @(IO TimeSpec) @(IO Timestamp) $ getTime Realtime+++data LoggerProviderOptions = LoggerProviderOptions+  { loggerProviderOptionsResource :: MaterializedResources+  , loggerProviderOptionsAttributeLimits :: A.AttributeLimits+  }+++{- | Options for creating a @LoggerProvider@ with no resources and default limits.++ In effect, logging is a no-op when using this configuration and no-op Processors.+-}+emptyLoggerProviderOptions :: LoggerProviderOptions+emptyLoggerProviderOptions =+  LoggerProviderOptions+    { loggerProviderOptionsResource = emptyMaterializedResources+    , loggerProviderOptionsAttributeLimits = A.defaultAttributeLimits+    }+++{- | Initialize a new @LoggerProvider@++ You should generally use @getGlobalLoggerProvider@ for most applications.+-}+createLoggerProvider :: [LogRecordProcessor] -> LoggerProviderOptions -> LoggerProvider+createLoggerProvider ps LoggerProviderOptions {..} =+  LoggerProvider+    { loggerProviderProcessors = V.fromList ps+    , loggerProviderResource = loggerProviderOptionsResource+    , loggerProviderAttributeLimits = loggerProviderOptionsAttributeLimits+    }+++-- | Logging is no-op when using this @LoggerProvider@ because it has no processors and empty options.+noOpLoggerProvider :: LoggerProvider+noOpLoggerProvider = createLoggerProvider [] emptyLoggerProviderOptions+++globalLoggerProvider :: IORef LoggerProvider+globalLoggerProvider = unsafePerformIO $ newIORef noOpLoggerProvider+{-# NOINLINE globalLoggerProvider #-}+++-- | Access the globally configured @LoggerProvider@. This @LoggerProvider@ is no-op until initialized by the SDK+getGlobalLoggerProvider :: (MonadIO m) => m LoggerProvider+getGlobalLoggerProvider = liftIO $ readIORef globalLoggerProvider+++{- | Overwrite the globally configured @LoggerProvider@.++ @Logger@s acquired from the previously installed @LoggerProvider@s+ will continue to use that @LoggerProvider@s settings.+-}+setGlobalLoggerProvider :: (MonadIO m) => LoggerProvider -> m ()+setGlobalLoggerProvider = liftIO . writeIORef globalLoggerProvider+++{- | This method provides a way for provider to do any cleanup required.++ This will also trigger shutdowns on all internal processors.+-}+shutdownLoggerProvider :: (MonadIO m) => LoggerProvider -> m ()+shutdownLoggerProvider LoggerProvider {loggerProviderProcessors} = liftIO $ do+  asyncShutdownResults <- V.forM loggerProviderProcessors $ \processor -> do+    logRecordProcessorShutdown processor+  mapM_ wait asyncShutdownResults+++{- | This method provides a way for provider to immediately export all @LogRecord@s that have not yet+ been exported for all the internal processors.+-}+forceFlushLoggerProvider+  :: (MonadIO m)+  => LoggerProvider+  -> 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.+forceFlushLoggerProvider LoggerProvider {loggerProviderProcessors} mtimeout = liftIO $ do+  jobs <- V.forM loggerProviderProcessors $ \processor -> async $ do+    logRecordProcessorForceFlush processor+  mresult <-+    timeout (fromMaybe 5_000_000 mtimeout) $+      V.foldM+        ( \status action -> do+            res <- waitCatch action+            pure $! case res of+              Left _err -> FlushError+              Right _ok -> status+        )+        FlushSuccess+        jobs+  case mresult of+    Nothing -> pure FlushTimeout+    Just res -> pure res+++makeLogger+  :: LoggerProvider+  -- ^ The @LoggerProvider@ holds the configuration for the @Logger@.+  -> InstrumentationLibrary+  -- ^ The library that the @Logger@ instruments. This uniquely identifies the @Logger@.+  -> Logger+makeLogger loggerLoggerProvider loggerInstrumentationScope = Logger {..}+++createImmutableLogRecord+  :: (MonadIO m)+  => LA.AttributeLimits+  -> LogRecordArguments+  -> m ImmutableLogRecord+createImmutableLogRecord attributeLimits LogRecordArguments {..} = do+  currentTimestamp <- getCurrentTimestamp+  let logRecordObservedTimestamp = fromMaybe currentTimestamp observedTimestamp++  logRecordTracingDetails <- runMaybeT $ do+    currentContext <- liftIO getContext+    currentSpan <- MaybeT $ pure $ lookupSpan $ fromMaybe currentContext context+    SpanContext {traceId, spanId, traceFlags} <- getSpanContext currentSpan+    pure (traceId, spanId, traceFlags)++  let logRecordAttributes =+        LA.addAttributes+          attributeLimits+          LA.emptyAttributes+          attributes++  when (LA.attributesDropped logRecordAttributes > 0) $ void logDroppedAttributes++  pure+    ImmutableLogRecord+      { logRecordTimestamp = timestamp+      , logRecordObservedTimestamp+      , logRecordTracingDetails+      , logRecordSeverityNumber = severityNumber+      , logRecordSeverityText = severityText <|> (toShortName =<< severityNumber)+      , logRecordBody = body+      , logRecordAttributes+      }+++-- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.+logDroppedAttributes :: (MonadIO m) => m ReadWriteLogRecord+logDroppedAttributes = emitOTelLogRecord H.empty Warn "At least 1 attribute was discarded due to the attribute limits set in the logger provider."+++-- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.+emitOTelLogRecord :: (MonadIO m) => H.HashMap Text LA.AnyValue -> SeverityNumber -> Text -> m ReadWriteLogRecord+emitOTelLogRecord attrs severity bodyText = do+  glp <- getGlobalLoggerProvider+  let gl =+        makeLogger glp $+          InstrumentationLibrary+            { libraryName = "hs-opentelemetry-api"+            , libraryVersion = T.pack $ showVersion version+            , librarySchemaUrl = ""+            , libraryAttributes = A.emptyAttributes+            }++  emitLogRecord gl $+    emptyLogRecordArguments+      { severityNumber = Just severity+      , body = toValue bodyText+      , attributes = attrs+      }+++{- | Emits a @LogRecord@ with properties specified by the passed in Logger and LogRecordArguments.+If observedTimestamp is not set in LogRecordArguments, it will default to the current timestamp.+If context is not specified in LogRecordArguments it will default to the current context.++The emitted @LogRecord@ will be passed to any @LogRecordProcessor@s registered on the @LoggerProvider@+that created the @Logger@.+-}+emitLogRecord+  :: (MonadIO m)+  => Logger+  -> LogRecordArguments+  -> m ReadWriteLogRecord+emitLogRecord l args = do+  let LoggerProvider {loggerProviderProcessors, loggerProviderAttributeLimits} = loggerLoggerProvider l++  ilr <- createImmutableLogRecord loggerProviderAttributeLimits args+  lr <- liftIO $ mkReadWriteLogRecord l ilr++  ctxt <- getContext+  mapM_ (\processor -> liftIO $ logRecordProcessorOnEmit processor lr ctxt) loggerProviderProcessors++  pure lr+++{- | Add an attribute to a @LogRecord@.++This is not an atomic modification++As an application developer when you need to record an attribute first consult existing semantic conventions for Resources, Spans, and Metrics. If an appropriate name does not exists you will need to come up with a new name. To do that consider a few options:++The name is specific to your company and may be possibly used outside the company as well. To avoid clashes with names introduced by other companies (in a distributed system that uses applications from multiple vendors) it is recommended to prefix the new name by your company’s reverse domain name, e.g. 'com.acme.shopname'.++The name is specific to your application that will be used internally only. If you already have an internal company process that helps you to ensure no name clashes happen then feel free to follow it. Otherwise it is recommended to prefix the attribute name by your application name, provided that the application name is reasonably unique within your organization (e.g. 'myuniquemapapp.longitude' is likely fine). Make sure the application name does not clash with an existing semantic convention namespace.++The name may be generally applicable to applications in the industry. In that case consider submitting a proposal to this specification to add a new name to the semantic conventions, and if necessary also to add a new namespace.++It is recommended to limit names to printable Basic Latin characters (more precisely to 'U+0021' .. 'U+007E' subset of Unicode code points), although the Haskell OpenTelemetry specification DOES provide full Unicode support.++Attribute names that start with 'otel.' are reserved to be defined by OpenTelemetry specification. These are typically used to express OpenTelemetry concepts in formats that don’t have a corresponding concept.++For example, the 'otel.library.name' attribute is used to record the instrumentation library name, which is an OpenTelemetry concept that is natively represented in OTLP, but does not have an equivalent in other telemetry formats and protocols.++Any additions to the 'otel.*' namespace MUST be approved as part of OpenTelemetry specification.+-}+addAttribute :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> Text -> a -> m ()+addAttribute lr k v =+  let attributeLimits = readLogRecordAttributeLimits lr+  in liftIO $+      modifyLogRecord+        lr+        ( \ilr@ImmutableLogRecord {logRecordAttributes} ->+            ilr+              { logRecordAttributes =+                  LA.addAttribute+                    attributeLimits+                    logRecordAttributes+                    k+                    v+              }+        )+++{- | A convenience function related to 'addAttribute' that adds multiple attributes to a @LogRecord@ at the same time.++This function may be slightly more performant than repeatedly calling 'addAttribute'.++This is not an atomic modification+-}+addAttributes :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> HashMap Text a -> m ()+addAttributes lr attrs =+  let attributeLimits = readLogRecordAttributeLimits lr+  in liftIO $+      modifyLogRecord+        lr+        ( \ilr@ImmutableLogRecord {logRecordAttributes} ->+            ilr+              { logRecordAttributes =+                  LA.addAttributes+                    attributeLimits+                    logRecordAttributes+                    attrs+              }+        )+++{- | This can be useful for pulling data for attributes and+ using it to copy / otherwise use the data to further enrich+ instrumentation.+-}+logRecordGetAttributes :: (IsReadableLogRecord r, MonadIO m) => r -> m LogAttributes+logRecordGetAttributes lr = liftIO $ logRecordAttributes <$> readLogRecord lr
+ src/OpenTelemetry/Internal/Logs/Types.hs view
@@ -0,0 +1,491 @@+{-# LANGUAGE NamedFieldPuns #-}++module OpenTelemetry.Internal.Logs.Types (+  LogRecordExporter,+  LogRecordExporterArguments (..),+  mkLogRecordExporter,+  logRecordExporterExport,+  logRecordExporterForceFlush,+  logRecordExporterShutdown,+  LogRecordProcessor (..),+  LoggerProvider (..),+  Logger (..),+  ReadWriteLogRecord,+  mkReadWriteLogRecord,+  ReadableLogRecord,+  mkReadableLogRecord,+  IsReadableLogRecord (..),+  IsReadWriteLogRecord (..),+  ImmutableLogRecord (..),+  LogRecordArguments (..),+  emptyLogRecordArguments,+  SeverityNumber (..),+  toShortName,+) where++import Control.Concurrent (MVar, newMVar, withMVar)+import Control.Concurrent.Async+import Data.Function (on)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import Data.IORef (IORef, atomicModifyIORef, modifyIORef, newIORef, readIORef)+import Data.Text (Text)+import Data.Vector (Vector)+import OpenTelemetry.Common (Timestamp, TraceFlags)+import OpenTelemetry.Context.Types (Context)+import OpenTelemetry.Internal.Common.Types (ExportResult, InstrumentationLibrary, ShutdownResult)+import OpenTelemetry.Internal.Trace.Id (SpanId, TraceId)+import OpenTelemetry.LogAttributes+import OpenTelemetry.Resource (MaterializedResources)+++-- | See @LogRecordExporter@ for documentation+data LogRecordExporterArguments = LogRecordExporterArguments+  { logRecordExporterArgumentsExport :: Vector ReadableLogRecord -> IO ExportResult+  -- ^ See @logRecordExporterExport@ for documentation+  , logRecordExporterArgumentsForceFlush :: IO ()+  -- ^ See @logRecordExporterArgumentsForceFlush@ for documentation+  , logRecordExporterArgumentsShutdown :: IO ()+  -- ^ See @logRecordExporterArgumentsShutdown@ for documentation+  }+++{- | @LogRecordExporter@ defines the interface that protocol-specific exporters must implement so that they can be plugged into OpenTelemetry SDK and support sending of telemetry data.++The goal of the interface is to minimize burden of implementation for protocol-dependent telemetry exporters. The protocol exporter is expected to be primarily a simple telemetry data encoder and transmitter.++@LogRecordExporter@s provide thread safety when calling @logRecordExporterExport@+-}+newtype LogRecordExporter = LogRecordExporter {unExporter :: MVar LogRecordExporterArguments}+++mkLogRecordExporter :: LogRecordExporterArguments -> IO LogRecordExporter+mkLogRecordExporter = fmap LogRecordExporter . newMVar+++{- | Exports a batch of ReadableLogRecords. Protocol exporters that will implement this function are typically expected to serialize+and transmit the data to the destination.++Export will never be called concurrently for the same exporter instance. Depending on the implementation the result of the export+may be returned to the Processor not in the return value of the call to Export but in a language specific way for signaling completion+of an asynchronous task. This means that while an instance of an exporter will never have it Export called concurrently it does not+mean that the task of exporting can not be done concurrently. How this is done is outside the scope of this specification.+Each implementation MUST document the concurrency characteristics the SDK requires of the exporter.++Export MUST NOT block indefinitely, there MUST be a reasonable upper limit after which the call must time out with an error result (Failure).++Concurrent requests and retry logic is the responsibility of the exporter. The default SDK’s LogRecordProcessors SHOULD NOT implement+retry logic, as the required logic is likely to depend heavily on the specific protocol and backend the logs are being sent to.+For example, the OpenTelemetry Protocol (OTLP) specification defines logic for both sending concurrent requests and retrying requests.++Result:+Success - The batch has been successfully exported. For protocol exporters this typically means that the data is sent over the wire and delivered to the destination server.+Failure - exporting failed. The batch must be dropped. For example, this can happen when the batch contains bad data and cannot be serialized.+-}+logRecordExporterExport :: LogRecordExporter -> Vector ReadableLogRecord -> IO ExportResult+logRecordExporterExport exporter lrs = withMVar (unExporter exporter) $ \e -> logRecordExporterArgumentsExport e lrs+++{- | This is a hint to ensure that the export of any ReadableLogRecords the exporter has received prior to the call to ForceFlush SHOULD+be completed as soon as possible, preferably before returning from this method.++ForceFlush SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.++ForceFlush SHOULD only be called in cases where it is absolutely necessary, such as when using some FaaS providers that may suspend+the process after an invocation, but before the exporter exports the ReadlableLogRecords.++ForceFlush SHOULD complete or abort within some timeout. ForceFlush can be implemented as a blocking API or an asynchronous API which+notifies the caller via a callback or an event. OpenTelemetry SDK authors MAY decide if they want to make the flush timeout configurable.+-}+logRecordExporterForceFlush :: LogRecordExporter -> IO ()+logRecordExporterForceFlush = flip withMVar logRecordExporterArgumentsForceFlush . unExporter+++{- | Shuts down the exporter. Called when SDK is shut down. This is an opportunity for exporter to do any cleanup required.++Shutdown SHOULD be called only once for each LogRecordExporter instance. After the call to Shutdown subsequent calls to Export are not+allowed and SHOULD return a Failure result.++Shutdown SHOULD NOT block indefinitely (e.g. if it attempts to flush the data and the destination is unavailable).+OpenTelemetry SDK authors MAY decide if they want to make the shutdown timeout configurable.+-}+logRecordExporterShutdown :: LogRecordExporter -> IO ()+logRecordExporterShutdown = flip withMVar logRecordExporterArgumentsShutdown . unExporter+++{- | LogRecordProcessor is an interface which allows hooks for LogRecord emitting.++Built-in processors are responsible for batching and conversion of LogRecords to exportable representation and passing batches to exporters.++LogRecordProcessors can be registered directly on SDK LoggerProvider and they are invoked in the same order as they were registered.++Each processor registered on LoggerProvider is part of a pipeline that consists of a processor and optional exporter. The SDK MUST allow each pipeline to end with an individual exporter.++The SDK MUST allow users to implement and configure custom processors and decorate built-in processors for advanced scenarios such as enriching with attributes.++The following diagram shows LogRecordProcessor’s relationship to other components in the SDK:+++-----+------------------------+   +------------------------------+   +-------------------------++|     |                        |   |                              |   |                         |+|     |                        |   | Batching LogRecordProcessor  |   |    LogRecordExporter    |+|     |                        +---> Simple LogRecordProcessor    +--->     (OtlpExporter)      |+|     |                        |   |                              |   |                         |+| SDK | Logger.emit(LogRecord) |   +------------------------------+   +-------------------------++|     |                        |+|     |                        |+|     |                        |+|     |                        |+|     |                        |++-----+------------------------++-}+data LogRecordProcessor = LogRecordProcessor+  { logRecordProcessorOnEmit :: ReadWriteLogRecord -> Context -> IO ()+  -- ^ Called when a LogRecord is emitted. This method is called synchronously on the thread that emitted the LogRecord, therefore it SHOULD NOT block or throw exceptions.+  --+  -- A LogRecordProcessor may freely modify logRecord for the duration of the OnEmit call. If logRecord is needed after OnEmit returns (i.e. for asynchronous processing) only reads are permitted.+  , logRecordProcessorShutdown :: IO (Async ShutdownResult)+  -- ^ Shuts down the processor. Called when SDK is shut down. This is an opportunity for processor to do any cleanup required.+  --+  -- Shutdown SHOULD be called only once for each LogRecordProcessor instance. After the call to Shutdown, subsequent calls to OnEmit are not allowed. SDKs SHOULD ignore these calls gracefully, if possible.+  --+  -- Shutdown SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.+  --+  -- Shutdown MUST include the effects of ForceFlush.+  --+  -- Shutdown SHOULD complete or abort within some timeout. Shutdown can be implemented as a blocking API or an asynchronous API which notifies the caller via a callback or an event.+  -- OpenTelemetry SDK authors can decide if they want to make the shutdown timeout configurable.+  , logRecordProcessorForceFlush :: IO ()+  -- ^ This is a hint to ensure that any tasks associated with LogRecords for which the LogRecordProcessor had already received events prior to the call to ForceFlush SHOULD be completed+  -- as soon as possible, preferably before returning from this method.+  --+  -- In particular, if any LogRecordProcessor has any associated exporter, it SHOULD try to call the exporter’s Export with all LogRecords for which this was not already done and then invoke ForceFlush on it.+  -- The built-in LogRecordProcessors MUST do so. If a timeout is specified (see below), the LogRecordProcessor MUST prioritize honoring the timeout over finishing all calls. It MAY skip or abort some or all+  -- Export or ForceFlush calls it has made to achieve this goal.+  --+  -- ForceFlush SHOULD provide a way to let the caller know whether it succeeded, failed or timed out.+  --+  -- ForceFlush SHOULD only be called in cases where it is absolutely necessary, such as when using some FaaS providers that may suspend the process after an invocation, but before the LogRecordProcessor exports the emitted LogRecords.+  --+  -- ForceFlush SHOULD complete or abort within some timeout. ForceFlush can be implemented as a blocking API or an asynchronous API which notifies the caller via a callback or an event. OpenTelemetry SDK authors+  -- can decide if they want to make the flush timeout configurable.+  }+++-- | @Logger@s can be created from @LoggerProvider@s+data LoggerProvider = LoggerProvider+  { loggerProviderProcessors :: Vector LogRecordProcessor+  , loggerProviderResource :: MaterializedResources+  -- ^ Describes the source of the log, aka resource. Multiple occurrences of events coming from the same event source can happen across time and they all have the same value of Resource.+  -- Can contain for example information about the application that emits the record or about the infrastructure where the application runs. Data formats that represent this data model+  -- may be designed in a manner that allows the Resource field to be recorded only once per batch of log records that come from the same source. SHOULD follow OpenTelemetry semantic conventions for Resources.+  -- This field is optional.+  , loggerProviderAttributeLimits :: AttributeLimits+  }+++{- | @LogRecords@ can be created from @Loggers@. @Logger@s are uniquely identified by the @libraryName@, @libraryVersion@, @schemaUrl@ fields of @InstrumentationLibrary@.+Creating two @Logger@s with the same identity but different @libraryAttributes@ is a user error.+-}+data Logger = Logger+  { loggerInstrumentationScope :: InstrumentationLibrary+  -- ^ Details about the library that the @Logger@ instruments.+  , loggerLoggerProvider :: LoggerProvider+  -- ^ The @LoggerProvider@ that created this @Logger@. All configuration for the @Logger@ is contained in the @LoggerProvider@.+  }+++{- | This is a data type that can represent logs from various sources: application log files, machine generated events, system logs, etc. [Specification outlined here.](https://opentelemetry.io/docs/specs/otel/logs/data-model/)+Existing log formats can be unambiguously mapped to this data type. Reverse mapping from this data type is also possible to the extent that the target log format has equivalent capabilities.+Uses an IORef under the hood to allow mutability.+-}+data ReadWriteLogRecord = ReadWriteLogRecord Logger (IORef ImmutableLogRecord)+++mkReadWriteLogRecord :: Logger -> ImmutableLogRecord -> IO ReadWriteLogRecord+mkReadWriteLogRecord l = fmap (ReadWriteLogRecord l) . newIORef+++newtype ReadableLogRecord = ReadableLogRecord {readableLogRecord :: ReadWriteLogRecord}+++mkReadableLogRecord :: ReadWriteLogRecord -> ReadableLogRecord+mkReadableLogRecord = ReadableLogRecord+++{- | This is a typeclass representing @LogRecord@s that can be read from.++A function receiving this as an argument MUST be able to access all the information added to the LogRecord. It MUST also be able to access the Instrumentation Scope and Resource information (implicitly) associated with the LogRecord.++The trace context fields MUST be populated from the resolved Context (either the explicitly passed Context or the current Context) when emitted.++Counts for attributes due to collection limits MUST be available for exporters to report as described in the transformation to non-OTLP formats specification.+-}+class IsReadableLogRecord r where+  -- | Reads the current state of the @LogRecord@ from its internal @IORef@. The implementation mirrors @readIORef@.+  readLogRecord :: r -> IO ImmutableLogRecord+++  -- | Reads the @InstrumentationScope@ from the @Logger@ that emitted the @LogRecord@+  readLogRecordInstrumentationScope :: r -> InstrumentationLibrary+++  -- | Reads the @Resource@ from the @LoggerProvider@ that emitted the @LogRecord@+  readLogRecordResource :: r -> MaterializedResources+++{- | This is a typeclass representing @LogRecord@s that can be read from or written to. All @ReadWriteLogRecord@s are @ReadableLogRecord@s.++A function receiving this as an argument MUST additionally be able to modify the following information added to the LogRecord:++- Timestamp+- ObservedTimestamp+- SeverityText+- SeverityNumber+- Body+- Attributes (addition, modification, removal)+- TraceId+- SpanId+- TraceFlags+-}+class (IsReadableLogRecord r) => IsReadWriteLogRecord r where+  -- | Reads the attribute limits from the @LoggerProvider@ that emitted the @LogRecord@. These are needed to add more attributes.+  readLogRecordAttributeLimits :: r -> AttributeLimits+++  -- | Modifies the @LogRecord@ using its internal @IORef@. This is lazy and is not an atomic operation. The implementation mirrors @modifyIORef@.+  modifyLogRecord :: r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()+++  -- | An atomic version of @modifyLogRecord@. This function is lazy. The implementation mirrors @atomicModifyIORef@.+  atomicModifyLogRecord :: r -> (ImmutableLogRecord -> (ImmutableLogRecord, b)) -> IO b+++instance IsReadableLogRecord ReadableLogRecord where+  readLogRecord = readLogRecord . readableLogRecord+  readLogRecordInstrumentationScope = readLogRecordInstrumentationScope . readableLogRecord+  readLogRecordResource = readLogRecordResource . readableLogRecord+++instance IsReadableLogRecord ReadWriteLogRecord where+  readLogRecord (ReadWriteLogRecord _ ref) = readIORef ref+  readLogRecordInstrumentationScope (ReadWriteLogRecord (Logger {loggerInstrumentationScope}) _) = loggerInstrumentationScope+  readLogRecordResource (ReadWriteLogRecord Logger {loggerLoggerProvider = LoggerProvider {loggerProviderResource}} _) = loggerProviderResource+++instance IsReadWriteLogRecord ReadWriteLogRecord where+  readLogRecordAttributeLimits (ReadWriteLogRecord Logger {loggerLoggerProvider = LoggerProvider {loggerProviderAttributeLimits}} _) = loggerProviderAttributeLimits+  modifyLogRecord (ReadWriteLogRecord _ ref) = modifyIORef ref+  atomicModifyLogRecord (ReadWriteLogRecord _ ref) = atomicModifyIORef ref+++data ImmutableLogRecord = ImmutableLogRecord+  { logRecordTimestamp :: Maybe Timestamp+  -- ^ Time when the event occurred measured by the origin clock. This field is optional, it may be missing if the timestamp is unknown.+  , logRecordObservedTimestamp :: Timestamp+  -- ^ Time when the event was observed by the collection system. For events that originate in OpenTelemetry (e.g. using OpenTelemetry Logging SDK)+  -- this timestamp is typically set at the generation time and is equal to Timestamp. For events originating externally and collected by OpenTelemetry (e.g. using Collector)+  -- this is the time when OpenTelemetry’s code observed the event measured by the clock of the OpenTelemetry code. This field SHOULD be set once the event is observed by OpenTelemetry.+  --+  -- For converting OpenTelemetry log data to formats that support only one timestamp or when receiving OpenTelemetry log data by recipients that support only one timestamp internally the following logic is recommended:+  -- - Use Timestamp if it is present, otherwise use ObservedTimestamp+  , logRecordTracingDetails :: Maybe (TraceId, SpanId, TraceFlags)+  -- ^ Tuple contains three fields:+  --+  -- - Request trace id as defined in W3C Trace Context. Can be set for logs that are part of request processing and have an assigned trace id.+  -- - Span id. Can be set for logs that are part of a particular processing span.+  -- - Trace flag as defined in W3C Trace Context specification. At the time of writing the specification defines one flag - the SAMPLED flag.+  , logRecordSeverityText :: Maybe Text+  -- ^ severity text (also known as log level). This is the original string representation of the severity as it is known at the source. If this field is missing+  -- and SeverityNumber is present then the short name that corresponds to the SeverityNumber may be used as a substitution. This field is optional.+  , logRecordSeverityNumber :: Maybe SeverityNumber+  -- ^ SeverityNumber is an integer number. Smaller numerical values correspond to less severe events (such as debug events), larger numerical values correspond to+  -- more severe events (such as errors and critical events). The following table defines the meaning of SeverityNumber value:+  --+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | SeverityNumber range  | Range name  | Meaning                                                                                  |+  -- +=======================+=============+==========================================================================================++  -- | 1-4                   | TRACE       | A fine-grained debugging event. Typically disabled in default configurations.            |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | 5-8                   | DEBUG       | A debugging event.                                                                       |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | 9-12                  | INFO        | An informational event. Indicates that an event happened.                                |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | 13-16                 | WARN        | A warning event. Not an error but is likely more important than an informational event.  |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | 17-20                 | ERROR       | An error event. Something went wrong.                                                    |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- | 21-24                 | FATAL       | A fatal error such as application or system crash.                                       |+  -- +-----------------------+-------------+------------------------------------------------------------------------------------------++  -- Smaller numerical values in each range represent less important (less severe) events. Larger numerical values in each range represent more important (more severe) events.+  -- For example SeverityNumber=17 describes an error that is less critical than an error with SeverityNumber=20.+  --+  -- Mappings from existing logging systems and formats (or source format for short) must define how severity (or log level) of that particular format corresponds to SeverityNumber+  -- of this data model based on the meaning given for each range in the above table. [More Information](https://opentelemetry.io/docs/specs/otel/logs/data-model/#mapping-of-severitynumber)+  --+  -- [These short names](https://opentelemetry.io/docs/specs/otel/logs/data-model/#displaying-severity) can be used to represent SeverityNumber in the UI+  --+  -- In the contexts where severity participates in less-than / greater-than comparisons SeverityNumber field should be used.+  -- SeverityNumber can be compared to another SeverityNumber or to numbers in the 1..24 range (or to the corresponding short names).+  , logRecordBody :: AnyValue+  -- ^ A value containing the body of the log record. Can be for example a human-readable string message (including multi-line) describing the event in a free form or it can be a+  -- structured data composed of arrays and maps of other values. Body MUST support any type to preserve the semantics of structured logs emitted by the applications.+  -- Can vary for each occurrence of the event coming from the same source. This field is optional.+  --+  -- Type any+  --    Value of type any can be one of the following:+  --    - A scalar value: number, string or boolean,+  --    - A byte array,+  --    - An array (a list) of any values,+  --    - A map<string, any>.+  , logRecordAttributes :: LogAttributes+  -- ^ Additional information about the specific event occurrence. Unlike the Resource field, which is fixed for a particular source, Attributes can vary for each occurrence of the event coming from the same source.+  -- Can contain information about the request context (other than Trace Context Fields). The log attribute model MUST support any type, a superset of standard Attribute, to preserve the semantics of structured attributes+  -- emitted by the applications. This field is optional.+  }+++{- | Arguments that may be set on LogRecord creation. If observedTimestamp is not set, it will default to the current timestamp.+If context is not specified it will default to the current context. Refer to the documentation of @LogRecord@ for descriptions+of the fields.+-}+data LogRecordArguments = LogRecordArguments+  { timestamp :: Maybe Timestamp+  , observedTimestamp :: Maybe Timestamp+  , context :: Maybe Context+  , severityText :: Maybe Text+  , severityNumber :: Maybe SeverityNumber+  , body :: AnyValue+  , attributes :: HashMap Text AnyValue+  }+++emptyLogRecordArguments :: LogRecordArguments+emptyLogRecordArguments =+  LogRecordArguments+    { timestamp = Nothing+    , observedTimestamp = Nothing+    , context = Nothing+    , severityText = Nothing+    , severityNumber = Nothing+    , body = NullValue+    , attributes = H.empty+    }+++data SeverityNumber+  = Trace+  | Trace2+  | Trace3+  | Trace4+  | Debug+  | Debug2+  | Debug3+  | Debug4+  | Info+  | Info2+  | Info3+  | Info4+  | Warn+  | Warn2+  | Warn3+  | Warn4+  | Error+  | Error2+  | Error3+  | Error4+  | Fatal+  | Fatal2+  | Fatal3+  | Fatal4+  | Unknown !Int+++instance Enum SeverityNumber where+  toEnum 1 = Trace+  toEnum 2 = Trace2+  toEnum 3 = Trace3+  toEnum 4 = Trace4+  toEnum 5 = Debug+  toEnum 6 = Debug2+  toEnum 7 = Debug3+  toEnum 8 = Debug4+  toEnum 9 = Info+  toEnum 10 = Info2+  toEnum 11 = Info3+  toEnum 12 = Info4+  toEnum 13 = Warn+  toEnum 14 = Warn2+  toEnum 15 = Warn3+  toEnum 16 = Warn4+  toEnum 17 = Error+  toEnum 18 = Error2+  toEnum 19 = Error3+  toEnum 20 = Error4+  toEnum 21 = Fatal+  toEnum 22 = Fatal2+  toEnum 23 = Fatal3+  toEnum 24 = Fatal4+  toEnum n = Unknown n+++  fromEnum Trace = 1+  fromEnum Trace2 = 2+  fromEnum Trace3 = 3+  fromEnum Trace4 = 4+  fromEnum Debug = 5+  fromEnum Debug2 = 6+  fromEnum Debug3 = 7+  fromEnum Debug4 = 8+  fromEnum Info = 9+  fromEnum Info2 = 10+  fromEnum Info3 = 11+  fromEnum Info4 = 12+  fromEnum Warn = 13+  fromEnum Warn2 = 14+  fromEnum Warn3 = 15+  fromEnum Warn4 = 16+  fromEnum Error = 17+  fromEnum Error2 = 18+  fromEnum Error3 = 19+  fromEnum Error4 = 20+  fromEnum Fatal = 21+  fromEnum Fatal2 = 22+  fromEnum Fatal3 = 23+  fromEnum Fatal4 = 24+  fromEnum (Unknown n) = n+++instance Eq SeverityNumber where+  (==) = on (==) fromEnum+++instance Ord SeverityNumber where+  compare = on compare fromEnum+++toShortName :: SeverityNumber -> Maybe Text+toShortName Trace = Just "TRACE"+toShortName Trace2 = Just "TRACE2"+toShortName Trace3 = Just "TRACE3"+toShortName Trace4 = Just "TRACE4"+toShortName Debug = Just "DEBUG"+toShortName Debug2 = Just "DEBUG2"+toShortName Debug3 = Just "DEBUG3"+toShortName Debug4 = Just "DEBUG4"+toShortName Info = Just "INFO"+toShortName Info2 = Just "INFO2"+toShortName Info3 = Just "INFO3"+toShortName Info4 = Just "INFO4"+toShortName Warn = Just "WARN"+toShortName Warn2 = Just "WARN2"+toShortName Warn3 = Just "WARN3"+toShortName Warn4 = Just "WARN4"+toShortName Error = Just "ERROR"+toShortName Error2 = Just "ERROR2"+toShortName Error3 = Just "ERROR3"+toShortName Error4 = Just "ERROR4"+toShortName Fatal = Just "FATAL"+toShortName Fatal2 = Just "FATAL2"+toShortName Fatal3 = Just "FATAL3"+toShortName Fatal4 = Just "FATAL4"+toShortName (Unknown _) = Nothing
src/OpenTelemetry/Internal/Trace/Types.hs view
@@ -8,23 +8,19 @@ module OpenTelemetry.Internal.Trace.Types where  import Control.Concurrent.Async (Async)-import Control.Exception (SomeException) import Control.Monad.IO.Class import Data.Bits import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as H-import Data.Hashable (Hashable) import Data.IORef (IORef, readIORef)-import Data.String (IsString (..)) import Data.Text (Text) import Data.Vector (Vector) import Data.Word (Word8)-import GHC.Generics import Network.HTTP.Types (RequestHeaders, ResponseHeaders) import OpenTelemetry.Attributes import OpenTelemetry.Common import OpenTelemetry.Context.Types-import OpenTelemetry.Logging.Core (Log)+import OpenTelemetry.Internal.Common.Types import OpenTelemetry.Propagator (Propagator) import OpenTelemetry.Resource import OpenTelemetry.Trace.Id@@ -33,71 +29,18 @@ import OpenTelemetry.Util  -data ExportResult-  = Success-  | Failure (Maybe SomeException)---{- | An identifier for the library that provides the instrumentation for a given Instrumented Library.- Instrumented Library and Instrumentation Library may be the same library if it has built-in OpenTelemetry instrumentation.-- The inspiration of the OpenTelemetry project is to make every library and application observable out of the box by having them call OpenTelemetry API directly.- However, many libraries will not have such integration, and as such there is a need for a separate library which would inject such calls, using mechanisms such as wrapping interfaces,- subscribing to library-specific callbacks, or translating existing telemetry into the OpenTelemetry model.-- A library that enables OpenTelemetry observability for another library is called an Instrumentation Library.-- An instrumentation library should be named to follow any naming conventions of the instrumented library (e.g. 'middleware' for a web framework).-- If there is no established name, the recommendation is to prefix packages with "hs-opentelemetry-instrumentation", followed by the instrumented library name itself.-- In general, you can initialize the instrumentation library like so:-- @-- import qualified Data.Text as T- import Data.Version (showVersion)- import Paths_your_package_name-- instrumentationLibrary :: InstrumentationLibrary- instrumentationLibrary = InstrumentationLibrary-   { libraryName = "your_package_name"-   , libraryVersion = T.pack $ showVersion version-   }-- @--}-data InstrumentationLibrary = InstrumentationLibrary-  { libraryName :: {-# UNPACK #-} !Text-  -- ^ The name of the instrumentation library-  , libraryVersion :: {-# UNPACK #-} !Text-  -- ^ The version of the instrumented library-  }-  deriving (Ord, Eq, Generic, Show)---instance Hashable InstrumentationLibrary---instance IsString InstrumentationLibrary where-  fromString str = InstrumentationLibrary (fromString str) ""---data Exporter a = Exporter-  { exporterExport :: HashMap InstrumentationLibrary (Vector a) -> IO ExportResult-  , exporterShutdown :: IO ()+data SpanExporter = SpanExporter+  { spanExporterExport :: HashMap InstrumentationLibrary (Vector ImmutableSpan) -> IO ExportResult+  , spanExporterShutdown :: IO ()   }  -data ShutdownResult = ShutdownSuccess | ShutdownFailure | ShutdownTimeout---data Processor = Processor-  { processorOnStart :: IORef ImmutableSpan -> Context -> IO ()+data SpanProcessor = SpanProcessor+  { spanProcessorOnStart :: IORef ImmutableSpan -> Context -> IO ()   -- ^ Called when a span is started. This method is called synchronously on the thread that started the span, therefore it should not block or throw exceptions.-  , processorOnEnd :: IORef ImmutableSpan -> IO ()+  , spanProcessorOnEnd :: IORef ImmutableSpan -> IO ()   -- ^ Called after a span is ended (i.e., the end timestamp is already set). This method is called synchronously within the 'OpenTelemetry.Trace.endSpan' API, therefore it should not block or throw an exception.-  , processorShutdown :: IO (Async ShutdownResult)+  , spanProcessorShutdown :: IO (Async ShutdownResult)   -- ^ Shuts down the processor. Called when SDK is shut down. This is an opportunity for processor to do any cleanup required.   --   -- Shutdown SHOULD be called only once for each SpanProcessor instance. After the call to Shutdown, subsequent calls to OnStart, OnEnd, or ForceFlush are not allowed. SDKs SHOULD ignore these calls gracefully, if possible.@@ -107,7 +50,7 @@   -- Shutdown MUST include the effects of ForceFlush.   --   -- Shutdown SHOULD complete or abort within some timeout. Shutdown can be implemented as a blocking API or an asynchronous API which notifies the caller via a callback or an event. OpenTelemetry client authors can decide if they want to make the shutdown timeout configurable.-  , processorForceFlush :: IO ()+  , spanProcessorForceFlush :: IO ()   -- ^ This is a hint to ensure that any tasks associated with Spans for which the SpanProcessor had already received events prior to the call to ForceFlush SHOULD be completed as soon as possible, preferably before returning from this method.   --   -- In particular, if any Processor has any associated exporter, it SHOULD try to call the exporter's Export with all spans for which this was not already done and then invoke ForceFlush on it. The built-in SpanProcessors MUST do so. If a timeout is specified (see below), the SpanProcessor MUST prioritize honoring the timeout over finishing all calls. It MAY skip or abort some or all Export or ForceFlush calls it has made to achieve this goal.@@ -124,14 +67,13 @@ 'Tracer's can be created from a 'TracerProvider'. -} data TracerProvider = TracerProvider-  { tracerProviderProcessors :: !(Vector Processor)+  { tracerProviderProcessors :: !(Vector SpanProcessor)   , tracerProviderIdGenerator :: !IdGenerator   , tracerProviderSampler :: !Sampler   , tracerProviderResources :: !MaterializedResources   , tracerProviderAttributeLimits :: !AttributeLimits   , tracerProviderSpanLimits :: !SpanLimits   , tracerProviderPropagators :: !(Propagator Context RequestHeaders ResponseHeaders)-  , tracerProviderLogger :: Log Text -> IO ()   }  @@ -232,19 +174,6 @@   }  --- | The outcome of a call to 'OpenTelemetry.Trace.forceFlush'-data FlushResult-  = -- | One or more spans did not export from all associated exporters-    -- within the alotted timeframe.-    FlushTimeout-  | -- | Flushing spans to all associated exporters succeeded.-    FlushSuccess-  | -- | One or more exporters failed to successfully export one or more-    -- unexported spans.-    FlushError-  deriving (Show)-- {- | @SpanKind@ describes the relationship between the @Span@, its parents, and its children in a Trace. @SpanKind@ describes two independent properties that benefit tracing systems during analysis. @@ -337,7 +266,7 @@   , spanEnd :: Maybe Timestamp   -- ^ A timestamp that corresponds to the end of the span, if the span has ended.   , spanAttributes :: Attributes-  , spanLinks :: FrozenBoundedCollection Link+  , spanLinks :: AppendOnlyBoundedCollection Link   -- ^ Zero or more links to related spans. Links can be useful for connecting causal relationships between things like web requests that enqueue asynchronous tasks to be processed.   , spanEvents :: AppendOnlyBoundedCollection Event   -- ^ Events, which denote a point in time occurrence. These can be useful for recording data about a span such as when an exception was thrown, or to emit structured logs into the span tree.
+ src/OpenTelemetry/LogAttributes.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}++module OpenTelemetry.LogAttributes (+  LogAttributes (..),+  emptyAttributes,+  addAttribute,+  addAttributes,+  getAttributes,+  lookupAttribute,+  AnyValue (..),+  ToValue (..),++  -- * Attribute limits+  AttributeLimits (..),+  defaultAttributeLimits,++  -- * unsafe utilities+  unsafeLogAttributesFromListIgnoringLimits,+  unsafeMergeLogAttributesIgnoringLimits,+) where++import qualified Data.HashMap.Strict as H+import Data.Text (Text)+import qualified Data.Text as T+import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits)+import OpenTelemetry.Internal.Common.Types+++data LogAttributes = LogAttributes+  { attributes :: !(H.HashMap Text AnyValue)+  , attributesCount :: {-# UNPACK #-} !Int+  , attributesDropped :: {-# UNPACK #-} !Int+  }+  deriving stock (Show, Eq)+++emptyAttributes :: LogAttributes+emptyAttributes = LogAttributes mempty 0 0+++addAttribute :: (ToValue a) => AttributeLimits -> LogAttributes -> Text -> a -> LogAttributes+addAttribute AttributeLimits {..} LogAttributes {..} !k !v = case attributeCountLimit of+  Nothing -> LogAttributes newAttrs newCount attributesDropped+  Just limit_ ->+    if newCount > limit_+      then LogAttributes attributes attributesCount (attributesDropped + 1)+      else LogAttributes newAttrs newCount attributesDropped+  where+    newAttrs = H.insert k (maybe id limitLengths attributeCountLimit $ toValue v) attributes+    newCount = H.size newAttrs+{-# INLINE addAttribute #-}+++addAttributes :: (ToValue a) => AttributeLimits -> LogAttributes -> H.HashMap Text a -> LogAttributes+addAttributes AttributeLimits {..} LogAttributes {..} attrs = case attributeCountLimit of+  Nothing -> LogAttributes newAttrs newCount attributesDropped+  Just limit_ ->+    if newCount > limit_+      then LogAttributes attributes attributesCount (attributesDropped + H.size attrs)+      else LogAttributes newAttrs newCount attributesDropped+  where+    newAttrs = H.union attributes $ H.map toValue attrs+    newCount = H.size newAttrs+{-# INLINE addAttributes #-}+++getAttributes :: LogAttributes -> (Int, H.HashMap Text AnyValue)+getAttributes LogAttributes {..} = (attributesCount, attributes)+++lookupAttribute :: LogAttributes -> Text -> Maybe AnyValue+lookupAttribute LogAttributes {..} k = H.lookup k attributes+++limitLengths :: Int -> AnyValue -> AnyValue+limitLengths limit (TextValue t) = TextValue (T.take limit t)+limitLengths limit (ArrayValue arr) = ArrayValue $ fmap (limitLengths limit) arr+limitLengths limit (HashMapValue h) = HashMapValue $ fmap (limitLengths limit) h+limitLengths _ val = val+++unsafeMergeLogAttributesIgnoringLimits :: LogAttributes -> LogAttributes -> LogAttributes+unsafeMergeLogAttributesIgnoringLimits (LogAttributes l lc ld) (LogAttributes r rc rd) = LogAttributes (l <> r) (lc + rc) (ld + rd)+++unsafeLogAttributesFromListIgnoringLimits :: [(Text, AnyValue)] -> LogAttributes+unsafeLogAttributesFromListIgnoringLimits l = LogAttributes hm c 0+  where+    hm = H.fromList l+    c = H.size hm
− src/OpenTelemetry/Logging/Core.hs 
@@ -1,144 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module OpenTelemetry.Logging.Core where--import Data.Int (Int32, Int64)-import Data.Text (Text)-import OpenTelemetry.Attributes (Attribute)-import OpenTelemetry.Common-import OpenTelemetry.Resource (MaterializedResources)-import OpenTelemetry.Trace.Id (SpanId, TraceId)---data Log body = Log-  { timestamp :: Maybe Timestamp-  -- ^ Time when the event occurred measured by the origin clock. This field is optional, it may be missing if the timestamp is unknown.-  , tracingDetails :: Maybe (TraceId, SpanId, TraceFlags)-  -- ^ Tuple contains three fields:-  ---  -- - Request trace id as defined in W3C Trace Context. Can be set for logs that are part of request processing and have an assigned trace id.-  -- - Span id. Can be set for logs that are part of a particular processing span.-  -- - Trace flag as defined in W3C Trace Context specification. At the time of writing the specification defines one flag - the SAMPLED flag.-  , severityText :: Maybe Text-  -- ^ severity text (also known as log level). This is the original string representation of the severity as it is known at the source. If this field is missing and SeverityNumber is present then the short name that corresponds to the SeverityNumber may be used as a substitution. This field is optional.-  , severityNumber :: Maybe Int64-  -- ^ SeverityNumber is an integer number. Smaller numerical values correspond to less severe events (such as debug events), larger numerical values correspond to more severe events (such as errors and critical events). The following table defines the meaning of SeverityNumber value:-  ---  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | SeverityNumber range  | Range name  | Meaning                                                                                  |-  -- +=======================+=============+==========================================================================================+-  -- | 1-4                   | TRACE       | A fine-grained debugging event. Typically disabled in default configurations.            |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | 5-8                   | DEBUG       | A debugging event.                                                                       |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | 9-12                  | INFO        | An informational event. Indicates that an event happened.                                |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | 13-16                 | WARN        | A warning event. Not an error but is likely more important than an informational event.  |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | 17-20                 | ERROR       | An error event. Something went wrong.                                                    |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  -- | 21-24                 | FATAL       | A fatal error such as application or system crash.                                       |-  -- +-----------------------+-------------+------------------------------------------------------------------------------------------+-  , name :: Maybe Text-  -- ^ Short low cardinality event type that does not contain varying parts. Name describes what happened (e.g. "ProcessStarted"). Recommended to be no longer than 50 characters. Typically used for filtering and grouping purposes in backends.-  , body :: body-  -- ^ A value containing the body of the log record. Can be for example a human-readable string message (including multi-line) describing the event in a free form or it can be a structured data composed of arrays and maps of other values. First-party Applications SHOULD use a string message. However, a structured body may be necessary to preserve the semantics of some existing log formats. Can vary for each occurrence of the event coming from the same source. This field is optional.-  , {--    Type any-      Value of type any can be one of the following:--      A scalar value: number, string or boolean,--      A byte array,--      An array (a list) of any values,--      A map<string, any>.-    -}--    resource :: Maybe MaterializedResources-  -- ^ Describes the source of the log, aka resource. Multiple occurrences of events coming from the same event source can happen across time and they all have the same value of Resource. Can contain for example information about the application that emits the record or about the infrastructure where the application runs. Data formats that represent this data model may be designed in a manner that allows the Resource field to be recorded only once per batch of log records that come from the same source. SHOULD follow OpenTelemetry semantic conventions for Resources. This field is optional.-  , attributes :: Maybe [(Text, Attribute)]-  -- ^ Additional information about the specific event occurrence. Unlike the Resource field, which is fixed for a particular source, Attributes can vary for each occurrence of the event coming from the same source. Can contain information about the request context (other than TraceId/SpanId). SHOULD follow OpenTelemetry semantic conventions for Log Attributes or semantic conventions for Span Attributes. This field is optional.-  }-  deriving stock (Functor)---data SeverityNumber-  = Trace-  | Trace2-  | Trace3-  | Trace4-  | Debug-  | Debug2-  | Debug3-  | Debug4-  | Info-  | Info2-  | Info3-  | Info4-  | Warn-  | Warn2-  | Warn3-  | Warn4-  | Error-  | Error2-  | Error3-  | Error4-  | Fatal-  | Fatal2-  | Fatal3-  | Fatal4-  | Unknown !Int32-  deriving (Eq, Ord, Read, Show)---- severityTrace :: SeverityNumber--- severityTrace = 1--- severityTrace2 :: SeverityNumber--- severityTrace2 = 2--- severityTrace3 :: SeverityNumber--- severityTrace3 = 3--- severityTrace4 :: SeverityNumber--- severityTrace4 = 4--- severityDebug :: SeverityNumber--- severityDebug = 5--- severityDebug2 :: SeverityNumber--- severityDebug2 = 6--- severityDebug3 :: SeverityNumber--- severityDebug3 = 7--- severityDebug4 :: SeverityNumber--- severityDebug4 = 8--- severityInfo :: SeverityNumber--- severityInfo = 9--- severityInfo2 :: SeverityNumber--- severityInfo2 = 10--- severityInfo3 :: SeverityNumber--- severityInfo3 = 11--- severityInfo4 :: SeverityNumber--- severityInfo4 = 12--- severityWarn :: SeverityNumber--- severityWarn = 13--- severityWarn2 :: SeverityNumber--- severityWarn2 = 14--- severityWarn3 :: SeverityNumber--- severityWarn3 = 15--- severityWarn4 :: SeverityNumber--- severityWarn4 = 16--- severityError :: SeverityNumber--- severityError = 17--- severityError2 :: SeverityNumber--- severityError2 = 18--- severityError3 :: SeverityNumber--- severityError3 = 19--- severityError4 :: SeverityNumber--- severityError4 = 20--- severityFatal :: SeverityNumber--- severityFatal = 21--- severityFatal2 :: SeverityNumber--- severityFatal2 = 22--- severityFatal3 :: SeverityNumber--- severityFatal3 = 23--- severityFatal4 :: SeverityNumber--- severityFatal4 = 24
+ src/OpenTelemetry/Logs/Core.hs view
@@ -0,0 +1,36 @@+module OpenTelemetry.Logs.Core (+  -- * @LoggerProvider@ operations+  LoggerProvider (..),+  LoggerProviderOptions (..),+  emptyLoggerProviderOptions,+  createLoggerProvider,+  setGlobalLoggerProvider,+  getGlobalLoggerProvider,+  shutdownLoggerProvider,+  forceFlushLoggerProvider,++  -- * @Logger@ operations+  InstrumentationLibrary (..),+  Logger (..),+  makeLogger,++  -- * @LogRecord@ operations+  ReadableLogRecord,+  ReadWriteLogRecord,+  IsReadableLogRecord (..),+  IsReadWriteLogRecord (..),+  LogRecordArguments (..),+  AnyValue (..),+  ToValue (..),+  SeverityNumber (..),+  toShortName,+  emitLogRecord,+  addAttribute,+  addAttributes,+  logRecordGetAttributes,+) where++import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Logs.Core+import OpenTelemetry.Internal.Logs.Types+
src/OpenTelemetry/Processor.hs view
@@ -1,30 +1,41 @@------------------------------------------------------------------------------+{-# LANGUAGE PatternSynonyms #-} ------------------------------------------------------------------------------+module OpenTelemetry.Processor+  {-# DEPRECATED "use OpenTelemetry.Processor.Span instead" #-} (+  Processor,+  SpanProcessor (+    Processor,+    processorOnStart,+    processorOnEnd,+    processorShutdown,+    processorForceFlush+  ),+  ShutdownResult (..),+) where -{- |- Module      :  OpenTelemetry.Processor- Copyright   :  (c) Ian Duncan, 2021- License     :  BSD-3- Description :  Hooks for performing actions on the start and end of recording spans- Maintainer  :  Ian Duncan- Stability   :  experimental- Portability :  non-portable (GHC extensions)+import Control.Concurrent.Async (Async)+import Data.IORef (IORef)+import OpenTelemetry.Context (Context)+import OpenTelemetry.Internal.Trace.Types (ImmutableSpan)+import OpenTelemetry.Processor.Span - Span processor is an interface which allows hooks for span start and end method invocations. The span processors are invoked only when IsRecording is true. - Built-in span processors are responsible for batching and conversion of spans to exportable representation and passing batches to exporters.+{-# DEPRECATED Processor "use SpanProcessor instead" #-} - Span processors can be registered directly on SDK TracerProvider and they are invoked in the same order as they were registered. - Each processor registered on TracerProvider is a start of pipeline that consist of span processor and optional exporter. SDK MUST allow to end each pipeline with individual exporter.+type Processor = SpanProcessor - SDK MUST allow users to implement and configure custom processors and decorate built-in processors for advanced scenarios such as tagging or filtering.--}-module OpenTelemetry.Processor (-  Processor (..),-  ShutdownResult (..),-) where -import OpenTelemetry.Internal.Trace.Types-+pattern Processor+  :: (IORef ImmutableSpan -> Context -> IO ())+  -> (IORef ImmutableSpan -> IO ())+  -> IO (Async ShutdownResult)+  -> IO ()+  -> SpanProcessor+pattern Processor {processorOnStart, processorOnEnd, processorShutdown, processorForceFlush} =+  SpanProcessor+    { spanProcessorOnStart = processorOnStart+    , spanProcessorOnEnd = processorOnEnd+    , spanProcessorShutdown = processorShutdown+    , spanProcessorForceFlush = processorForceFlush+    }
+ src/OpenTelemetry/Processor/LogRecord.hs view
@@ -0,0 +1,8 @@+module OpenTelemetry.Processor.LogRecord (+  LogRecordProcessor (..),+  ShutdownResult (..),+) where++import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Logs.Types+
+ src/OpenTelemetry/Processor/Span.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++{- |+ Module      :  OpenTelemetry.Processor.Span+ Copyright   :  (c) Ian Duncan, 2021+ License     :  BSD-3+ Description :  Hooks for performing actions on the start and end of recording spans+ Maintainer  :  Ian Duncan+ Stability   :  experimental+ Portability :  non-portable (GHC extensions)++ Span processor is an interface which allows hooks for span start and end method invocations. The span processors are invoked only when IsRecording is true.++ Built-in span processors are responsible for batching and conversion of spans to exportable representation and passing batches to exporters.++ Span processors can be registered directly on SDK TracerProvider and they are invoked in the same order as they were registered.++ Each processor registered on TracerProvider is a start of pipeline that consist of span processor and optional exporter. SDK MUST allow to end each pipeline with individual exporter.++ SDK MUST allow users to implement and configure custom processors and decorate built-in processors for advanced scenarios such as tagging or filtering.+-}+module OpenTelemetry.Processor.Span (+  SpanProcessor (..),+  ShutdownResult (..),+) where++import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Trace.Types+
src/OpenTelemetry/Resource.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- @@ -34,6 +35,7 @@    -- * Creating resources from data structures   ToResource (..),+  MaterializeResource,   materializeResources,    -- * Using resources with a 'OpenTelemetry.Trace.TracerProvider'@@ -91,6 +93,7 @@ k .=? mv = (\k' v -> (k', toAttribute v)) k <$> mv  +-- | Merge two resources, taking the left-biased union of attributes. instance Semigroup (Resource s) where   (<>) (Resource l) (Resource r) = Resource (unsafeMergeAttributesIgnoringLimits l r) @@ -121,10 +124,9 @@    and updating resources are not empty and are different). The resulting resource is    therefore statically prohibited by this type-level function. -}-type family ResourceMerge schemaLeft schemaRight :: Maybe Symbol where-  ResourceMerge 'Nothing 'Nothing = 'Nothing-  ResourceMerge 'Nothing ('Just s) = 'Just s-  ResourceMerge ('Just s) 'Nothing = 'Just s+type family ResourceMerge (schemaLeft :: Maybe Symbol) (schemaRight :: Maybe Symbol) :: Maybe Symbol where+  ResourceMerge 'Nothing a = a+  ResourceMerge a 'Nothing = a   ResourceMerge ('Just s) ('Just s) = 'Just s  @@ -136,11 +138,11 @@  @since 0.0.1.0 -} mergeResources-  :: Resource old-  -- ^ the old resource-  -> Resource new+  :: Resource new   -- ^ the updating resource whose attributes take precedence-  -> Resource (ResourceMerge old new)+  -> Resource old+  -- ^ the old resource+  -> Resource (ResourceMerge new old) mergeResources (Resource l) (Resource r) = Resource (unsafeMergeAttributesIgnoringLimits l r)  @@ -176,6 +178,7 @@   { materializedResourcesSchema :: Maybe String   , materializedResourcesAttributes :: Attributes   }+  deriving (Show, Eq)   {- | A placeholder for 'MaterializedResources' when no resource information is
+ src/OpenTelemetry/SemanticsConfig.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.SemanticsConfig (+  SemanticsOptions (httpOption),+  HttpOption (..),+  getSemanticsOptions,+  getSemanticsOptions',+) where++import Control.Exception.Safe (throwIO, tryAny)+import Data.IORef (newIORef, readIORef, writeIORef)+import qualified Data.Text as T+import System.Environment (lookupEnv)+import System.IO.Unsafe (unsafePerformIO)+++{- | This is a record that contains options for whether the new stable semantics conventions should be emitted.+Semantics conventions that have been declared stable:+- [http](https://opentelemetry.io/blog/2023/http-conventions-declared-stable/#migration-plan)+-}+data SemanticsOptions = SemanticsOptions {httpOption :: HttpOption}+++-- | This option determines whether stable, old, or both kinds of http attributes are emitted.+data HttpOption+  = Stable+  | StableAndOld+  | Old+  deriving (Show, Eq)+++-- | These are the default values emitted if OTEL_SEM_CONV_STABILITY_OPT_IN is unset or does not contain values for a specific category of option.+defaultOptions :: SemanticsOptions+defaultOptions = SemanticsOptions {httpOption = Old}+++-- | Detects the presence of "http/dup" or "http" in OTEL_SEMCONV_STABILITY_OPT_IN or uses the default option if they are not there.+parseHttpOption :: (Foldable t) => t T.Text -> HttpOption+parseHttpOption envs+  | "http/dup" `elem` envs = StableAndOld+  | "http" `elem` envs = Stable+  | otherwise = httpOption defaultOptions+++-- | Detects the presence of semantics options in OTEL_SEMCONV_STABILITY_OPT_IN or uses the defaultOptions if they are not present.+parseSemanticsOptions :: Maybe String -> SemanticsOptions+parseSemanticsOptions Nothing = defaultOptions+parseSemanticsOptions (Just env) = SemanticsOptions {..}+  where+    envs = fmap T.strip $ T.splitOn "," $ T.pack env+    httpOption = parseHttpOption envs+++{- | Version of getSemanticsOptions that is not memoized. It is recommended to use getSemanticsOptions for efficiency purposes+unless it is necessary to retrieve the value of OTEL_SEMCONV_STABILITY_OPT_IN every time getSemanticsOptions' is called.+-}+getSemanticsOptions' :: IO SemanticsOptions+getSemanticsOptions' = parseSemanticsOptions <$> lookupEnv "OTEL_SEMCONV_STABILITY_OPT_IN"+++{- | Create a new memoized IO action using an 'IORef' under the surface. Note that+the action may be run in multiple threads simultaneously, so this may not be+thread safe (depending on the underlying action). For the sake of reading an environment+variable and parsing some stuff, we don't have to be concerned about thread-safety.+-}+memoize :: IO a -> IO (IO a)+memoize action = do+  ref <- newIORef Nothing+  pure $ do+    mres <- readIORef ref+    res <- case mres of+      Just res -> pure res+      Nothing -> do+        res <- tryAny action+        writeIORef ref $ Just res+        pure res+    either throwIO pure res+++{-  | Retrieves OTEL_SEMCONV_STABILITY_OPT_IN and parses it into SemanticsOptions.++This uses the [global IORef trick](https://www.parsonsmatt.org/2021/04/21/global_ioref_in_template_haskell.html)+to memoize the settings for efficiency. Note that getSemanticsOptions stores and returns the+value of the first time it was called and will not change when OTEL_SEMCONV_STABILITY_OPT_IN+is updated. Use getSemanticsOptions' to read OTEL_SEMCONV_STABILITY_OPT_IN every time the+function is called.+-}+getSemanticsOptions :: IO SemanticsOptions+getSemanticsOptions = unsafePerformIO $ memoize getSemanticsOptions'+{-# NOINLINE getSemanticsOptions #-}
src/OpenTelemetry/Trace/Core.hs view
@@ -49,6 +49,7 @@   createTracerProvider,   shutdownTracerProvider,   forceFlushTracerProvider,+  FlushResult (..),   getTracerProviderResources,   getTracerProviderPropagators,   getGlobalTracerProvider,@@ -65,6 +66,7 @@   getImmutableSpanTracer,   getTracerTracerProvider,   InstrumentationLibrary (..),+  detectInstrumentationLibrary,   TracerOptions (..),   tracerOptions, @@ -93,8 +95,6 @@   SpanKind (..),   defaultSpanArguments,   SpanArguments (..),-  NewLink (..),-  Link (..),    -- ** Recording @Event@s   Event (..),@@ -110,6 +110,9 @@   ToAttribute (..),   PrimitiveAttribute (..),   ToPrimitiveAttribute (..),+  Link (..),+  NewLink (..),+  addLink,    -- ** Recording error information   recordException,@@ -164,9 +167,11 @@ import OpenTelemetry.Common import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal+import OpenTelemetry.Internal.Common.Types+import OpenTelemetry.Internal.Logs.Core (emitOTelLogRecord, logDroppedAttributes)+import qualified OpenTelemetry.Internal.Logs.Types as SeverityNumber (SeverityNumber (..)) import OpenTelemetry.Internal.Trace.Types import qualified OpenTelemetry.Internal.Trace.Types as Types-import OpenTelemetry.Logging.Core (Log) import OpenTelemetry.Propagator (Propagator) import OpenTelemetry.Resource import OpenTelemetry.Trace.Id@@ -275,18 +280,21 @@                           emptyAttributes                           (H.unions [additionalInfo, attrs, attributes])                     , spanLinks =-                        let limitedLinks = fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t)-                         in frozenBoundedCollection limitedLinks $ fmap freezeLink links+                        let emptyLinks = emptyAppendOnlyBoundedCollection $ fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t)+                        in foldl (\c l -> appendToBoundedCollection c l) emptyLinks (fmap (freezeLink t) links)                     , spanEvents = emptyAppendOnlyBoundedCollection $ fromMaybe 128 (eventCountLimit $ tracerProviderSpanLimits $ tracerProvider t)                     , spanStatus = Unset                     , spanStart = st                     , spanEnd = Nothing                     , spanTracer = t                     }++            when (A.attributesDropped (spanAttributes is) > 0) $ void logDroppedAttributes+             s <- newIORef is-            eResult <- try $ mapM_ (\processor -> processorOnStart processor s ctxt) $ tracerProviderProcessors $ tracerProvider t+            eResult <- try $ mapM_ (\processor -> spanProcessorOnStart processor s ctxt) $ tracerProviderProcessors $ tracerProvider t             case eResult of-              Left err -> print (err :: SomeException)+              Left err -> void $ emitOTelLogRecord H.empty SeverityNumber.Error $ T.pack $ show (err :: SomeException)               Right _ -> pure ()             pure $ Span s @@ -294,35 +302,39 @@         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-        }   ownCodeAttributes :: (HasCallStack) => H.HashMap Text Attribute ownCodeAttributes = case getCallStack callStack of-  _ : caller : _ -> srcAttributes caller+  -- The call stack is (probably) not frozen and the top entry is our call. Assume we have a full call stack+  -- and look one further step up for our own code.+  (("ownCodeAttributes", _) : ownCode : _) -> srcAttributes ownCode+  -- The call stack doesn't look like we expect, potentially frozen or empty. In this case we can't+  -- really do much, so give up.   _ -> mempty   callerAttributes :: (HasCallStack) => H.HashMap Text Attribute callerAttributes = case getCallStack callStack of-  _ : _ : caller : _ -> srcAttributes caller+  -- The call stack is (probably) not frozen and the top entry is our call. Assume we have a full call stack+  -- and look two further steps up for the caller.+  (("callerAttributes", _) : _ : caller : _) -> srcAttributes caller+  -- The call stack doesn't look like we expect. Guess that it got frozen, and so the most+  -- useful thing to do is to assume that the "caller" is the top of the frozen call stack+  (caller : _) -> srcAttributes caller+  -- Empty call stack   _ -> mempty   srcAttributes :: (String, SrcLoc) -> H.HashMap Text Attribute-srcAttributes (fn, loc) = H.fromList-  [ ("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)-  ]+srcAttributes (fn, loc) =+  H.fromList+    [ ("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 are added to the end of the span argument list, so will be discarded@@ -488,6 +500,22 @@ addEvent (Dropped _) _ = pure ()  +-- | Add a link to a recording span.+addLink :: (MonadIO m) => Span -> NewLink -> m ()+addLink (Span s) l = liftIO $ do+  modifyIORef' s $ \(!i) -> i {spanLinks = appendToBoundedCollection (spanLinks i) (freezeLink (spanTracer i) l)}+addLink (FrozenSpan _) _ = pure ()+addLink (Dropped _) _ = pure ()+++freezeLink :: Tracer -> NewLink -> Link+freezeLink t NewLink {..} =+  Link+    { frozenLinkContext = linkContext+    , frozenLinkAttributes = A.addAttributes (limitBy t linkAttributeCountLimit) A.emptyAttributes 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.@@ -555,9 +583,9 @@   ts <- maybe getTimestamp pure mts   (alreadyFinished, frozenS) <- atomicModifyIORef' s $ \(!i) ->     let ref = i {spanEnd = spanEnd i <|> Just ts}-     in (ref, (isJust $ spanEnd i, ref))+    in (ref, (isJust $ spanEnd i, ref))   unless alreadyFinished $ do-    eResult <- try $ mapM_ (`processorOnEnd` s) $ tracerProviderProcessors $ tracerProvider $ spanTracer frozenS+    eResult <- try $ mapM_ (`spanProcessorOnEnd` s) $ tracerProviderProcessors $ tracerProvider $ spanTracer frozenS     case eResult of       Left err -> print (err :: SomeException)       Right _ -> pure ()@@ -688,7 +716,6 @@   , tracerProviderOptionsAttributeLimits :: AttributeLimits   , tracerProviderOptionsSpanLimits :: SpanLimits   , tracerProviderOptionsPropagators :: Propagator Context RequestHeaders ResponseHeaders-  , tracerProviderOptionsLogger :: Log Text -> IO ()   }  @@ -707,14 +734,13 @@     defaultAttributeLimits     defaultSpanLimits     mempty-    (\_ -> pure ())   {- | Initialize a new tracer provider   You should generally use 'getGlobalTracerProvider' for most applications. -}-createTracerProvider :: (MonadIO m) => [Processor] -> TracerProviderOptions -> m TracerProvider+createTracerProvider :: (MonadIO m) => [SpanProcessor] -> TracerProviderOptions -> m TracerProvider createTracerProvider ps opts = liftIO $ do   let g = tracerProviderOptionsIdGenerator opts   pure $@@ -726,7 +752,6 @@       (tracerProviderOptionsAttributeLimits opts)       (tracerProviderOptionsSpanLimits opts)       (tracerProviderOptionsPropagators opts)-      (tracerProviderOptionsLogger opts)   {- | Access the globally configured 'TracerProvider'. Once the@@ -834,7 +859,7 @@ shutdownTracerProvider :: (MonadIO m) => TracerProvider -> m () shutdownTracerProvider TracerProvider {..} = liftIO $ do   asyncShutdownResults <- forM tracerProviderProcessors $ \processor -> do-    processorShutdown processor+    spanProcessorShutdown processor   mapM_ wait asyncShutdownResults  @@ -850,7 +875,7 @@   -- ^ Result that denotes whether the flush action succeeded, failed, or timed out. forceFlushTracerProvider TracerProvider {..} mtimeout = liftIO $ do   jobs <- forM tracerProviderProcessors $ \processor -> async $ do-    processorForceFlush processor+    spanProcessorForceFlush processor   mresult <-     timeout (fromMaybe 5_000_000 mtimeout) $       foldM
src/OpenTelemetry/Util.hs view
@@ -36,16 +36,11 @@   appendOnlyBoundedCollectionSize,   appendOnlyBoundedCollectionValues,   appendOnlyBoundedCollectionDroppedElementCount,-  FrozenBoundedCollection,-  frozenBoundedCollection,-  frozenBoundedCollectionValues,-  frozenBoundedCollectionDroppedElementCount, ) where  import Control.Exception (SomeException) import qualified Control.Exception as EUnsafe import Control.Monad.IO.Unlift-import Data.Foldable import Data.Kind import qualified Data.Vector as V import Foreign.C (CInt (..))@@ -103,14 +98,14 @@ instance forall a. (Show a) => Show (AppendOnlyBoundedCollection a) where   showsPrec d AppendOnlyBoundedCollection {collection = c, maxSize = m, dropped = r} =     let vec = Builder.build c :: V.Vector a-     in showParen (d > 10) $-          showString "AppendOnlyBoundedCollection {collection = "-            . shows vec-            . showString ", maxSize = "-            . shows m-            . showString ", dropped = "-            . shows r-            . showString "}"+    in showParen (d > 10) $+        showString "AppendOnlyBoundedCollection {collection = "+          . shows vec+          . showString ", maxSize = "+          . shows m+          . showString ", dropped = "+          . shows r+          . showString "}"   -- | Initialize a bounded collection that admits a maximum size@@ -138,27 +133,6 @@   if appendOnlyBoundedCollectionSize c < ms     then AppendOnlyBoundedCollection (b <> Builder.singleton x) ms d     else AppendOnlyBoundedCollection b ms (d + 1)---data FrozenBoundedCollection a = FrozenBoundedCollection-  { collection :: !(V.Vector a)-  , dropped :: !Int-  }-  deriving (Show)---frozenBoundedCollection :: (Foldable f) => Int -> f a -> FrozenBoundedCollection a-frozenBoundedCollection maxSize_ coll = FrozenBoundedCollection (V.fromListN maxSize_ $ toList coll) (collLength - maxSize_)-  where-    collLength = length coll---frozenBoundedCollectionValues :: FrozenBoundedCollection a -> V.Vector a-frozenBoundedCollectionValues (FrozenBoundedCollection coll _) = coll---frozenBoundedCollectionDroppedElementCount :: FrozenBoundedCollection a -> Int-frozenBoundedCollectionDroppedElementCount (FrozenBoundedCollection _ dropped_) = dropped_   {- | Like 'Context.Exception.bracket', but provides the @after@ function with information about
+ test/OpenTelemetry/AttributesSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE PatternSynonyms #-}++module OpenTelemetry.AttributesSpec where++import qualified Data.Text as T+import qualified OpenTelemetry.Attributes as A+import qualified Test.Hspec as Hspec+++spec :: Hspec.Spec+spec = Hspec.describe "Attributes" $ do+  Hspec.describe "addAttribute" $ do+    let overwritesPrevious :: (A.ToAttribute a) => T.Text -> a -> a -> A.Attributes -> Hspec.Spec+        overwritesPrevious attrKey newValue prevValue attrs = do+          let addAttr = addAttributeDefault attrKey+          Hspec.it "Overwrites previous value with new value at this key." $+            addAttr newValue (addAttr prevValue attrs) `Hspec.shouldBe` addAttr newValue attrs++    overwritesPrevious Example ("new value" :: T.Text) "prev value" A.emptyAttributes+  Hspec.describe "unsafeMergeAttributesIgnoringLimits" $ do+    Hspec.it "Is left-biased when keys conflict" $ do+      let left = addAttributeDefault Example (1 :: Int) A.emptyAttributes+          right = addAttributeDefault Example (2 :: Int) A.emptyAttributes+      A.unsafeMergeAttributesIgnoringLimits left right `Hspec.shouldBe` left+++pattern Example :: T.Text+pattern Example = "example"+++addAttributeDefault :: (A.ToAttribute a) => T.Text -> a -> A.Attributes -> A.Attributes+addAttributeDefault attrKey value attrs = A.addAttribute A.defaultAttributeLimits attrs attrKey value
+ test/OpenTelemetry/InstrumentationLibrarySpec.hs view
@@ -0,0 +1,25 @@+module OpenTelemetry.InstrumentationLibrarySpec where++import OpenTelemetry.Attributes+import OpenTelemetry.Internal.Common.Types+import Test.Hspec+++spec :: Spec+spec = describe "InstrumentationLibrary" $ do+  describe "parsing" $ do+    it "handles a simple example basic example" $ do+      parseInstrumentationLibrary "hello-world-1.0.5"+        `shouldBe` Just (InstrumentationLibrary {libraryName = "hello-world", libraryVersion = "1.0.5", librarySchemaUrl = "", libraryAttributes = emptyAttributes})++    it "handles capital letters and numbers in package names" $ do+      parseInstrumentationLibrary "HUnit2-v3-1"+        `shouldBe` Just (InstrumentationLibrary {libraryName = "HUnit2-v3", libraryVersion = "1", librarySchemaUrl = "", libraryAttributes = emptyAttributes})++    it "discards trailing content" $ do+      parseInstrumentationLibrary "hello-world-1.0.5-inplace"+        `shouldBe` Just (InstrumentationLibrary {libraryName = "hello-world", libraryVersion = "1.0.5", librarySchemaUrl = "", libraryAttributes = emptyAttributes})++    it "handles missing version" $ do+      parseInstrumentationLibrary "hello-world"+        `shouldBe` Just (InstrumentationLibrary {libraryName = "hello-world", libraryVersion = "", librarySchemaUrl = "", libraryAttributes = emptyAttributes})
+ test/OpenTelemetry/Logs/CoreSpec.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Logs.CoreSpec where++import qualified Data.HashMap.Strict as H+import Data.IORef+import qualified Data.Text as T+import qualified OpenTelemetry.Attributes as A+import OpenTelemetry.Internal.Logs.Types+import qualified OpenTelemetry.LogAttributes as LA+import OpenTelemetry.Logs.Core+import OpenTelemetry.Resource+import OpenTelemetry.Resource.OperatingSystem+import Test.Hspec+++newtype TestLogRecordProcessor = TestLogRecordProcessor LogRecordProcessor+++instance Show TestLogRecordProcessor where+  show _ = "LogRecordProcessor {..}"+++spec :: Spec+spec = describe "Core" $ do+  describe "The global logger provider" $ do+    it "Returns a no-op LoggerProvider when not initialized" $ do+      LoggerProvider {..} <- getGlobalLoggerProvider+      fmap TestLogRecordProcessor loggerProviderProcessors `shouldSatisfy` null+      loggerProviderResource `shouldBe` emptyMaterializedResources+      loggerProviderAttributeLimits `shouldBe` LA.defaultAttributeLimits+    it "Allows a LoggerProvider to be set and returns that with subsequent calls to getGlobalLoggerProvider" $ do+      let lp =+            createLoggerProvider [] $+              LoggerProviderOptions+                { loggerProviderOptionsResource =+                    materializeResources $+                      toResource+                        OperatingSystem+                          { osType = "exampleOs"+                          , osDescription = Nothing+                          , osName = Nothing+                          , osVersion = Nothing+                          }+                , loggerProviderOptionsAttributeLimits =+                    LA.AttributeLimits+                      { attributeCountLimit = Just 50+                      , attributeLengthLimit = Just 50+                      }+                }++      setGlobalLoggerProvider lp++      glp <- getGlobalLoggerProvider+      fmap TestLogRecordProcessor (loggerProviderProcessors glp) `shouldSatisfy` null+      loggerProviderResource glp `shouldBe` loggerProviderResource lp+      loggerProviderAttributeLimits glp `shouldBe` loggerProviderAttributeLimits lp+  describe "addAttribute" $ do+    it "works" $ do+      lp <- getGlobalLoggerProvider+      let l = makeLogger lp InstrumentationLibrary {libraryName = "exampleLibrary", libraryVersion = "", librarySchemaUrl = "", libraryAttributes = A.emptyAttributes}+      lr <- emitLogRecord l $ emptyLogRecordArguments {attributes = H.fromList [("something", "a thing")]}++      addAttribute lr "anotherThing" ("another thing" :: LA.AnyValue)++      (_, attrs) <- LA.getAttributes <$> logRecordGetAttributes lr+      attrs+        `shouldBe` H.fromList+          [ ("anotherThing", "another thing")+          , ("something", "a thing")+          ]+  describe "addAttributes" $ do+    it "works" $ do+      lp <- getGlobalLoggerProvider+      let l = makeLogger lp InstrumentationLibrary {libraryName = "exampleLibrary", libraryVersion = "", librarySchemaUrl = "", libraryAttributes = A.emptyAttributes}+      lr <- emitLogRecord l $ emptyLogRecordArguments {attributes = H.fromList [("something", "a thing")]}++      addAttributes lr $+        H.fromList+          [ ("anotherThing", "another thing" :: LA.AnyValue)+          , ("twoThing", "the second another thing")+          ]++      (_, attrs) <- LA.getAttributes <$> logRecordGetAttributes lr+      attrs+        `shouldBe` H.fromList+          [ ("anotherThing", "another thing")+          , ("something", "a thing")+          , ("twoThing", "the second another thing")+          ]
+ test/OpenTelemetry/ResourceSpec.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternSynonyms #-}++module OpenTelemetry.ResourceSpec where++import qualified Data.Text as T+import qualified OpenTelemetry.Resource as R+import qualified Test.Hspec as Hspec+++spec :: Hspec.Spec+spec = Hspec.describe "Resource" $ do+  Hspec.describe "mergeResources" $ do+    Hspec.it "Is left-biased when attribute keys conflict" $ do+      let right = mkExampleResource "Old Right" 3+          left = mkExampleResource "New Left" 7+      R.materializeResources (R.mergeResources left right) `Hspec.shouldBe` R.materializeResources left++  Hspec.describe "Semigroup.<>" $ do+    Hspec.it "Is left-biased when attribute keys conflict" $ do+      let right = mkExampleResource "Old Right" 3+          left = mkExampleResource "New Left" 7+      R.materializeResources (left <> right) `Hspec.shouldBe` R.materializeResources left+++mkExampleResource :: T.Text -> Int -> R.Resource 'Nothing+mkExampleResource name count =+  R.mkResource [ExampleName R..= name, ExampleCount R..= count]+++pattern ExampleName :: T.Text+pattern ExampleName = "example.name"+++pattern ExampleCount :: T.Text+pattern ExampleCount = "example.count"
+ test/OpenTelemetry/SemanticsConfigSpec.hs view
@@ -0,0 +1,44 @@+module OpenTelemetry.SemanticsConfigSpec where++import OpenTelemetry.SemanticsConfig+import System.Environment+import Test.Hspec+++envVarName :: String+envVarName = "OTEL_SEMCONV_STABILITY_OPT_IN"+++spec :: Spec+spec = do+  describe "SemanticsConfig" $ do+    describe "HttpOption" $ do+      it "defaults to 'Old' when env var has no value" $ do+        unsetEnv envVarName+        semanticsOptions <- getSemanticsOptions'+        httpOption semanticsOptions `shouldBe` Old+      mapM_+        ( \(envVarVal, expectedVal) ->+            it ("returns " ++ show expectedVal ++ " when env var is " ++ show envVarVal) $ do+              setEnv envVarName envVarVal+              semanticsOptions <- getSemanticsOptions'+              httpOption semanticsOptions `shouldBe` expectedVal+        )+        [ ("http", Stable)+        , ("http/du", Old) -- intentionally similar to both "http/dup" and "http"+        , ("http/dup", StableAndOld)+        , ("http/dup,http", StableAndOld)+        , ("http,http/dup", StableAndOld)+        , ("http,something-random,http/dup", StableAndOld)+        ]+    context "memoization" $ do+      it "works" $ do+        setEnv envVarName "http"+        semanticsOptions <- getSemanticsOptions+        httpOption semanticsOptions `shouldBe` Stable+      it ("does not change when " ++ envVarName ++ " changes") $ do+        setEnv envVarName "http"+        semanticsOptions <- getSemanticsOptions+        setEnv envVarName "http/dup"+        semanticsOptions <- getSemanticsOptions+        httpOption semanticsOptions `shouldBe` Stable -- and not StableAndOld because of memoization
test/Spec.hs view
@@ -11,8 +11,13 @@ import OpenTelemetry.Attributes (lookupAttribute) -- Specs +import qualified OpenTelemetry.AttributesSpec as Attributes import qualified OpenTelemetry.BaggageSpec as Baggage import OpenTelemetry.Context+import qualified OpenTelemetry.InstrumentationLibrarySpec as InstrumentationLibrary+import qualified OpenTelemetry.Logs.CoreSpec as CoreSpec+import qualified OpenTelemetry.ResourceSpec as Resource+import qualified OpenTelemetry.SemanticsConfigSpec as SemanticsConfigSpec import OpenTelemetry.Trace.Core import qualified OpenTelemetry.Trace.SamplerSpec as Sampler import qualified OpenTelemetry.Trace.TraceFlagsSpec as TraceFlags@@ -31,7 +36,7 @@ exceptionTest :: IO () exceptionTest = do   tp <- getGlobalTracerProvider-  t <- OpenTelemetry.Trace.Core.getTracer tp "test" tracerOptions+  let t = OpenTelemetry.Trace.Core.makeTracer tp "test" tracerOptions   spanToCheck <- newIORef undefined   handle (\(TestException _) -> pure ()) $ do     inSpan' t "test" defaultSpanArguments $ \span -> do@@ -51,6 +56,11 @@   -- describe "inSpan" $ do   --   it "records exceptions" $ do   --     exceptionTest+  Attributes.spec   Baggage.spec+  Resource.spec+  InstrumentationLibrary.spec   Sampler.spec   TraceFlags.spec+  SemanticsConfigSpec.spec+  CoreSpec.spec