hs-opentelemetry-propagator-datadog (empty) → 0.0.0.0
raw patch · 11 files changed
+731/−0 lines, 11 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, criterion, deepseq, hs-opentelemetry-api, hs-opentelemetry-propagator-datadog, hs-opentelemetry-sdk, hspec, http-types, pretty-hex, primitive, text
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- benchmark/header-codec/main.hs +28/−0
- hs-opentelemetry-propagator-datadog.cabal +103/−0
- old-src/Raw.hs +154/−0
- old-src/String.hs +41/−0
- src/OpenTelemetry/Propagator/Datadog.hs +102/−0
- src/OpenTelemetry/Propagator/Datadog/Internal.hs +143/−0
- test/spec/OpenTelemetry/Propagator/Datadog/InternalSpec.hs +76/−0
- test/spec/OpenTelemetry/Propagator/DatadogSpec.hs +45/−0
- test/spec/Spec.hs +2/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Change Log++## 0.0.0.0++2023.10.03++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021++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 Author name here 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.
+ benchmark/header-codec/main.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}++import Control.DeepSeq (NFData)+import qualified Criterion.Main as C+import qualified Data.ByteString.Short as SB+import OpenTelemetry.Propagator.Datadog.Internal+import OpenTelemetry.Trace.Id (TraceId)+import qualified String+++main :: IO ()+main =+ C.defaultMain+ [ C.bgroup+ "newTraceIdFromHeader"+ [ C.bench "new" $ C.nf newTraceIdFromHeader "1"+ , 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+ ]+ ]+++instance NFData TraceId
+ hs-opentelemetry-propagator-datadog.cabal view
@@ -0,0 +1,103 @@+cabal-version: 2.4++name: hs-opentelemetry-propagator-datadog+version: 0.0.0.0+author: Kazuki Okamoto (岡本和樹)+maintainer: kazuki.okamoto@herp.co.jp+copyright: Kazuki Okamoto (岡本和樹), HERP, Inc.+license: BSD-3-Clause+license-file: LICENSE+category: Telemetry+homepage: https://github.com/iand675/hs-opentelemetry+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+ LICENSE++common common+ build-depends: base >= 4 && < 5+ ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ default-language: Haskell2010++library+ import: common+ hs-source-dirs: src+ exposed-modules: OpenTelemetry.Propagator.Datadog+ OpenTelemetry.Propagator.Datadog.Internal+ build-depends: bytestring < 0.11,+ hs-opentelemetry-api >= 0.1 && < 0.2,+ hs-opentelemetry-sdk >= 0.0 && < 0.1,+ http-types < 0.13,+ primitive < 0.9,+ text < 1.3,+ ghc-options: -Wcompat+ -Wno-name-shadowing+ if impl(ghc >= 6.4)+ ghc-options: -Wincomplete-record-updates+ if impl(ghc >= 6.8)+ ghc-options: -Wmonomorphism-restriction+ if impl(ghc >= 7.0)+ ghc-options: -Wmissing-import-lists+ if impl(ghc >= 7.2)+ ghc-options: -Wincomplete-uni-patterns+ -Widentities+ if impl(ghc >= 8.0)+ ghc-options: -Wmissing-exported-signatures+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -Wmissing-home-modules+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages+ if impl(ghc >= 9.0)+ ghc-options: -Winvalid-haddock+ if impl(ghc >= 9.2)+ ghc-options: -Wmissing-kind-signatures+ -Woperator-whitespace+ -Wredundant-bang-patterns++test-suite spec+ import: common+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test/spec+ old-src+ other-modules: OpenTelemetry.Propagator.DatadogSpec+ OpenTelemetry.Propagator.Datadog.InternalSpec+ Raw+ String+ build-depends: hs-opentelemetry-propagator-datadog,+ hs-opentelemetry-api,+ bytestring,+ hspec,+ pretty-hex,+ primitive,+ QuickCheck+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N+ build-tool-depends: hspec-discover:hspec-discover++benchmark header-codec+ import: common+ type: exitcode-stdio-1.0+ main-is: main.hs+ other-modules: Raw+ String+ hs-source-dirs: benchmark/header-codec+ old-src+ build-depends: hs-opentelemetry-propagator-datadog,+ hs-opentelemetry-api,+ bytestring,+ criterion,+ deepseq,+ primitive
+ old-src/Raw.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++module Raw (+ newTraceIdFromHeader,+ newSpanIdFromHeader,+ newHeaderFromTraceId,+ newHeaderFromSpanId,+ showWord64BS,+ readWord64BS,+ asciiWord8ToWord8,+ word8ToAsciiWord8,+) where++import Control.Monad.ST (ST, runST)+import Data.Bits (Bits (complement, shift, (.&.)))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BI+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short.Internal as SBI+import qualified Data.Char as C+import Data.Primitive.ByteArray (+ ByteArray (ByteArray),+ MutableByteArray,+ freezeByteArray,+ indexByteArray,+ newByteArray,+ writeByteArray,+ )+import Data.Primitive.Ptr (writeOffPtr)+import Data.Word (Word64, Word8)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable (peekElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO)+++newTraceIdFromHeader+ :: ByteString+ -- ^ ASCII numeric text+ -> ShortByteString+newTraceIdFromHeader bs =+ let len = 16 :: Int+ !(ByteArray ba) =+ runST $ do+ mba <- newByteArray len+ let w64 = readWord64BS bs+ writeByteArray mba 0 (0 :: Word64) -- fill zeros to one upper Word64-size area+ writeByteArrayNbo mba 1 w64 -- offset one Word64-size+ freezeByteArray mba 0 len+ in SBI.SBS ba+++newSpanIdFromHeader+ :: ByteString+ -- ^ ASCII numeric text+ -> ShortByteString+newSpanIdFromHeader bs =+ let len = 8 :: Int+ !(ByteArray ba) =+ runST $ do+ mba <- newByteArray len+ let w64 = readWord64BS bs+ writeByteArrayNbo mba 0 w64+ freezeByteArray mba 0 len+ in SBI.SBS ba+++{- | Write a primitive value to the byte array with network-byte-order (big-endian).+The offset is given in elements of type @a@ rather than in bytes.+-}+writeByteArrayNbo :: MutableByteArray s -> Int -> Word64 -> ST s ()+writeByteArrayNbo mba offset value = do+ writeByteArray mba offset (0 :: Word64)+ loop 0 value+ where+ loop _ 0 = pure ()+ loop 8 _ = pure ()+ loop n v = do+ let -- equivelent:+ -- (p, q) = v `divMod` (2 ^ (8 :: Int))+ p = shift v (-8)+ q = v .&. complement (shift p 8)+ writeByteArray mba (8 * (offset + 1) - n - 1) (fromIntegral q :: Word8)+ loop (n + 1) p+++readWord64BS :: ByteString -> Word64+readWord64BS (BI.PS fptr _ len) =+ 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+++asciiWord8ToWord8 :: Word8 -> Word8+asciiWord8ToWord8 b = b - fromIntegral (C.ord '0')+++newHeaderFromTraceId :: ShortByteString -> ByteString+newHeaderFromTraceId (SBI.SBS ba) =+ let w64 = indexByteArrayNbo (ByteArray ba) 1+ in showWord64BS w64+++newHeaderFromSpanId :: ShortByteString -> ByteString+newHeaderFromSpanId (SBI.SBS ba) =+ let w64 = indexByteArrayNbo (ByteArray ba) 0+ in showWord64BS w64+++indexByteArrayNbo :: ByteArray -> Int -> 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)+++showWord64BS :: Word64 -> ByteString+showWord64BS v =+ 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')+++word8ToWord64 :: Word8 -> Word64+word8ToWord64 = fromIntegral
+ old-src/String.hs view
@@ -0,0 +1,41 @@+module String where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Short as SB+import Data.Word (Word64)+++newTraceIdFromHeader :: ByteString -> SB.ShortByteString+newTraceIdFromHeader = SB.toShort . fillLeadingZeros 16 . convertWord64ToBinaryByteString . read . BC.unpack+++newSpanIdFromHeader :: ByteString -> SB.ShortByteString+newSpanIdFromHeader = SB.toShort . fillLeadingZeros 8 . convertWord64ToBinaryByteString . read . BC.unpack+++newHeaderFromTraceId :: SB.ShortByteString -> ByteString+newHeaderFromTraceId = BC.pack . show . convertBinaryByteStringToWord64 . SB.fromShort+++newHeaderFromSpanId :: SB.ShortByteString -> ByteString+newHeaderFromSpanId = BC.pack . show . convertBinaryByteStringToWord64 . SB.fromShort+++convertWord64ToBinaryByteString :: Word64 -> ByteString+convertWord64ToBinaryByteString =+ B.pack . toWord8s []+ where+ toWord8s acc 0 = acc+ toWord8s acc n =+ let (p, q) = n `divMod` (2 ^ (8 :: Int))+ in toWord8s (fromIntegral q : acc) p+++fillLeadingZeros :: Word -> ByteString -> ByteString+fillLeadingZeros len bs = B.replicate (fromIntegral len - B.length bs) 0 <> bs+++convertBinaryByteStringToWord64 :: ByteString -> Word64+convertBinaryByteStringToWord64 = B.foldl (\acc b -> (2 ^ (8 :: Int)) * acc + fromIntegral b) 0 -- GHC.Prim.indexWord8ArrayAsWord64# とか駆使すると早くなりそう
+ src/OpenTelemetry/Propagator/Datadog.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Propagator.Datadog (+ datadogTraceContextPropagator,+ convertOpenTelemetrySpanIdToDatadogSpanId,+ convertOpenTelemetryTraceIdToDatadogTraceId,+) where++import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Short.Internal as SBI+import Data.Primitive (ByteArray (ByteArray))+import Data.String (IsString)+import qualified Data.Text as T+import Data.Word (Word64)+import Network.HTTP.Types (+ RequestHeaders,+ ResponseHeaders,+ )+import OpenTelemetry.Common (TraceFlags (TraceFlags))+import OpenTelemetry.Context (+ Context,+ insertSpan,+ lookupSpan,+ )+import OpenTelemetry.Internal.Trace.Id (+ SpanId (SpanId),+ TraceId (TraceId),+ )+import OpenTelemetry.Propagator (Propagator (Propagator, extractor, injector, propagatorNames))+import OpenTelemetry.Propagator.Datadog.Internal (+ indexByteArrayNbo,+ newHeaderFromSpanId,+ newHeaderFromTraceId,+ newSpanIdFromHeader,+ newTraceIdFromHeader,+ )+import OpenTelemetry.Trace (SpanContext (SpanContext, isRemote, spanId, traceFlags, traceId, traceState))+import OpenTelemetry.Trace.Core (+ getSpanContext,+ wrapSpanContext,+ )+import OpenTelemetry.Trace.TraceState (TraceState (TraceState))+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 ResponseHeaders+datadogTraceContextPropagator =+ Propagator+ { propagatorNames = ["datadog trace context"]+ , extractor = \hs 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+ 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)]+ }+ case spanContext' of+ Nothing -> pure c+ Just spanContext -> pure $ insertSpan (wrapSpanContext spanContext) c+ , injector = \c hs ->+ case lookupSpan c of+ Nothing -> pure hs+ Just span' -> do+ SpanContext {traceId, spanId, traceState = TraceState traceState} <- getSpanContext span'+ let traceIdValue = (\(TraceId b) -> newHeaderFromTraceId b) traceId+ parentIdValue = (\(SpanId b) -> newHeaderFromSpanId b) 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+ pure $+ (traceIdKey, traceIdValue)+ : (parentIdKey, parentIdValue)+ : (samplingPriorityKey, samplingPriority)+ : hs+ }+ where+ traceIdKey, parentIdKey, samplingPriorityKey :: (IsString s) => s+ traceIdKey = "x-datadog-trace-id"+ parentIdKey = "x-datadog-parent-id"+ samplingPriorityKey = "x-datadog-sampling-priority"+++convertOpenTelemetrySpanIdToDatadogSpanId :: SpanId -> Word64+convertOpenTelemetrySpanIdToDatadogSpanId (SpanId (SBI.SBS a)) = indexByteArrayNbo (ByteArray a) 0+++convertOpenTelemetryTraceIdToDatadogTraceId :: TraceId -> Word64+convertOpenTelemetryTraceIdToDatadogTraceId (TraceId (SBI.SBS a)) = indexByteArrayNbo (ByteArray a) 1
+ src/OpenTelemetry/Propagator/Datadog/Internal.hs view
@@ -0,0 +1,143 @@+{-# 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.+++----------+-----------------+----------------++| | Trace ID | Span ID |++----------+-----------------+----------------++| Internal | 128-bit integer | 64-bit integer |++----------+-----------------+----------------++| 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 Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable (peekElemOff)+import System.IO.Unsafe (unsafeDupablePerformIO)+++newTraceIdFromHeader+ :: ByteString+ -- ^ ASCII text of 64-bit integer+ -> ShortByteString+ -- ^ 128-bit integer+newTraceIdFromHeader bs =+ let w64 = readWord64BS bs+ builder = BB.word64BE 0 <> BB.word64BE w64+ in SB.toShort $ BL.toStrict $ BB.toLazyByteString builder+++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+++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+++asciiWord8ToWord8 :: Word8 -> Word8+asciiWord8ToWord8 b = b - fromIntegral (C.ord '0')+++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+++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+++-- | 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)+++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')+++word8ToWord64 :: Word8 -> Word64+word8ToWord64 = fromIntegral
+ test/spec/OpenTelemetry/Propagator/Datadog/InternalSpec.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++module OpenTelemetry.Propagator.Datadog.InternalSpec where++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 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')++ 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'++ 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'+++newtype HexString = HexString ShortByteString deriving (Eq)+++instance Show HexString where+ show (HexString s) = simpleHex $ SB.fromShort s
+ test/spec/OpenTelemetry/Propagator/DatadogSpec.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++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.Propagator.Datadog+import Test.Hspec+import Test.QuickCheck+++spec :: Spec+spec = do+ context "convertOpenTelemetrySpanIdToDatadogSpanId" $ do+ it "can conert values" $+ property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+ let v =+ fromIntegral x1 * (2 ^ 8) ^ 7+ + fromIntegral x2 * (2 ^ 8) ^ 6+ + fromIntegral x3 * (2 ^ 8) ^ 5+ + fromIntegral x4 * (2 ^ 8) ^ 4+ + fromIntegral x5 * (2 ^ 8) ^ 3+ + 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++ context "convertOpenTelemetryTraceIdToDatadogTraceId" $ do+ it "can conert values" $+ property $ \(x1, x2, x3, x4, x5, x6, x7, x8) -> do+ let v =+ fromIntegral x1 * (2 ^ 8) ^ 7+ + fromIntegral x2 * (2 ^ 8) ^ 6+ + fromIntegral x3 * (2 ^ 8) ^ 5+ + fromIntegral x4 * (2 ^ 8) ^ 4+ + fromIntegral x5 * (2 ^ 8) ^ 3+ + 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
+ test/spec/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+