{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module OpenTelemetry.Internal.Trace.Id (
  TraceId (..),
  newTraceId,
  isEmptyTraceId,
  traceIdBytes,
  bytesToTraceId,
  baseEncodedToTraceId,
  traceIdBaseEncodedBuilder,
  traceIdBaseEncodedByteString,
  traceIdBaseEncodedText,
  SpanId (..),
  newSpanId,
  isEmptySpanId,
  spanIdBytes,
  bytesToSpanId,
  Base (..),
  baseEncodedToSpanId,
  spanIdBaseEncodedBuilder,
  spanIdBaseEncodedByteString,
  spanIdBaseEncodedText,
) where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.ByteArray.Encoding (
  Base (Base16),
  convertFromBase,
  convertToBase,
 )
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import Data.ByteString.Short.Internal (
  ShortByteString (SBS),
  fromShort,
  toShort,
 )
import Data.Hashable (Hashable)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import GHC.Exts (
  IsString (fromString),
  eqWord#,
  indexWord64Array#,
  int2Word#,
  isTrue#,
  or#,
 )


#if MIN_VERSION_base(4,17,0)
import GHC.Exts (word64ToWord#)
#endif

import GHC.Generics (Generic)
import OpenTelemetry.Trace.Id.Generator (
  IdGenerator (generateSpanIdBytes, generateTraceIdBytes),
 )
import Prelude hiding (length)


-- TODO faster encoding decoding via something like
-- https://github.com/lemire/Code-used-on-Daniel-Lemire-s-blog/blob/03fc2e82fdef2c6fd25721203e1654428fee123d/2019/04/17/hexparse.cpp#L390

-- | A valid trace identifier is a 16-byte array with at least one non-zero byte.
newtype TraceId = TraceId ShortByteString
  deriving stock (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, 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, (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)
  deriving newtype (Eq TraceId
Eq TraceId =>
(Int -> TraceId -> Int) -> (TraceId -> Int) -> Hashable TraceId
Int -> TraceId -> Int
TraceId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TraceId -> Int
hashWithSalt :: Int -> TraceId -> Int
$chash :: TraceId -> Int
hash :: TraceId -> Int
Hashable)


-- | A valid span identifier is an 8-byte array with at least one non-zero byte.
newtype SpanId = SpanId ShortByteString
  deriving stock (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, 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)
  deriving newtype (Eq SpanId
Eq SpanId =>
(Int -> SpanId -> Int) -> (SpanId -> Int) -> Hashable SpanId
Int -> SpanId -> Int
SpanId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SpanId -> Int
hashWithSalt :: Int -> SpanId -> Int
$chash :: SpanId -> Int
hash :: SpanId -> Int
Hashable)


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


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


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

 This function is generally called by the @hs-opentelemetry-sdk@,
 but may be useful in some testing situations.

 @since 0.1.0.0
-}
newTraceId :: (MonadIO m) => IdGenerator -> m TraceId
newTraceId :: forall (m :: * -> *). MonadIO m => IdGenerator -> m TraceId
newTraceId IdGenerator
gen = IO TraceId -> m TraceId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ShortByteString -> TraceId
TraceId (ShortByteString -> TraceId)
-> (ByteString -> ShortByteString) -> ByteString -> TraceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> TraceId) -> IO ByteString -> IO TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdGenerator -> IO ByteString
generateTraceIdBytes IdGenerator
gen)


{- | Check whether all bytes in the 'TraceId' are zero.

 @since 0.1.0.0
-}
isEmptyTraceId :: TraceId -> Bool
#if MIN_VERSION_base(4,17,0)
isEmptyTraceId :: TraceId -> Bool
isEmptyTraceId (TraceId (SBS ByteArray#
arr)) =
  Int# -> Bool
isTrue#
    (Word# -> Word# -> Int#
eqWord#
      (Word# -> Word# -> Word#
or#
        (Word64# -> Word#
word64ToWord# (ByteArray# -> Int# -> Word64#
indexWord64Array# ByteArray#
arr Int#
0#))
        (Word64# -> Word#
word64ToWord# (ByteArray# -> Int# -> Word64#
indexWord64Array# ByteArray#
arr Int#
1#)))
      (Int# -> Word#
int2Word# Int#
0#))
#else
isEmptyTraceId (TraceId (SBS arr)) =
  isTrue#
    (eqWord#
      (or#
        (indexWord64Array# arr 0#)
        (indexWord64Array# arr 1#))
      (int2Word# 0#))
#endif


{- | Access the byte-level representation of the provided 'TraceId'

 @since 0.1.0.0
-}
traceIdBytes :: TraceId -> ByteString
traceIdBytes :: TraceId -> ByteString
traceIdBytes (TraceId ShortByteString
bytes) = ShortByteString -> ByteString
fromShort ShortByteString
bytes


{- | 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 =
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16
    then TraceId -> Either String TraceId
forall a b. b -> Either a b
Right (TraceId -> Either String TraceId)
-> TraceId -> Either String TraceId
forall a b. (a -> b) -> a -> b
$ ShortByteString -> TraceId
TraceId (ShortByteString -> TraceId) -> ShortByteString -> TraceId
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
toShort ByteString
bs
    else String -> Either String TraceId
forall a b. a -> Either a b
Left String
"bytesToTraceId: TraceId must be 8 bytes long"


{- | Convert a 'ByteString' of a specified base-encoding into a 'TraceId'.
 Will fail if the decoded value is not exactly 16 bytes long.

 @since 0.1.0.0
-}
baseEncodedToTraceId :: Base -> ByteString -> Either String TraceId
baseEncodedToTraceId :: Base -> ByteString -> Either String TraceId
baseEncodedToTraceId Base
b ByteString
bs = do
  ByteString
r <- Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
b ByteString
bs
  ByteString -> Either String TraceId
bytesToTraceId ByteString
r


{- | Output a 'TraceId' into a base-encoded bytestring 'Builder'.

 @since 0.1.0.0
-}
traceIdBaseEncodedBuilder :: Base -> TraceId -> Builder
traceIdBaseEncodedBuilder :: Base -> TraceId -> Builder
traceIdBaseEncodedBuilder Base
b = ByteString -> Builder
B.byteString (ByteString -> Builder)
-> (TraceId -> ByteString) -> TraceId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
b (ByteString -> ByteString)
-> (TraceId -> ByteString) -> TraceId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> ByteString
traceIdBytes


{- | Output a 'TraceId' into a base-encoded 'ByteString'.

 @since 0.1.0.0
-}
traceIdBaseEncodedByteString :: Base -> TraceId -> ByteString
traceIdBaseEncodedByteString :: Base -> TraceId -> ByteString
traceIdBaseEncodedByteString Base
b = Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
b (ByteString -> ByteString)
-> (TraceId -> ByteString) -> TraceId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceId -> ByteString
traceIdBytes


{- | Output a 'TraceId' into a base-encoded 'Text'.

 @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


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

 This function is generally called by the @hs-opentelemetry-sdk@,
 but may be useful in some testing situations.

 @since 0.1.0.0
-}
newSpanId :: (MonadIO m) => IdGenerator -> m SpanId
newSpanId :: forall (m :: * -> *). MonadIO m => IdGenerator -> m SpanId
newSpanId IdGenerator
gen = IO SpanId -> m SpanId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ShortByteString -> SpanId
SpanId (ShortByteString -> SpanId)
-> (ByteString -> ShortByteString) -> ByteString -> SpanId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> SpanId) -> IO ByteString -> IO SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdGenerator -> IO ByteString
generateSpanIdBytes IdGenerator
gen)


{- | Check whether all bytes in the 'SpanId' are zero.

 @since 0.1.0.0
-}
isEmptySpanId :: SpanId -> Bool
#if MIN_VERSION_base(4,17,0)
isEmptySpanId :: SpanId -> Bool
isEmptySpanId (SpanId (SBS ByteArray#
arr)) = Int# -> Bool
isTrue#
  (Word# -> Word# -> Int#
eqWord#
    (Word64# -> Word#
word64ToWord# (ByteArray# -> Int# -> Word64#
indexWord64Array# ByteArray#
arr Int#
0#))
    (Int# -> Word#
int2Word# Int#
0#))
#else
isEmptySpanId (SpanId (SBS arr)) = isTrue#
  (eqWord#
    (indexWord64Array# arr 0#)
    (int2Word# 0#))
#endif


{- | Access the byte-level representation of the provided 'SpanId'

 @since 0.1.0.0
-}
spanIdBytes :: SpanId -> ByteString
spanIdBytes :: SpanId -> ByteString
spanIdBytes (SpanId ShortByteString
bytes) = ShortByteString -> ByteString
fromShort ShortByteString
bytes


{- | Convert a 'ByteString' of a specified base-encoding into a 'SpanId'.
 Will fail if the decoded value is not exactly 8 bytes long.

 @since 0.1.0.0
-}
bytesToSpanId :: ByteString -> Either String SpanId
bytesToSpanId :: ByteString -> Either String SpanId
bytesToSpanId ByteString
bs =
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
    then SpanId -> Either String SpanId
forall a b. b -> Either a b
Right (SpanId -> Either String SpanId) -> SpanId -> Either String SpanId
forall a b. (a -> b) -> a -> b
$ ShortByteString -> SpanId
SpanId (ShortByteString -> SpanId) -> ShortByteString -> SpanId
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
toShort ByteString
bs
    else String -> Either String SpanId
forall a b. a -> Either a b
Left String
"bytesToSpanId: SpanId must be 8 bytes long"


{- | Convert a 'ByteString' of a specified base-encoding into a 'SpanId'.
 Will fail if the decoded value is not exactly 8 bytes long.

 @since 0.1.0.0
-}
baseEncodedToSpanId :: Base -> ByteString -> Either String SpanId
baseEncodedToSpanId :: Base -> ByteString -> Either String SpanId
baseEncodedToSpanId Base
b ByteString
bs = do
  ByteString
r <- Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
b ByteString
bs
  ByteString -> Either String SpanId
bytesToSpanId ByteString
r


{- | Output a 'SpanId' into a base-encoded bytestring 'Builder'.

 @since 0.1.0.0
-}
spanIdBaseEncodedBuilder :: Base -> SpanId -> Builder
spanIdBaseEncodedBuilder :: Base -> SpanId -> Builder
spanIdBaseEncodedBuilder Base
b = ByteString -> Builder
B.byteString (ByteString -> Builder)
-> (SpanId -> ByteString) -> SpanId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
b (ByteString -> ByteString)
-> (SpanId -> ByteString) -> SpanId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> ByteString
spanIdBytes


{- | Output a 'SpanId' into a base-encoded 'ByteString'.

 @since 0.1.0.0
-}
spanIdBaseEncodedByteString :: Base -> SpanId -> ByteString
spanIdBaseEncodedByteString :: Base -> SpanId -> ByteString
spanIdBaseEncodedByteString Base
b = Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
b (ByteString -> ByteString)
-> (SpanId -> ByteString) -> SpanId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanId -> ByteString
spanIdBytes


{- | Output a 'SpanId' into a base-encoded 'Text'.

 @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