{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.Id
( Id
, generate
, fromString
, fromText
, longOrShortTraceId
, longTraceId
, toByteString
, toByteStringUnshortened
, toString
, toStringUnshortened
, toText
, 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)
data Id =
IntComponents [Int]
| IdString String
| 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)
generate :: IO Id
generate :: IO Id
generate = do
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)
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
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
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
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
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
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
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
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
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
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest = [Int] -> Id
IntComponents