-- |
--
-- <https://docs.aws.amazon.com/xray/latest/devguide/xray-api-sendingdata.html#xray-api-traceids>
--
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