{-# 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.List (foldl) 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