{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.Id
( Id
, generate
, fromString
, toByteString
, 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 Data.List (foldl)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
import Numeric (showHex)
import qualified System.Random as Random
data Id =
IntComponents [Int]
| IdString String
deriving (Eq, Generic, Show)
instance FromJSON Id where
parseJSON :: Value -> Parser Id
parseJSON = Aeson.withText "Id string" $
\string -> return $ IdString $ (T.unpack string)
instance ToJSON Id where
toJSON :: Id -> Value
toJSON =
Aeson.String . toText
appendAsHex :: Int -> String -> Int -> String
appendAsHex noOfComponents accumulator intValue =
appendPaddedHex accumulator intValue
where
toHex = (flip showHex) "" . abs
padding = 64 `div` noOfComponents `div` 4
toPaddedHex = leftPad padding . toHex
appendPaddedHex = flip ((++) . toPaddedHex)
leftPad :: Int -> String -> String
leftPad digits s
| length s < digits = replicate (digits - length s) '0' ++ s
| otherwise = s
generate :: IO Id
generate = do
let
requiredNumberOfIntComponents = 64 `div` bitsPerInt
(randomInts :: [Int]) <-
replicateM requiredNumberOfIntComponents Random.randomIO
return $ IntComponents $ randomInts
bitsPerInt :: Int
bitsPerInt =
floor $ logBase (2 :: Double) $ fromIntegral (maxBound :: Int)
fromString :: String -> Id
fromString = IdString
toString :: Id -> String
toString theId =
case theId of
IntComponents intComponents ->
let
noOfComponents = length intComponents
in
foldl
(appendAsHex noOfComponents)
""
(reverse intComponents)
IdString string ->
string
toText :: Id -> Text
toText =
T.pack . toString
toByteString :: Id -> BSC8.ByteString
toByteString =
BSC8.pack . toString
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest = IntComponents