Update HTTP Semantic Conventions to Stable Versions

api/hs-opentelemetry-api.cabal

@@ -1,6 +1,6 @@
 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
 
@@ -52,6 +52,7 @@ library
       OpenTelemetry.Resource.Service
       OpenTelemetry.Resource.Telemetry
       OpenTelemetry.Resource.Webengine
+      OpenTelemetry.SemanticsConfig
       OpenTelemetry.Trace.Core
       OpenTelemetry.Trace.Id
       OpenTelemetry.Trace.Id.Generator
@@ -83,6 +84,7 @@ library
     , http-types
     , memory
     , mtl
+    , safe-exceptions
     , template-haskell
     , text
     , thread-utils-context ==0.3.*
@@ -99,6 +101,7 @@ test-suite hs-opentelemetry-api-test
   main-is: Spec.hs
   other-modules:
       OpenTelemetry.BaggageSpec
+      OpenTelemetry.SemanticsConfigSpec
       OpenTelemetry.Trace.SamplerSpec
       OpenTelemetry.Trace.TraceFlagsSpec
       Paths_hs_opentelemetry_api
@@ -124,6 +127,7 @@ test-suite hs-opentelemetry-api-test
     , http-types
     , memory
     , mtl
+    , safe-exceptions
     , template-haskell
     , text
     , thread-utils-context ==0.3.*

api/package.yaml

@@ -44,6 +44,7 @@ dependencies:
 - ghc-prim
 - unliftio-core
 - vector-builder
+- safe-exceptions
 
 library:
   source-dirs: src

api/src/OpenTelemetry/SemanticsConfig.hs

@@ -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 #-}

api/src/OpenTelemetry/Trace/Core.hs

@@ -276,7 +276,7 @@ createSpanWithoutCallStack t ctxt n args@SpanArguments {..} = liftIO $ do
                           (H.unions [additionalInfo, attrs, attributes])
                     , spanLinks =
                         let limitedLinks = fromMaybe 128 (linkCountLimit $ tracerProviderSpanLimits $ tracerProvider t)
-                         in frozenBoundedCollection limitedLinks $ fmap freezeLink links
+                        in frozenBoundedCollection limitedLinks $ fmap freezeLink links
                     , spanEvents = emptyAppendOnlyBoundedCollection $ fromMaybe 128 (eventCountLimit $ tracerProviderSpanLimits $ tracerProvider t)
                     , spanStatus = Unset
                     , spanStart = st
@@ -316,13 +316,14 @@ callerAttributes = case getCallStack callStack of
 
 
 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
@@ -555,7 +556,7 @@ endSpan (Span s) mts = liftIO $ do
   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
     case eResult of

api/src/OpenTelemetry/Util.hs

@@ -103,14 +103,14 @@ data AppendOnlyBoundedCollection a = AppendOnlyBoundedCollection
 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

api/test/OpenTelemetry/SemanticsConfigSpec.hs

@@ -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

api/test/Spec.hs

@@ -13,6 +13,7 @@ import OpenTelemetry.Attributes (lookupAttribute)
 
 import qualified OpenTelemetry.BaggageSpec as Baggage
 import OpenTelemetry.Context
+import qualified OpenTelemetry.SemanticsConfigSpec as SemanticsConfigSpec
 import OpenTelemetry.Trace.Core
 import qualified OpenTelemetry.Trace.SamplerSpec as Sampler
 import qualified OpenTelemetry.Trace.TraceFlagsSpec as TraceFlags
@@ -54,3 +55,4 @@ main = hspec $ do
   Baggage.spec
   Sampler.spec
   TraceFlags.spec
+  SemanticsConfigSpec.spec

exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 
@@ -283,13 +283,13 @@ otlpExporter conf = do
         Left err@(HttpExceptionRequest req e)
           | HTTPClient.host req == "localhost"
           , HTTPClient.port req == 4317 || HTTPClient.port req == 4318
-          , ConnectionFailure _someExn <- e
-            -> do
-              pure $ Failure Nothing
+          , ConnectionFailure _someExn <- e ->
+              do
+                pure $ Failure Nothing
           | otherwise ->
-            if isRetryableException e
-              then exponentialBackoff
-              else pure $ Failure $ Just $ SomeException err
+              if isRetryableException e
+                then exponentialBackoff
+                else pure $ Failure $ Just $ SomeException err
         Left err -> do
           pure $ Failure $ Just $ SomeException err
         Right resp ->

hie.yaml

@@ -6,6 +6,12 @@ cradle:
     - path: "api/test"
       component: "hs-opentelemetry-api:test:hs-opentelemetry-api-test"
 
+    - path: "examples/hspec/src"
+      component: "hspec-example:lib"
+
+    - path: "examples/hspec/test"
+      component: "hspec-example:test:test"
+
     - path: "examples/yesod-minimal/src"
       component: "yesod-minimal:lib"
 
@@ -90,8 +96,8 @@ cradle:
     - path: "propagators/b3/src"
       component: "hs-opentelemetry-propagator-b3:lib"
 
-    - path: "propagators/b3/test/spec"
-      component: "hs-opentelemetry-propagator-b3:test:spec"
+    - path: "propagators/b3/test"
+      component: "hs-opentelemetry-propagator-b3:test:hs-opentelemetry-propagator-b3-test"
 
     - path: "propagators/datadog/src"
       component: "hs-opentelemetry-propagator-datadog:lib"
@@ -105,6 +111,21 @@ cradle:
     - path: "propagators/datadog/benchmark/header-codec/main.hs"
       component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
 
+    - path: "propagators/datadog/old-src/main.hs"
+      component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
+
+    - path: "propagators/datadog/benchmark/header-codec/Raw.hs"
+      component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
+
+    - path: "propagators/datadog/benchmark/header-codec/String.hs"
+      component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
+
+    - path: "propagators/datadog/old-src/Raw.hs"
+      component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
+
+    - path: "propagators/datadog/old-src/String.hs"
+      component: "hs-opentelemetry-propagator-datadog:bench:header-codec"
+
     - path: "propagators/w3c/src"
       component: "hs-opentelemetry-propagator-w3c:lib"
 
@@ -116,9 +137,3 @@ cradle:
 
     - path: "sdk/test"
       component: "hs-opentelemetry-sdk:test:hs-opentelemetry-sdk-test"
-
-    - path: "utils/exceptions/src"
-      component: "hs-opentelemetry-utils-exceptions:lib"
-
-    - path: "utils/exceptions/test"
-      component: "hs-opentelemetry-utils-exceptions:test:exceptions-test"

instrumentation/conduit/src/OpenTelemetry/Instrumentation/Conduit.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module OpenTelemetry.Instrumentation.Conduit where
 

instrumentation/http-client/hs-opentelemetry-instrumentation-http-client.cabal

@@ -1,6 +1,6 @@
 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