{-# 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 , toString , 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 (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 -- |Generates a new random 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 = 64 `div` bitsPerInt (randomInts :: [Int]) <- replicateM requiredNumberOfIntComponents Random.randomIO return $ IntComponents $ randomInts bitsPerInt :: Int bitsPerInt = floor $ logBase (2 :: Double) $ fromIntegral (maxBound :: Int) -- |Converts a string into an ID. fromString :: String -> Id fromString = IdString -- |Converts an ID into a String toString :: Id -> String toString theId = case theId of IntComponents intComponents -> let noOfComponents = length intComponents in foldl (appendAsHex noOfComponents) "" (reverse intComponents) IdString string -> string -- |Converts an ID into a Text toText :: Id -> Text toText = T.pack . toString -- |Converts an ID into a ByteString toByteString :: Id -> BSC8.ByteString toByteString = BSC8.pack . toString -- |Only exposed for testing, do not use this. createFromIntsForTest :: [Int] -> Id createFromIntsForTest = IntComponents