diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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"`. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/hs-opentelemetry-propagator-xray.cabal b/hs-opentelemetry-propagator-xray.cabal new file mode 100644 --- /dev/null +++ b/hs-opentelemetry-propagator-xray.cabal @@ -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 . +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 diff --git a/src/OpenTelemetry/Propagator/XRay.hs b/src/OpenTelemetry/Propagator/XRay.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Propagator/XRay.hs @@ -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 . +-} +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 diff --git a/src/OpenTelemetry/Propagator/XRay/Internal.hs b/src/OpenTelemetry/Propagator/XRay/Internal.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Propagator/XRay/Internal.hs @@ -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 . +-} +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 diff --git a/test/OpenTelemetry/Propagator/XRaySpec.hs b/test/OpenTelemetry/Propagator/XRaySpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/Propagator/XRaySpec.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +