module OpenTelemetry.AWSXRay.IdGenerator
( XRayIdGenerationError
, awsXRayIdGenerator
) where
import Prelude
import Control.Monad (replicateM)
import Data.ByteArray.Encoding (convertFromBase)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import Data.Char (intToDigit)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Numeric (showHex)
import OpenTelemetry.Trace.Id (Base(..))
import OpenTelemetry.Trace.Id.Generator
import OpenTelemetry.Trace.Id.Generator.Default
import System.Random.Stateful (applyAtomicGen, globalStdGen, uniformR)
import UnliftIO.Exception (Exception(..), throwIO)
data XRayIdGenerationError = FailedToConvert ByteString Base String
deriving stock Int -> XRayIdGenerationError -> ShowS
[XRayIdGenerationError] -> ShowS
XRayIdGenerationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XRayIdGenerationError] -> ShowS
$cshowList :: [XRayIdGenerationError] -> ShowS
show :: XRayIdGenerationError -> String
$cshow :: XRayIdGenerationError -> String
showsPrec :: Int -> XRayIdGenerationError -> ShowS
$cshowsPrec :: Int -> XRayIdGenerationError -> ShowS
Show
instance Exception XRayIdGenerationError where
displayException :: XRayIdGenerationError -> String
displayException = \case
FailedToConvert ByteString
bs Base
base String
message ->
String
"Failed to convert generated bytestring ("
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
bs
forall a. Semigroup a => a -> a -> a
<> String
") in "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Base
base
forall a. Semigroup a => a -> a -> a
<> String
": "
forall a. Semigroup a => a -> a -> a
<> String
message
awsXRayIdGenerator :: IdGenerator
awsXRayIdGenerator :: IdGenerator
awsXRayIdGenerator = IdGenerator
{ generateSpanIdBytes :: IO ByteString
generateSpanIdBytes = IdGenerator -> IO ByteString
generateSpanIdBytes IdGenerator
defaultIdGenerator
, generateTraceIdBytes :: IO ByteString
generateTraceIdBytes = IO ByteString
generateXRayTraceIdBytes
}
generateXRayTraceIdBytes :: IO ByteString
generateXRayTraceIdBytes :: IO ByteString
generateXRayTraceIdBytes = do
Int
epoch <- forall a b. (RealFrac a, Integral b) => a -> b
round @_ @Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime
String
unique <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
24 IO Char
randomHex
let
tid :: ByteString
tid = String -> ByteString
BS8.pack forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex Int
epoch String
"" forall a. Semigroup a => a -> a -> a
<> String
unique
base :: Base
base = Base
Base16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base -> String -> XRayIdGenerationError
FailedToConvert ByteString
tid Base
base) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
base ByteString
tid
randomHex :: IO Char
randomHex :: IO Char
randomHex = Int -> Char
intToDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) g a.
MonadIO m =>
(g -> (a, g)) -> AtomicGenM g -> m a
applyAtomicGen (forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
1, Int
15)) AtomicGenM StdGen
globalStdGen