{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}

{- |
Module      : OpenTelemetry.Internal.Trace.Id
Description : Internal representation of trace and span identifiers with hex encoding via C FFI.
Stability   : experimental
-}
module OpenTelemetry.Internal.Trace.Id (
  TraceId (..),
  newTraceId,
  isEmptyTraceId,
  traceIdBytes,
  bytesToTraceId,
  baseEncodedToTraceId,
  traceIdBaseEncodedBuilder,
  traceIdBaseEncodedByteString,
  traceIdBaseEncodedText,
  SpanId (..),
  newSpanId,
  newTraceAndSpanId,
  isEmptySpanId,
  spanIdBytes,
  bytesToSpanId,
  Base (..),
  baseEncodedToSpanId,
  spanIdBaseEncodedBuilder,
  spanIdBaseEncodedByteString,
  spanIdBaseEncodedText,

  -- * Nil (all-zero) IDs
  nilTraceId,
  nilSpanId,

  -- * Traceparent codec (C FFI)
  decodeTraceparent,
  encodeTraceparent,
) where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bits (shiftR, (.&.), (.|.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Internal as BI
import Data.ByteString.Short (ShortByteString, fromShort)
import qualified Data.ByteString.Unsafe as BU
import Data.Hashable (Hashable (..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Word (Word64, Word8)
import Foreign.C.Types (CInt (..), CSize (..))
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (peek, peekElemOff, poke)
import GHC.Exts (IsString (fromString))
import GHC.Generics (Generic)
import OpenTelemetry.Trace.Id.Generator (IdGenerator (..))
import System.IO.Unsafe (unsafeDupablePerformIO)
import Prelude hiding (length)


-- * C FFI


foreign import ccall unsafe "hs_otel_encode_trace_id"
  c_encodeTraceId :: Ptr Word8 -> Ptr Word8 -> IO ()


foreign import ccall unsafe "hs_otel_encode_span_id"
  c_encodeSpanId :: Ptr Word8 -> Ptr Word8 -> IO ()


foreign import ccall unsafe "hs_otel_decode_hex"
  c_decodeHex :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt


foreign import ccall unsafe "hs_otel_xoshiro_next"
  c_xoshiroNext :: IO Word64


-- * TraceId


{- | A valid trace identifier is a 16-byte array with at least one non-zero byte.

Stored as two machine-word @Word64@ values in native byte order.
When @UNPACK@ed into a containing record (e.g. 'SpanContext'), both
words are stored inline. No separate heap object, no pointer chase.

 @since 0.0.1.0
-}
data TraceId
  = TraceId
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
  deriving stock (TraceId -> TraceId -> Bool
(TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool) -> Eq TraceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceId -> TraceId -> Bool
== :: TraceId -> TraceId -> Bool
$c/= :: TraceId -> TraceId -> Bool
/= :: TraceId -> TraceId -> Bool
Eq, Eq TraceId
Eq TraceId =>
(TraceId -> TraceId -> Ordering)
-> (TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> Bool)
-> (TraceId -> TraceId -> TraceId)
-> (TraceId -> TraceId -> TraceId)
-> Ord TraceId
TraceId -> TraceId -> Bool
TraceId -> TraceId -> Ordering
TraceId -> TraceId -> TraceId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TraceId -> TraceId -> Ordering
compare :: TraceId -> TraceId -> Ordering
$c< :: TraceId -> TraceId -> Bool
< :: TraceId -> TraceId -> Bool
$c<= :: TraceId -> TraceId -> Bool
<= :: TraceId -> TraceId -> Bool
$c> :: TraceId -> TraceId -> Bool
> :: TraceId -> TraceId -> Bool
$c>= :: TraceId -> TraceId -> Bool
>= :: TraceId -> TraceId -> Bool
$cmax :: TraceId -> TraceId -> TraceId
max :: TraceId -> TraceId -> TraceId
$cmin :: TraceId -> TraceId -> TraceId
min :: TraceId -> TraceId -> TraceId
Ord, (forall x. TraceId -> Rep TraceId x)
-> (forall x. Rep TraceId x -> TraceId) -> Generic TraceId
forall x. Rep TraceId x -> TraceId
forall x. TraceId -> Rep TraceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceId -> Rep TraceId x
from :: forall x. TraceId -> Rep TraceId x
$cto :: forall x. Rep TraceId x -> TraceId
to :: forall x. Rep TraceId x -> TraceId
Generic)


instance Hashable TraceId where
  hashWithSalt :: Int -> TraceId -> Int
hashWithSalt Int
s (TraceId Word64
hi Word64
lo) = Int
s Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
hi Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word64
lo
  {-# INLINE hashWithSalt #-}


instance Show TraceId where
  showsPrec :: Int -> TraceId -> ShowS
showsPrec Int
d TraceId
i = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"TraceId " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Base -> TraceId -> Text
traceIdBaseEncodedText Base
Base16 TraceId
i)


instance IsString TraceId where
  fromString :: String -> TraceId
fromString String
str = case Base -> ByteString -> Either String TraceId
baseEncodedToTraceId Base
Base16 (String -> ByteString
forall a. IsString a => String -> a
fromString String
str) of
    Left String
err -> String -> TraceId
forall a. HasCallStack => String -> a
error String
err
    Right TraceId
ok -> TraceId
ok


{- | All-zero 'TraceId'.

@since 0.0.1.0
-}
nilTraceId :: TraceId
nilTraceId :: TraceId
nilTraceId = Word64 -> Word64 -> TraceId
TraceId Word64
0 Word64
0
{-# INLINE nilTraceId #-}


{- | Generate a 'TraceId' using the provided 'IdGenerator'.

 @since 0.1.0.0
-}
newTraceId :: (MonadIO m) => IdGenerator -> m TraceId
newTraceId :: forall (m :: * -> *). MonadIO m => IdGenerator -> m TraceId
newTraceId IdGenerator
DefaultIdGenerator = IO TraceId -> m TraceId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TraceId
generateTraceId
newTraceId (CustomIdGenerator IO ShortByteString
_ IO ShortByteString
genTrace) = IO TraceId -> m TraceId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TraceId -> m TraceId) -> IO TraceId -> m TraceId
forall a b. (a -> b) -> a -> b
$ ShortByteString -> TraceId
sbsToTraceId (ShortByteString -> TraceId) -> IO ShortByteString -> IO TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ShortByteString
genTrace
{-# INLINE newTraceId #-}


-- | @since 0.1.0.0
isEmptyTraceId :: TraceId -> Bool
isEmptyTraceId :: TraceId -> Bool
isEmptyTraceId (TraceId Word64
hi Word64
lo) = (Word64
hi Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
lo) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
{-# INLINE isEmptyTraceId #-}


-- | @since 0.1.0.0
traceIdBytes :: TraceId -> ByteString
traceIdBytes :: TraceId -> ByteString
traceIdBytes (TraceId Word64
hi Word64
lo) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
16 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Word64
hi
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (ZonkAny 2) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr (ZonkAny 2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)) Word64
lo


{- | Convert a 'ByteString' to a 'TraceId'. Will fail if the 'ByteString'
 is not exactly 16 bytes long.

 @since 0.1.0.0
-}
bytesToTraceId :: ByteString -> Either String TraceId
bytesToTraceId :: ByteString -> Either String TraceId
bytesToTraceId ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = String -> Either String TraceId
forall a b. a -> Either a b
Left String
"bytesToTraceId: TraceId must be 16 bytes long"
  | Bool
otherwise = IO (Either String TraceId) -> Either String TraceId
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String TraceId) -> Either String TraceId)
-> IO (Either String TraceId) -> Either String TraceId
forall a b. (a -> b) -> a -> b
$
      ByteString
-> (CString -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
bs ((CString -> IO (Either String TraceId))
 -> IO (Either String TraceId))
-> (CString -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a b. (a -> b) -> a -> b
$ \CString
src -> do
        let !p :: Ptr Word64
p = CString -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr CString
src :: Ptr Word64
        !hi <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
p Int
0
        !lo <- peekElemOff p 1
        pure $! Right $! TraceId hi lo


{- | Convert a hex-encoded 'ByteString' into a 'TraceId'.

 @since 0.1.0.0
-}
baseEncodedToTraceId :: Base -> ByteString -> Either String TraceId
baseEncodedToTraceId :: Base -> ByteString -> Either String TraceId
baseEncodedToTraceId Base
Base16 ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = String -> Either String TraceId
forall a b. a -> Either a b
Left String
"baseEncodedToTraceId: expected 32 hex chars"
  | Bool
otherwise = IO (Either String TraceId) -> Either String TraceId
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String TraceId) -> Either String TraceId)
-> IO (Either String TraceId) -> Either String TraceId
forall a b. (a -> b) -> a -> b
$
      ByteString
-> (CStringLen -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either String TraceId))
 -> IO (Either String TraceId))
-> (CStringLen -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a b. (a -> b) -> a -> b
$ \(CString
src, Int
_) ->
        Int
-> (Ptr Word8 -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr Word8 -> IO (Either String TraceId))
 -> IO (Either String TraceId))
-> (Ptr Word8 -> IO (Either String TraceId))
-> IO (Either String TraceId)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
          rc <- Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
c_decodeHex (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
src) Ptr Word8
dst CSize
16
          if rc == 0
            then do
              let !p = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dst :: Ptr Word64
              !hi <- peekElemOff p 0
              !lo <- peekElemOff p 1
              pure $! Right $! TraceId hi lo
            else pure $ Left "invalid hex character"


-- | @since 0.1.0.0
traceIdBaseEncodedBuilder :: Base -> TraceId -> Builder
traceIdBaseEncodedBuilder :: Base -> TraceId -> Builder
traceIdBaseEncodedBuilder Base
Base16 = ByteString -> Builder
B.byteString (ByteString -> Builder)
-> (TraceId -> ByteString) -> TraceId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> TraceId -> ByteString
traceIdBaseEncodedByteString Base
Base16


{- | SIMD-accelerated hex encoding (SSSE3 on x86_64, NEON on aarch64).

 @since 0.1.0.0
-}
traceIdBaseEncodedByteString :: Base -> TraceId -> ByteString
traceIdBaseEncodedByteString :: Base -> TraceId -> ByteString
traceIdBaseEncodedByteString Base
Base16 (TraceId Word64
hi Word64
lo) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
32 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
    Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> do
      Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
src :: Ptr Word64) Word64
hi
      Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (ZonkAny 1) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
src Ptr Word8 -> Int -> Ptr (ZonkAny 1)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: Ptr Word64) Word64
lo
      Ptr Word8 -> Ptr Word8 -> IO ()
c_encodeTraceId Ptr Word8
src Ptr Word8
dst


-- | @since 0.1.0.0
traceIdBaseEncodedText :: Base -> TraceId -> Text
traceIdBaseEncodedText :: Base -> TraceId -> Text
traceIdBaseEncodedText Base
b = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (TraceId -> ByteString) -> TraceId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> TraceId -> ByteString
traceIdBaseEncodedByteString Base
b


-- * SpanId


{- | A valid span identifier is an 8-byte array with at least one non-zero byte.

Stored as a single machine-word @Word64@ in native byte order.

 @since 0.0.1.0
-}
data SpanId
  = SpanId
      {-# UNPACK #-} !Word64
  deriving stock (SpanId -> SpanId -> Bool
(SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool) -> Eq SpanId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpanId -> SpanId -> Bool
== :: SpanId -> SpanId -> Bool
$c/= :: SpanId -> SpanId -> Bool
/= :: SpanId -> SpanId -> Bool
Eq, Eq SpanId
Eq SpanId =>
(SpanId -> SpanId -> Ordering)
-> (SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> SpanId)
-> (SpanId -> SpanId -> SpanId)
-> Ord SpanId
SpanId -> SpanId -> Bool
SpanId -> SpanId -> Ordering
SpanId -> SpanId -> SpanId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpanId -> SpanId -> Ordering
compare :: SpanId -> SpanId -> Ordering
$c< :: SpanId -> SpanId -> Bool
< :: SpanId -> SpanId -> Bool
$c<= :: SpanId -> SpanId -> Bool
<= :: SpanId -> SpanId -> Bool
$c> :: SpanId -> SpanId -> Bool
> :: SpanId -> SpanId -> Bool
$c>= :: SpanId -> SpanId -> Bool
>= :: SpanId -> SpanId -> Bool
$cmax :: SpanId -> SpanId -> SpanId
max :: SpanId -> SpanId -> SpanId
$cmin :: SpanId -> SpanId -> SpanId
min :: SpanId -> SpanId -> SpanId
Ord, (forall x. SpanId -> Rep SpanId x)
-> (forall x. Rep SpanId x -> SpanId) -> Generic SpanId
forall x. Rep SpanId x -> SpanId
forall x. SpanId -> Rep SpanId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpanId -> Rep SpanId x
from :: forall x. SpanId -> Rep SpanId x
$cto :: forall x. Rep SpanId x -> SpanId
to :: forall x. Rep SpanId x -> SpanId
Generic)


instance Hashable SpanId where
  hashWithSalt :: Int -> SpanId -> Int
hashWithSalt Int
s (SpanId Word64
w) = Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Word64
w
  {-# INLINE hashWithSalt #-}


instance Show SpanId where
  showsPrec :: Int -> SpanId -> ShowS
showsPrec Int
d SpanId
i = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"SpanId " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Base -> SpanId -> Text
spanIdBaseEncodedText Base
Base16 SpanId
i)


instance IsString SpanId where
  fromString :: String -> SpanId
fromString String
str = case Base -> ByteString -> Either String SpanId
baseEncodedToSpanId Base
Base16 (String -> ByteString
forall a. IsString a => String -> a
fromString String
str) of
    Left String
err -> String -> SpanId
forall a. HasCallStack => String -> a
error String
err
    Right SpanId
ok -> SpanId
ok


{- | All-zero 'SpanId'.

@since 0.0.1.0
-}
nilSpanId :: SpanId
nilSpanId :: SpanId
nilSpanId = Word64 -> SpanId
SpanId Word64
0
{-# INLINE nilSpanId #-}


{- | Generate a 'SpanId' using the provided 'IdGenerator'.

 @since 0.1.0.0
-}
newSpanId :: (MonadIO m) => IdGenerator -> m SpanId
newSpanId :: forall (m :: * -> *). MonadIO m => IdGenerator -> m SpanId
newSpanId IdGenerator
DefaultIdGenerator = IO SpanId -> m SpanId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SpanId
generateSpanId
newSpanId (CustomIdGenerator IO ShortByteString
genSpan IO ShortByteString
_) = IO SpanId -> m SpanId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpanId -> m SpanId) -> IO SpanId -> m SpanId
forall a b. (a -> b) -> a -> b
$ ShortByteString -> SpanId
sbsToSpanId (ShortByteString -> SpanId) -> IO ShortByteString -> IO SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ShortByteString
genSpan
{-# INLINE newSpanId #-}


{- | Generate both a TraceId and SpanId. For 'DefaultIdGenerator', this is a
single FFI call (3 xoshiro steps) instead of 3 separate calls. Used for
root spans where both IDs need generating.
-}
newTraceAndSpanId :: (MonadIO m) => IdGenerator -> m (TraceId, SpanId)
newTraceAndSpanId :: forall (m :: * -> *).
MonadIO m =>
IdGenerator -> m (TraceId, SpanId)
newTraceAndSpanId IdGenerator
DefaultIdGenerator = IO (TraceId, SpanId) -> m (TraceId, SpanId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TraceId, SpanId)
generateTraceAndSpanId
newTraceAndSpanId IdGenerator
gen = IO (TraceId, SpanId) -> m (TraceId, SpanId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TraceId, SpanId) -> m (TraceId, SpanId))
-> IO (TraceId, SpanId) -> m (TraceId, SpanId)
forall a b. (a -> b) -> a -> b
$ do
  !tid <- IdGenerator -> IO TraceId
forall (m :: * -> *). MonadIO m => IdGenerator -> m TraceId
newTraceId IdGenerator
gen
  !sid <- newSpanId gen
  pure (tid, sid)
{-# INLINE newTraceAndSpanId #-}


-- | @since 0.1.0.0
isEmptySpanId :: SpanId -> Bool
isEmptySpanId :: SpanId -> Bool
isEmptySpanId (SpanId Word64
w) = Word64
w Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
{-# INLINE isEmptySpanId #-}


-- | @since 0.1.0.0
spanIdBytes :: SpanId -> ByteString
spanIdBytes :: SpanId -> ByteString
spanIdBytes (SpanId Word64
w) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
8 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Word64
w


-- | @since 0.1.0.0
bytesToSpanId :: ByteString -> Either String SpanId
bytesToSpanId :: ByteString -> Either String SpanId
bytesToSpanId ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 = String -> Either String SpanId
forall a b. a -> Either a b
Left String
"bytesToSpanId: SpanId must be 8 bytes long"
  | Bool
otherwise = IO (Either String SpanId) -> Either String SpanId
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String SpanId) -> Either String SpanId)
-> IO (Either String SpanId) -> Either String SpanId
forall a b. (a -> b) -> a -> b
$
      ByteString
-> (CString -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
bs ((CString -> IO (Either String SpanId))
 -> IO (Either String SpanId))
-> (CString -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a b. (a -> b) -> a -> b
$ \CString
src -> do
        !w <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (CString -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr CString
src :: Ptr Word64)
        pure $! Right $! SpanId w


-- | @since 0.1.0.0
baseEncodedToSpanId :: Base -> ByteString -> Either String SpanId
baseEncodedToSpanId :: Base -> ByteString -> Either String SpanId
baseEncodedToSpanId Base
Base16 ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = String -> Either String SpanId
forall a b. a -> Either a b
Left String
"baseEncodedToSpanId: expected 16 hex chars"
  | Bool
otherwise = IO (Either String SpanId) -> Either String SpanId
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String SpanId) -> Either String SpanId)
-> IO (Either String SpanId) -> Either String SpanId
forall a b. (a -> b) -> a -> b
$
      ByteString
-> (CStringLen -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either String SpanId))
 -> IO (Either String SpanId))
-> (CStringLen -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a b. (a -> b) -> a -> b
$ \(CString
src, Int
_) ->
        Int
-> (Ptr Word8 -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 ((Ptr Word8 -> IO (Either String SpanId))
 -> IO (Either String SpanId))
-> (Ptr Word8 -> IO (Either String SpanId))
-> IO (Either String SpanId)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst -> do
          rc <- Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
c_decodeHex (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
src) Ptr Word8
dst CSize
8
          if rc == 0
            then do
              !w <- peek (castPtr dst :: Ptr Word64)
              pure $! Right $! SpanId w
            else pure $ Left "invalid hex character"


-- | @since 0.1.0.0
spanIdBaseEncodedBuilder :: Base -> SpanId -> Builder
spanIdBaseEncodedBuilder :: Base -> SpanId -> Builder
spanIdBaseEncodedBuilder Base
Base16 = ByteString -> Builder
B.byteString (ByteString -> Builder)
-> (SpanId -> ByteString) -> SpanId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> SpanId -> ByteString
spanIdBaseEncodedByteString Base
Base16


-- | @since 0.1.0.0
spanIdBaseEncodedByteString :: Base -> SpanId -> ByteString
spanIdBaseEncodedByteString :: Base -> SpanId -> ByteString
spanIdBaseEncodedByteString Base
Base16 (SpanId Word64
w) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
16 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
    Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> do
      Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
src :: Ptr Word64) Word64
w
      Ptr Word8 -> Ptr Word8 -> IO ()
c_encodeSpanId Ptr Word8
src Ptr Word8
dst


-- | @since 0.1.0.0
spanIdBaseEncodedText :: Base -> SpanId -> Text
spanIdBaseEncodedText :: Base -> SpanId -> Text
spanIdBaseEncodedText Base
b = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (SpanId -> ByteString) -> SpanId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> SpanId -> ByteString
spanIdBaseEncodedByteString Base
b


-- * Generation: xoshiro256++ (DefaultIdGenerator)


{- | Generate a 'TraceId' via thread-local xoshiro256++.
Two FFI calls returning Word64 directly. No buffer, no ByteArray#.
-}
generateTraceId :: IO TraceId
generateTraceId :: IO TraceId
generateTraceId = do
  !hi <- IO Word64
c_xoshiroNext
  !lo <- c_xoshiroNext
  pure $! TraceId hi lo
{-# INLINE generateTraceId #-}


-- | Generate a 'SpanId' via thread-local xoshiro256++.
generateSpanId :: IO SpanId
generateSpanId :: IO SpanId
generateSpanId = do
  !w <- IO Word64
c_xoshiroNext
  pure $! SpanId w
{-# INLINE generateSpanId #-}


{- | Generate a TraceId + SpanId for root spans.

Three sequential @unsafe@ FFI calls to xoshiro256++ (~9 ns total).
A Cmm primop returning an unboxed triple via Sp-allocated out-pointers
was benchmarked at the same cost (~9.7 ns) because the per-call FFI
overhead (~3 ns) is already lower than the Cmm stack manipulation.
-}
generateTraceAndSpanId :: IO (TraceId, SpanId)
generateTraceAndSpanId :: IO (TraceId, SpanId)
generateTraceAndSpanId = do
  !hi <- IO Word64
c_xoshiroNext
  !lo <- c_xoshiroNext
  !sid <- c_xoshiroNext
  pure (TraceId hi lo, SpanId sid)
{-# INLINE generateTraceAndSpanId #-}


-- * CustomIdGenerator SBS -> Word64 conversion


sbsToTraceId :: ShortByteString -> TraceId
sbsToTraceId :: ShortByteString -> TraceId
sbsToTraceId ShortByteString
sbs =
  let !bs :: ByteString
bs = ShortByteString -> ByteString
fromShort ShortByteString
sbs
  in case ByteString -> Either String TraceId
bytesToTraceId ByteString
bs of
       Right TraceId
tid -> TraceId
tid
       Left String
_ -> TraceId
nilTraceId


sbsToSpanId :: ShortByteString -> SpanId
sbsToSpanId :: ShortByteString -> SpanId
sbsToSpanId ShortByteString
sbs =
  let !bs :: ByteString
bs = ShortByteString -> ByteString
fromShort ShortByteString
sbs
  in case ByteString -> Either String SpanId
bytesToSpanId ByteString
bs of
       Right SpanId
sid -> SpanId
sid
       Left String
_ -> SpanId
nilSpanId


{- | Base encoding scheme. Only 'Base16' (hexadecimal) is supported.

@since 0.0.1.0
-}
data Base = Base16
  deriving (Int -> Base -> ShowS
[Base] -> ShowS
Base -> String
(Int -> Base -> ShowS)
-> (Base -> String) -> ([Base] -> ShowS) -> Show Base
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base -> ShowS
showsPrec :: Int -> Base -> ShowS
$cshow :: Base -> String
show :: Base -> String
$cshowList :: [Base] -> ShowS
showList :: [Base] -> ShowS
Show, Base -> Base -> Bool
(Base -> Base -> Bool) -> (Base -> Base -> Bool) -> Eq Base
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base -> Base -> Bool
== :: Base -> Base -> Bool
$c/= :: Base -> Base -> Bool
/= :: Base -> Base -> Bool
Eq)


-- * Traceparent codec (C FFI)


foreign import ccall unsafe "hs_otel_parse_traceparent"
  c_parseTraceparent :: Ptr Word8 -> CSize -> Ptr Word64 -> IO CInt


foreign import ccall unsafe "hs_otel_encode_traceparent"
  c_encodeTraceparent
    :: Word64
    -> Word64
    -> Word64
    -> Word8
    -> Word8
    -> Ptr Word8
    -> IO ()


{- | Parse a W3C traceparent header in a single SIMD-accelerated C call.

 Returns the version, trace ID, span ID, and flags byte, or 'Nothing'
 on any format error (bad hex, wrong length, missing dashes, all-zero IDs).

 @since 0.4.0.0
-}
decodeTraceparent :: ByteString -> Maybe (Word8, TraceId, SpanId, Word8)
decodeTraceparent :: ByteString -> Maybe (Word8, TraceId, SpanId, Word8)
decodeTraceparent ByteString
bs = IO (Maybe (Word8, TraceId, SpanId, Word8))
-> Maybe (Word8, TraceId, SpanId, Word8)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe (Word8, TraceId, SpanId, Word8))
 -> Maybe (Word8, TraceId, SpanId, Word8))
-> IO (Maybe (Word8, TraceId, SpanId, Word8))
-> Maybe (Word8, TraceId, SpanId, Word8)
forall a b. (a -> b) -> a -> b
$
  ByteString
-> (CStringLen -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> IO (Maybe (Word8, TraceId, SpanId, Word8))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
 -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> (CStringLen -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> IO (Maybe (Word8, TraceId, SpanId, Word8))
forall a b. (a -> b) -> a -> b
$ \(CString
src, Int
len) ->
    Int
-> (Ptr (ZonkAny 0) -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> IO (Maybe (Word8, TraceId, SpanId, Word8))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr (ZonkAny 0) -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
 -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> (Ptr (ZonkAny 0) -> IO (Maybe (Word8, TraceId, SpanId, Word8)))
-> IO (Maybe (Word8, TraceId, SpanId, Word8))
forall a b. (a -> b) -> a -> b
$ \Ptr (ZonkAny 0)
buf -> do
      let !p :: Ptr Word64
p = Ptr (ZonkAny 0) -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr (ZonkAny 0)
buf :: Ptr Word64
      rc <- Ptr Word8 -> CSize -> Ptr Word64 -> IO CInt
c_parseTraceparent (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
src) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word64
p
      if rc == 0
        then do
          !hi <- peekElemOff p 0
          !lo <- peekElemOff p 1
          !sid <- peekElemOff p 2
          !meta <- peekElemOff p 3
          let !ver = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
meta Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) :: Word8
              !fl = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
meta Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFF) :: Word8
          pure $! Just (ver, TraceId hi lo, SpanId sid, fl)
        else pure Nothing


{- | Encode a traceparent header (55 bytes) in a single SIMD-accelerated C call.

 @since 0.4.0.0
-}
encodeTraceparent :: Word8 -> TraceId -> SpanId -> Word8 -> ByteString
encodeTraceparent :: Word8 -> TraceId -> SpanId -> Word8 -> ByteString
encodeTraceparent Word8
ver (TraceId Word64
hi Word64
lo) (SpanId Word64
sid) Word8
fl =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
55 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
    Word64 -> Word64 -> Word64 -> Word8 -> Word8 -> Ptr Word8 -> IO ()
c_encodeTraceparent Word64
hi Word64
lo Word64
sid Word8
ver Word8
fl Ptr Word8
dst