hs-opentelemetry-propagator-datadog 0.0.1.1 → 1.0.0.0

raw patch · 8 files changed

+235/−212 lines, 8 filesdep −http-typesdep ~hs-opentelemetry-apidep ~hs-opentelemetry-propagator-datadogPVP ok

version bump matches the API change (PVP)

Dependencies removed: http-types

Dependency ranges changed: hs-opentelemetry-api, hs-opentelemetry-propagator-datadog

API changes (from Hackage documentation)

Files

• Changelog.md +22/−0
• LICENSE +1/−1
• benchmark/header-codec/main.hs +13/−4
• hs-opentelemetry-propagator-datadog.cabal +14/−8
• src/OpenTelemetry/Propagator/Datadog.hs +81/−35
• src/OpenTelemetry/Propagator/Datadog/Internal.hs +57/−97
• test/spec/OpenTelemetry/Propagator/Datadog/InternalSpec.hs +34/−59
• test/spec/OpenTelemetry/Propagator/DatadogSpec.hs +13/−8

@@ -0,0 +1,22 @@+# Changelog for hs-opentelemetry-propagator-datadog++## Unreleased++## 1.0.0.0 - 2026-05-29++- Fix: extractor now derives `traceFlags` from `x-datadog-sampling-priority` header.+  Previously always set `TraceFlags 1` (sampled) regardless of the priority value.+  Priority <= 0 now correctly yields unsampled `TraceFlags 0`.+- Fix: negative sampling priorities (e.g. `-1` for user reject) now parsed correctly.+  Previously `charToDigit` couldn't handle the `-` sign; replaced with `readMaybe`.+- Fix: injector now falls back to `traceFlags` when `x-datadog-sampling-priority` is+  absent from `TraceState`, emitting `"0"` for unsampled spans. Previously always+  defaulted to `"1"`.++## 0.0.1.1++- Update dependency bounds for hs-opentelemetry-api 0.3.0.0++## 0.0.1.0++- Initial release

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

@@ -3,12 +3,19 @@  import Control.DeepSeq (NFData) import qualified Criterion.Main as C+import qualified Data.ByteString as B import qualified Data.ByteString.Short as SB+import OpenTelemetry.Internal.Trace.Id (TraceId (..), bytesToTraceId) import OpenTelemetry.Propagator.Datadog.Internal-import OpenTelemetry.Trace.Id (TraceId) import qualified String  +mkTid :: [Word] -> TraceId+mkTid bs = case bytesToTraceId (B.pack (map fromIntegral bs)) of+  Right t -> t+  Left _ -> error "bad trace id"++ main :: IO () main =   C.defaultMain@@ -18,9 +25,11 @@         , C.bench "old" $ C.nf String.newTraceIdFromHeader "1"         ]     , C.bgroup "newHeaderFromTraceId" $-        let value = SB.pack [0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 10, 11, 12, 13, 14, 15]-        in [ C.bench "new" $ C.nf newHeaderFromTraceId value-           , C.bench "old" $ C.nf String.newHeaderFromTraceId value+        let bytes = [0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 10, 11, 12, 13, 14, 15]+            newValue = mkTid bytes+            oldValue = SB.pack (map fromIntegral bytes)+        in [ C.bench "new" $ C.nf newHeaderFromTraceId newValue+           , C.bench "old" $ C.nf String.newHeaderFromTraceId oldValue            ]     ] 

@@ -1,17 +1,23 @@ cabal-version: 2.4  name: hs-opentelemetry-propagator-datadog-version: 0.0.1.1+version: 1.0.0.0 author: Kazuki Okamoto (岡本和樹) maintainer: kazuki.okamoto@herp.co.jp license: BSD-3-Clause license-file: LICENSE-category: Telemetry-homepage: https://github.com/iand675/hs-opentelemetry+copyright: 2024 Ian Duncan, Mercury Technologies+category: OpenTelemetry, Telemetry, Tracing, Datadog+homepage: https://github.com/iand675/hs-opentelemetry#readme bug-reports: https://github.com/iand675/hs-opentelemetry/issues synopsis: Datadog Propagator for OpenTelemetry description: This package provides a Datadog style propagator for hs-opentelemetry suite.+extra-doc-files: Changelog.md +source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry+ common common   build-depends: base >= 4 && < 5   ghc-options: -Wall@@ -25,8 +31,7 @@   exposed-modules: OpenTelemetry.Propagator.Datadog                    OpenTelemetry.Propagator.Datadog.Internal   build-depends: bytestring,-                 hs-opentelemetry-api ^>= 0.3,-                 http-types,+                 hs-opentelemetry-api ^>= 1.0,                  primitive,                  text   ghc-options: -Wcompat@@ -69,13 +74,14 @@                  OpenTelemetry.Propagator.Datadog.InternalSpec                  Raw                  String-  build-depends: hs-opentelemetry-propagator-datadog,-                 hs-opentelemetry-api,+  build-depends: hs-opentelemetry-propagator-datadog ^>= 1.0,+                 hs-opentelemetry-api ^>= 1.0,                  bytestring,                  hspec,                  pretty-hex,                  primitive,-                 QuickCheck+                 QuickCheck,+                 text   ghc-options: -threaded                -rtsopts                -with-rtsopts=-N

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}@@ -8,26 +9,32 @@   convertOpenTelemetryTraceIdToDatadogTraceId, ) where -import qualified Data.ByteString.Char8 as BC+import Data.Bits (shiftL, (.|.))+import qualified Data.ByteString.Short as SB import qualified Data.ByteString.Short.Internal as SBI-import Data.Primitive (ByteArray (ByteArray))-import Data.String (IsString)+import Data.Primitive.ByteArray (ByteArray (ByteArray))+import qualified Data.Primitive.ByteArray as BA+import Data.Text (Text) import qualified Data.Text as T-import Data.Word (Word64)-import Network.HTTP.Types (RequestHeaders)+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Read as TR+import Data.Word (Word64, Word8) import OpenTelemetry.Common (TraceFlags (TraceFlags)) import OpenTelemetry.Context (-  Context,   insertSpan,   lookupSpan,  ) import OpenTelemetry.Internal.Trace.Id (-  SpanId (SpanId),-  TraceId (TraceId),+  SpanId,+  TraceId,  )-import OpenTelemetry.Propagator (Propagator (Propagator, extractor, injector, propagatorNames))+import OpenTelemetry.Propagator (+  Propagator (Propagator, extractor, injector, propagatorFields),+  TextMapPropagator,+  textMapInsert,+  textMapLookup,+ ) import OpenTelemetry.Propagator.Datadog.Internal (-  indexByteArrayNbo,   newHeaderFromSpanId,   newHeaderFromTraceId,   newSpanIdFromHeader,@@ -36,64 +43,103 @@ import OpenTelemetry.Trace.Core (   SpanContext (SpanContext, isRemote, spanId, traceFlags, traceId, traceState),   getSpanContext,+  isSampled,   wrapSpanContext,  )-import OpenTelemetry.Trace.TraceState (TraceState (TraceState))+import OpenTelemetry.Trace.Id (spanIdBytes, traceIdBytes)+import OpenTelemetry.Trace.TraceState (TraceState (TraceState), Value (Value)) import qualified OpenTelemetry.Trace.TraceState as TS   -- Reference: bi-directional conversion of IDs of Open Telemetry and ones of Datadog -- - English: https://docs.datadoghq.com/tracing/other_telemetry/connect_logs_and_traces/opentelemetry/ -- - Japanese: https://docs.datadoghq.com/ja/tracing/connect_logs_and_traces/opentelemetry/-datadogTraceContextPropagator :: Propagator Context RequestHeaders RequestHeaders+datadogTraceContextPropagator :: TextMapPropagator datadogTraceContextPropagator =   Propagator-    { propagatorNames = ["datadog trace context"]-    , extractor = \hs c -> do+    { propagatorFields = ["datadog trace context"]+    , extractor = \tm c -> do         let spanContext' = do-              traceId <- TraceId . newTraceIdFromHeader <$> lookup traceIdKey hs-              parentId <- SpanId . newSpanIdFromHeader <$> lookup parentIdKey hs-              samplingPriority <- T.pack . BC.unpack <$> lookup samplingPriorityKey hs+              tidText <- textMapLookup traceIdKey tm+              sidText <- textMapLookup parentIdKey tm+              let tidBs = Text.encodeUtf8 tidText+                  sidBs = Text.encodeUtf8 sidText+                  traceId = newTraceIdFromHeader tidBs+                  parentId = newSpanIdFromHeader sidBs+                  mPri = textMapLookup samplingPriorityKey tm+                  (prioFlags, tsEntries) =+                    case mPri of+                      Nothing -> (TraceFlags 1, [])+                      Just txt ->+                        ( if datadogSamplingPriorityIndicatesSampled txt+                            then TraceFlags 1+                            else TraceFlags 0+                        , [(TS.Key samplingPriorityKey, TS.Value txt)]+                        )               pure $                 SpanContext                   { traceId                   , spanId = parentId                   , isRemote = True-                  , -- when 0, not sampled-                    -- refer: OpenTelemetry.Internal.Trace.Types.isSampled-                    traceFlags = TraceFlags 1-                  , traceState = TraceState [(TS.Key samplingPriorityKey, TS.Value samplingPriority)]+                  , traceFlags = prioFlags+                  , traceState = TraceState tsEntries                   }         case spanContext' of           Nothing -> pure c           Just spanContext -> pure $ insertSpan (wrapSpanContext spanContext) c-    , injector = \c hs ->+    , injector = \c tm ->         case lookupSpan c of-          Nothing -> pure hs+          Nothing -> pure tm           Just span' -> do-            SpanContext {traceId, spanId, traceState = TraceState traceState} <- getSpanContext span'-            let traceIdValue = (\(TraceId b) -> newHeaderFromTraceId b) traceId-                parentIdValue = (\(SpanId b) -> newHeaderFromSpanId b) spanId+            SpanContext {traceId, spanId, traceState = TraceState traceState, traceFlags} <- getSpanContext span'+            let traceIdValue = newHeaderFromTraceId traceId+                parentIdValue = newHeaderFromSpanId spanId             samplingPriority <-               case lookup (TS.Key samplingPriorityKey) traceState of-                Nothing -> pure "1" -- when an origin of the trace-                Just (TS.Value p) -> pure $ BC.pack $ T.unpack p+                Nothing ->+                  pure $+                    if isSampled traceFlags then "1" else "0"+                Just (Value p) -> pure p             pure $-              (traceIdKey, traceIdValue)-                : (parentIdKey, parentIdValue)-                : (samplingPriorityKey, samplingPriority)-                : hs+              textMapInsert samplingPriorityKey samplingPriority $+                textMapInsert parentIdKey (Text.decodeUtf8 parentIdValue) $+                  textMapInsert traceIdKey (Text.decodeUtf8 traceIdValue) tm     }   where-    traceIdKey, parentIdKey, samplingPriorityKey :: (IsString s) => s+    traceIdKey, parentIdKey, samplingPriorityKey :: Text     traceIdKey = "x-datadog-trace-id"     parentIdKey = "x-datadog-parent-id"     samplingPriorityKey = "x-datadog-sampling-priority" +    -- Parsed sampling decisions for Datadog @x-datadog-sampling-priority@.+    -- Non-numeric values are treated as sampled (upstream senders disagree;+    -- see propagator tests).+    datadogSamplingPriorityIndicatesSampled :: Text -> Bool+    datadogSamplingPriorityIndicatesSampled txt =+      case TR.signed TR.decimal (T.strip txt) of+        Right (n, rest)+          | T.null rest ->+              n > (0 :: Integer)+        _ -> True ++-- | Read eight bytes at @8 * offset@ as a big-endian 'Word64'.+indexByteArrayNbo :: BA.ByteArray -> Int -> Word64+indexByteArrayNbo ba !off = go 0 0+  where+    !base = 8 * off+    go :: Int -> Word64 -> Word64+    go 8 !acc = acc+    go n !acc =+      let !b = fromIntegral (BA.indexByteArray ba (base + n) :: Word8) :: Word64+      in go (n + 1) ((acc `shiftL` 8) .|. b)++ convertOpenTelemetrySpanIdToDatadogSpanId :: SpanId -> Word64-convertOpenTelemetrySpanIdToDatadogSpanId (SpanId (SBI.SBS a)) = indexByteArrayNbo (ByteArray a) 0+convertOpenTelemetrySpanIdToDatadogSpanId s = case SB.toShort (spanIdBytes s) of+  SBI.SBS a -> indexByteArrayNbo (ByteArray a) 0   convertOpenTelemetryTraceIdToDatadogTraceId :: TraceId -> Word64-convertOpenTelemetryTraceIdToDatadogTraceId (TraceId (SBI.SBS a)) = indexByteArrayNbo (ByteArray a) 1+convertOpenTelemetryTraceIdToDatadogTraceId t = case SB.toShort (traceIdBytes t) of+  SBI.SBS a -> indexByteArrayNbo (ByteArray a) 1

@@ -1,143 +1,103 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Strict #-} -{- | Conversion of the hs-opentelemetry internal representation of the trace ID and the span ID and the Datadog header representation of them each other.+{- | Conversion between OTel trace/span IDs (Word64-based) and Datadog+header format (decimal ASCII of a 64-bit integer, big-endian byte order). +@ +----------+-----------------+----------------+ |          | Trace ID        | Span ID        | +----------+-----------------+----------------+-| Internal | 128-bit integer | 64-bit integer |+| Internal | 2 x Word64 (LE)| 1 x Word64 (LE)| +----------+-----------------+----------------+ | Datadog  | ASCII text of   | ASCII text of  | | Header   | 64-bit integer  | 64-bit integer | +----------+-----------------+----------------++@ -} module OpenTelemetry.Propagator.Datadog.Internal (   newTraceIdFromHeader,   newSpanIdFromHeader,   newHeaderFromTraceId,   newHeaderFromSpanId,-  indexByteArrayNbo, ) where -import Data.Bits (Bits (shift)) import Data.ByteString (ByteString)-import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString.Lazy as BL-import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as SB-import qualified Data.ByteString.Short.Internal as SBI-import qualified Data.Char as C-import Data.Primitive.ByteArray (ByteArray (ByteArray), indexByteArray) import Data.Primitive.Ptr (writeOffPtr)-import Data.Word (Word64, Word8)+import Data.Word (Word64, Word8, byteSwap64) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Storable (peekElemOff)+import OpenTelemetry.Internal.Trace.Id (SpanId (..), TraceId (..)) import System.IO.Unsafe (unsafeDupablePerformIO)  -newTraceIdFromHeader-  :: ByteString-  -- ^ ASCII text of 64-bit integer-  -> ShortByteString-  -- ^ 128-bit integer+{- | Parse a decimal ASCII header value into a 'TraceId'.+Datadog uses the low 64 bits of the 128-bit trace ID, in big-endian.+The high 64 bits are set to zero.+-}+newTraceIdFromHeader :: ByteString -> TraceId newTraceIdFromHeader bs =-  let w64 = readWord64BS bs-      builder = BB.word64BE 0 <> BB.word64BE w64-  in SB.toShort $ BL.toStrict $ BB.toLazyByteString builder+  let !w64 = readWord64BS bs+  in TraceId 0 (byteSwap64 w64)  -newSpanIdFromHeader-  :: ByteString-  -- ^ ASCII text of 64-bit integer-  -> ShortByteString-  -- ^ 64-bit integer-newSpanIdFromHeader bs =-  let w64 = readWord64BS bs-      builder = BB.word64BE w64-  in SB.toShort $ BL.toStrict $ BB.toLazyByteString builder+-- | Parse a decimal ASCII header value into a 'SpanId'.+newSpanIdFromHeader :: ByteString -> SpanId+newSpanIdFromHeader bs = SpanId (byteSwap64 (readWord64BS bs))  -readWord64BS :: ByteString -> Word64-readWord64BS (BI.PS fptr _ len) =-  -- Safe.-  unsafeDupablePerformIO $-    withForeignPtr fptr readWord64Ptr-  where-    readWord64Ptr ptr =-      readWord64PtrOffset 0 0-      where-        readWord64PtrOffset offset acc-          | offset < len = do-              b <- peekElemOff ptr offset-              let n = fromIntegral $ asciiWord8ToWord8 b :: Word64-              readWord64PtrOffset (offset + 1) $ n + acc * 10-          | otherwise = pure acc+{- | Render the low 64 bits of a 'TraceId' as a decimal ASCII string+(Datadog header format).+-}+newHeaderFromTraceId :: TraceId -> ByteString+newHeaderFromTraceId (TraceId _hi lo) = showWord64BS (byteSwap64 lo)  -asciiWord8ToWord8 :: Word8 -> Word8-asciiWord8ToWord8 b = b - fromIntegral (C.ord '0')+-- | Render a 'SpanId' as a decimal ASCII string (Datadog header format).+newHeaderFromSpanId :: SpanId -> ByteString+newHeaderFromSpanId (SpanId w) = showWord64BS (byteSwap64 w)  -newHeaderFromTraceId-  :: ShortByteString-  -- ^ 128-bit integer-  -> ByteString-  -- ^ ASCII text of 64-bit integer-newHeaderFromTraceId (SBI.SBS ba) =-  let w64 = indexByteArrayNbo (ByteArray ba) 1-  in showWord64BS w64-+-- ---------------------------------------------------------------------------+-- Internal helpers+-- --------------------------------------------------------------------------- -newHeaderFromSpanId-  :: ShortByteString-  -- ^ 64-bit integer-  -> ByteString-  -- ^ ASCII text of 64-bit integer-newHeaderFromSpanId (SBI.SBS ba) =-  let w64 = indexByteArrayNbo (ByteArray ba) 0-  in showWord64BS w64+readWord64BS :: ByteString -> Word64+readWord64BS (BI.PS fptr _ len) =+  unsafeDupablePerformIO $+    withForeignPtr fptr $ \ptr ->+      let go !offset !acc+            | offset < len = do+                b <- peekElemOff ptr offset+                let !n = fromIntegral (asciiDigit b) :: Word64+                go (offset + 1) (acc * 10 + n)+            | otherwise = pure acc+      in go 0 0  --- | Read 'ByteArray' to 'Word64' with network-byte-order.-indexByteArrayNbo-  :: ByteArray-  -> Int-  -- ^ Offset in 'Word64'-size unit-  -> Word64-indexByteArrayNbo ba offset =-  loop 0 0-  where-    loop 8 acc = acc-    loop n acc = loop (n + 1) $ shift acc 8 + word8ToWord64 (indexByteArray ba $ 8 * offset + n)+asciiDigit :: Word8 -> Word8+asciiDigit b = b - 0x30   showWord64BS :: Word64 -> ByteString showWord64BS v =-  -- Safe.   unsafeDupablePerformIO $-    BI.createUptoN 20 writeWord64Ptr -- 20 = length (show (maxBound :: Word64))-  where-    writeWord64Ptr ptr =-      loop (19 :: Int) v 0 False-      where-        loop 0 v offset _ = do-          writeOffPtr ptr offset (word8ToAsciiWord8 $ fromIntegral v)-          pure $ offset + 1-        loop n v offset upper = do-          let (p, q) = v `divMod` (10 ^ n)-          if p == 0 && not upper-            then loop (n - 1) q offset upper-            else do-              writeOffPtr ptr offset (word8ToAsciiWord8 $ fromIntegral p)-              loop (n - 1) q (offset + 1) True---word8ToAsciiWord8 :: Word8 -> Word8-word8ToAsciiWord8 b = b + fromIntegral (C.ord '0')+    BI.createUptoN 20 $ \ptr ->+      let go :: Int -> Word64 -> Int -> Bool -> IO Int+          go 0 v' offset _ = do+            writeOffPtr ptr offset (toAsciiDigit $ fromIntegral v')+            pure $ offset + 1+          go n v' offset upper = do+            let (!p, !q) = v' `divMod` (10 ^ n)+            if p == 0 && not upper+              then go (n - 1) q offset upper+              else do+                writeOffPtr ptr offset (toAsciiDigit $ fromIntegral p)+                go (n - 1) q (offset + 1) True+      in go (19 :: Int) v 0 False  -word8ToWord64 :: Word8 -> Word64-word8ToWord64 = fromIntegral+toAsciiDigit :: Word8 -> Word8+toAsciiDigit b = b + 0x30

@@ -1,76 +1,51 @@-{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-}  module OpenTelemetry.Propagator.Datadog.InternalSpec where +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC-import Data.ByteString.Short (ShortByteString)-import qualified Data.ByteString.Short as SB-import Data.Word (Word64)-import Hexdump (simpleHex)+import Data.Word (Word64, Word8)+import OpenTelemetry.Internal.Trace.Id (SpanId, TraceId, bytesToSpanId, bytesToTraceId) import OpenTelemetry.Propagator.Datadog.Internal-import qualified String import Test.Hspec import Test.QuickCheck  -spec :: Spec-spec = do-  context "newTraceIdFromHeader" $ do-    it "is equal to the old implementation" $-      property $ \x -> do-        let x' = BC.pack $ show (x :: Word64)-        HexString (newTraceIdFromHeader x')-          `shouldBe` HexString (String.newTraceIdFromHeader x')+mkTraceId :: [Word8] -> TraceId+mkTraceId bs = case bytesToTraceId (B.pack bs) of+  Right t -> t+  Left _ -> error "bad trace id" -  context "newSpanIdFromHeader" $ do-    it "is equal to the old implementation" $-      property $ \x -> do-        let x' = BC.pack $ show (x :: Word64)-        HexString (newSpanIdFromHeader x')-          `shouldBe` HexString (String.newSpanIdFromHeader x') -  context "newHeaderFromTraceId" $ do-    it "is equal to the old implementation" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8, x9, (x10, x11, x12, x13, x14, x15, x16)) -> do-        let x' = SB.pack [x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16]-        newHeaderFromTraceId x'-          `shouldBe` String.newHeaderFromTraceId x'+mkSpanId :: [Word8] -> SpanId+mkSpanId bs = case bytesToSpanId (B.pack bs) of+  Right s -> s+  Left _ -> error "bad span id" -  context "newHeaderFromSpanId" $ do-    it "is equal to the old implementation" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do-        let x' = SB.pack [x1, x2, x3, x4, x5, x6, x7, x8]-        newHeaderFromSpanId x'-          `shouldBe` String.newHeaderFromSpanId x' -  context "composition of newTraceIdFromHeader and newHeaderFromTraceId" $ do-    it "is identical" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do-        let x' = SB.pack $ replicate 8 0 ++ [x1, x2, x3, x4, x5, x6, x7, x8]-        HexString (newTraceIdFromHeader $ newHeaderFromTraceId x') `shouldBe` HexString x'--  context "composition of newHeaderFromTraceId and newTraceIdFromHeader" $ do-    it "is identical" $-      property $ \x -> do-        let x' = BC.pack $ show (x :: Word64)-        newHeaderFromTraceId (newTraceIdFromHeader x') `shouldBe` x'--  context "composition of newSpanIdFromHeader and newHeaderFromSpanId" $ do-    it "is identical" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do-        let x' = SB.pack [x1, x2, x3, x4, x5, x6, x7, x8]-        newSpanIdFromHeader (newHeaderFromSpanId x') `shouldBe` x'--  context "composition of newHeaderFromSpanId and newSpanIdFromHeader" $ do-    it "is identical" $-      property $ \x -> do-        let x' = BC.pack $ show (x :: Word64)-        newHeaderFromSpanId (newSpanIdFromHeader x') `shouldBe` x'-+spec :: Spec+spec =+  -- Datadog decimal trace/parent id header encoding+  -- https://docs.datadoghq.com/tracing/trace_collection/trace_context_propagation/+  do+    context "newTraceIdFromHeader / newHeaderFromTraceId" $ do+      it "round-trips decimal header bytes to TraceId (zero high bits)" $+        property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+          let tid = mkTraceId $ replicate 8 0 ++ [x1, x2, x3, x4, x5, x6, x7, x8]+          newTraceIdFromHeader (newHeaderFromTraceId tid) `shouldBe` tid -newtype HexString = HexString ShortByteString deriving (Eq)+      it "round-trips TraceId (zero high) to decimal header" $+        property $ \x -> do+          let x' = BC.pack $ show (x :: Word64)+          newHeaderFromTraceId (newTraceIdFromHeader x') `shouldBe` x' +    context "newSpanIdFromHeader / newHeaderFromSpanId" $ do+      it "round-trips decimal header bytes to SpanId" $+        property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+          let sid = mkSpanId [x1, x2, x3, x4, x5, x6, x7, x8]+          newSpanIdFromHeader (newHeaderFromSpanId sid) `shouldBe` sid -instance Show HexString where-  show (HexString s) = simpleHex $ SB.fromShort s+      it "round-trips SpanId to decimal header" $+        property $ \x -> do+          let x' = BC.pack $ show (x :: Word64)+          newHeaderFromSpanId (newSpanIdFromHeader x') `shouldBe` x'

@@ -5,8 +5,7 @@ module OpenTelemetry.Propagator.DatadogSpec where  import qualified Data.ByteString as B-import qualified Data.ByteString.Short as SB-import OpenTelemetry.Internal.Trace.Id+import OpenTelemetry.Internal.Trace.Id (bytesToSpanId, bytesToTraceId) import OpenTelemetry.Propagator.Datadog import Test.Hspec import Test.QuickCheck@@ -16,7 +15,7 @@ spec = do   context "convertOpenTelemetrySpanIdToDatadogSpanId" $ do     it "can conert values" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) ->         let v =               fromIntegral x1 * (2 ^ 8) ^ 7                 + fromIntegral x2 * (2 ^ 8) ^ 6@@ -26,12 +25,15 @@                 + fromIntegral x6 * (2 ^ 8) ^ 2                 + fromIntegral x7 * (2 ^ 8) ^ 1                 + fromIntegral x8-            spanId = SpanId $ SB.toShort $ B.pack [x1, x2, x3, x4, x5, x6, x7, x8]-        convertOpenTelemetrySpanIdToDatadogSpanId spanId `shouldBe` v+            otelSpanId =+              case bytesToSpanId (B.pack [x1, x2, x3, x4, x5, x6, x7, x8]) of+                Right sid -> sid+                Left err -> error err+        in convertOpenTelemetrySpanIdToDatadogSpanId otelSpanId == v    context "convertOpenTelemetryTraceIdToDatadogTraceId" $ do     it "can conert values" $-      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+      property $ \(x1, x2, x3, x4, x5, x6, x7, x8) ->         let v =               fromIntegral x1 * (2 ^ 8) ^ 7                 + fromIntegral x2 * (2 ^ 8) ^ 6@@ -41,5 +43,8 @@                 + fromIntegral x6 * (2 ^ 8) ^ 2                 + fromIntegral x7 * (2 ^ 8) ^ 1                 + fromIntegral x8-            traceId = TraceId $ SB.toShort $ B.pack $ replicate 8 0 ++ [x1, x2, x3, x4, x5, x6, x7, x8]-        convertOpenTelemetryTraceIdToDatadogTraceId traceId `shouldBe` v+            otelTraceId =+              case bytesToTraceId (B.pack (replicate 8 0 ++ [x1, x2, x3, x4, x5, x6, x7, x8])) of+                Right tid -> tid+                Left err -> error err+        in convertOpenTelemetryTraceIdToDatadogTraceId otelTraceId == v