{-# LANGUAGE ExistentialQuantification, RankNTypes, UndecidableInstances #-}

module Tracing.Core (
    Span(..),
    SpanRelation(..),
    SpanRelationTag(..),
    SpanContext(..),
    SpanTag(..),
    OpName(..),
    SpanId(..),
    TraceId(..),
    Tracer(..),
    TracingInstructions(..),
    MonadTracer(..),
    HasSpanId(..),
    ToSpanTag(..),
    Tag(..),

    recordSpan,
    debugPrintSpan
    ) where

import Control.Arrow ((&&&))
import Control.Exception.Lifted (bracket)
import Control.Monad.Trans (liftIO, MonadIO)
import Control.Monad.Reader (MonadReader, ask, local)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString.Lazy as BSL
import Data.Time.Clock (NominalDiffTime, UTCTime, getCurrentTime, diffUTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Data.Int
import Data.Aeson (ToJSON, encode)
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import Data.String (IsString)
import System.Random (randomRIO)
import Data.IORef (IORef, atomicModifyIORef',readIORef)
import qualified Data.Map.Strict as M
import Web.HttpApiData (FromHttpApiData)

-- | Human-readable name for the span
newtype OpName = OpName Text
    deriving (OpName -> OpName -> Bool
(OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool) -> Eq OpName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpName -> OpName -> Bool
$c/= :: OpName -> OpName -> Bool
== :: OpName -> OpName -> Bool
$c== :: OpName -> OpName -> Bool
Eq, Eq OpName
Eq OpName
-> (OpName -> OpName -> Ordering)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> Bool)
-> (OpName -> OpName -> OpName)
-> (OpName -> OpName -> OpName)
-> Ord OpName
OpName -> OpName -> Bool
OpName -> OpName -> Ordering
OpName -> OpName -> OpName
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 :: OpName -> OpName -> OpName
$cmin :: OpName -> OpName -> OpName
max :: OpName -> OpName -> OpName
$cmax :: OpName -> OpName -> OpName
>= :: OpName -> OpName -> Bool
$c>= :: OpName -> OpName -> Bool
> :: OpName -> OpName -> Bool
$c> :: OpName -> OpName -> Bool
<= :: OpName -> OpName -> Bool
$c<= :: OpName -> OpName -> Bool
< :: OpName -> OpName -> Bool
$c< :: OpName -> OpName -> Bool
compare :: OpName -> OpName -> Ordering
$ccompare :: OpName -> OpName -> Ordering
$cp1Ord :: Eq OpName
Ord, Int -> OpName -> ShowS
[OpName] -> ShowS
OpName -> String
(Int -> OpName -> ShowS)
-> (OpName -> String) -> ([OpName] -> ShowS) -> Show OpName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpName] -> ShowS
$cshowList :: [OpName] -> ShowS
show :: OpName -> String
$cshow :: OpName -> String
showsPrec :: Int -> OpName -> ShowS
$cshowsPrec :: Int -> OpName -> ShowS
Show, String -> OpName
(String -> OpName) -> IsString OpName
forall a. (String -> a) -> IsString a
fromString :: String -> OpName
$cfromString :: String -> OpName
IsString)

-- | An opaque & unique identifier for a trace segment, called a Span
newtype SpanId = SpanId Int64
    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, ByteString -> Either Text SpanId
Text -> Either Text SpanId
(Text -> Either Text SpanId)
-> (ByteString -> Either Text SpanId)
-> (Text -> Either Text SpanId)
-> FromHttpApiData SpanId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text SpanId
$cparseQueryParam :: Text -> Either Text SpanId
parseHeader :: ByteString -> Either Text SpanId
$cparseHeader :: ByteString -> Either Text SpanId
parseUrlPiece :: Text -> Either Text SpanId
$cparseUrlPiece :: Text -> Either Text SpanId
FromHttpApiData)

-- | An opaque & unique identifier for a logical operation. Traces are composed of many 'Span's
newtype TraceId = TraceId Int64
    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, ByteString -> Either Text TraceId
Text -> Either Text TraceId
(Text -> Either Text TraceId)
-> (ByteString -> Either Text TraceId)
-> (Text -> Either Text TraceId)
-> FromHttpApiData TraceId
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text TraceId
$cparseQueryParam :: Text -> Either Text TraceId
parseHeader :: ByteString -> Either Text TraceId
$cparseHeader :: ByteString -> Either Text TraceId
parseUrlPiece :: Text -> Either Text TraceId
$cparseUrlPiece :: Text -> Either Text TraceId
FromHttpApiData)

class HasSpanId a where
    getSpanId :: a -> SpanId
    setSpanId ::  a -> SpanId -> a

-- | Indicates that the current monad can provide a 'Tracer' and related context.
-- It assumes some form of environment. While this exposes some mutable state, all
-- of it is hidden away behind the `recordSpan` api.
class (Monad m, HasSpanId r, MonadReader r m) => MonadTracer m r where
    getTracer :: m Tracer -- ^ 'Tracer' is global to the process
    currentTrace :: m TraceId -- ^ Set during the initial request from the outside world, this is propagated across all nodes in the call
    isDebug :: m Bool -- ^ Set during the initial request from the outside world, this is propagated across all nodes in the call

    currentSpan :: m SpanId
    currentSpan = r -> SpanId
forall a. HasSpanId a => a -> SpanId
getSpanId (r -> SpanId) -> m r -> m SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Wraps a computation & writes it to the 'Tracer''s IORef. To start a new top-level span, and therefore
-- a new trace, call this function with *spanType* == 'Nothing'. Otherwise, this will create a child span.
--
-- Doesn't support parallel computations yet
recordSpan :: (MonadIO m, MonadBaseControl IO m, MonadTracer m r) =>
    Maybe SpanRelationTag
    -> [Tag]
    -> OpName
    -> m a
    -> m a
recordSpan :: Maybe SpanRelationTag -> [Tag] -> OpName -> m a -> m a
recordSpan Maybe SpanRelationTag
spanType [Tag]
tags OpName
opName m a
action = do
    Tracer {$sel:svcName:Tracer :: Tracer -> Text
svcName=Text
serviceName, IORef [Span]
$sel:spanBuffer:Tracer :: Tracer -> IORef [Span]
spanBuffer :: IORef [Span]
spanBuffer} <- m Tracer
forall (m :: * -> *) r. MonadTracer m r => m Tracer
getTracer
    SpanId
activeSpanId <- m SpanId
forall (m :: * -> *) r. MonadTracer m r => m SpanId
currentSpan
    TraceId
traceId <- m TraceId
forall (m :: * -> *) r. MonadTracer m r => m TraceId
currentTrace
    Bool
debug <- m Bool
forall (m :: * -> *) r. MonadTracer m r => m Bool
isDebug

    -- generates a thunk that completes once the action provided to 'recordSpan' finishes.
    -- While this is running, there is a new "activeSpanId" that any children will use. Nested calls
    -- generate a stack of spans.
    let startSpan :: m ActiveSpan
startSpan = do
            UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            SpanId
newSpanId <- (Int64 -> SpanId) -> m Int64 -> m SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> SpanId
SpanId (m Int64 -> m SpanId)
-> (IO Int64 -> m Int64) -> IO Int64 -> m SpanId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m SpanId) -> IO Int64 -> m SpanId
forall a b. (a -> b) -> a -> b
$ (Int64, Int64) -> IO Int64
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int64
0, Int64
forall a. Bounded a => a
maxBound)
            let loggedSpanId :: SpanId
loggedSpanId = SpanId -> SpanId -> SpanId
resolveSpanId SpanId
activeSpanId SpanId
newSpanId
                rel :: [SpanRelation]
rel = TraceId -> SpanId -> [SpanRelation]
newSpanRelation TraceId
traceId SpanId
activeSpanId
                makeSpan :: UTCTime -> Span
makeSpan UTCTime
ts =
                    Span :: OpName
-> SpanContext
-> POSIXTime
-> POSIXTime
-> [SpanRelation]
-> Map Text SpanTag
-> Map Text Text
-> Bool
-> Text
-> Span
Span {
                        $sel:operationName:Span :: OpName
operationName = OpName
opName,
                        $sel:context:Span :: SpanContext
context = TraceId -> SpanId -> SpanContext
SpanContext TraceId
traceId SpanId
loggedSpanId,
                        $sel:timestamp:Span :: POSIXTime
timestamp = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
now,
                        $sel:relations:Span :: [SpanRelation]
relations = [SpanRelation]
rel,
                        $sel:tags:Span :: Map Text SpanTag
tags = [(Text, SpanTag)] -> Map Text SpanTag
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, SpanTag)] -> Map Text SpanTag)
-> [(Text, SpanTag)] -> Map Text SpanTag
forall a b. (a -> b) -> a -> b
$ (\(Tag Text
key a
t) -> (Text
key, a -> SpanTag
forall a. ToSpanTag a => a -> SpanTag
toSpanTag a
t) ) (Tag -> (Text, SpanTag)) -> [Tag] -> [(Text, SpanTag)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag]
tags,
                        $sel:baggage:Span :: Map Text Text
baggage = Map Text Text
forall k a. Map k a
M.empty, -- TODO Allow adding these
                        $sel:duration:Span :: POSIXTime
duration = UTCTime -> UTCTime -> POSIXTime
diffUTCTime UTCTime
ts UTCTime
now,
                        Bool
$sel:debug:Span :: Bool
debug :: Bool
debug,
                        Text
$sel:serviceName:Span :: Text
serviceName :: Text
serviceName
                        }
            ActiveSpan -> m ActiveSpan
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveSpan -> m ActiveSpan) -> ActiveSpan -> m ActiveSpan
forall a b. (a -> b) -> a -> b
$ SpanId -> (UTCTime -> Span) -> ActiveSpan
ActiveSpan SpanId
loggedSpanId UTCTime -> Span
makeSpan


        closeSpan :: ActiveSpan -> m ()
closeSpan (ActiveSpan SpanId
_ UTCTime -> Span
finishSpan) = do
            UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            let span :: Span
span = UTCTime -> Span
finishSpan UTCTime
now
                sid :: SpanId
sid = SpanContext -> SpanId
spanId (Span -> SpanContext
context Span
span :: SpanContext)
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [Span] -> ([Span] -> ([Span], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Span]
spanBuffer (\[Span]
xs -> (Span
spanSpan -> [Span] -> [Span]
forall a. a -> [a] -> [a]
:[Span]
xs, ()))

        runAction :: ActiveSpan -> m a
runAction (ActiveSpan SpanId
spanId UTCTime -> Span
_) =
            (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (r -> SpanId -> r
forall a. HasSpanId a => a -> SpanId -> a
`setSpanId` SpanId
spanId) m a
action

    m ActiveSpan -> (ActiveSpan -> m ()) -> (ActiveSpan -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m ActiveSpan
startSpan
            ActiveSpan -> m ()
closeSpan
            ActiveSpan -> m a
runAction
    where
        -- When this is a top level span, there should be no SpanRelationTag. These two functions work
        -- together to ensure the spans nest properly
        resolveSpanId :: SpanId -> SpanId -> SpanId
resolveSpanId SpanId
activeSpanId SpanId
newSpanId =
            if Maybe SpanRelationTag -> Bool
forall a. Maybe a -> Bool
isJust Maybe SpanRelationTag
spanType
            then SpanId
newSpanId
            else SpanId
activeSpanId
        newSpanRelation :: TraceId -> SpanId -> [SpanRelation]
newSpanRelation TraceId
traceId SpanId
activeSpanId =
            case Maybe SpanRelationTag
spanType of
                Just SpanRelationTag
Child -> [SpanContext -> SpanRelation
ChildOf (SpanContext -> SpanRelation) -> SpanContext -> SpanRelation
forall a b. (a -> b) -> a -> b
$ TraceId -> SpanId -> SpanContext
SpanContext TraceId
traceId SpanId
activeSpanId]
                Just SpanRelationTag
Follows -> [SpanContext -> SpanRelation
FollowsFrom (SpanContext -> SpanRelation) -> SpanContext -> SpanRelation
forall a b. (a -> b) -> a -> b
$ TraceId -> SpanId -> SpanContext
SpanContext TraceId
traceId SpanId
activeSpanId]
                Maybe SpanRelationTag
Nothing -> []

-- | Instructions that are specific to a single trace
data TracingInstructions =
    TracingInstructions {
        TracingInstructions -> TraceId
traceId :: !TraceId,
        TracingInstructions -> SpanId
spanId :: !SpanId,
        TracingInstructions -> Maybe SpanId
parentSpanId :: !(Maybe SpanId),
        TracingInstructions -> Bool
debug :: !Bool,
        TracingInstructions -> Bool
sample :: !Bool
        } deriving (TracingInstructions -> TracingInstructions -> Bool
(TracingInstructions -> TracingInstructions -> Bool)
-> (TracingInstructions -> TracingInstructions -> Bool)
-> Eq TracingInstructions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracingInstructions -> TracingInstructions -> Bool
$c/= :: TracingInstructions -> TracingInstructions -> Bool
== :: TracingInstructions -> TracingInstructions -> Bool
$c== :: TracingInstructions -> TracingInstructions -> Bool
Eq, Int -> TracingInstructions -> ShowS
[TracingInstructions] -> ShowS
TracingInstructions -> String
(Int -> TracingInstructions -> ShowS)
-> (TracingInstructions -> String)
-> ([TracingInstructions] -> ShowS)
-> Show TracingInstructions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracingInstructions] -> ShowS
$cshowList :: [TracingInstructions] -> ShowS
show :: TracingInstructions -> String
$cshow :: TracingInstructions -> String
showsPrec :: Int -> TracingInstructions -> ShowS
$cshowsPrec :: Int -> TracingInstructions -> ShowS
Show)

data ActiveSpan =
    ActiveSpan {ActiveSpan -> SpanId
asid :: SpanId, ActiveSpan -> UTCTime -> Span
finishSpan :: UTCTime -> Span}

-- | Global context required for tracing. The `spanBuffer` should be manually drained by library users.
data Tracer =
    Tracer {
        Tracer -> IORef [Span]
spanBuffer :: IORef [Span],
        Tracer -> Text
svcName :: T.Text
    }

-- | Uniquely identifies a given 'Span' & points to its encompasing trace
data SpanContext =
    SpanContext {
        SpanContext -> TraceId
traceId :: !TraceId,
        SpanContext -> SpanId
spanId :: !SpanId
    } deriving (SpanContext -> SpanContext -> Bool
(SpanContext -> SpanContext -> Bool)
-> (SpanContext -> SpanContext -> Bool) -> Eq SpanContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanContext -> SpanContext -> Bool
$c/= :: SpanContext -> SpanContext -> Bool
== :: SpanContext -> SpanContext -> Bool
$c== :: SpanContext -> SpanContext -> Bool
Eq, Int -> SpanContext -> ShowS
[SpanContext] -> ShowS
SpanContext -> String
(Int -> SpanContext -> ShowS)
-> (SpanContext -> String)
-> ([SpanContext] -> ShowS)
-> Show SpanContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanContext] -> ShowS
$cshowList :: [SpanContext] -> ShowS
show :: SpanContext -> String
$cshow :: SpanContext -> String
showsPrec :: Int -> SpanContext -> ShowS
$cshowsPrec :: Int -> SpanContext -> ShowS
Show)

-- | Spans may be top level, a child, or logically follow from a given span.
data SpanRelation =
    ChildOf !SpanContext | FollowsFrom !SpanContext
    deriving (SpanRelation -> SpanRelation -> Bool
(SpanRelation -> SpanRelation -> Bool)
-> (SpanRelation -> SpanRelation -> Bool) -> Eq SpanRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanRelation -> SpanRelation -> Bool
$c/= :: SpanRelation -> SpanRelation -> Bool
== :: SpanRelation -> SpanRelation -> Bool
$c== :: SpanRelation -> SpanRelation -> Bool
Eq, Int -> SpanRelation -> ShowS
[SpanRelation] -> ShowS
SpanRelation -> String
(Int -> SpanRelation -> ShowS)
-> (SpanRelation -> String)
-> ([SpanRelation] -> ShowS)
-> Show SpanRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanRelation] -> ShowS
$cshowList :: [SpanRelation] -> ShowS
show :: SpanRelation -> String
$cshow :: SpanRelation -> String
showsPrec :: Int -> SpanRelation -> ShowS
$cshowsPrec :: Int -> SpanRelation -> ShowS
Show)

-- | Indicates the type of relation this span represents
data SpanRelationTag = Child | Follows

-- | A timed section of code with a logical name and 'SpanContext'. Individual spans will be reconstructed by an
-- OpenTracing backend into a single trace.
data Span = Span {
    Span -> OpName
operationName :: !OpName,
    Span -> SpanContext
context :: !SpanContext,
    Span -> POSIXTime
timestamp :: !POSIXTime,
    Span -> POSIXTime
duration :: !NominalDiffTime,
    Span -> [SpanRelation]
relations :: ![SpanRelation],
    Span -> Map Text SpanTag
tags :: !(M.Map Text SpanTag),
    Span -> Map Text Text
baggage:: !(M.Map Text Text),
    Span -> Bool
debug :: !Bool,
    Span -> Text
serviceName :: !Text
    } deriving Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show

-- | Dump the details of a span. Used for debugging or logging
debugPrintSpan ::
    Span
    -> Text
debugPrintSpan :: Span -> Text
debugPrintSpan Span
span =
    Text
"Span: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"id ["Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>(SpanId -> Text
unSpan (SpanId -> Text) -> SpanId -> Text
forall a b. (a -> b) -> a -> b
$ SpanContext -> SpanId
spanId (Span -> SpanContext
context Span
span :: SpanContext))Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"] "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"op ["Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>(OpName -> Text
unOp (OpName -> Text) -> OpName -> Text
forall a b. (a -> b) -> a -> b
$ Span -> OpName
operationName Span
span)Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"] "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"duration ["Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>(String -> Text
T.pack (String -> Text) -> (POSIXTime -> String) -> POSIXTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> String
forall a. Show a => a -> String
show (POSIXTime -> Text) -> POSIXTime -> Text
forall a b. (a -> b) -> a -> b
$ Span -> POSIXTime
duration Span
span)Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"relations "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>(String -> Text
T.pack (String -> Text)
-> ([SpanRelation] -> String) -> [SpanRelation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SpanRelation] -> String
forall a. Show a => a -> String
show ([SpanRelation] -> Text) -> [SpanRelation] -> Text
forall a b. (a -> b) -> a -> b
$ Span -> [SpanRelation]
relations Span
span)
    where
        unOp :: OpName -> Text
unOp (OpName Text
o) = Text
o
        unSpan :: SpanId -> Text
unSpan (SpanId Int64
s) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
s

-- | Used to embed additional information into a Span for consumption & viewing in a tracing backend
data SpanTag
    = TagString !Text
    | TagBool !Bool
    | TagInt !Int64
    | TagDouble !Double
    deriving (SpanTag -> SpanTag -> Bool
(SpanTag -> SpanTag -> Bool)
-> (SpanTag -> SpanTag -> Bool) -> Eq SpanTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanTag -> SpanTag -> Bool
$c/= :: SpanTag -> SpanTag -> Bool
== :: SpanTag -> SpanTag -> Bool
$c== :: SpanTag -> SpanTag -> Bool
Eq, Int -> SpanTag -> ShowS
[SpanTag] -> ShowS
SpanTag -> String
(Int -> SpanTag -> ShowS)
-> (SpanTag -> String) -> ([SpanTag] -> ShowS) -> Show SpanTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanTag] -> ShowS
$cshowList :: [SpanTag] -> ShowS
show :: SpanTag -> String
$cshow :: SpanTag -> String
showsPrec :: Int -> SpanTag -> ShowS
$cshowsPrec :: Int -> SpanTag -> ShowS
Show)

-- | Allows for easily representing multiple types in a tag list
data Tag = forall a. ToSpanTag a => Tag T.Text a

-- | The type in question may be converted into a 'SpanTag'
class ToSpanTag a where
    toSpanTag :: a -> SpanTag

instance ToSpanTag SpanTag where
    toSpanTag :: SpanTag -> SpanTag
toSpanTag = SpanTag -> SpanTag
forall a. a -> a
id

instance ToJSON a => ToSpanTag a where
    toSpanTag :: a -> SpanTag
toSpanTag = Text -> SpanTag
TagString (Text -> SpanTag) -> (a -> Text) -> a -> SpanTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode