{-# 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