{-# LANGUAGE OverloadedStrings #-}
module Control.Monad.Trace.Internal (
TraceID(..), encodeTraceID, decodeTraceID, randomTraceID,
SpanID(..), encodeSpanID, decodeSpanID, randomSpanID,
Context(..),
Name,
Span(..),
SamplingDecision(..), spanIsSampled, spanIsDebug,
Reference(..),
Key, Value(..)
) where
import Control.Monad (replicateM)
import qualified Data.Aeson as JSON
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Base16 as Base16
import Data.Map.Strict (Map)
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (POSIXTime)
import System.Random (randomIO)
type Name = Text
type Key = Text
newtype TraceID = TraceID ByteString deriving (TraceID -> TraceID -> Bool
(TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool) -> Eq TraceID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceID -> TraceID -> Bool
$c/= :: TraceID -> TraceID -> Bool
== :: TraceID -> TraceID -> Bool
$c== :: TraceID -> TraceID -> Bool
Eq, Eq TraceID
Eq TraceID
-> (TraceID -> TraceID -> Ordering)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> Bool)
-> (TraceID -> TraceID -> TraceID)
-> (TraceID -> TraceID -> TraceID)
-> Ord TraceID
TraceID -> TraceID -> Bool
TraceID -> TraceID -> Ordering
TraceID -> TraceID -> TraceID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TraceID -> TraceID -> TraceID
$cmin :: TraceID -> TraceID -> TraceID
max :: TraceID -> TraceID -> TraceID
$cmax :: TraceID -> TraceID -> TraceID
>= :: TraceID -> TraceID -> Bool
$c>= :: TraceID -> TraceID -> Bool
> :: TraceID -> TraceID -> Bool
$c> :: TraceID -> TraceID -> Bool
<= :: TraceID -> TraceID -> Bool
$c<= :: TraceID -> TraceID -> Bool
< :: TraceID -> TraceID -> Bool
$c< :: TraceID -> TraceID -> Bool
compare :: TraceID -> TraceID -> Ordering
$ccompare :: TraceID -> TraceID -> Ordering
$cp1Ord :: Eq TraceID
Ord, Int -> TraceID -> ShowS
[TraceID] -> ShowS
TraceID -> String
(Int -> TraceID -> ShowS)
-> (TraceID -> String) -> ([TraceID] -> ShowS) -> Show TraceID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceID] -> ShowS
$cshowList :: [TraceID] -> ShowS
show :: TraceID -> String
$cshow :: TraceID -> String
showsPrec :: Int -> TraceID -> ShowS
$cshowsPrec :: Int -> TraceID -> ShowS
Show)
encodeTraceID :: TraceID -> Text
encodeTraceID :: TraceID -> Text
encodeTraceID (TraceID ByteString
bs) = ByteString -> Text
hexEncode ByteString
bs
decodeTraceID :: Text -> Maybe TraceID
decodeTraceID :: Text -> Maybe TraceID
decodeTraceID Text
txt = case Text -> Maybe ByteString
hexDecode Text
txt of
Just ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 -> TraceID -> Maybe TraceID
forall a. a -> Maybe a
Just (TraceID -> Maybe TraceID) -> TraceID -> Maybe TraceID
forall a b. (a -> b) -> a -> b
$ ByteString -> TraceID
TraceID ByteString
bs
Maybe ByteString
_ -> Maybe TraceID
forall a. Maybe a
Nothing
instance JSON.FromJSON TraceID where
parseJSON :: Value -> Parser TraceID
parseJSON = String -> (Text -> Parser TraceID) -> Value -> Parser TraceID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"TraceID" ((Text -> Parser TraceID) -> Value -> Parser TraceID)
-> (Text -> Parser TraceID) -> Value -> Parser TraceID
forall a b. (a -> b) -> a -> b
$ Parser TraceID
-> (TraceID -> Parser TraceID) -> Maybe TraceID -> Parser TraceID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser TraceID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid hex-encoding") TraceID -> Parser TraceID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TraceID -> Parser TraceID)
-> (Text -> Maybe TraceID) -> Text -> Parser TraceID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TraceID
decodeTraceID
instance JSON.ToJSON TraceID where
toJSON :: TraceID -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Text -> Value) -> (TraceID -> Text) -> TraceID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceID -> Text
encodeTraceID
randomTraceID :: IO TraceID
randomTraceID :: IO TraceID
randomTraceID = ByteString -> TraceID
TraceID (ByteString -> TraceID) -> IO ByteString -> IO TraceID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
randomID Int
16
newtype SpanID = SpanID ByteString deriving (SpanID -> SpanID -> Bool
(SpanID -> SpanID -> Bool)
-> (SpanID -> SpanID -> Bool) -> Eq SpanID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanID -> SpanID -> Bool
$c/= :: SpanID -> SpanID -> Bool
== :: SpanID -> SpanID -> Bool
$c== :: SpanID -> SpanID -> Bool
Eq, Eq SpanID
Eq SpanID
-> (SpanID -> SpanID -> Ordering)
-> (SpanID -> SpanID -> Bool)
-> (SpanID -> SpanID -> Bool)
-> (SpanID -> SpanID -> Bool)
-> (SpanID -> SpanID -> Bool)
-> (SpanID -> SpanID -> SpanID)
-> (SpanID -> SpanID -> SpanID)
-> Ord SpanID
SpanID -> SpanID -> Bool
SpanID -> SpanID -> Ordering
SpanID -> SpanID -> SpanID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SpanID -> SpanID -> SpanID
$cmin :: SpanID -> SpanID -> SpanID
max :: SpanID -> SpanID -> SpanID
$cmax :: SpanID -> SpanID -> SpanID
>= :: SpanID -> SpanID -> Bool
$c>= :: SpanID -> SpanID -> Bool
> :: SpanID -> SpanID -> Bool
$c> :: SpanID -> SpanID -> Bool
<= :: SpanID -> SpanID -> Bool
$c<= :: SpanID -> SpanID -> Bool
< :: SpanID -> SpanID -> Bool
$c< :: SpanID -> SpanID -> Bool
compare :: SpanID -> SpanID -> Ordering
$ccompare :: SpanID -> SpanID -> Ordering
$cp1Ord :: Eq SpanID
Ord, Int -> SpanID -> ShowS
[SpanID] -> ShowS
SpanID -> String
(Int -> SpanID -> ShowS)
-> (SpanID -> String) -> ([SpanID] -> ShowS) -> Show SpanID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanID] -> ShowS
$cshowList :: [SpanID] -> ShowS
show :: SpanID -> String
$cshow :: SpanID -> String
showsPrec :: Int -> SpanID -> ShowS
$cshowsPrec :: Int -> SpanID -> ShowS
Show)
encodeSpanID :: SpanID -> Text
encodeSpanID :: SpanID -> Text
encodeSpanID (SpanID ByteString
bs) = ByteString -> Text
hexEncode ByteString
bs
decodeSpanID :: Text -> Maybe SpanID
decodeSpanID :: Text -> Maybe SpanID
decodeSpanID Text
txt = case Text -> Maybe ByteString
hexDecode Text
txt of
Just ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 -> SpanID -> Maybe SpanID
forall a. a -> Maybe a
Just (SpanID -> Maybe SpanID) -> SpanID -> Maybe SpanID
forall a b. (a -> b) -> a -> b
$ ByteString -> SpanID
SpanID ByteString
bs
Maybe ByteString
_ -> Maybe SpanID
forall a. Maybe a
Nothing
instance JSON.FromJSON SpanID where
parseJSON :: Value -> Parser SpanID
parseJSON = String -> (Text -> Parser SpanID) -> Value -> Parser SpanID
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"SpanID" ((Text -> Parser SpanID) -> Value -> Parser SpanID)
-> (Text -> Parser SpanID) -> Value -> Parser SpanID
forall a b. (a -> b) -> a -> b
$ Parser SpanID
-> (SpanID -> Parser SpanID) -> Maybe SpanID -> Parser SpanID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser SpanID
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid hex-encoding") SpanID -> Parser SpanID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SpanID -> Parser SpanID)
-> (Text -> Maybe SpanID) -> Text -> Parser SpanID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe SpanID
decodeSpanID
instance JSON.ToJSON SpanID where
toJSON :: SpanID -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Text -> Value) -> (SpanID -> Text) -> SpanID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanID -> Text
encodeSpanID
randomSpanID :: IO SpanID
randomSpanID :: IO SpanID
randomSpanID = ByteString -> SpanID
SpanID (ByteString -> SpanID) -> IO ByteString -> IO SpanID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
randomID Int
8
data Context = Context
{ Context -> TraceID
contextTraceID :: !TraceID
, Context -> SpanID
contextSpanID :: !SpanID
, Context -> Map Text ByteString
contextBaggages :: !(Map Key ByteString)
} deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Eq Context
Eq Context
-> (Context -> Context -> Ordering)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Context)
-> (Context -> Context -> Context)
-> Ord Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c< :: Context -> Context -> Bool
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
$cp1Ord :: Eq Context
Ord, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)
data Reference
= ChildOf !SpanID
| FollowsFrom !Context
deriving (Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq, Eq Reference
Eq Reference
-> (Reference -> Reference -> Ordering)
-> (Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool)
-> (Reference -> Reference -> Reference)
-> (Reference -> Reference -> Reference)
-> Ord Reference
Reference -> Reference -> Bool
Reference -> Reference -> Ordering
Reference -> Reference -> Reference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Reference -> Reference -> Reference
$cmin :: Reference -> Reference -> Reference
max :: Reference -> Reference -> Reference
$cmax :: Reference -> Reference -> Reference
>= :: Reference -> Reference -> Bool
$c>= :: Reference -> Reference -> Bool
> :: Reference -> Reference -> Bool
$c> :: Reference -> Reference -> Bool
<= :: Reference -> Reference -> Bool
$c<= :: Reference -> Reference -> Bool
< :: Reference -> Reference -> Bool
$c< :: Reference -> Reference -> Bool
compare :: Reference -> Reference -> Ordering
$ccompare :: Reference -> Reference -> Ordering
$cp1Ord :: Eq Reference
Ord, Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show)
data Value
= TagValue !JSON.Value
| LogValue !JSON.Value !(Maybe POSIXTime)
data Span = Span
{ Span -> Text
spanName :: !Name
, Span -> Context
spanContext :: !Context
, Span -> Set Reference
spanReferences :: !(Set Reference)
, Span -> SamplingDecision
spanSamplingDecision :: !SamplingDecision
}
data SamplingDecision
= Always
| Never
| Debug
deriving (SamplingDecision -> SamplingDecision -> Bool
(SamplingDecision -> SamplingDecision -> Bool)
-> (SamplingDecision -> SamplingDecision -> Bool)
-> Eq SamplingDecision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplingDecision -> SamplingDecision -> Bool
$c/= :: SamplingDecision -> SamplingDecision -> Bool
== :: SamplingDecision -> SamplingDecision -> Bool
$c== :: SamplingDecision -> SamplingDecision -> Bool
Eq, Eq SamplingDecision
Eq SamplingDecision
-> (SamplingDecision -> SamplingDecision -> Ordering)
-> (SamplingDecision -> SamplingDecision -> Bool)
-> (SamplingDecision -> SamplingDecision -> Bool)
-> (SamplingDecision -> SamplingDecision -> Bool)
-> (SamplingDecision -> SamplingDecision -> Bool)
-> (SamplingDecision -> SamplingDecision -> SamplingDecision)
-> (SamplingDecision -> SamplingDecision -> SamplingDecision)
-> Ord SamplingDecision
SamplingDecision -> SamplingDecision -> Bool
SamplingDecision -> SamplingDecision -> Ordering
SamplingDecision -> SamplingDecision -> SamplingDecision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SamplingDecision -> SamplingDecision -> SamplingDecision
$cmin :: SamplingDecision -> SamplingDecision -> SamplingDecision
max :: SamplingDecision -> SamplingDecision -> SamplingDecision
$cmax :: SamplingDecision -> SamplingDecision -> SamplingDecision
>= :: SamplingDecision -> SamplingDecision -> Bool
$c>= :: SamplingDecision -> SamplingDecision -> Bool
> :: SamplingDecision -> SamplingDecision -> Bool
$c> :: SamplingDecision -> SamplingDecision -> Bool
<= :: SamplingDecision -> SamplingDecision -> Bool
$c<= :: SamplingDecision -> SamplingDecision -> Bool
< :: SamplingDecision -> SamplingDecision -> Bool
$c< :: SamplingDecision -> SamplingDecision -> Bool
compare :: SamplingDecision -> SamplingDecision -> Ordering
$ccompare :: SamplingDecision -> SamplingDecision -> Ordering
$cp1Ord :: Eq SamplingDecision
Ord, Int -> SamplingDecision
SamplingDecision -> Int
SamplingDecision -> [SamplingDecision]
SamplingDecision -> SamplingDecision
SamplingDecision -> SamplingDecision -> [SamplingDecision]
SamplingDecision
-> SamplingDecision -> SamplingDecision -> [SamplingDecision]
(SamplingDecision -> SamplingDecision)
-> (SamplingDecision -> SamplingDecision)
-> (Int -> SamplingDecision)
-> (SamplingDecision -> Int)
-> (SamplingDecision -> [SamplingDecision])
-> (SamplingDecision -> SamplingDecision -> [SamplingDecision])
-> (SamplingDecision -> SamplingDecision -> [SamplingDecision])
-> (SamplingDecision
-> SamplingDecision -> SamplingDecision -> [SamplingDecision])
-> Enum SamplingDecision
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SamplingDecision
-> SamplingDecision -> SamplingDecision -> [SamplingDecision]
$cenumFromThenTo :: SamplingDecision
-> SamplingDecision -> SamplingDecision -> [SamplingDecision]
enumFromTo :: SamplingDecision -> SamplingDecision -> [SamplingDecision]
$cenumFromTo :: SamplingDecision -> SamplingDecision -> [SamplingDecision]
enumFromThen :: SamplingDecision -> SamplingDecision -> [SamplingDecision]
$cenumFromThen :: SamplingDecision -> SamplingDecision -> [SamplingDecision]
enumFrom :: SamplingDecision -> [SamplingDecision]
$cenumFrom :: SamplingDecision -> [SamplingDecision]
fromEnum :: SamplingDecision -> Int
$cfromEnum :: SamplingDecision -> Int
toEnum :: Int -> SamplingDecision
$ctoEnum :: Int -> SamplingDecision
pred :: SamplingDecision -> SamplingDecision
$cpred :: SamplingDecision -> SamplingDecision
succ :: SamplingDecision -> SamplingDecision
$csucc :: SamplingDecision -> SamplingDecision
Enum, Int -> SamplingDecision -> ShowS
[SamplingDecision] -> ShowS
SamplingDecision -> String
(Int -> SamplingDecision -> ShowS)
-> (SamplingDecision -> String)
-> ([SamplingDecision] -> ShowS)
-> Show SamplingDecision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplingDecision] -> ShowS
$cshowList :: [SamplingDecision] -> ShowS
show :: SamplingDecision -> String
$cshow :: SamplingDecision -> String
showsPrec :: Int -> SamplingDecision -> ShowS
$cshowsPrec :: Int -> SamplingDecision -> ShowS
Show)
spanIsSampled :: Span -> Bool
spanIsSampled :: Span -> Bool
spanIsSampled Span
spn = Span -> SamplingDecision
spanSamplingDecision Span
spn SamplingDecision -> SamplingDecision -> Bool
forall a. Eq a => a -> a -> Bool
/= SamplingDecision
Never
spanIsDebug :: Span -> Bool
spanIsDebug :: Span -> Bool
spanIsDebug Span
spn = Span -> SamplingDecision
spanSamplingDecision Span
spn SamplingDecision -> SamplingDecision -> Bool
forall a. Eq a => a -> a -> Bool
== SamplingDecision
Debug
randomID :: Int -> IO ByteString
randomID :: Int -> IO ByteString
randomID Int
len = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> IO [Word8] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Word8 -> IO [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len IO Word8
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
hexDecode :: Text-> Maybe ByteString
hexDecode :: Text -> Maybe ByteString
hexDecode Text
t = case ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
Right ByteString
bs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
Either String ByteString
_ -> Maybe ByteString
forall a. Maybe a
Nothing
hexEncode :: ByteString -> Text
hexEncode :: ByteString -> Text
hexEncode = String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.Char8.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode