hs-opentelemetry-propagator-b3 0.0.1.3 → 1.0.0.0

raw patch · 7 files changed

+443/−128 lines, 7 filesdep +hs-opentelemetry-propagator-b3dep +hspecdep −http-typesdep ~hs-opentelemetry-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: hs-opentelemetry-propagator-b3, hspec

Dependencies removed: http-types

Dependency ranges changed: hs-opentelemetry-api

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• LICENSE +1/−1
• README.md +2/−0
• hs-opentelemetry-propagator-b3.cabal +32/−16
• src/OpenTelemetry/Propagator/B3.hs +46/−30
• src/OpenTelemetry/Propagator/B3/Internal.hs +111/−81
• test/Spec.hs +245/−0

@@ -2,6 +2,12 @@  ## Unreleased +## 1.0.0.0 - 2026-05-29++- Fix: B3 multi-header extraction now gives `X-B3-Flags` (debug) precedence over+  `X-B3-Sampled`. Previously `sampled <|> debug` meant `X-B3-Sampled: 0` overrode+  `X-B3-Flags: 1`, violating Zipkin's "debug implies accept" rule.+ ## 0.0.1.3  - Update dependency bounds for hs-opentelemetry-api 0.3.0.0

@@ -1,4 +1,4 @@-Copyright Ian Duncan (c) 2021+Copyright Ian Duncan (c) 2021-2026  All rights reserved. 

@@ -1,1 +1,3 @@ # hs-opentelemetry-propagator-b3++[![hs-opentelemetry-propagator-b3](https://img.shields.io/hackage/v/hs-opentelemetry-propagator-b3?style=flat-square&logo=haskell&label=hs-opentelemetry-propagator-b3&labelColor=5D4F85)](https://hackage.haskell.org/package/hs-opentelemetry-propagator-b3)

@@ -1,22 +1,22 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack -name:               hs-opentelemetry-propagator-b3-version:            0.0.1.3-synopsis:           Trace propagation via HTTP headers following the b3 tracestate spec.-description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/propagators/b3#readme>-category:           OpenTelemetry, Tracing, Web-homepage:           https://github.com/iand675/hs-opentelemetry#readme-bug-reports:        https://github.com/iand675/hs-opentelemetry/issues-author:             Ian Duncan-maintainer:         ian@iankduncan.com-copyright:          2021 Ian Duncan-license:            BSD3-license-file:       LICENSE-build-type:         Simple+name:           hs-opentelemetry-propagator-b3+version:        1.0.0.0+synopsis:       Trace propagation via HTTP headers following the b3 tracestate spec.+description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/propagators/b3#readme>+category:       OpenTelemetry, Tracing, Web+homepage:       https://github.com/iand675/hs-opentelemetry#readme+bug-reports:    https://github.com/iand675/hs-opentelemetry/issues+author:         Ian Duncan+maintainer:     ian@iankduncan.com+copyright:      2021 Ian Duncan+license:        BSD3+license-file:   LICENSE+build-type:     Simple extra-source-files:     README.md     ChangeLog.md@@ -38,7 +38,23 @@       attoparsec     , base >=4.7 && <5     , bytestring-    , hs-opentelemetry-api ==0.3.*-    , http-types+    , hs-opentelemetry-api ==1.0.*+    , text+  default-language: Haskell2010++test-suite hs-opentelemetry-propagator-b3-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hs_opentelemetry_propagator_b3+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , hs-opentelemetry-api ==1.0.*+    , hs-opentelemetry-propagator-b3 ==1.0.*+    , hspec     , text   default-language: Haskell2010

@@ -1,8 +1,6 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}  {- | B3 Propagation Requirements:  https://github.com/openzipkin/b3-propagation@@ -16,15 +14,18 @@ --------------------------------------------------------------------------------  import Control.Applicative ((<|>))-import Data.ByteString (ByteString) import Data.List (intersperse) import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Text.Encoding as Text-import Network.HTTP.Types (HeaderName, RequestHeaders) import OpenTelemetry.Common (TraceFlags (..))-import OpenTelemetry.Context (Context) import qualified OpenTelemetry.Context as Context-import OpenTelemetry.Propagator (Propagator (..))+import OpenTelemetry.Propagator (+  Propagator (..),+  TextMap,+  TextMapPropagator,+  textMapInsert,+  textMapLookup,+ ) import OpenTelemetry.Propagator.B3.Internal import qualified OpenTelemetry.Trace.Core as Core import qualified OpenTelemetry.Trace.TraceState as TS@@ -33,10 +34,10 @@  -------------------------------------------------------------------------------- -b3TraceContextPropagator :: Propagator Context RequestHeaders RequestHeaders+b3TraceContextPropagator :: TextMapPropagator b3TraceContextPropagator =   Propagator-    { propagatorNames = ["B3 Trace Context"]+    { propagatorFields = ["B3 Trace Context"]     , extractor = \hs c ->         case b3Extractor hs of           Nothing -> pure c@@ -45,20 +46,21 @@         case Context.lookupSpan c of           Nothing -> pure hs           Just span' -> do-            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState} <- Core.getSpanContext span'+            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState, traceFlags} <- Core.getSpanContext span'             let traceIdValue = encodeTraceId traceId                 spanIdValue = encodeSpanId spanId-                samplingStateValue = lookup (TS.Key "sampling-state") traceState >>= samplingStateFromValue >>= printSamplingStateSingle+                samplingStateValue =+                  printSamplingStateSingle $ injectSamplingState traceState traceFlags                 value = mconcat $ intersperse "-" $ [traceIdValue, spanIdValue] <> catMaybes [Text.encodeUtf8 <$> samplingStateValue] -            pure $ (b3Header, value) : hs+            pure $ textMapInsert b3Header (Text.decodeUtf8 value) hs     }  -b3MultiTraceContextPropagator :: Propagator Context RequestHeaders RequestHeaders+b3MultiTraceContextPropagator :: TextMapPropagator b3MultiTraceContextPropagator =   Propagator-    { propagatorNames = ["B3 Multi Trace Context"]+    { propagatorFields = ["B3 Multi Trace Context"]     , extractor = \hs c -> do         case b3Extractor hs of           Nothing -> pure c@@ -67,32 +69,46 @@         case Context.lookupSpan c of           Nothing -> pure hs           Just span' -> do-            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState} <- Core.getSpanContext span'+            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState, traceFlags} <- Core.getSpanContext span'             let traceIdValue = encodeTraceId traceId                 spanIdValue = encodeSpanId spanId-                samplingStateValue = lookup (TS.Key "sampling-state") traceState >>= samplingStateFromValue >>= printSamplingStateMulti--            pure $-              (xb3TraceIdHeader, traceIdValue)-                : (xb3SpanIdHeader, spanIdValue)-                : hs-                ++ catMaybes [fmap Text.encodeUtf8 <$> samplingStateValue]+                samplingStateMay =+                  printSamplingStateMulti $ injectSamplingState traceState traceFlags+                hs' =+                  textMapInsert xb3SpanIdHeader (Text.decodeUtf8 spanIdValue) $+                    textMapInsert xb3TraceIdHeader (Text.decodeUtf8 traceIdValue) hs+            pure $ case samplingStateMay of+              Nothing -> hs'+              Just (k, v) -> textMapInsert k v hs'     }   -------------------------------------------------------------------------------- +{- | B3 sampling for injection: prefer explicit @sampling-state@ in trace state,+otherwise derive from 'TraceFlags' (so local spans inject without a prior extract).+-}+injectSamplingState :: [(TS.Key, TS.Value)] -> TraceFlags -> SamplingState+injectSamplingState traceState traceFlags =+  case lookup (TS.Key "sampling-state") traceState >>= samplingStateFromValue of+    Just s -> s+    Nothing ->+      if Core.isSampled traceFlags then Accept else Deny+++--------------------------------------------------------------------------------+ {- | For both @B3@ and @B3 Multi@ formats, we must attempt single and  multi header extraction:  https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/context/api-propagators.md#configuration -}-b3Extractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3Extractor :: TextMap -> Maybe Core.SpanContext b3Extractor hs = b3SingleExtractor hs <|> b3MultiExtractor hs  -b3SingleExtractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3SingleExtractor :: TextMap -> Maybe Core.SpanContext b3SingleExtractor hs = do-  B3SingleHeader {..} <- decodeB3SingleHeader =<< Prelude.lookup b3Header hs+  B3SingleHeader {..} <- decodeB3SingleHeader =<< (Text.encodeUtf8 <$> textMapLookup b3Header hs)    let traceFlags = if samplingState == Accept || samplingState == Debug then TraceFlags 1 else TraceFlags 0 @@ -106,15 +122,15 @@       }  -b3MultiExtractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3MultiExtractor :: TextMap -> Maybe Core.SpanContext b3MultiExtractor hs = do-  traceId <- decodeXb3TraceIdHeader =<< Prelude.lookup xb3TraceIdHeader hs-  spanId <- decodeXb3SpanIdHeader =<< Prelude.lookup xb3SpanIdHeader hs+  traceId <- decodeXb3TraceIdHeader =<< (Text.encodeUtf8 <$> textMapLookup xb3TraceIdHeader hs)+  spanId <- decodeXb3SpanIdHeader =<< (Text.encodeUtf8 <$> textMapLookup xb3SpanIdHeader hs) -  let sampled = decodeXb3SampledHeader =<< Prelude.lookup xb3SampledHeader hs-      debug = decodeXb3FlagsHeader =<< Prelude.lookup xb3FlagsHeader hs+  let sampled = decodeXb3SampledHeader =<< (Text.encodeUtf8 <$> textMapLookup xb3SampledHeader hs)+      debug = decodeXb3FlagsHeader =<< (Text.encodeUtf8 <$> textMapLookup xb3FlagsHeader hs)       -- NOTE: Debug implies Accept (https://github.com/openzipkin/b3-propagation#debug-flag)-      samplingState = fromMaybe Defer $ sampled <|> debug+      samplingState = fromMaybe Defer $ debug <|> sampled   let traceFlags = if samplingState == Accept || samplingState == Debug then TraceFlags 1 else TraceFlags 0    pure $

@@ -1,7 +1,7 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Strict #-}  {- | Conversion of the hs-opentelemetry internal representation of the trace ID and the span ID and the B3 header representation of them each other.@@ -44,21 +44,28 @@   xb3SpanIdHeader,   xb3SampledHeader,   xb3FlagsHeader,+  xb3ParentSpanIdHeader, ) where  -------------------------------------------------------------------------------- -import Control.Applicative ((<|>))-import Control.Monad (void)-import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL-import qualified Data.Char as C-import Data.Functor (($>)) import Data.Text (Text)-import Network.HTTP.Types (HeaderName)-import OpenTelemetry.Trace.Id (Base (..), SpanId, TraceId, baseEncodedToSpanId, baseEncodedToTraceId, spanIdBaseEncodedBuilder, traceIdBaseEncodedBuilder)+import Data.Word (Word8)+import OpenTelemetry.Trace.Id (+  Base (..),+  SpanId,+  TraceId,+  baseEncodedToSpanId,+  baseEncodedToTraceId,+  bytesToTraceId,+  spanIdBaseEncodedBuilder,+  spanIdBytes,+  traceIdBaseEncodedBuilder,+ ) import OpenTelemetry.Trace.TraceState (Value (..))  @@ -81,87 +88,53 @@ --------------------------------------------------------------------------------  decodeXb3TraceIdHeader :: ByteString -> Maybe TraceId-decodeXb3TraceIdHeader tp = case Atto.parseOnly parserTraceId tp of-  Left _ -> Nothing-  Right traceId -> Just traceId+decodeXb3TraceIdHeader bs = either (const Nothing) Just (decodeTraceIdFromHex bs)   decodeXb3SpanIdHeader :: ByteString -> Maybe SpanId-decodeXb3SpanIdHeader tp = case Atto.parseOnly parserSpanId tp of-  Left _ -> Nothing-  Right spanId -> Just spanId+decodeXb3SpanIdHeader bs = either (const Nothing) Just (baseEncodedToSpanId Base16 bs)   decodeXb3SampledHeader :: ByteString -> Maybe SamplingState-decodeXb3SampledHeader tp = case Atto.parseOnly parserXb3Sampled tp of-  Left _ -> Nothing-  Right sampled -> Just sampled+decodeXb3SampledHeader "1" = Just Accept+decodeXb3SampledHeader "0" = Just Deny+decodeXb3SampledHeader _ = Nothing   decodeXb3FlagsHeader :: ByteString -> Maybe SamplingState-decodeXb3FlagsHeader tp = case Atto.parseOnly parserXb3Flags tp of-  Left _ -> Nothing-  Right flags -> Just flags+decodeXb3FlagsHeader "1" = Just Debug+decodeXb3FlagsHeader _ = Nothing   decodeB3SingleHeader :: ByteString -> Maybe B3SingleHeader-decodeB3SingleHeader tp = case Atto.parseOnly parserB3Single tp of-  Left _ -> Nothing-  Right b3 -> Just b3+decodeB3SingleHeader = parseB3Single   decodeB3SampleHeader :: ByteString -> Maybe SamplingState-decodeB3SampleHeader tp = case Atto.parseOnly parserSamplingState tp of-  Left _ -> Nothing-  Right b3 -> Just b3+decodeB3SampleHeader "1" = Just Accept+decodeB3SampleHeader "0" = Just Deny+decodeB3SampleHeader "d" = Just Debug+decodeB3SampleHeader _ = Nothing   -------------------------------------------------------------------------------- -parserTraceId :: Atto.Parser TraceId-parserTraceId = do-  traceIdBs <- Atto.takeWhile C.isHexDigit-  case baseEncodedToTraceId Base16 traceIdBs of-    Left err -> fail err-    Right traceId -> pure traceId---parserSpanId :: Atto.Parser SpanId-parserSpanId = do-  parentIdBs <- Atto.takeWhile C.isHexDigit-  case baseEncodedToSpanId Base16 parentIdBs of-    Left err -> fail err-    Right ok -> pure ok+{- | Decode a B3 @X-B3-TraceId@ value: 32 hex chars (128-bit) or 16 hex chars+ (64-bit, zero-padded to 128-bit per B3).+-}+decodeTraceIdFromHex :: ByteString -> Either String TraceId+decodeTraceIdFromHex hexBs+  | BS.length hexBs == 32 = baseEncodedToTraceId Base16 hexBs+  | BS.length hexBs == 16 = do+      sid <- baseEncodedToSpanId Base16 hexBs+      bytesToTraceId (BS.replicate 8 0 <> spanIdBytes sid)+  | otherwise = Left "B3 trace id: expected 16 or 32 hex characters"   data SamplingState = Accept | Deny | Debug | Defer   deriving (Eq)  --- | Parser for the @x-b3-sampled@ header value.-parserXb3Sampled :: Atto.Parser SamplingState-parserXb3Sampled = accept <|> deny-  where-    accept = "1" $> Accept-    deny = "0" $> Deny---parserXb3Flags :: Atto.Parser SamplingState-parserXb3Flags = "1" $> Debug---{- | Note that this parser is only correct for the B3 single header- format. In B3 Multi you can only pass a @0@ or @1@ for the sample- state for 'Accept' and 'Deny' respectively.--}-parserSamplingState :: Atto.Parser SamplingState-parserSamplingState = accept <|> deny <|> debug-  where-    accept = "1" $> Accept-    deny = "0" $> Deny-    debug = "d" $> Debug-- {- | Encode a 'SamplingState' as the Sampling State component of the  @b3@ header value. -}@@ -173,7 +146,7 @@   Defer -> Nothing  -printSamplingStateMulti :: SamplingState -> Maybe (HeaderName, Text)+printSamplingStateMulti :: SamplingState -> Maybe (Text, Text) printSamplingStateMulti = \case   Accept -> Just (xb3SampledHeader, "1")   Deny -> Just (xb3SampledHeader, "0")@@ -208,32 +181,89 @@   }  -parserB3Single :: Atto.Parser B3SingleHeader-parserB3Single = do-  traceId <- parserTraceId-  spanId <- void "-" *> parserSpanId-  samplingState <- Atto.option Defer (void "-" *> parserSamplingState)-  parentSpanId <- Atto.option Nothing (void "-" *> fmap Just parserSpanId)-  pure B3SingleHeader {..}+{- | Hand-rolled parser for @{traceId}-{spanId}[-{samplingState}[-{parentSpanId}]]@.+Scans for dash positions instead of using attoparsec.+-}+parseB3Single :: ByteString -> Maybe B3SingleHeader+parseB3Single bs = do+  let !len = BS.length bs+  -- Find the first dash — trace ID is 16 or 32 hex chars+  !dashIdx <- findDash bs 0+  !tid <- either (const Nothing) Just (decodeTraceIdFromHex (BS.take dashIdx bs))+  -- Span ID: next 16 hex chars after the dash+  let !spanStart = dashIdx + 1+      !spanEnd = spanStart + 16+  if spanEnd > len+    then Nothing+    else do+      !sid <- either (const Nothing) Just (baseEncodedToSpanId Base16 (BS.take 16 (BS.drop spanStart bs)))+      -- Optional sampling state and parent span ID+      if spanEnd == len+        then Just $! B3SingleHeader tid sid Defer Nothing+        else do+          guardByte bs spanEnd 0x2d -- '-'+          let !sampStart = spanEnd + 1+          if sampStart >= len+            then Nothing+            else do+              let (!ss, !afterSamp) = parseSamplingAt bs sampStart+              if afterSamp >= len+                then Just $! B3SingleHeader tid sid ss Nothing+                else do+                  guardByte bs afterSamp 0x2d -- '-'+                  let !parentStart = afterSamp + 1+                      !parentEnd = parentStart + 16+                  if parentEnd /= len+                    then Nothing+                    else do+                      !psid <- either (const Nothing) Just (baseEncodedToSpanId Base16 (BS.take 16 (BS.drop parentStart bs)))+                      Just $! B3SingleHeader tid sid ss (Just psid)  +findDash :: ByteString -> Int -> Maybe Int+findDash bs i+  | i >= BS.length bs = Nothing+  | BS.index bs i == 0x2d = Just i+  | otherwise = findDash bs (i + 1)+++guardByte :: ByteString -> Int -> Word8 -> Maybe ()+guardByte bs i expected+  | i < BS.length bs && BS.index bs i == expected = Just ()+  | otherwise = Nothing+++parseSamplingAt :: ByteString -> Int -> (SamplingState, Int)+parseSamplingAt bs i+  | i >= BS.length bs = (Defer, i)+  | otherwise = case BS.index bs i of+      0x31 -> (Accept, i + 1) -- '1'+      0x30 -> (Deny, i + 1) -- '0'+      0x64 -> (Debug, i + 1) -- 'd'+      _ -> (Defer, i)++ -------------------------------------------------------------------------------- -b3Header :: HeaderName+b3Header :: Text b3Header = "b3"  -xb3TraceIdHeader :: HeaderName-xb3TraceIdHeader = "X-B3-TraceId"+xb3TraceIdHeader :: Text+xb3TraceIdHeader = "x-b3-traceid"  -xb3SpanIdHeader :: HeaderName-xb3SpanIdHeader = "X-B3-SpanId"+xb3SpanIdHeader :: Text+xb3SpanIdHeader = "x-b3-spanid"  -xb3SampledHeader :: HeaderName-xb3SampledHeader = "X-B3-Sampled"+xb3SampledHeader :: Text+xb3SampledHeader = "x-b3-sampled"  -xb3FlagsHeader :: HeaderName-xb3FlagsHeader = "X-B3-Flags"+xb3FlagsHeader :: Text+xb3FlagsHeader = "x-b3-flags"+++xb3ParentSpanIdHeader :: Text+xb3ParentSpanIdHeader = "x-b3-parentspanid"

@@ -0,0 +1,245 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.Maybe (isJust, isNothing)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import OpenTelemetry.Common (TraceFlags (..))+import OpenTelemetry.Context (Context, empty, insertSpan, lookupSpan)+import OpenTelemetry.Propagator (+  Propagator (..),+  emptyTextMap,+  textMapFromList,+  textMapLookup,+ )+import OpenTelemetry.Propagator.B3 (b3MultiTraceContextPropagator, b3TraceContextPropagator)+import qualified OpenTelemetry.Propagator.B3.Internal as B3I+import OpenTelemetry.Trace.Core (SpanContext (..), getSpanContext, isSampled, wrapSpanContext)+import OpenTelemetry.Trace.Id (Base (..), SpanId, TraceId, baseEncodedToSpanId, baseEncodedToTraceId)+import qualified OpenTelemetry.Trace.TraceState as TS+import Test.Hspec+++main :: IO ()+main = hspec spec+++spec :: Spec+spec =+  -- B3 single-header and multi-header propagation+  -- https://github.com/openzipkin/b3-propagation+  describe "OpenTelemetry.Propagator.B3" $ do+    describe "extraction" $ do+      -- B3 single header: TraceId-SpanId-1 (sampled)+      -- https://github.com/openzipkin/b3-propagation#single-header+      it "extracts SpanContext from the single b3 header (sampled)" $ do+        let headers =+              textMapFromList+                [+                  ( "b3"+                  , "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1-1"+                  )+                ]+        ctx' <- extractor b3TraceContextPropagator headers empty+        assertExpectedRemoteSampled ctx'++      -- B3 multiple headers: X-B3-TraceId, X-B3-SpanId, X-B3-Sampled+      -- https://github.com/openzipkin/b3-propagation#multiple-headers+      it "extracts the same SpanContext from multi-header B3 (sampled)" $ do+        let headers =+              textMapFromList+                [ ("x-b3-traceid", "80f198ee56343ba864fe8b2a57d3eff7")+                , ("x-b3-spanid", "e457b5a2e4d86bd1")+                , ("x-b3-sampled", "1")+                ]+        ctx' <- extractor b3MultiTraceContextPropagator headers empty+        assertExpectedRemoteSampled ctx'++      it "leaves the context unchanged when headers are missing" $ do+        ctx1 <- extractor b3TraceContextPropagator emptyTextMap empty+        ctx2 <- extractor b3MultiTraceContextPropagator emptyTextMap empty+        lookupSpan ctx1 `shouldSatisfy` isNothing+        lookupSpan ctx2 `shouldSatisfy` isNothing++      -- Single header: trailing -0 means unsampled+      -- https://github.com/openzipkin/b3-propagation#single-header+      it "extracts SpanContext with sampled bit unset when b3 ends in -0" $ do+        let headers =+              textMapFromList+                [+                  ( "b3"+                  , "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1-0"+                  )+                ]+        ctx' <- extractor b3TraceContextPropagator headers empty+        case lookupSpan ctx' of+          Nothing -> expectationFailure "expected span in context"+          Just span -> do+            sc <- getSpanContext span+            traceId sc `shouldBe` expectedTraceId+            spanId sc `shouldBe` expectedSpanId+            isRemote sc `shouldBe` True+            isSampled (traceFlags sc) `shouldBe` False++      -- X-B3-Flags: 1 (debug) forces trace on; overrides X-B3-Sampled: 0+      -- https://github.com/openzipkin/b3-propagation#debug-flag+      it "debug flag takes precedence over X-B3-Sampled: 0 in multi-header" $ do+        let headers =+              textMapFromList+                [ ("x-b3-traceid", "80f198ee56343ba864fe8b2a57d3eff7")+                , ("x-b3-spanid", "e457b5a2e4d86bd1")+                , ("x-b3-sampled", "0")+                , ("x-b3-flags", "1")+                ]+        ctx' <- extractor b3MultiTraceContextPropagator headers empty+        case lookupSpan ctx' of+          Nothing -> expectationFailure "expected span in context"+          Just span -> do+            sc <- getSpanContext span+            traceId sc `shouldBe` expectedTraceId+            spanId sc `shouldBe` expectedSpanId+            isRemote sc `shouldBe` True+            isSampled (traceFlags sc) `shouldBe` True++      it "X-B3-Sampled: 0 alone means unsampled in multi-header" $ do+        let headers =+              textMapFromList+                [ ("x-b3-traceid", "80f198ee56343ba864fe8b2a57d3eff7")+                , ("x-b3-spanid", "e457b5a2e4d86bd1")+                , ("x-b3-sampled", "0")+                ]+        ctx' <- extractor b3MultiTraceContextPropagator headers empty+        case lookupSpan ctx' of+          Nothing -> expectationFailure "expected span in context"+          Just span -> do+            sc <- getSpanContext span+            isSampled (traceFlags sc) `shouldBe` False++    describe "injection" $ do+      -- Single header format TraceId-SpanId-SamplingState+      -- https://github.com/openzipkin/b3-propagation#single-header+      it "injects the b3 single header with traceId-spanId-sampling" $ do+        let ctx = insertSpan (wrapSpanContext sampleSpanContext) empty+        hs <- injector b3TraceContextPropagator ctx emptyTextMap+        case textMapLookup B3I.b3Header hs of+          Nothing -> expectationFailure "expected b3 header"+          Just v -> case T.splitOn "-" v of+            [tid, sid, samp] -> do+              tid `shouldBe` traceIdHex+              sid `shouldBe` spanIdHex+              samp `shouldBe` "1"+            _ ->+              expectationFailure $+                "expected traceId-spanId-sampling in b3 header, got: " ++ show v++      -- https://github.com/openzipkin/b3-propagation#multiple-headers+      it "injects X-B3-TraceId, X-B3-SpanId, and X-B3-Sampled for multi-header propagation" $ do+        let ctx = insertSpan (wrapSpanContext sampleSpanContext) empty+        hs <- injector b3MultiTraceContextPropagator ctx emptyTextMap+        textMapLookup B3I.xb3TraceIdHeader hs `shouldBe` Just traceIdHex+        textMapLookup B3I.xb3SpanIdHeader hs `shouldBe` Just spanIdHex+        textMapLookup B3I.xb3SampledHeader hs `shouldBe` Just "1"++    describe "B3 Internal" $ do+      -- 128-bit or 64-bit (padded) trace id hex+      -- https://github.com/openzipkin/b3-propagation#trace-identifiers+      it "decodeXb3TraceIdHeader parses 128-bit trace ID" $ do+        B3I.decodeXb3TraceIdHeader "80f198ee56343ba864fe8b2a57d3eff7" `shouldSatisfy` isJust++      it "decodeXb3TraceIdHeader parses 64-bit trace ID (zero-padded)" $ do+        B3I.decodeXb3TraceIdHeader "e457b5a2e4d86bd1" `shouldSatisfy` isJust++      it "decodeXb3TraceIdHeader rejects invalid hex" $ do+        B3I.decodeXb3TraceIdHeader "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz" `shouldBe` Nothing++      it "decodeXb3TraceIdHeader rejects empty" $ do+        B3I.decodeXb3TraceIdHeader "" `shouldBe` Nothing++      it "decodeXb3SpanIdHeader parses valid span ID" $ do+        B3I.decodeXb3SpanIdHeader "e457b5a2e4d86bd1" `shouldSatisfy` isJust++      it "decodeXb3SpanIdHeader rejects too-short hex" $ do+        B3I.decodeXb3SpanIdHeader "e457" `shouldBe` Nothing++      -- Single header with optional parent span id segment+      -- https://github.com/openzipkin/b3-propagation#single-header+      it "decodeB3SingleHeader parses full header with parent" $ do+        let hdr = "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1-1-05e3ac9a4f6e3b90"+        case B3I.decodeB3SingleHeader hdr of+          Nothing -> expectationFailure "expected parse"+          Just b3 -> do+            B3I.parentSpanId b3 `shouldSatisfy` isJust+            B3I.spanId b3 `shouldBe` expectedSpanId+            B3I.traceId b3 `shouldBe` expectedTraceId++      -- Sampling state "d" (debug)+      -- https://github.com/openzipkin/b3-propagation#sampling-state+      it "decodeB3SingleHeader parses header with sampling=d (debug)" $ do+        let hdr = "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1-d"+        case B3I.decodeB3SingleHeader hdr of+          Nothing -> expectationFailure "expected parse"+          Just b3 -> (B3I.samplingState b3 == B3I.Debug) `shouldBe` True++      it "decodeB3SingleHeader parses header without sampling" $ do+        let hdr = "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1"+        case B3I.decodeB3SingleHeader hdr of+          Nothing -> expectationFailure "expected parse"+          Just b3 -> (B3I.samplingState b3 == B3I.Defer) `shouldBe` True++      it "decodeXb3SampledHeader parses 1 as Accept" $ do+        (B3I.decodeXb3SampledHeader "1" == Just B3I.Accept) `shouldBe` True++      it "decodeXb3SampledHeader parses 0 as Deny" $ do+        (B3I.decodeXb3SampledHeader "0" == Just B3I.Deny) `shouldBe` True++      it "decodeXb3FlagsHeader parses 1 as Debug" $ do+        (B3I.decodeXb3FlagsHeader "1" == Just B3I.Debug) `shouldBe` True++      it "decodeXb3FlagsHeader rejects 0" $ do+        isNothing (B3I.decodeXb3FlagsHeader "0") `shouldBe` True+++traceIdHex :: T.Text+traceIdHex = "80f198ee56343ba864fe8b2a57d3eff7"+++spanIdHex :: T.Text+spanIdHex = "e457b5a2e4d86bd1"+++expectedTraceId :: TraceId+expectedTraceId =+  case baseEncodedToTraceId Base16 (TE.encodeUtf8 traceIdHex) of+    Right t -> t+    Left e -> error ("expectedTraceId: " ++ e)+++expectedSpanId :: SpanId+expectedSpanId =+  case baseEncodedToSpanId Base16 (TE.encodeUtf8 spanIdHex) of+    Right s -> s+    Left e -> error ("expectedSpanId: " ++ e)+++sampleSpanContext :: SpanContext+sampleSpanContext =+  SpanContext+    { traceId = expectedTraceId+    , spanId = expectedSpanId+    , isRemote = False+    , traceFlags = TraceFlags 1+    , traceState = TS.empty+    }+++assertExpectedRemoteSampled :: Context -> IO ()+assertExpectedRemoteSampled ctx' =+  case lookupSpan ctx' of+    Nothing -> expectationFailure "expected span in context"+    Just span -> do+      sc <- getSpanContext span+      traceId sc `shouldBe` expectedTraceId+      spanId sc `shouldBe` expectedSpanId+      isRemote sc `shouldBe` True+      isSampled (traceFlags sc) `shouldBe` True