{-# 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
   , fromText
   , longOrShortTraceId
   , longTraceId
   , toByteString
   , toByteStringUnshortened
   , toString
   , toStringUnshortened
   , 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 qualified Data.String               (IsString (..))
import           Data.Text                 (Text)
import qualified Data.Text                 as T
import           GHC.Generics
import           Numeric                   (showHex)
import qualified System.Random             as Random

import           Instana.SDK.Internal.Util (leftPad)


-- |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
    -- |a 16 character/64 bit ID that has been shortened from a longer original.
    -- The first component is the shortened ID, the second the is original ID.
  | ShortenedId String 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
fromString (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


instance Data.String.IsString Id where
  fromString :: String -> Id
fromString = String -> Id
fromString


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)


-- |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 (m :: * -> *). (Random a, MonadIO m) => m 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 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
    ShortenedId string :: String
string _ ->
      String
string


-- |Converts an ID into a String, using the unshortened value (in case this is a
-- ShortenedId).
toStringUnshortened :: Id -> String
toStringUnshortened :: Id -> String
toStringUnshortened theId :: Id
theId =
  case Id
theId of
    ShortenedId _ unshortened :: String
unshortened ->
      String
unshortened
    _ ->
      Id -> String
toString Id
theId


-- |Retrieves the original long trace ID as a string in case this ID has been
-- created by shortening a 128 bit trace ID, or Nothing otherwise.
longTraceId :: Id -> Maybe String
longTraceId :: Id -> Maybe String
longTraceId theId :: Id
theId =
  case Id
theId of
    ShortenedId _ original :: String
original -> String -> Maybe String
forall a. a -> Maybe a
Just String
original
    _                      -> Maybe String
forall a. Maybe a
Nothing


-- |Retrieves the original long trace ID as a string in case this ID has been
-- created by shortening a 128 bit trace ID, or the full ID as a string
-- otherwise.
longOrShortTraceId :: Id -> String
longOrShortTraceId :: Id -> String
longOrShortTraceId theId :: Id
theId =
  case Id
theId of
    ShortenedId _ original :: String
original -> String
original
    _                      -> Id -> String
toString Id
theId


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


--- |Converts a Text into an ID.
fromText :: Text -> Id
fromText :: Text -> Id
fromText t :: Text
t =
  if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 16 then
    String -> String -> Id
ShortenedId (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.takeEnd 16 Text
t) (Text -> String
T.unpack Text
t)
  else
    String -> Id
IdString (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t


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


-- |Converts an ID into a ByteString, providing the unshortened value (this
-- only makes a difference when this is a ShortenedId).
toByteStringUnshortened :: Id -> BSC8.ByteString
toByteStringUnshortened :: Id -> ByteString
toByteStringUnshortened =
  String -> ByteString
BSC8.pack (String -> ByteString) -> (Id -> String) -> Id -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
toStringUnshortened


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