{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

{- |
 Module      :  OpenTelemetry.Trace.Id.Generator.Default
 Copyright   :  (c) Ian Duncan, 2021
 License     :  BSD-3
 Maintainer  :  Ian Duncan
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)

 A reasonably performant out of the box implementation of random span and trace id generation.
-}
module OpenTelemetry.Trace.Id.Generator.Default (
  defaultIdGenerator,
) where

import OpenTelemetry.Trace.Id.Generator (IdGenerator (..))
import System.IO.Unsafe (unsafePerformIO)
import System.Random.Stateful


{- | The default generator for trace and span ids.

 @since 0.1.0.0
-}
defaultIdGenerator :: IdGenerator
defaultIdGenerator :: IdGenerator
defaultIdGenerator = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  StdGen
genBase <- forall (m :: * -> *). MonadIO m => m StdGen
initStdGen
  let (StdGen
spanIdGen, StdGen
traceIdGen) = forall g. RandomGen g => g -> (g, g)
split StdGen
genBase
  AtomicGenM StdGen
sg <- forall (m :: * -> *) g. MonadIO m => g -> m (AtomicGenM g)
newAtomicGenM StdGen
spanIdGen
  AtomicGenM StdGen
tg <- forall (m :: * -> *) g. MonadIO m => g -> m (AtomicGenM g)
newAtomicGenM StdGen
traceIdGen
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    IdGenerator
      { generateSpanIdBytes :: IO ByteString
generateSpanIdBytes = forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM Int
8 AtomicGenM StdGen
sg
      , generateTraceIdBytes :: IO ByteString
generateTraceIdBytes = forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM Int
16 AtomicGenM StdGen
tg
      }
{-# NOINLINE defaultIdGenerator #-}