{-|
Module: OpenTracing

The [OpenTracing spec](https://github.com/opentracing/specification/blob/master/specification.md) defines a platform agnostic approach for distributed tracing. Distributed
tracing gives us insights into how complex programs spread across multiple processes are
performing together.

This package provides a core implementation of the OpenTracing spec. It includes
functionality to

  * Create `Span`s describing application code executions, including `Tag`s and
    `LogRecord`s

  * Serialize and deserialize `SpanContext`s across process boundaries

  * Batch and log `FinishedSpan`s

It does not provide any functionality for consuming `Span`s. There are platform specific
backends (CloudTrace, Zipkin, Jaeger, etc) that are provided in other packages.

-}
{-# LANGUAGE ConstraintKinds  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes       #-}
{-# LANGUAGE StrictData       #-}

module OpenTracing
    ( -- * Distributed tracing
      -- | These are mtl style constraints and runners for working with tracers in
      -- a distributed environment. When traces cross process boundaries (for example
      -- in an RPC call, information about the `SpanContext` needs to be transmitted
      -- from one process to another, so that all `Span`s in the same trace can be
      -- reported in the same trace forest.
      --
      -- To satisfy these constraints, you have to have access to a `Propagation` in
      -- the application environment, which manages serialization and deserialization of
      -- `SpanContext`s.
      HasOpenTracing
    , MonadOpenTracing
    , runOpenTracing

      -- * Local tracing
      -- | If you aren't tracing a distributed system, these simpler constraints
      -- will work. The only thing required is a `Tracer.Tracer` in the application
      -- context. If the program execution crosses process boundaries, no serialization
      -- will be performed.
    , MonadTracer
    , Tracer.Tracer(..)
    , Tracer.HasTracer(..)
    , Tracer.runTracer

    -- * Tracing functions
    -- | Functions to trace application code
    , traced
    , traced_
    , startSpan
    , finishSpan

    -- * Propagation
    -- | Functions for serialization and deserialization in a distributed tracing
    -- environment
    , extract
    , inject

    -- * Additional modules
    , module OpenTracing.Log
    , module OpenTracing.Propagation
    , module OpenTracing.Sampling
    , module OpenTracing.Span
    , module OpenTracing.Tags
    , module OpenTracing.Types
    )
where

import           Control.Exception.Safe
import           Control.Lens
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           OpenTracing.Log
import           OpenTracing.Propagation hiding (inject, extract)
import qualified OpenTracing.Propagation as Propagation
import           OpenTracing.Sampling
import           OpenTracing.Span
import           OpenTracing.Tags
import qualified OpenTracing.Tracer      as Tracer
import           OpenTracing.Types
import           Prelude                 hiding (span)


type HasOpenTracing   r p   = (Tracer.HasTracer r, HasPropagation r p)
type MonadOpenTracing r p m = (HasOpenTracing r p, MonadReader r m)
type MonadTracer      r   m = (Tracer.HasTracer r, MonadReader r m)
type MonadPropagation r p m = (HasPropagation r p, MonadReader r m)


runOpenTracing :: HasOpenTracing r p => r -> ReaderT r m a -> m a
runOpenTracing :: r -> ReaderT r m a -> m a
runOpenTracing = (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

-- | Trace a computation as a span. This is a high-level operation that will handle
-- all aspects of the trace, including timing and reporting. If the traced computation
-- throws an excpetion, `traced` will clean up and add logs before rethrowing the
-- exception
--
-- @
--         traced (spanOpts "hello" mempty          ) $ \parent ->
--         traced (spanOpts "world" (childOf parent)) $ \child ->
--            liftIO $ do
--                putStrLn "doing some work..."
--                addLogRecord child (Message "doing some work")
--                threadDelay 500000
-- @
--
traced
    :: ( MonadTracer r m
       , MonadMask     m
       , MonadIO       m
       )
    => SpanOpts
    -- ^ The options to use when creating the span. Options include:
    --
    --   * Operation name
    --
    --   * Tags
    --
    --   * Relations to other spans
    -> (ActiveSpan -> m a)
    -- ^ the computation to trace. The argument is the
    -- span that is created. It can be used to:
    --
    --   * Add logs
    --
    --   * Add child spans
    -> m (Traced  a)
traced :: SpanOpts -> (ActiveSpan -> m a) -> m (Traced a)
traced SpanOpts
opt ActiveSpan -> m a
f = Getting Tracer r Tracer -> m Tracer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tracer r Tracer
forall a r. HasTracer a => Getting r a Tracer
Tracer.tracer m Tracer -> (Tracer -> m (Traced a)) -> m (Traced a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Tracer
t -> Tracer -> SpanOpts -> (ActiveSpan -> m a) -> m (Traced a)
forall t (m :: * -> *) a.
(HasTracer t, MonadMask m, MonadIO m) =>
t -> SpanOpts -> (ActiveSpan -> m a) -> m (Traced a)
Tracer.traced Tracer
t SpanOpts
opt ActiveSpan -> m a
f

-- | Variant of `traced` that doesn't return the wrapped value.
traced_
    :: ( MonadTracer r m
       , MonadMask     m
       , MonadIO       m
       )
    => SpanOpts
    -> (ActiveSpan -> m a)
    -> m a
traced_ :: SpanOpts -> (ActiveSpan -> m a) -> m a
traced_ SpanOpts
opt ActiveSpan -> m a
f = Traced a -> a
forall a. Traced a -> a
tracedResult (Traced a -> a) -> m (Traced a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpanOpts -> (ActiveSpan -> m a) -> m (Traced a)
forall r (m :: * -> *) a.
(MonadTracer r m, MonadMask m, MonadIO m) =>
SpanOpts -> (ActiveSpan -> m a) -> m (Traced a)
traced SpanOpts
opt ActiveSpan -> m a
f

startSpan
    :: ( MonadTracer r m
       , MonadIO       m
       )
    => SpanOpts
    -> m ActiveSpan
startSpan :: SpanOpts -> m ActiveSpan
startSpan SpanOpts
opt = Getting Tracer r Tracer -> m Tracer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tracer r Tracer
forall a r. HasTracer a => Getting r a Tracer
Tracer.tracer m Tracer -> (Tracer -> m ActiveSpan) -> m ActiveSpan
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tracer -> SpanOpts -> m ActiveSpan)
-> SpanOpts -> Tracer -> m ActiveSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tracer -> SpanOpts -> m ActiveSpan
forall t (m :: * -> *).
(HasTracer t, MonadIO m) =>
t -> SpanOpts -> m ActiveSpan
Tracer.startSpan SpanOpts
opt

finishSpan
    :: ( MonadTracer r m
       , MonadIO       m
       )
    => ActiveSpan
    -> m FinishedSpan
finishSpan :: ActiveSpan -> m FinishedSpan
finishSpan ActiveSpan
a = Getting Tracer r Tracer -> m Tracer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tracer r Tracer
forall a r. HasTracer a => Getting r a Tracer
Tracer.tracer m Tracer -> (Tracer -> m FinishedSpan) -> m FinishedSpan
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tracer -> ActiveSpan -> m FinishedSpan)
-> ActiveSpan -> Tracer -> m FinishedSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tracer -> ActiveSpan -> m FinishedSpan
forall t (m :: * -> *).
(HasTracer t, MonadIO m) =>
t -> ActiveSpan -> m FinishedSpan
Tracer.finishSpan ActiveSpan
a

-- | Serialize a `SpanContext` into the format `c` using a serializer from
-- the application context. See `OpenTracing.Propagation` for more info.
inject
    :: forall c r p m.
       ( MonadPropagation r p m
       , HasCarrier       c p
       )
    => SpanContext
    -> m c
inject :: SpanContext -> m c
inject SpanContext
ctx = (Propagation p -> SpanContext -> c)
-> SpanContext -> Propagation p -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip Propagation p -> SpanContext -> c
forall c r (p :: [*]).
(HasCarrier c p, HasPropagation r p) =>
r -> SpanContext -> c
Propagation.inject SpanContext
ctx (Propagation p -> c) -> m (Propagation p) -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Propagation p) r (Propagation p) -> m (Propagation p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Propagation p) r (Propagation p)
forall a (p :: [*]) r.
HasPropagation a p =>
Getting r a (Propagation p)
propagation

-- | Attempt to deserialize a `SpanContext` from the format @c@ using a deserializer
-- from the application context. See `OpenTracing.Propagation` for more info.
extract
    :: forall c r p m.
       ( MonadPropagation r p m
       , HasCarrier       c p
       )
    => c
    -> m (Maybe SpanContext)
extract :: c -> m (Maybe SpanContext)
extract c
c = (Propagation p -> c -> Maybe SpanContext)
-> c -> Propagation p -> Maybe SpanContext
forall a b c. (a -> b -> c) -> b -> a -> c
flip Propagation p -> c -> Maybe SpanContext
forall c r (p :: [*]).
(HasCarrier c p, HasPropagation r p) =>
r -> c -> Maybe SpanContext
Propagation.extract c
c (Propagation p -> Maybe SpanContext)
-> m (Propagation p) -> m (Maybe SpanContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Propagation p) r (Propagation p) -> m (Propagation p)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Propagation p) r (Propagation p)
forall a (p :: [*]) r.
HasPropagation a p =>
Getting r a (Propagation p)
propagation