hs-opentelemetry-propagator-xray (empty) → 1.0.0.0
raw patch · 7 files changed
+677/−0 lines, 7 filesdep +basedep +bytestringdep +hs-opentelemetry-api
Dependencies added: base, bytestring, hs-opentelemetry-api, hs-opentelemetry-propagator-xray, hspec, text, unordered-containers
Files
- ChangeLog.md +13/−0
- LICENSE +30/−0
- hs-opentelemetry-propagator-xray.cabal +72/−0
- src/OpenTelemetry/Propagator/XRay.hs +109/−0
- src/OpenTelemetry/Propagator/XRay/Internal.hs +181/−0
- test/OpenTelemetry/Propagator/XRaySpec.hs +270/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,13 @@+# Changelog for hs-opentelemetry-propagator-xray++## 1.0.0.0 - 2026-05-29++- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release.++## 0.0.1.0++- Initial release.+- Extract and inject `X-Amzn-Trace-Id` header (AWS X-Ray trace context).+- Converts between X-Ray trace ID format (`1-{epoch}-{unique}`) and+ standard 128-bit OpenTelemetry trace IDs.+- Registry integration under the name `"xray"`.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2024-2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ian Duncan nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ hs-opentelemetry-propagator-xray.cabal view
@@ -0,0 +1,72 @@+cabal-version: 2.4++name: hs-opentelemetry-propagator-xray+version: 1.0.0.0+synopsis: AWS X-Ray trace context propagation for OpenTelemetry.+description:+ Propagator implementing the AWS X-Ray trace context format+ (@X-Amzn-Trace-Id@ header).+ .+ The X-Ray format is used by AWS services such as Application Load+ Balancer, API Gateway, and Lambda. This package lets Haskell services+ participate in traces originated or propagated by AWS infrastructure.+ .+ Use alongside W3C Trace Context for mixed environments:+ @OTEL_PROPAGATORS=tracecontext,baggage,xray@.+ .+ See <https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader>.+category: OpenTelemetry, Tracing, AWS, 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: 2024 Ian Duncan, Mercury Technologies+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-doc-files:+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/iand675/hs-opentelemetry++library+ exposed-modules:+ OpenTelemetry.Propagator.XRay+ OpenTelemetry.Propagator.XRay.Internal+ other-modules:+ Paths_hs_opentelemetry_propagator_xray+ autogen-modules:+ Paths_hs_opentelemetry_propagator_xray+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5+ , bytestring+ , hs-opentelemetry-api ^>= 1.0+ , text+ default-language: Haskell2010++test-suite hs-opentelemetry-propagator-xray-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ OpenTelemetry.Propagator.XRaySpec+ Paths_hs_opentelemetry_propagator_xray+ autogen-modules:+ Paths_hs_opentelemetry_propagator_xray+ 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-xray ^>= 1.0+ , hspec+ , text+ , unordered-containers+ default-language: Haskell2010+ build-tool-depends: hspec-discover:hspec-discover
+ src/OpenTelemetry/Propagator/XRay.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++{- | AWS X-Ray Propagation Format.++The @X-Amzn-Trace-Id@ header is used by AWS services (ALB, API Gateway,+Lambda, etc.) to propagate trace context. The trace ID embeds a Unix+epoch timestamp in its first 4 bytes, but is otherwise a standard 128-bit+identifier that maps directly to an OpenTelemetry trace ID.++== Header format++@+X-Amzn-Trace-Id: Root=1-{epoch8hex}-{unique24hex};Parent={spanid16hex};Sampled={0|1}+@++== Interoperability with W3C Trace Context++Use alongside W3C propagators for mixed AWS / non-AWS environments:++@+OTEL_PROPAGATORS=tracecontext,baggage,xray+@++Both propagators will extract context from their respective headers.+On injection both headers are emitted, so downstream services can+consume whichever format they understand.++See <https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader>.+-}+module OpenTelemetry.Propagator.XRay (+ xrayPropagator,++ -- * Registry integration+ registerXRayPropagator,+) where++import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Encoding as TE+import OpenTelemetry.Common (TraceFlags (..))+import OpenTelemetry.Context (Context)+import qualified OpenTelemetry.Context as Context+import OpenTelemetry.Propagator (+ Propagator (..),+ TextMap,+ textMapInsert,+ textMapLookup,+ )+import OpenTelemetry.Propagator.XRay.Internal+import OpenTelemetry.Registry (registerTextMapPropagator)+import qualified OpenTelemetry.Trace.Core as Core+import OpenTelemetry.Trace.Id (Base (..), spanIdBaseEncodedBuilder)+import OpenTelemetry.Trace.TraceState (TraceState (..))+++{- | Propagator for the AWS X-Ray @X-Amzn-Trace-Id@ header.++Extracts @Root@, @Parent@, and @Sampled@ fields from incoming headers+and injects them on outgoing headers.++@since 0.0.1.0+-}+xrayPropagator :: Propagator Context TextMap TextMap+xrayPropagator =+ Propagator+ { propagatorFields = [xrayTraceIdHeader]+ , extractor = \tm c ->+ case textMapLookup xrayTraceIdHeader tm of+ Nothing -> pure c+ Just val ->+ case decodeXRayHeader (TE.encodeUtf8 val) of+ Nothing -> pure c+ Just xh ->+ let sc =+ Core.SpanContext+ { Core.traceId = xhTraceId xh+ , Core.spanId = xhSpanId xh+ , Core.isRemote = True+ , Core.traceFlags = case xhSampled xh of+ Just True -> TraceFlags 1+ _ -> TraceFlags 0 -- absent or explicitly unsampled+ , Core.traceState = TraceState []+ }+ in pure $ Context.insertSpan (Core.wrapSpanContext sc) c+ , injector = \c tm ->+ case Context.lookupSpan c of+ Nothing -> pure tm+ Just span' -> do+ sc <- Core.getSpanContext span'+ let root = TE.decodeUtf8 $ otelTraceIdToXRay (Core.traceId sc)+ parent =+ TE.decodeUtf8 $+ BL.toStrict $+ BB.toLazyByteString $+ spanIdBaseEncodedBuilder Base16 (Core.spanId sc)+ sampled = if Core.isSampled (Core.traceFlags sc) then "1" else "0"+ headerValue = "Root=" <> root <> ";Parent=" <> parent <> ";Sampled=" <> sampled+ pure $ textMapInsert xrayTraceIdHeader headerValue tm+ }+++{- | Register the X-Ray propagator under the name @\"xray\"@ in the+global registry.++@since 0.0.1.0+-}+registerXRayPropagator :: IO ()+registerXRayPropagator =+ registerTextMapPropagator "xray" xrayPropagator
+ src/OpenTelemetry/Propagator/XRay/Internal.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- | Internal codec for the AWS X-Ray propagation format.++The wire format for the @X-Amzn-Trace-Id@ header is:++@+Root=1-{8hex-epoch}-{24hex-unique};Parent={16hex-spanid};Sampled={0|1}+@++The trace ID is a standard 128-bit value. X-Ray splits it into a 4-byte+epoch timestamp and a 12-byte unique part, separated by dashes and+prefixed with a version number (@1@). Stripping the delimiters yields a+32-hex-char OpenTelemetry trace ID.++See <https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader>.+-}+module OpenTelemetry.Propagator.XRay.Internal (+ -- * Header key+ xrayTraceIdHeader,++ -- * Parsed header+ XRayHeader (..),++ -- * Decoders+ decodeXRayHeader,++ -- * Trace ID conversion+ otelTraceIdToXRay,+ xrayTraceIdToOTel,+) where++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 Data.Text (Text)+import Data.Word (Word8)+import OpenTelemetry.Trace.Id (+ Base (..),+ SpanId,+ TraceId,+ baseEncodedToSpanId,+ baseEncodedToTraceId,+ traceIdBaseEncodedBuilder,+ )+++-- Header key -----------------------------------------------------------------++xrayTraceIdHeader :: Text+xrayTraceIdHeader = "x-amzn-trace-id"+++-- Parsed header --------------------------------------------------------------++data XRayHeader = XRayHeader+ { xhTraceId :: !TraceId+ , xhSpanId :: !SpanId+ , xhSampled :: !(Maybe Bool)+ {- ^ @Nothing@ when the @Sampled@ field is absent (deferred decision).+ @Just True@ = sampled, @Just False@ = not sampled.+ -}+ }+ deriving (Eq, Show)+++-- Trace ID conversion --------------------------------------------------------++-- | Convert an OTel 128-bit trace ID to X-Ray format: @1-{epoch8}-{unique24}@.+otelTraceIdToXRay :: TraceId -> ByteString+otelTraceIdToXRay tid =+ let hex = BL.toStrict $ BB.toLazyByteString $ traceIdBaseEncodedBuilder Base16 tid+ (epoch, unique) = BS.splitAt 8 hex+ in "1-" <> epoch <> "-" <> unique+++{- | Parse an X-Ray trace ID (@1-{epoch8}-{unique24}@) into an OTel trace ID.+Returns 'Nothing' on malformed input.+-}+xrayTraceIdToOTel :: ByteString -> Maybe TraceId+xrayTraceIdToOTel bs+ | BS.length bs /= 35 = Nothing+ | BS.index bs 0 /= charW8 '1' = Nothing+ | BS.index bs 1 /= charW8 '-' = Nothing+ | BS.index bs 10 /= charW8 '-' = Nothing+ | otherwise =+ let epoch = BS.take 8 (BS.drop 2 bs)+ unique = BS.drop 11 bs+ combined = epoch <> unique+ in case baseEncodedToTraceId Base16 combined of+ Left _ -> Nothing+ Right tid -> Just tid+++-- Decoders -------------------------------------------------------------------++{- | Maximum allowed size for an X-Ray header in bytes.++The standard format is ~74 bytes:+@Root=1-{8hex}-{24hex};Parent={16hex};Sampled={0|1}@++We allow 512 bytes to accommodate optional custom fields while still+preventing DoS from scanning arbitrarily large inputs. This is well below+typical web server header limits (8KB-50KB).+-}+maxHeaderSize :: Int+maxHeaderSize = 512+++-- | Parse a full @X-Amzn-Trace-Id@ header value.+decodeXRayHeader :: ByteString -> Maybe XRayHeader+decodeXRayHeader bs+ | BS.length bs > maxHeaderSize = Nothing+ | otherwise = parseXRayKVs bs+++{- | Hand-rolled parser for semicolon-separated key=value pairs.+Extracts Root, Parent, Sampled; ignores other fields.+-}+parseXRayKVs :: ByteString -> Maybe XRayHeader+parseXRayKVs bs = go bs Nothing Nothing Nothing+ where+ go !remaining mRoot mParent mSampled+ | BS.null remaining =+ case (mRoot, mParent) of+ (Just tid, Just sid) -> Just $! XRayHeader tid sid mSampled+ _ -> Nothing+ | otherwise =+ let !trimmed = BS.dropWhile (== charW8 ' ') remaining+ (!key, !afterEq) = BS.break (== charW8 '=') trimmed+ in if BS.null afterEq+ then Nothing -- no '=' found+ else+ let !valAndRest = BS.drop 1 afterEq -- skip '='+ (!val, !rest) = breakSemicolon valAndRest+ !next = skipSpacesAfterSemicolon rest+ in if+ | key == "Root" ->+ case xrayTraceIdToOTel val of+ Nothing -> Nothing+ Just !tid -> go next (Just tid) mParent mSampled+ | key == "Parent" ->+ case parseSpanIdHex val of+ Nothing -> Nothing+ Just !sid -> go next mRoot (Just sid) mSampled+ | key == "Sampled" ->+ let !s = val == "1"+ in go next mRoot mParent (Just s)+ | otherwise ->+ go next mRoot mParent mSampled++ breakSemicolon :: ByteString -> (ByteString, ByteString)+ breakSemicolon bs' =+ let (!v, !rest) = BS.break (== charW8 ';') bs'+ in (stripTrailingSpaces v, rest)++ stripTrailingSpaces :: ByteString -> ByteString+ stripTrailingSpaces = fst . BS.spanEnd (== charW8 ' ')++ skipSpacesAfterSemicolon :: ByteString -> ByteString+ skipSpacesAfterSemicolon !rest+ | BS.null rest = rest+ | otherwise =+ let !afterSemi = BS.drop 1 rest -- skip ';'+ in BS.dropWhile (== charW8 ' ') afterSemi+++parseSpanIdHex :: ByteString -> Maybe SpanId+parseSpanIdHex bs+ | BS.length bs /= 16 = Nothing+ | otherwise = case baseEncodedToSpanId Base16 bs of+ Left _ -> Nothing+ Right sid -> Just sid+++charW8 :: Char -> Word8+charW8 = fromIntegral . fromEnum
+ test/OpenTelemetry/Propagator/XRaySpec.hs view
@@ -0,0 +1,270 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Propagator.XRaySpec (spec) 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 (..),+ TextMap,+ emptyTextMap,+ textMapFromList,+ textMapLookup,+ )+import OpenTelemetry.Propagator.XRay (xrayPropagator)+import OpenTelemetry.Propagator.XRay.Internal+import qualified OpenTelemetry.Trace.Core as Core+import OpenTelemetry.Trace.Id (+ Base (..),+ SpanId,+ TraceId,+ baseEncodedToSpanId,+ baseEncodedToTraceId,+ )+import OpenTelemetry.Trace.TraceState (TraceState (..))+import Test.Hspec+++mkTraceId :: String -> TraceId+mkTraceId hex = case baseEncodedToTraceId Base16 (TE.encodeUtf8 $ T.pack hex) of+ Right tid -> tid+ Left err -> error $ "bad test trace id: " ++ err+++mkSpanId :: String -> SpanId+mkSpanId hex = case baseEncodedToSpanId Base16 (TE.encodeUtf8 $ T.pack hex) of+ Right sid -> sid+ Left err -> error $ "bad test span id: " ++ err+++mkContext :: TraceId -> SpanId -> Bool -> IO Context+mkContext tid sid sampled = do+ let sc =+ Core.SpanContext+ { Core.traceId = tid+ , Core.spanId = sid+ , Core.isRemote = False+ , Core.traceFlags = if sampled then TraceFlags 1 else TraceFlags 0+ , Core.traceState = TraceState []+ }+ pure $ insertSpan (Core.wrapSpanContext sc) empty+++extractWith :: T.Text -> IO Context+extractWith headerVal = do+ let tm = textMapFromList [("x-amzn-trace-id", headerVal)]+ extractor xrayPropagator tm empty+++spec :: Spec+spec =+ -- AWS X-Ray tracing header (Root, Parent, Sampled)+ -- https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader+ describe "OpenTelemetry.Propagator.XRay" $ do+ describe "Internal: trace ID conversion" $ do+ -- Root=1-{8 hex epoch}-{24 hex unique}+ -- https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader+ it "converts OTel trace ID to X-Ray format" $ do+ let tid = mkTraceId "5759e988bd862e3fe1be46a994272793"+ otelTraceIdToXRay tid `shouldBe` "1-5759e988-bd862e3fe1be46a994272793"++ it "converts X-Ray trace ID back to OTel format" $ do+ let expected = mkTraceId "5759e988bd862e3fe1be46a994272793"+ xrayTraceIdToOTel "1-5759e988-bd862e3fe1be46a994272793" `shouldBe` Just expected++ it "round-trips trace ID through X-Ray encoding" $ do+ let tid = mkTraceId "463ac35c9f6413ad48485a3953bb6124"+ xray = otelTraceIdToXRay tid+ xrayTraceIdToOTel xray `shouldBe` Just tid++ it "rejects trace ID with wrong version" $ do+ xrayTraceIdToOTel "2-5759e988-bd862e3fe1be46a994272793" `shouldBe` Nothing++ it "rejects trace ID with wrong length" $ do+ xrayTraceIdToOTel "1-5759e988-bd862e3fe1be46a99427279" `shouldBe` Nothing++ it "rejects trace ID with missing delimiters" $ do+ xrayTraceIdToOTel "1-5759e988bd862e3fe1be46a994272793" `shouldBe` Nothing++ describe "Internal: header parsing" $ do+ it "parses a standard X-Ray header" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8;Sampled=1"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh ->+ xhTraceId xh == mkTraceId "5759e988bd862e3fe1be46a994272793"+ && xhSpanId xh == mkSpanId "53995c3f42cd8ad8"+ && xhSampled xh == Just True+ Nothing -> False++ it "parses header with Sampled=0" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8;Sampled=0"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh -> xhSampled xh == Just False+ Nothing -> False++ it "handles missing Sampled field (deferred — Nothing)" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh -> xhSampled xh == Nothing+ Nothing -> False++ it "handles reordered fields" $ do+ let hdr = "Sampled=1;Parent=53995c3f42cd8ad8;Root=1-5759e988-bd862e3fe1be46a994272793"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh ->+ xhTraceId xh == mkTraceId "5759e988bd862e3fe1be46a994272793"+ && xhSpanId xh == mkSpanId "53995c3f42cd8ad8"+ && xhSampled xh == Just True+ Nothing -> False++ it "ignores extra fields (Self, Lineage, etc.)" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8;Sampled=1;Self=1-abc12345-def67890123456789012"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh ->+ xhTraceId xh == mkTraceId "5759e988bd862e3fe1be46a994272793"+ && xhSampled xh == Just True+ Nothing -> False++ it "handles spaces around semicolons" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793 ; Parent=53995c3f42cd8ad8 ; Sampled=1"+ let result = decodeXRayHeader hdr+ result `shouldSatisfy` \case+ Just xh ->+ xhTraceId xh == mkTraceId "5759e988bd862e3fe1be46a994272793"+ Nothing -> False++ it "rejects header with missing Root" $ do+ let hdr = "Parent=53995c3f42cd8ad8;Sampled=1"+ decodeXRayHeader hdr `shouldSatisfy` isNothing++ it "rejects header with missing Parent" $ do+ let hdr = "Root=1-5759e988-bd862e3fe1be46a994272793;Sampled=1"+ decodeXRayHeader hdr `shouldSatisfy` isNothing++ it "rejects header with invalid trace ID" $ do+ let hdr = "Root=1-ZZZZZZZZ-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8;Sampled=1"+ decodeXRayHeader hdr `shouldSatisfy` isNothing++ it "rejects empty header" $ do+ decodeXRayHeader "" `shouldSatisfy` isNothing++ it "rejects oversized header (> 512 bytes)" $ do+ -- Create a header with valid Root/Parent but padded with junk to exceed 512 bytes+ let validPart = "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=1"+ -- Add enough padding to exceed 512 bytes (valid part is ~81 bytes)+ padding = replicate (512 - length validPart + 1) 'x'+ oversized = TE.encodeUtf8 $ T.pack $ validPart ++ padding+ decodeXRayHeader oversized `shouldSatisfy` isNothing++ describe "trace context extraction" $ do+ it "extracts sampled span context from header" $ do+ ctx <- extractWith "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=1"+ case lookupSpan ctx of+ Nothing -> expectationFailure "expected span in context"+ Just span' -> do+ sc <- Core.getSpanContext span'+ Core.traceId sc `shouldBe` mkTraceId "65a8c9d20abcdef1234567890abcdef0"+ Core.spanId sc `shouldBe` mkSpanId "53995c3f42cd8ad8"+ Core.isRemote sc `shouldBe` True+ Core.isSampled (Core.traceFlags sc) `shouldBe` True++ it "extracts unsampled span context from header" $ do+ ctx <- extractWith "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=0"+ case lookupSpan ctx of+ Nothing -> expectationFailure "expected span in context"+ Just span' -> do+ sc <- Core.getSpanContext span'+ Core.isSampled (Core.traceFlags sc) `shouldBe` False++ it "returns unchanged context when header is missing" $ do+ ctx <- extractor xrayPropagator emptyTextMap empty+ lookupSpan ctx `shouldSatisfy` (not . isJust)++ it "returns unchanged context on malformed header" $ do+ ctx <- extractWith "not-a-valid-header"+ lookupSpan ctx `shouldSatisfy` (not . isJust)++ describe "trace context injection" $ do+ it "injects X-Ray header from span context" $ do+ let tid = mkTraceId "65a8c9d20abcdef1234567890abcdef0"+ sid = mkSpanId "53995c3f42cd8ad8"+ ctx <- mkContext tid sid True+ tm <- injector xrayPropagator ctx emptyTextMap+ textMapLookup "x-amzn-trace-id" tm+ `shouldBe` Just "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=1"++ it "injects unsampled X-Ray header" $ do+ let tid = mkTraceId "65a8c9d20abcdef1234567890abcdef0"+ sid = mkSpanId "53995c3f42cd8ad8"+ ctx <- mkContext tid sid False+ tm <- injector xrayPropagator ctx emptyTextMap+ textMapLookup "x-amzn-trace-id" tm+ `shouldBe` Just "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=0"++ it "does not inject when no span in context" $ do+ tm <- injector xrayPropagator empty emptyTextMap+ textMapLookup "x-amzn-trace-id" tm `shouldBe` Nothing++ describe "round-trip" $ do+ it "inject then extract preserves trace identity" $ do+ let tid = mkTraceId "5759e988bd862e3fe1be46a994272793"+ sid = mkSpanId "abcdef0123456789"+ ctx <- mkContext tid sid True+ tm <- injector xrayPropagator ctx emptyTextMap+ ctx' <- extractor xrayPropagator tm empty+ case lookupSpan ctx' of+ Nothing -> expectationFailure "expected span after round-trip"+ Just span' -> do+ sc <- Core.getSpanContext span'+ Core.traceId sc `shouldBe` tid+ Core.spanId sc `shouldBe` sid+ Core.isSampled (Core.traceFlags sc) `shouldBe` True+ Core.isRemote sc `shouldBe` True++ it "round-trips unsampled spans" $ do+ let tid = mkTraceId "0000000100000002000000030000000f"+ sid = mkSpanId "1234567890abcdef"+ ctx <- mkContext tid sid False+ tm <- injector xrayPropagator ctx emptyTextMap+ ctx' <- extractor xrayPropagator tm empty+ case lookupSpan ctx' of+ Nothing -> expectationFailure "expected span after round-trip"+ Just span' -> do+ sc <- Core.getSpanContext span'+ Core.traceId sc `shouldBe` tid+ Core.spanId sc `shouldBe` sid+ Core.isSampled (Core.traceFlags sc) `shouldBe` False++ -- X-Ray vs W3C in same carrier (extractor behavior with multiple formats)+ describe "W3C interoperability" $ do+ it "works alongside W3C headers in the same TextMap" $ do+ let tm =+ textMapFromList+ [ ("traceparent", "00-65a8c9d20abcdef1234567890abcdef0-53995c3f42cd8ad8-01")+ , ("x-amzn-trace-id", "Root=1-65a8c9d2-0abcdef1234567890abcdef0;Parent=53995c3f42cd8ad8;Sampled=1")+ ]+ ctx <- extractor xrayPropagator tm empty+ case lookupSpan ctx of+ Nothing -> expectationFailure "expected X-Ray extraction to succeed"+ Just span' -> do+ sc <- Core.getSpanContext span'+ Core.traceId sc `shouldBe` mkTraceId "65a8c9d20abcdef1234567890abcdef0"++ it "injected header can be extracted by the same propagator" $ do+ let tid = mkTraceId "aabbccdd11223344aabbccdd11223344"+ sid = mkSpanId "ff00ff00ff00ff00"+ ctx <- mkContext tid sid True+ tm <- injector xrayPropagator ctx emptyTextMap+ let headerVal = textMapLookup "x-amzn-trace-id" tm+ headerVal `shouldSatisfy` \case+ Just v -> "Root=1-aabbccdd-11223344aabbccdd11223344" `T.isPrefixOf` v+ Nothing -> False
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+