IdGenerator.hs

-- |
--
-- <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 Show

instance Exception XRayIdGenerationError where
  displayException = \case
    FailedToConvert bs base message ->
      "Failed to convert generated bytestring ("
        <> show bs
        <> ") in "
        <> show base
        <> ": "
        <> message

awsXRayIdGenerator :: IdGenerator
awsXRayIdGenerator = IdGenerator
  { generateSpanIdBytes = generateSpanIdBytes defaultIdGenerator
  , generateTraceIdBytes = generateXRayTraceIdBytes
  }

generateXRayTraceIdBytes :: IO ByteString
generateXRayTraceIdBytes = do
  epoch <- round @_ @Int <$> getPOSIXTime
  unique <- replicateM 24 randomHex

  let
    tid = BS8.pack $ showHex epoch "" <> unique
    base = Base16

  either (throwIO . FailedToConvert tid base) pure $ convertFromBase base tid

randomHex :: IO Char
randomHex = intToDigit <$> applyAtomicGen (uniformR (1, 15)) globalStdGen