pgmq-effectful 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+324/−124 lines, 5 filesdep ~hs-opentelemetry-apidep ~hs-opentelemetry-exporter-in-memorydep ~hs-opentelemetry-propagator-w3cPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-propagator-w3c, hs-opentelemetry-sdk, hs-opentelemetry-semantic-conventions, pgmq-core, pgmq-hasql, pgmq-migration
API changes (from Hackage documentation)
+ Pgmq.Effectful.Telemetry: db_operation_name :: AttributeKey Text
+ Pgmq.Effectful.Telemetry: db_system_name :: AttributeKey Text
+ Pgmq.Effectful.Telemetry: messaging_operation_name :: AttributeKey Text
+ Pgmq.Effectful.Telemetry: messaging_operation_type :: AttributeKey Text
Files
- CHANGELOG.md +23/−0
- pgmq-effectful.cabal +12/−12
- src/Pgmq/Effectful/Interpreter/Traced.hs +54/−19
- src/Pgmq/Effectful/Telemetry.hs +47/−8
- test/TracedInterpreterSpec.hs +188/−85
CHANGELOG.md view
@@ -1,5 +1,28 @@ # Revision history for pgmq-effectful +## 0.3.0.0 -- 2026-05-31++### Breaking Changes++* Now requires the `hs-opentelemetry` 1.0 package family and+ `hs-opentelemetry-semantic-conventions` 1.40 (previously the 0.x+ series). Downstream projects must upgrade their OpenTelemetry+ dependencies to build against this release.++### New Features++* `Pgmq.Effectful.Telemetry` re-exports the stable semantic-convention+ attribute keys `messaging_operation_name`, `messaging_operation_type`,+ `db_system_name`, and `db_operation_name`.+* The traced interpreter now honours `OTEL_SEMCONV_STABILITY_OPT_IN` to+ choose old, stable, or duplicate messaging and database attributes.+ The default remains compatible with the v1.24 attributes emitted by+ 0.2.0.0. Use `OTEL_SEMCONV_STABILITY_OPT_IN=messaging,database` for+ stable-only attributes (`messaging.operation.name`,+ `messaging.operation.type`, `db.system.name`, `db.operation.name`),+ or `messaging/dup,database/dup` to emit both old and stable names+ during migration.+ ## 0.2.0.0 -- 2026-04-23 ### Breaking Changes
pgmq-effectful.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: pgmq-effectful-version: 0.2.0.0+version: 0.3.0.0 synopsis: Effectful effects for PGMQ (PostgreSQL Message Queue) description: Effectful effects and interpreters for pgmq-hs, a Haskell client@@ -54,11 +54,11 @@ , effectful-core ^>=2.5 || ^>=2.6 , hasql ^>=1.10 , hasql-pool ^>=1.4- , hs-opentelemetry-api >=0.2 && <0.4- , hs-opentelemetry-semantic-conventions >=0.1 && <0.2+ , hs-opentelemetry-api >=1.0 && <2+ , hs-opentelemetry-semantic-conventions >=1.40 && <2 , http-types >=0.12 && <0.13- , pgmq-core >=0.2 && <0.3- , pgmq-hasql >=0.2 && <0.3+ , pgmq-core >=0.3 && <0.4+ , pgmq-hasql >=0.3 && <0.4 , text >=2.0 && <2.2 , unliftio >=0.2 && <0.3 , unordered-containers >=0.2 && <0.3@@ -95,14 +95,14 @@ , ephemeral-pg >=0.2.1 , hasql ^>=1.10 , hasql-pool ^>=1.4- , hs-opentelemetry-api >=0.2 && <0.4- , hs-opentelemetry-exporter-in-memory >=0.0 && <0.1- , hs-opentelemetry-propagator-w3c >=0.0 && <0.2- , hs-opentelemetry-sdk >=0.0 && <0.2- , hs-opentelemetry-semantic-conventions >=0.1 && <0.2- , pgmq-core >=0.2 && <0.3+ , hs-opentelemetry-api >=1.0 && <2+ , hs-opentelemetry-exporter-in-memory >=1.0 && <2+ , hs-opentelemetry-propagator-w3c >=1.0 && <2+ , hs-opentelemetry-sdk >=1.0 && <2+ , hs-opentelemetry-semantic-conventions >=1.40 && <2+ , pgmq-core >=0.3 && <0.4 , pgmq-effectful- , pgmq-migration >=0.2 && <0.3+ , pgmq-migration >=0.3 && <0.4 , random ^>=1.2 , tasty ^>=1.5 , tasty-hunit ^>=0.10
src/Pgmq/Effectful/Interpreter/Traced.hs view
@@ -6,25 +6,31 @@ -- == OpenTelemetry Semantic Conventions -- -- Spans emitted by this interpreter follow OpenTelemetry--- [Semantic Conventions v1.24](https://github.com/open-telemetry/semantic-conventions/tree/v1.24.0)--- for messaging clients and database clients.+-- [Semantic Conventions v1.40](https://github.com/open-telemetry/semantic-conventions/tree/v1.40.0)+-- for messaging clients and database clients, while preserving the+-- older v1.24 attributes by default unless+-- @OTEL_SEMCONV_STABILITY_OPT_IN@ opts into stable conventions. -- -- For every operation the interpreter emits: ----- * @db.system = "postgresql"@--- * @db.operation = "pgmq.<fn>"@ (for example @"pgmq.send"@, @"pgmq.read"@,--- @"pgmq.archive"@).+-- * default mode: @db.system = "postgresql"@ and+-- @db.operation = "pgmq.<fn>"@+-- * @OTEL_SEMCONV_STABILITY_OPT_IN=database@: @db.system.name = "postgresql"@+-- and @db.operation.name = "pgmq.<fn>"@+-- * @OTEL_SEMCONV_STABILITY_OPT_IN=database/dup@: both sets. -- -- For /messaging/ operations (the publish and receive families) the -- interpreter additionally emits: -- -- * @messaging.system = "pgmq"@--- * @messaging.operation@ — one of @"publish"@ (every @send*@ variant,--- including topic sends) or @"receive"@ (every @read*@ and @pop@--- variant). The @"process"@ operation is intentionally not emitted--- here — it belongs to the consumer, which should open its own--- @process@ span around application-level handling of a received--- message (see 'Pgmq.Effectful.Traced.readMessageWithContext').+-- * default mode: @messaging.operation@ — one of @"publish"@ (every+-- @send*@ variant, including topic sends) or @"receive"@ (every+-- @read*@ and @pop@ variant). Stable messaging mode emits+-- @messaging.operation.name@ and @messaging.operation.type@ instead;+-- duplicate mode emits both sets. The @"process"@ operation is+-- intentionally not emitted here — it belongs to the consumer, which+-- should open its own @process@ span around application-level handling+-- of a received message (see 'Pgmq.Effectful.Traced.readMessageWithContext'). -- * @messaging.destination.name@ — the queue name, or for topic sends -- the routing key (which is the logical destination for pgmq topics). --@@ -87,6 +93,7 @@ import Hasql.Pool qualified as Pool import Hasql.Session qualified import OpenTelemetry.Attributes.Map (AttributeMap, insertByKey)+import OpenTelemetry.SemanticsConfig (StabilityOpt (..), databaseOption, getSemanticsOptions', lookupStability) import OpenTelemetry.Trace.Core qualified as OTel import Pgmq.Effectful.Effect (Pgmq (..)) import Pgmq.Effectful.Interpreter@@ -118,11 +125,11 @@ } -- | Describes how a 'Pgmq' operation maps onto OpenTelemetry semantic--- conventions v1.24.+-- conventions. data OpInfo = OpInfo { -- | The pgmq SQL function being invoked (@"pgmq.send"@ etc.). opDbFunction :: !Text,- -- | The v1.24 @messaging.operation@ verb, if any. One of+ -- | The legacy @messaging.operation@ verb, if any. One of -- @"publish"@ or @"receive"@; @Nothing@ for lifecycle/observability -- operations. opMessagingKind :: !(Maybe Text),@@ -383,15 +390,14 @@ Just d -> op <> " " <> d Nothing -> op -operationAttributes :: OpInfo -> AttributeMap-operationAttributes info =+operationAttributesWith :: StabilityOpt -> StabilityOpt -> OpInfo -> AttributeMap+operationAttributesWith dbStability messagingStability info = let base =- insertByKey db_system ("postgresql" :: Text)- . insertByKey db_operation info.opDbFunction+ databaseAttributes dbStability info withMsgKind = case info.opMessagingKind of Just mk -> insertByKey messaging_system ("pgmq" :: Text)- . insertByKey messaging_operation mk+ . messagingOperationAttributes messagingStability mk Nothing -> id withDest = case info.opDestination of Just d -> insertByKey messaging_destination_name d@@ -405,6 +411,32 @@ Nothing -> id in (withMsgId . withCount . withDest . withMsgKind . base) mempty +databaseAttributes :: StabilityOpt -> OpInfo -> AttributeMap -> AttributeMap+databaseAttributes stability info = case stability of+ Old ->+ insertByKey db_system ("postgresql" :: Text)+ . insertByKey db_operation info.opDbFunction+ Stable ->+ insertByKey db_system_name ("postgresql" :: Text)+ . insertByKey db_operation_name info.opDbFunction+ StableAndOld ->+ insertByKey db_system ("postgresql" :: Text)+ . insertByKey db_operation info.opDbFunction+ . insertByKey db_system_name ("postgresql" :: Text)+ . insertByKey db_operation_name info.opDbFunction++messagingOperationAttributes :: StabilityOpt -> Text -> AttributeMap -> AttributeMap+messagingOperationAttributes stability op = case stability of+ Old ->+ insertByKey messaging_operation op+ Stable ->+ insertByKey messaging_operation_name op+ . insertByKey messaging_operation_type op+ StableAndOld ->+ insertByKey messaging_operation op+ . insertByKey messaging_operation_name op+ . insertByKey messaging_operation_type op+ withTracedOp :: (IOE :> es, Error PgmqRuntimeError :> es) => TracingConfig ->@@ -413,9 +445,12 @@ Hasql.Session.Session a -> Eff es a withTracedOp config pool info session = do+ semOpts <- Effectful.liftIO getSemanticsOptions'+ let dbStability = databaseOption semOpts+ messagingStability = lookupStability "messaging" semOpts let args = OTel.addAttributesToSpanArguments- (operationAttributes info)+ (operationAttributesWith dbStability messagingStability info) OTel.defaultSpanArguments {OTel.kind = info.opSpanKind} result <- Effectful.liftIO $
src/Pgmq/Effectful/Telemetry.hs view
@@ -8,12 +8,14 @@ -- B3, Datadog, …). The pgmq header payload is a JSON object whose -- keys are header names (lower-cased) and whose values are strings. -- * Re-exports of typed 'AttributeKey' values from--- "OpenTelemetry.SemanticConventions" for the v1.24 attributes used--- by the pgmq instrumentation.+-- "OpenTelemetry.SemanticConventions" for the attributes used by the+-- pgmq instrumentation. -- -- The semantic-conventions names mirror OpenTelemetry specification--- v1.24 as generated into @hs-opentelemetry-semantic-conventions@--- 0.1.0.0.+-- v1.40 as generated into @hs-opentelemetry-semantic-conventions@+-- 1.40.0.0. The traced interpreter uses+-- @OTEL_SEMCONV_STABILITY_OPT_IN@ to choose old, stable, or duplicate+-- database and messaging operation attributes. module Pgmq.Effectful.Telemetry ( -- * Trace Context Propagation injectTraceContext,@@ -31,8 +33,12 @@ messaging_destination_name, messaging_message_id, messaging_batch_messageCount,+ messaging_operation_name,+ messaging_operation_type, db_system, db_operation,+ db_system_name,+ db_operation_name, ) where @@ -45,14 +51,26 @@ import Data.Text.Encoding qualified as TE import Network.HTTP.Types (RequestHeaders) import OpenTelemetry.Context qualified as Ctxt-import OpenTelemetry.Propagator (Propagator, extract, inject)+import OpenTelemetry.Propagator+ ( TextMap,+ TextMapPropagator,+ emptyTextMap,+ extract,+ inject,+ textMapFromList,+ textMapToList,+ ) import OpenTelemetry.SemanticConventions ( db_operation,+ db_operation_name, db_system,+ db_system_name, messaging_batch_messageCount, messaging_destination_name, messaging_message_id, messaging_operation,+ messaging_operation_name,+ messaging_operation_type, messaging_system, ) import OpenTelemetry.Trace.Core@@ -94,16 +112,37 @@ m Ctxt.Context extractTraceContext provider headers ctxt = let propagator = getTracerProviderPropagators provider- in extract propagator headers ctxt+ in extract propagator (traceHeadersToTextMap headers) ctxt -- | Propagator-generic inject wrapper (mainly useful for tests that -- want to pin the propagator explicitly). injectWith :: (MonadIO m) =>- Propagator Ctxt.Context RequestHeaders RequestHeaders ->+ TextMapPropagator -> Ctxt.Context -> m TraceHeaders-injectWith propagator ctxt = liftIO $ inject propagator ctxt []+injectWith propagator ctxt =+ liftIO $ textMapToTraceHeaders <$> inject propagator ctxt emptyTextMap++traceHeadersToTextMap :: TraceHeaders -> TextMap+traceHeadersToTextMap =+ textMapFromList+ . fmap+ ( \(name, value) ->+ ( TE.decodeUtf8 (CI.foldedCase name),+ TE.decodeUtf8 value+ )+ )++textMapToTraceHeaders :: TextMap -> TraceHeaders+textMapToTraceHeaders =+ fmap+ ( \(name, value) ->+ ( CI.mk (TE.encodeUtf8 name),+ TE.encodeUtf8 value+ )+ )+ . textMapToList -- | Encode carrier headers as a JSON object for storage in pgmq -- message headers (jsonb). Header names are lower-cased (via
test/TracedInterpreterSpec.hs view
@@ -2,8 +2,9 @@ module TracedInterpreterSpec (tests) where +import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)+import Control.Exception (bracket) import Control.Monad (unless)-import Control.Monad.IO.Class (liftIO) import Data.HashMap.Strict qualified as HM import Data.IORef (IORef, readIORef) import Data.Text (Text)@@ -16,7 +17,6 @@ import OpenTelemetry.Context qualified as Ctxt import OpenTelemetry.Context.ThreadLocal qualified as CtxtLocal import OpenTelemetry.Exporter.InMemory.Span qualified as InMemoryExporter-import OpenTelemetry.Propagator (extract) import OpenTelemetry.Propagator.W3CTraceContext qualified as W3C import OpenTelemetry.Trace.Core qualified as OTel import OpenTelemetry.Trace.Id.Generator.Default (defaultIdGenerator)@@ -38,8 +38,10 @@ sendMessage, sendMessageTraced, )-import Pgmq.Effectful.Telemetry (jsonToTraceHeaders)+import Pgmq.Effectful.Telemetry (extractTraceContext, jsonToTraceHeaders) import Pgmq.Types qualified as Pgmq+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.IO.Unsafe (unsafePerformIO) import System.Random (randomRIO) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)@@ -72,75 +74,131 @@ "Expected an error, got success" ], testGroup- "v1.24 semantic conventions"- [ testCase "publish emits messaging.* + db.* attributes" $ do- (tracer, _provider, spansRef) <- setupTracer- queue <- mkUniqueQueue "publish_attrs"- result <-- runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do- createQueue queue- sendMessage- SendMessage- { queueName = queue,- messageBody = MessageBody "hello",- delay = Nothing- }- _ <- assertRight result- spans <- readIORef spansRef- let publishSpans = filter ((==) "publish" . firstWord . OTel.spanName) spans- unless (length publishSpans == 1) $- assertFailure $- "Expected exactly one publish span, got "- <> show (map OTel.spanName spans)- s <- singleSpan publishSpans "publish"- assertEqual- "span name carries destination"- ("publish " <> queueNameToText queue)- (OTel.spanName s)- assertSpanKindProducer s- assertAttrText s "messaging.system" "pgmq"- assertAttrText s "messaging.operation" "publish"- assertAttrText s "messaging.destination.name" (queueNameToText queue)- assertAttrText s "db.system" "postgresql"- assertAttrText s "db.operation" "pgmq.send",- testCase "receive emits messaging.* + db.* attributes" $ do- (tracer, _provider, spansRef) <- setupTracer- queue <- mkUniqueQueue "receive_attrs"- result <-- runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do- createQueue queue- _ <-+ "semantic conventions"+ [ testCase "publish emits messaging.* + db.* attributes" $+ withSemconvOptIn "" $ do+ (tracer, _provider, spansRef) <- setupTracer+ queue <- mkUniqueQueue "publish_attrs"+ result <-+ runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do+ createQueue queue sendMessage SendMessage { queueName = queue,- messageBody = MessageBody "one",+ messageBody = MessageBody "hello", delay = Nothing }- readMessage- ReadMessage- { queueName = queue,- delay = 30,- batchSize = Just 1,- conditional = Nothing- }- _ <- assertRight result- spans <- readIORef spansRef- let receiveSpans = filter ((==) "receive" . firstWord . OTel.spanName) spans- unless (length receiveSpans == 1) $- assertFailure $- "Expected exactly one receive span, got "- <> show (map OTel.spanName spans)- s <- singleSpan receiveSpans "receive"- assertEqual- "span name carries destination"- ("receive " <> queueNameToText queue)- (OTel.spanName s)- assertSpanKindConsumer s- assertAttrText s "messaging.system" "pgmq"- assertAttrText s "messaging.operation" "receive"- assertAttrText s "messaging.destination.name" (queueNameToText queue)- assertAttrText s "db.system" "postgresql"- assertAttrText s "db.operation" "pgmq.read",+ _ <- assertRight result+ spans <- readIORef spansRef+ publishSpans <- spansWithFirstWord "publish" spans+ unless (length publishSpans == 1) $+ spanNames spans >>= \names ->+ assertFailure $+ "Expected exactly one publish span, got "+ <> show names+ s <- singleSpan publishSpans "publish"+ actualSpanName <- spanName s+ assertEqual+ "span name carries destination"+ ("publish " <> queueNameToText queue)+ actualSpanName+ assertSpanKindProducer s+ assertAttrText s "messaging.system" "pgmq"+ assertAttrText s "messaging.operation" "publish"+ assertAttrText s "messaging.destination.name" (queueNameToText queue)+ assertAttrText s "db.system" "postgresql"+ assertAttrText s "db.operation" "pgmq.send",+ testCase "receive emits messaging.* + db.* attributes" $+ withSemconvOptIn "" $ do+ (tracer, _provider, spansRef) <- setupTracer+ queue <- mkUniqueQueue "receive_attrs"+ result <-+ runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do+ createQueue queue+ _ <-+ sendMessage+ SendMessage+ { queueName = queue,+ messageBody = MessageBody "one",+ delay = Nothing+ }+ readMessage+ ReadMessage+ { queueName = queue,+ delay = 30,+ batchSize = Just 1,+ conditional = Nothing+ }+ _ <- assertRight result+ spans <- readIORef spansRef+ receiveSpans <- spansWithFirstWord "receive" spans+ unless (length receiveSpans == 1) $+ spanNames spans >>= \names ->+ assertFailure $+ "Expected exactly one receive span, got "+ <> show names+ s <- singleSpan receiveSpans "receive"+ actualSpanName <- spanName s+ assertEqual+ "span name carries destination"+ ("receive " <> queueNameToText queue)+ actualSpanName+ assertSpanKindConsumer s+ assertAttrText s "messaging.system" "pgmq"+ assertAttrText s "messaging.operation" "receive"+ assertAttrText s "messaging.destination.name" (queueNameToText queue)+ assertAttrText s "db.system" "postgresql"+ assertAttrText s "db.operation" "pgmq.read",+ testCase "stable opt-in emits stable messaging and database attributes" $+ withSemconvOptIn "messaging,database" $ do+ (tracer, _provider, spansRef) <- setupTracer+ queue <- mkUniqueQueue "stable_attrs"+ result <-+ runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do+ createQueue queue+ sendMessage+ SendMessage+ { queueName = queue,+ messageBody = MessageBody "hello",+ delay = Nothing+ }+ _ <- assertRight result+ spans <- readIORef spansRef+ publishSpans <- spansWithFirstWord "publish" spans+ s <- singleSpan publishSpans "publish"+ assertAttrText s "messaging.system" "pgmq"+ assertNoAttr s "messaging.operation"+ assertAttrText s "messaging.operation.name" "publish"+ assertAttrText s "messaging.operation.type" "publish"+ assertAttrText s "messaging.destination.name" (queueNameToText queue)+ assertNoAttr s "db.system"+ assertNoAttr s "db.operation"+ assertAttrText s "db.system.name" "postgresql"+ assertAttrText s "db.operation.name" "pgmq.send",+ testCase "dup opt-in emits old and stable messaging and database attributes" $+ withSemconvOptIn "messaging/dup,database/dup" $ do+ (tracer, _provider, spansRef) <- setupTracer+ queue <- mkUniqueQueue "dup_attrs"+ result <-+ runEff . runError @PgmqRuntimeError . runPgmqTraced pool tracer $ do+ createQueue queue+ sendMessage+ SendMessage+ { queueName = queue,+ messageBody = MessageBody "hello",+ delay = Nothing+ }+ _ <- assertRight result+ spans <- readIORef spansRef+ publishSpans <- spansWithFirstWord "publish" spans+ s <- singleSpan publishSpans "publish"+ assertAttrText s "messaging.operation" "publish"+ assertAttrText s "messaging.operation.name" "publish"+ assertAttrText s "messaging.operation.type" "publish"+ assertAttrText s "db.system" "postgresql"+ assertAttrText s "db.operation" "pgmq.send"+ assertAttrText s "db.system.name" "postgresql"+ assertAttrText s "db.operation.name" "pgmq.send", testCase "error path records exception event and Error status" $ do (tracer, _provider, spansRef) <- setupTracer bogus <- mkQueueName "queue_that_does_not_exist_xyz3"@@ -154,18 +212,20 @@ s <- case spans of [only] -> pure only _ ->- assertFailure- ( "Expected exactly one span, got "- <> show (map OTel.spanName spans)- )- >> fail ""+ spanNames spans >>= \names ->+ assertFailure+ ( "Expected exactly one span, got "+ <> show names+ )+ >> fail ""+ hot <- readIORef (OTel.spanHot s) let events = V.toList- (appendOnlyBoundedCollectionValues (OTel.spanEvents s))+ (appendOnlyBoundedCollectionValues (OTel.hotEvents hot)) hasExceptionEvent = any ((==) "exception" . OTel.eventName) events assertBool "span has exception event" hasExceptionEvent- case OTel.spanStatus s of+ case OTel.hotStatus hot of OTel.Error desc -> assertBool ( "span status description should be a short non-PII label, got "@@ -208,10 +268,8 @@ assertFailure "expected trace headers on received message, got none" Just hdrs -> do- let propagator = OTel.getTracerProviderPropagators provider ctx <-- liftIO $- extract propagator (jsonToTraceHeaders hdrs) Ctxt.empty+ extractTraceContext provider (jsonToTraceHeaders hdrs) Ctxt.empty case Ctxt.lookupSpan ctx of Nothing -> assertFailure $@@ -261,6 +319,18 @@ firstWord :: Text -> Text firstWord = T.takeWhile (/= ' ') +spanName :: OTel.ImmutableSpan -> IO Text+spanName s = OTel.hotName <$> readIORef (OTel.spanHot s)++spanNames :: [OTel.ImmutableSpan] -> IO [Text]+spanNames = traverse spanName++spansWithFirstWord :: Text -> [OTel.ImmutableSpan] -> IO [OTel.ImmutableSpan]+spansWithFirstWord word spans =+ fmap+ (fmap fst . filter ((==) word . firstWord . snd))+ (traverse (\s -> do name <- spanName s; pure (s, name)) spans)+ assertRight :: (Show a) => Either a b -> IO b assertRight = \case Right b -> pure b@@ -271,13 +341,14 @@ singleSpan spans label = case spans of [s] -> pure s _ ->- assertFailure- ( "expected exactly one "- <> label- <> " span, got "- <> show (map OTel.spanName spans)- )- >> fail ""+ spanNames spans >>= \names ->+ assertFailure+ ( "expected exactly one "+ <> label+ <> " span, got "+ <> show names+ )+ >> fail "" -- | 'OTel.SpanKind' has no 'Eq' instance, so assert via pattern. assertSpanKindProducer :: OTel.ImmutableSpan -> IO ()@@ -295,7 +366,8 @@ -- attribute map when the assertion fails. assertAttrText :: OTel.ImmutableSpan -> Text -> Text -> IO () assertAttrText s key expected = do- let attrMap = Attrs.getAttributeMap (OTel.spanAttributes s)+ hot <- readIORef (OTel.spanHot s)+ let attrMap = Attrs.getAttributeMap (OTel.hotAttributes hot) case HM.lookup key attrMap of Just (Attrs.AttributeValue (Attrs.TextAttribute actual)) -> assertEqual ("attribute " <> T.unpack key) expected actual@@ -309,3 +381,34 @@ <> show other <> " in " <> show attrMap++assertNoAttr :: OTel.ImmutableSpan -> Text -> IO ()+assertNoAttr s key = do+ hot <- readIORef (OTel.spanHot s)+ let attrMap = Attrs.getAttributeMap (OTel.hotAttributes hot)+ case HM.lookup key attrMap of+ Nothing -> pure ()+ Just actual ->+ assertFailure $+ "expected no attribute "+ <> T.unpack key+ <> "; got "+ <> show actual+ <> " in "+ <> show attrMap++withSemconvOptIn :: String -> IO a -> IO a+withSemconvOptIn value action =+ bracket+ (takeMVar semconvEnvLock *> (lookupEnv var <* setEnv var value))+ restore+ (const action)+ where+ var = "OTEL_SEMCONV_STABILITY_OPT_IN"+ restore = \case+ Nothing -> unsetEnv var *> putMVar semconvEnvLock ()+ Just old -> setEnv var old *> putMVar semconvEnvLock ()++semconvEnvLock :: MVar ()+semconvEnvLock = unsafePerformIO (newMVar ())+{-# NOINLINE semconvEnvLock #-}