{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Instana.SDK.Internal.Id
Description : A module for working with trace IDs and span IDs
-}
module Instana.SDK.Internal.Id
   ( Id
   , generate
   , fromString
   , toByteString
   , toText
   -- exposed for testing purposes
   , createFromIntsForTest
   )
   where


import           Control.Monad         (replicateM)
import           Data.Aeson            (FromJSON, ToJSON, Value)
import qualified Data.Aeson            as Aeson
import           Data.Aeson.Types      (Parser)
import qualified Data.ByteString.Char8 as BSC8
import           Data.Text             (Text)
import qualified Data.Text             as T
import           GHC.Generics
import           Numeric               (showHex)
import qualified System.Random         as Random


-- |Represents an ID (trace ID, span ID).
data Id =
    -- |a representation of a 64 bit ID with just enough Int components to
    -- reach 64 bits (used when generating new random IDs)
    IntComponents [Int]
    -- |a representation of a 64 bit ID as a plain string (used when
    -- deserializing IDs, for example when reading HTTP headers)
  | IdString String
  deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, (forall x. Id -> Rep Id x)
-> (forall x. Rep Id x -> Id) -> Generic Id
forall x. Rep Id x -> Id
forall x. Id -> Rep Id x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Id x -> Id
$cfrom :: forall x. Id -> Rep Id x
Generic, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)


instance FromJSON Id where
  parseJSON :: Value -> Parser Id
  parseJSON :: Value -> Parser Id
parseJSON = String -> (Text -> Parser Id) -> Value -> Parser Id
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText "Id string" ((Text -> Parser Id) -> Value -> Parser Id)
-> (Text -> Parser Id) -> Value -> Parser Id
forall a b. (a -> b) -> a -> b
$
    \string :: Text
string -> Id -> Parser Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ String -> Id
IdString (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ (Text -> String
T.unpack Text
string)


instance ToJSON Id where
  toJSON :: Id -> Value
  toJSON :: Id -> Value
toJSON =
    Text -> Value
Aeson.String (Text -> Value) -> (Id -> Text) -> Id -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Text
toText


appendAsHex :: Int -> String -> Int -> String
appendAsHex :: Int -> String -> Int -> String
appendAsHex noOfComponents :: Int
noOfComponents accumulator :: String
accumulator intValue :: Int
intValue =
  String -> Int -> String
appendPaddedHex String
accumulator Int
intValue
  where
    toHex :: Int -> String
toHex = ((Int -> ShowS) -> String -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex) "" (Int -> String) -> (Int -> Int) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs
    padding :: Int
padding = 64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
noOfComponents Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4
    toPaddedHex :: Int -> String
toPaddedHex = Int -> ShowS
leftPad Int
padding ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
toHex
    appendPaddedHex :: String -> Int -> String
appendPaddedHex = (Int -> ShowS) -> String -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (Int -> String) -> Int -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
toPaddedHex)


leftPad :: Int -> String -> String
leftPad :: Int -> ShowS
leftPad digits :: Int
digits s :: String
s
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
digits = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) '0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  | Bool
otherwise         = String
s


-- |Generates a new random ID.
generate :: IO Id
generate :: IO Id
generate = do
  -- The number of bits used for an Haskell Int depends on the GHC
  -- implementation. It is guaranteed to cover the range from -2^29 to 2^29 - 1.
  -- On modern systems it is often -2^63 to 2^63 - 1.
  --
  -- We need 64 bits, so we actually need to generate multiple Ints (usually
  -- two) and stitch them together during JSON decoding.
  let
    requiredNumberOfIntComponents :: Int
requiredNumberOfIntComponents = 64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bitsPerInt
  ([Int]
randomInts :: [Int]) <-
    Int -> IO Int -> IO [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
requiredNumberOfIntComponents IO Int
forall a. Random a => IO a
Random.randomIO
  Id -> IO Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IO Id) -> Id -> IO Id
forall a b. (a -> b) -> a -> b
$ [Int] -> Id
IntComponents ([Int] -> Id) -> [Int] -> Id
forall a b. (a -> b) -> a -> b
$ [Int]
randomInts


bitsPerInt :: Int
bitsPerInt :: Int
bitsPerInt =
  Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (2 :: Double) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)


-- |Converts a string into an ID.
fromString :: String -> Id
fromString :: String -> Id
fromString = String -> Id
IdString


-- |Converts an ID into a String
toString :: Id -> String
toString :: Id -> String
toString theId :: Id
theId =
  case Id
theId of
    IntComponents intComponents :: [Int]
intComponents ->
      let
        noOfComponents :: Int
noOfComponents = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
intComponents
      in
      (String -> Int -> String) -> String -> [Int] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
        (Int -> String -> Int -> String
appendAsHex Int
noOfComponents)
        ""
        ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
intComponents)
    IdString string :: String
string ->
      String
string


-- |Converts an ID into a Text
toText :: Id -> Text
toText :: Id -> Text
toText =
  String -> Text
T.pack (String -> Text) -> (Id -> String) -> Id -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
toString


-- |Converts an ID into a ByteString
toByteString :: Id -> BSC8.ByteString
toByteString :: Id -> ByteString
toByteString =
  String -> ByteString
BSC8.pack (String -> ByteString) -> (Id -> String) -> Id -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
toString


-- |Only exposed for testing, do not use this.
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest = [Int] -> Id
IntComponents