diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,12 @@ +# Changelog for hs-opentelemetry-propagator-jaeger + +## 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 `uber-trace-id` (Jaeger trace context) header. +- Extract and inject `uberctx-*` (Jaeger baggage) headers. +- Registry integration under the name `"jaeger"`. 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +# hs-opentelemetry-propagator-jaeger + +[![hs-opentelemetry-propagator-jaeger](https://img.shields.io/hackage/v/hs-opentelemetry-propagator-jaeger?style=flat-square&logo=haskell&label=hs-opentelemetry-propagator-jaeger&labelColor=5D4F85)](https://hackage.haskell.org/package/hs-opentelemetry-propagator-jaeger) + +Jaeger trace context propagation for the +[hs-opentelemetry](https://github.com/iand675/hs-opentelemetry) suite. + +Implements the `uber-trace-id` header format and `uberctx-*` baggage +headers as described in the +[Jaeger propagation format](https://www.jaegertracing.io/docs/1.21/client-libraries/#propagation-format). + +> **Note:** The Jaeger propagation format is deprecated in favor of +> [W3C Trace Context](https://www.w3.org/TR/trace-context/). Use this +> package for interoperability with legacy systems only. diff --git a/hs-opentelemetry-propagator-jaeger.cabal b/hs-opentelemetry-propagator-jaeger.cabal new file mode 100644 --- /dev/null +++ b/hs-opentelemetry-propagator-jaeger.cabal @@ -0,0 +1,72 @@ +cabal-version: 2.4 + +name: hs-opentelemetry-propagator-jaeger +version: 1.0.0.0 +synopsis: Jaeger trace context propagation for OpenTelemetry. +description: + Propagator implementing the Jaeger trace context format + (@uber-trace-id@ header) and Jaeger baggage (@uberctx-*@ headers). + . + The Jaeger format is deprecated in favour of W3C Trace Context but is + still widely deployed. This package lets Haskell services interoperate + with legacy Jaeger-instrumented systems. + . + See . +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: 2024 Ian Duncan, Mercury Technologies +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md +extra-doc-files: + ChangeLog.md + +source-repository head + type: git + location: https://github.com/iand675/hs-opentelemetry + +library + exposed-modules: + OpenTelemetry.Propagator.Jaeger + OpenTelemetry.Propagator.Jaeger.Internal + other-modules: + Paths_hs_opentelemetry_propagator_jaeger + autogen-modules: + Paths_hs_opentelemetry_propagator_jaeger + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + , bytestring + , hs-opentelemetry-api ^>= 1.0 + , text + , unordered-containers + default-language: Haskell2010 + +test-suite hs-opentelemetry-propagator-jaeger-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + OpenTelemetry.Propagator.JaegerSpec + Paths_hs_opentelemetry_propagator_jaeger + autogen-modules: + Paths_hs_opentelemetry_propagator_jaeger + 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-jaeger ^>= 1.0 + , hspec + , text + , unordered-containers + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover diff --git a/src/OpenTelemetry/Propagator/Jaeger.hs b/src/OpenTelemetry/Propagator/Jaeger.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Propagator/Jaeger.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{- | Jaeger Propagation Format: + + + The Jaeger propagation format is deprecated in favour of W3C Trace + Context. This package exists for interoperability with legacy systems. + + == Header: @uber-trace-id@ + + @ + {trace-id}:{span-id}:{parent-span-id}:{flags} + @ + + == Baggage: @uberctx-{key}@ + + Each baggage entry is a separate header with prefix @uberctx-@. +-} +module OpenTelemetry.Propagator.Jaeger ( + jaegerPropagator, + jaegerTraceContextPropagator, + + -- * Registry integration + registerJaegerPropagator, +) where + +import qualified Data.ByteString.Char8 as C +import qualified Data.HashMap.Strict as H +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import OpenTelemetry.Baggage (decodeBaggageHeader) +import qualified OpenTelemetry.Baggage as Baggage +import OpenTelemetry.Common (TraceFlags (..)) +import OpenTelemetry.Context (Context) +import qualified OpenTelemetry.Context as Context +import OpenTelemetry.Propagator ( + Propagator (..), + TextMap, + textMapInsert, + textMapKeys, + textMapLookup, + ) +import OpenTelemetry.Propagator.Jaeger.Internal +import OpenTelemetry.Registry (registerTextMapPropagator) +import qualified OpenTelemetry.Trace.Core as Core +import OpenTelemetry.Trace.TraceState (TraceState (..)) + + +{- | Propagator for the Jaeger trace context format. + +Handles both the @uber-trace-id@ header (trace context) and +@uberctx-*@ headers (baggage). +-} +jaegerPropagator :: Propagator Context TextMap TextMap +jaegerPropagator = jaegerTraceContextPropagator <> jaegerBaggagePropagator + + +{- | Propagator for the @uber-trace-id@ header only (no baggage). + +Use 'jaegerPropagator' if you also need Jaeger baggage propagation. +-} +jaegerTraceContextPropagator :: Propagator Context TextMap TextMap +jaegerTraceContextPropagator = + Propagator + { propagatorFields = [uberTraceIdHeader] + , extractor = \tm c -> + case textMapLookup uberTraceIdHeader tm of + Nothing -> pure c + Just val -> + case decodeUberTraceId (TE.encodeUtf8 val) of + Nothing -> pure c + Just jh -> + let sampled = flagsSampled (jhFlags jh) || flagsDebug (jhFlags jh) + sc = + Core.SpanContext + { Core.traceId = jhTraceId jh + , Core.spanId = jhSpanId jh + , Core.isRemote = True + , Core.traceFlags = if sampled then TraceFlags 1 else TraceFlags 0 + , 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 !sampled = Core.isSampled (Core.traceFlags sc) + !headerBs = encodeUberTraceId (Core.traceId sc) (Core.spanId sc) sampled + !headerValue = TE.decodeUtf8 headerBs + pure $ textMapInsert uberTraceIdHeader headerValue tm + } + + +-- | Propagator for Jaeger-style baggage (@uberctx-*@ headers). +jaegerBaggagePropagator :: Propagator Context TextMap TextMap +jaegerBaggagePropagator = + Propagator + { propagatorFields = [] + , extractor = \tm c -> do + let baggageKeys = filter (T.isPrefixOf uberBaggagePrefix) (textMapKeys tm) + entries = catMaybes $ map (extractBaggageEntry tm) baggageKeys + case entries of + [] -> pure c + kvs -> + case decodeBaggageHeader (C.pack $ encodeBaggageString kvs) of + Left _ -> pure c + Right bag -> pure $ Context.insertBaggage bag c + , injector = \c tm -> + case Context.lookupBaggage c of + Nothing -> pure tm + Just bag -> + let entries = H.toList (Baggage.values bag) + in pure $ + foldl + ( \acc (k, v) -> + let headerName = uberBaggagePrefix <> TE.decodeUtf8 (Baggage.tokenValue k) + in textMapInsert headerName (Baggage.value v) acc + ) + tm + entries + } + + +extractBaggageEntry :: TextMap -> Text -> Maybe (Text, Text) +extractBaggageEntry tm headerKey = do + val <- textMapLookup headerKey tm + let key = T.drop (T.length uberBaggagePrefix) headerKey + if T.null key + then Nothing + else Just (key, val) + + +encodeBaggageString :: [(Text, Text)] -> String +encodeBaggageString kvs = + T.unpack $ T.intercalate "," $ map (\(k, v) -> k <> "=" <> v) kvs + + +{- | Register the Jaeger propagator under the name @\"jaeger\"@ in the +global registry. + +@since 0.0.1.0 +-} +registerJaegerPropagator :: IO () +registerJaegerPropagator = + registerTextMapPropagator "jaeger" jaegerPropagator diff --git a/src/OpenTelemetry/Propagator/Jaeger/Internal.hs b/src/OpenTelemetry/Propagator/Jaeger/Internal.hs new file mode 100644 --- /dev/null +++ b/src/OpenTelemetry/Propagator/Jaeger/Internal.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} + +{- | Internal codec for the Jaeger propagation format. + +The wire format for the @uber-trace-id@ header is: + +@ +{trace-id}:{span-id}:{parent-span-id}:{flags} +@ + +See . +-} +module OpenTelemetry.Propagator.Jaeger.Internal ( + -- * Encoders + encodeTraceId, + encodeSpanId, + encodeUberTraceId, + + -- * Decoders + decodeUberTraceId, + + -- * Parsed header + JaegerHeader (..), + + -- * Flags + JaegerFlags (..), + flagsSampled, + flagsDebug, + + -- * Header keys + uberTraceIdHeader, + uberBaggagePrefix, +) where + +import Data.Bits (Bits ((.&.))) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Text (Text) +import Data.Word (Word8) +import OpenTelemetry.Trace.Id ( + Base (..), + SpanId, + TraceId, + baseEncodedToSpanId, + baseEncodedToTraceId, + bytesToTraceId, + spanIdBaseEncodedByteString, + spanIdBytes, + traceIdBaseEncodedByteString, + ) + + +-- Header keys ---------------------------------------------------------------- + +uberTraceIdHeader :: Text +uberTraceIdHeader = "uber-trace-id" + + +uberBaggagePrefix :: Text +uberBaggagePrefix = "uberctx-" + + +-- Flags ---------------------------------------------------------------------- + +-- | Jaeger flags byte from the wire format. +newtype JaegerFlags = JaegerFlags Word8 + deriving (Eq, Show) + + +flagsSampled :: JaegerFlags -> Bool +flagsSampled (JaegerFlags f) = f .&. 0x01 /= 0 + + +flagsDebug :: JaegerFlags -> Bool +flagsDebug (JaegerFlags f) = f .&. 0x02 /= 0 + + +-- Parsed header -------------------------------------------------------------- + +data JaegerHeader = JaegerHeader + { jhTraceId :: !TraceId + , jhSpanId :: !SpanId + , jhParentSpanId :: !(Maybe SpanId) + , jhFlags :: !JaegerFlags + } + deriving (Eq, Show) + + +-- Encoders ------------------------------------------------------------------- + +encodeTraceId :: TraceId -> ByteString +encodeTraceId = traceIdBaseEncodedByteString Base16 +{-# INLINE encodeTraceId #-} + + +encodeSpanId :: SpanId -> ByteString +encodeSpanId = spanIdBaseEncodedByteString Base16 +{-# INLINE encodeSpanId #-} + + +{- | Encode a Jaeger uber-trace-id header value directly as a ByteString. + +Format: @{trace-id}:{span-id}:0:{flags}@ +-} +encodeUberTraceId :: TraceId -> SpanId -> Bool -> ByteString +encodeUberTraceId tid sid sampled = + traceIdBaseEncodedByteString Base16 tid + <> ":" + <> spanIdBaseEncodedByteString Base16 sid + <> ":0:" + <> if sampled then "1" else "0" + + +-- Decoders ------------------------------------------------------------------- + +{- | Maximum allowed size for a Jaeger uber-trace-id header in bytes. + +The standard format is ~69 bytes: +@{32hex-tid}:{16hex-sid}:{16hex-parent}:{2hex-flags}@ + +We allow 512 bytes to prevent DoS from scanning arbitrarily large +malformed inputs. This is well below typical web server header limits +(8KB-50KB). +-} +maxHeaderSize :: Int +maxHeaderSize = 512 + + +{- | Decode a Jaeger @uber-trace-id@ header value. + +Uses memchr to locate colon delimiters and the existing SIMD hex +decoders for trace/span ID parsing. +-} +decodeUberTraceId :: ByteString -> Maybe JaegerHeader +decodeUberTraceId bs = do + let !len = BS.length bs + -- Reject oversized headers to prevent DoS. + if len > maxHeaderSize + then Nothing + -- Need at least: 16 (tid) + 1 (:) + 1 (sid) + 1 (:) + 1 (parent) + 1 (:) + 1 (flags) = 22 + else + if len < 22 + then Nothing + else do + -- Find three colons via memchr. + !c1 <- BS.elemIndex 0x3a bs + !c2rel <- BS.elemIndex 0x3a (BS.drop (c1 + 1) bs) + let !c2 = c1 + 1 + c2rel + !c3rel <- BS.elemIndex 0x3a (BS.drop (c2 + 1) bs) + let !c3 = c2 + 1 + c3rel + + -- Reject extra colons (trailing garbage). + case BS.elemIndex 0x3a (BS.drop (c3 + 1) bs) of + Just _ -> Nothing + Nothing -> do + let !tidHex = BS.take c1 bs + !sidHex = BS.take c2rel (BS.drop (c1 + 1) bs) + !parentHex = BS.take c3rel (BS.drop (c2 + 1) bs) + !flagsHex = BS.drop (c3 + 1) bs + + -- Flags: 1-2 hex digits, validated first (cheapest check). + !flags <- parseFlags flagsHex + + -- Trace ID: 16 or 32 hex chars. + !tid <- eitherToMaybe (decodeTraceIdFromHex tidHex) + + -- Span ID: must be valid hex (length validated by baseEncodedToSpanId). + !sid <- eitherToMaybe (baseEncodedToSpanId Base16 sidHex) + + -- Parent span ID: all-zeros means "no parent". + let !parentSid + | BS.null parentHex = Nothing + | BS.all (== 0x30) parentHex = Nothing + | otherwise = eitherToMaybe (baseEncodedToSpanId Base16 parentHex) + + pure + JaegerHeader + { jhTraceId = tid + , jhSpanId = sid + , jhParentSpanId = parentSid + , jhFlags = flags + } + + +-- Internal helpers ----------------------------------------------------------- + +{- | Decode a trace ID from hex, accepting both 64-bit (16 chars, zero-padded) +and 128-bit (32 chars) representations. +-} +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 "Jaeger trace id: expected 16 or 32 hex characters" + + +-- | Parse 1-2 hex characters into a flags byte. +parseFlags :: ByteString -> Maybe JaegerFlags +parseFlags flagsHex = case BS.length flagsHex of + 1 -> do + !a <- hexNibble (BS.index flagsHex 0) + Just $! JaegerFlags a + 2 -> do + !a <- hexNibble (BS.index flagsHex 0) + !b <- hexNibble (BS.index flagsHex 1) + Just $! JaegerFlags (a * 16 + b) + _ -> Nothing + + +hexNibble :: Word8 -> Maybe Word8 +hexNibble c + | c >= 0x30 && c <= 0x39 = Just (c - 0x30) + | c >= 0x41 && c <= 0x46 = Just (c - 0x41 + 10) + | c >= 0x61 && c <= 0x66 = Just (c - 0x61 + 10) + | otherwise = Nothing +{-# INLINE hexNibble #-} + + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe (Right x) = Just x +eitherToMaybe (Left _) = Nothing +{-# INLINE eitherToMaybe #-} diff --git a/test/OpenTelemetry/Propagator/JaegerSpec.hs b/test/OpenTelemetry/Propagator/JaegerSpec.hs new file mode 100644 --- /dev/null +++ b/test/OpenTelemetry/Propagator/JaegerSpec.hs @@ -0,0 +1,315 @@ +{-# LANGUAGE OverloadedStrings #-} + +module OpenTelemetry.Propagator.JaegerSpec (spec) where + +import qualified Data.ByteString as BS +import qualified Data.HashMap.Strict as H +import Data.Maybe (isNothing) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified OpenTelemetry.Baggage as Baggage +import OpenTelemetry.Common (TraceFlags (..)) +import OpenTelemetry.Context (Context, empty, insertBaggage, insertSpan, lookupBaggage, lookupSpan) +import OpenTelemetry.Propagator ( + Propagator (..), + TextMap, + emptyTextMap, + textMapFromList, + textMapKeys, + textMapLookup, + ) +import OpenTelemetry.Propagator.Jaeger (jaegerPropagator, jaegerTraceContextPropagator) +import qualified OpenTelemetry.Propagator.Jaeger.Internal as JI +import OpenTelemetry.Trace.Core (SpanContext (..), getSpanContext, isSampled, wrapSpanContext) +import OpenTelemetry.Trace.Id (Base (..), SpanId, TraceId, baseEncodedToSpanId, baseEncodedToTraceId) +import OpenTelemetry.Trace.TraceState (TraceState (..)) +import Test.Hspec + + +spec :: Spec +spec = + -- Jaeger uber-trace-id and uberctx-* propagation + -- https://www.jaegertracing.io/docs/1.21/client-libraries/#propagation-format + describe "OpenTelemetry.Propagator.Jaeger" $ do + describe "Internal codec" $ do + -- {trace-id}:{span-id}:{parent-span-id}:{flags} (hex) + -- https://www.jaegertracing.io/docs/1.21/client-libraries/#propagation-format + it "parses a 128-bit trace context header" $ do + let hdr = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> do + JI.jhTraceId jh `shouldBe` expectedTraceId + JI.jhSpanId jh `shouldBe` expectedSpanId + JI.jhParentSpanId jh `shouldBe` Nothing + JI.flagsSampled (JI.jhFlags jh) `shouldBe` True + JI.flagsDebug (JI.jhFlags jh) `shouldBe` False + + it "parses a 64-bit trace ID (left-padded to 128-bit)" $ do + let hdr = "64fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> do + JI.jhTraceId jh `shouldBe` expectedTraceId64 + JI.flagsSampled (JI.jhFlags jh) `shouldBe` True + + -- flags: sampled + debug bits + -- https://www.jaegertracing.io/docs/1.21/client-libraries/#propagation-format + it "parses debug flag (flags=03 means sampled+debug)" $ do + let hdr = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:03" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> do + JI.flagsSampled (JI.jhFlags jh) `shouldBe` True + JI.flagsDebug (JI.jhFlags jh) `shouldBe` True + + it "parses unsampled flag (flags=0)" $ do + let hdr = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:0" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> do + JI.flagsSampled (JI.jhFlags jh) `shouldBe` False + JI.flagsDebug (JI.jhFlags jh) `shouldBe` False + + it "parses debug-only flag (flags=2)" $ do + let hdr = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:2" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> do + JI.flagsSampled (JI.jhFlags jh) `shouldBe` False + JI.flagsDebug (JI.jhFlags jh) `shouldBe` True + + it "parses non-zero parent span ID" $ do + let hdr = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:05e3ac9a4f6e3b90:1" + case JI.decodeUberTraceId (TE.encodeUtf8 hdr) of + Nothing -> expectationFailure "expected parse" + Just jh -> case JI.jhParentSpanId jh of + Nothing -> expectationFailure "expected parent span ID" + Just _ -> pure () + + it "rejects empty input" $ do + JI.decodeUberTraceId "" `shouldBe` Nothing + + it "rejects missing fields" $ do + JI.decodeUberTraceId "abc:def:0" `shouldBe` Nothing + + it "rejects non-hex characters in trace ID" $ do + JI.decodeUberTraceId "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz:e457b5a2e4d86bd1:0:1" + `shouldBe` Nothing + + it "rejects trailing garbage" $ do + JI.decodeUberTraceId "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1:extra" + `shouldBe` Nothing + + it "rejects oversized header (> 512 bytes)" $ do + -- Create a header with valid format but padded to exceed 512 bytes + let validPart = "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1" + -- Add enough hex chars to exceed 512 bytes (valid part is ~47 bytes) + padding = replicate (512 - BS.length validPart + 1) '0' + oversized = validPart <> BS.pack (map (fromIntegral . fromEnum) padding) + JI.decodeUberTraceId oversized `shouldBe` Nothing + + describe "trace context extraction" $ do + it "extracts SpanContext from uber-trace-id (sampled)" $ do + let headers = + textMapFromList + [("uber-trace-id", "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1")] + ctx' <- extractor jaegerTraceContextPropagator 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 "extracts SpanContext from uber-trace-id (unsampled)" $ do + let headers = + textMapFromList + [("uber-trace-id", "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:0")] + ctx' <- extractor jaegerTraceContextPropagator headers empty + case lookupSpan ctx' of + Nothing -> expectationFailure "expected span in context" + Just span' -> do + sc <- getSpanContext span' + isSampled (traceFlags sc) `shouldBe` False + + it "debug flag implies sampled" $ do + let headers = + textMapFromList + [("uber-trace-id", "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:2")] + ctx' <- extractor jaegerTraceContextPropagator headers empty + case lookupSpan ctx' of + Nothing -> expectationFailure "expected span in context" + Just span' -> do + sc <- getSpanContext span' + isSampled (traceFlags sc) `shouldBe` True + + it "leaves context unchanged when header is missing" $ do + ctx' <- extractor jaegerTraceContextPropagator emptyTextMap empty + lookupSpan ctx' `shouldSatisfy` isNothing + + it "leaves context unchanged for malformed header" $ do + let headers = textMapFromList [("uber-trace-id", "not-a-valid-header")] + ctx' <- extractor jaegerTraceContextPropagator headers empty + lookupSpan ctx' `shouldSatisfy` isNothing + + -- HTTP header names are case-insensitive (RFC 9110) + it "header name is case-insensitive" $ do + let headers = + textMapFromList + [("Uber-Trace-Id", "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1")] + ctx' <- extractor jaegerTraceContextPropagator headers empty + case lookupSpan ctx' of + Nothing -> expectationFailure "expected span in context" + Just span' -> do + sc <- getSpanContext span' + traceId sc `shouldBe` expectedTraceId + + describe "trace context injection" $ do + it "injects uber-trace-id with sampled flag" $ do + let ctx = insertSpan (wrapSpanContext sampledSpanContext) empty + hs <- injector jaegerTraceContextPropagator ctx emptyTextMap + case textMapLookup "uber-trace-id" hs of + Nothing -> expectationFailure "expected uber-trace-id header" + Just v -> do + let parts = T.splitOn ":" v + length parts `shouldBe` 4 + parts !! 0 `shouldBe` traceIdHex + parts !! 1 `shouldBe` spanIdHex + parts !! 2 `shouldBe` "0" + parts !! 3 `shouldBe` "1" + + it "injects uber-trace-id with unsampled flag" $ do + let ctx = insertSpan (wrapSpanContext unsampledSpanContext) empty + hs <- injector jaegerTraceContextPropagator ctx emptyTextMap + case textMapLookup "uber-trace-id" hs of + Nothing -> expectationFailure "expected uber-trace-id header" + Just v -> do + let parts = T.splitOn ":" v + parts !! 3 `shouldBe` "0" + + it "does not inject when no span in context" $ do + hs <- injector jaegerTraceContextPropagator empty emptyTextMap + textMapLookup "uber-trace-id" hs `shouldSatisfy` isNothing + + describe "round-trip" $ do + it "extract after inject preserves trace and span IDs" $ do + let ctx = insertSpan (wrapSpanContext sampledSpanContext) empty + hs <- injector jaegerTraceContextPropagator ctx emptyTextMap + ctx' <- extractor jaegerTraceContextPropagator hs empty + case lookupSpan ctx' of + Nothing -> expectationFailure "expected span in context after round-trip" + Just span' -> do + sc <- getSpanContext span' + traceId sc `shouldBe` expectedTraceId + spanId sc `shouldBe` expectedSpanId + isSampled (traceFlags sc) `shouldBe` True + + it "round-trip preserves unsampled flag" $ do + let ctx = insertSpan (wrapSpanContext unsampledSpanContext) empty + hs <- injector jaegerTraceContextPropagator ctx emptyTextMap + ctx' <- extractor jaegerTraceContextPropagator hs empty + case lookupSpan ctx' of + Nothing -> expectationFailure "expected span in context" + Just span' -> do + sc <- getSpanContext span' + isSampled (traceFlags sc) `shouldBe` False + + -- Jaeger baggage as uberctx-{key} headers + -- https://www.jaegertracing.io/docs/1.21/client-libraries/#propagation-format + describe "baggage propagation" $ do + it "extracts baggage from uberctx-* headers" $ do + let headers = + textMapFromList + [ ("uber-trace-id", "80f198ee56343ba864fe8b2a57d3eff7:e457b5a2e4d86bd1:0:1") + , ("uberctx-user-id", "42") + , ("uberctx-session", "abc123") + ] + ctx' <- extractor jaegerPropagator headers empty + case lookupBaggage ctx' of + Nothing -> expectationFailure "expected baggage in context" + Just bag -> do + let vals = H.toList (Baggage.values bag) + length vals `shouldSatisfy` (>= 2) + + it "injects baggage as uberctx-* headers" $ do + case Baggage.decodeBaggageHeader "user-id=42,session=abc123" of + Left err -> expectationFailure $ "baggage setup failed: " ++ err + Right bag -> do + let ctx = + insertSpan (wrapSpanContext sampledSpanContext) $ + insertBaggage bag empty + hs <- injector jaegerPropagator ctx emptyTextMap + textMapLookup "uberctx-user-id" hs `shouldBe` Just "42" + textMapLookup "uberctx-session" hs `shouldBe` Just "abc123" + + it "does not inject baggage headers when no baggage in context" $ do + let ctx = insertSpan (wrapSpanContext sampledSpanContext) empty + hs <- injector jaegerPropagator ctx emptyTextMap + let baggageHeaders = filter (T.isPrefixOf "uberctx-") $ map fst $ textMapToListImpl hs + baggageHeaders `shouldBe` [] + + describe "propagatorFields" $ do + it "trace context propagator declares uber-trace-id" $ do + propagatorFields jaegerTraceContextPropagator `shouldBe` ["uber-trace-id"] + + +-- Helpers -------------------------------------------------------------------- + +textMapToListImpl :: TextMap -> [(T.Text, T.Text)] +textMapToListImpl tm = + map (\k -> (k, maybe "" id (textMapLookup k tm))) (textMapKeys tm) + + +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) + + +-- 64-bit trace ID "64fe8b2a57d3eff7" → zero-padded to 128-bit +expectedTraceId64 :: TraceId +expectedTraceId64 = + case baseEncodedToTraceId Base16 "000000000000000064fe8b2a57d3eff7" of + Right t -> t + Left e -> error ("expectedTraceId64: " ++ e) + + +expectedSpanId :: SpanId +expectedSpanId = + case baseEncodedToSpanId Base16 (TE.encodeUtf8 spanIdHex) of + Right s -> s + Left e -> error ("expectedSpanId: " ++ e) + + +sampledSpanContext :: SpanContext +sampledSpanContext = + SpanContext + { traceId = expectedTraceId + , spanId = expectedSpanId + , isRemote = False + , traceFlags = TraceFlags 1 + , traceState = TraceState [] + } + + +unsampledSpanContext :: SpanContext +unsampledSpanContext = + SpanContext + { traceId = expectedTraceId + , spanId = expectedSpanId + , isRemote = False + , traceFlags = TraceFlags 0 + , traceState = TraceState [] + } 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 #-} +