{-# LANGUAGE OverloadedLists #-}

{- |
 Module      :  OpenTelemetry.Trace.Sampler
 Copyright   :  (c) Ian Duncan, 2021
 License     :  BSD-3
 Description :  Sampling strategies for reducing tracing overhead
 Maintainer  :  Ian Duncan
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)

 This module provides several built-in sampling strategies, as well as the ability to define custom samplers.

 Sampling is the concept of selecting a few elements from a large collection and learning about the entire collection by extrapolating from the selected set. It’s widely used throughout the world whenever trying to tackle a problem of scale: for example, a survey assumes that by asking a small group of people a set of questions, you can learn something about the opinions of the entire populace.

 While it’s nice to believe that every event is precious, the reality of monitoring high volume production infrastructure is that there are some attributes to events that make them more interesting than the rest. Failures are often more interesting than successes! Rare events are more interesting than common events! Capturing some traffic from all customers can be better than capturing all traffic from some customers.

 Sampling as a basic technique for instrumentation is no different—by recording information about a representative subset of requests flowing through a system, you can learn about the overall performance of the system. And as with surveys and air monitoring, the way you choose your representative set (the sample set) can greatly influence the accuracy of your results.

 Sampling is widespread in observability systems because it lowers the cost of producing, collecting, and analyzing data in systems anywhere cost is a concern. Developers and operators in an observability system apply or attach key=value properties to observability data–spans and metrics–and we use these properties to investigate hypotheses about our systems after the fact. It is interesting to look at how sampling impacts our ability to analyze observability data, using key=value restrictions for some keys and grouping the output based on other keys.

 Sampling schemes let observability systems collect examples of data that are not merely exemplary, but also representative. Sampling schemes compute a set of representative items and, in doing so, score each item with what is commonly called the item's "sampling rate." A sampling rate of 10 indicates that the item represents an estimated 10 individuals in the original data set.
-}
module OpenTelemetry.Trace.Sampler (
  Sampler (..),
  SamplingResult (..),
  parentBased,
  parentBasedOptions,
  ParentBasedOptions (..),
  traceIdRatioBased,
  alwaysOn,
  alwaysOff,
) where

import Data.Binary.Get
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Text
import Data.Word (Word64)
import OpenTelemetry.Attributes (toAttribute)
import OpenTelemetry.Context
import OpenTelemetry.Internal.Trace.Types
import OpenTelemetry.Trace.Id
import OpenTelemetry.Trace.TraceState as TraceState


{- | Returns @RecordAndSample@ always.

 Description returns AlwaysOnSampler.

 @since 0.1.0.0
-}
alwaysOn :: Sampler
alwaysOn :: Sampler
alwaysOn =
  Sampler
    { getDescription :: Text
getDescription = Text
"AlwaysOnSampler"
    , shouldSample :: Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample = \Context
ctxt TraceId
_ Text
_ SpanArguments
_ -> do
        Maybe SpanContext
mspanCtxt <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Maybe Span
lookupSpan Context
ctxt)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplingResult
RecordAndSample, [], forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceState
TraceState.empty SpanContext -> TraceState
traceState Maybe SpanContext
mspanCtxt)
    }


{- | Returns @Drop@ always.

 Description returns AlwaysOffSampler.

 @since 0.1.0.0
-}
alwaysOff :: Sampler
alwaysOff :: Sampler
alwaysOff =
  Sampler
    { getDescription :: Text
getDescription = Text
"AlwaysOffSampler"
    , shouldSample :: Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample = \Context
ctxt TraceId
_ Text
_ SpanArguments
_ -> do
        Maybe SpanContext
mspanCtxt <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Maybe Span
lookupSpan Context
ctxt)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplingResult
Drop, [], forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceState
TraceState.empty SpanContext -> TraceState
traceState Maybe SpanContext
mspanCtxt)
    }


{- | The TraceIdRatioBased ignores the parent SampledFlag. To respect the parent SampledFlag,
 the TraceIdRatioBased should be used as a delegate of the @parentBased@ sampler specified below.

 Description returns a string of the form "TraceIdRatioBased{RATIO}" with RATIO replaced with the Sampler
 instance's trace sampling ratio represented as a decimal number.

 @since 0.1.0.0
-}
traceIdRatioBased :: Double -> Sampler
traceIdRatioBased :: Double -> Sampler
traceIdRatioBased Double
fraction =
  if Double
fraction forall a. Ord a => a -> a -> Bool
>= Double
1
    then Sampler
alwaysOn
    else Sampler
sampler
  where
    safeFraction :: Double
safeFraction = forall a. Ord a => a -> a -> a
max Double
fraction Double
0
    sampleRate :: Attribute
sampleRate =
      if Double
safeFraction forall a. Ord a => a -> a -> Bool
> Double
0
        then forall a. ToAttribute a => a -> Attribute
toAttribute ((forall a b. (RealFrac a, Integral b) => a -> b
round (Double
1 forall a. Fractional a => a -> a -> a
/ Double
safeFraction)) :: Int)
        else forall a. ToAttribute a => a -> Attribute
toAttribute (Int
0 :: Int)

    traceIdUpperBound :: Word64
traceIdUpperBound = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
fraction forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
1 :: Word64) forall a. Bits a => a -> Int -> a
`shiftL` Int
63)) :: Word64
    sampler :: Sampler
sampler =
      Sampler
        { getDescription :: Text
getDescription = Text
"TraceIdRatioBased{" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Double
fraction) forall a. Semigroup a => a -> a -> a
<> Text
"}"
        , shouldSample :: Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample = \Context
ctxt TraceId
tid Text
_ SpanArguments
_ -> do
            Maybe SpanContext
mspanCtxt <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Maybe Span
lookupSpan Context
ctxt)
            let x :: Word64
x = forall a. Get a -> ByteString -> a
runGet Get Word64
getWord64be (ByteString -> ByteString
L.fromStrict forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take Int
8 forall a b. (a -> b) -> a -> b
$ TraceId -> ByteString
traceIdBytes TraceId
tid) forall a. Bits a => a -> Int -> a
`shiftR` Int
1
            if Word64
x forall a. Ord a => a -> a -> Bool
< Word64
traceIdUpperBound
              then do
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplingResult
RecordAndSample, [(Text
"sampleRate", Attribute
sampleRate)], forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceState
TraceState.empty SpanContext -> TraceState
traceState Maybe SpanContext
mspanCtxt)
              else forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplingResult
Drop, [], forall b a. b -> (a -> b) -> Maybe a -> b
maybe TraceState
TraceState.empty SpanContext -> TraceState
traceState Maybe SpanContext
mspanCtxt)
        }


{- | This is a composite sampler. ParentBased helps distinguish between the following cases:

 No parent (root span).

 Remote parent (SpanContext.IsRemote() == true) with SampledFlag equals true

 Remote parent (SpanContext.IsRemote() == true) with SampledFlag equals false

 Local parent (SpanContext.IsRemote() == false) with SampledFlag equals true

 Local parent (SpanContext.IsRemote() == false) with SampledFlag equals false

 @since 0.1.0.0
-}
data ParentBasedOptions = ParentBasedOptions
  { ParentBasedOptions -> Sampler
rootSampler :: Sampler
  -- ^ Sampler called for spans with no parent (root spans)
  , ParentBasedOptions -> Sampler
remoteParentSampled :: Sampler
  -- ^ default: alwaysOn
  , ParentBasedOptions -> Sampler
remoteParentNotSampled :: Sampler
  -- ^ default: alwaysOff
  , ParentBasedOptions -> Sampler
localParentSampled :: Sampler
  -- ^ default: alwaysOn
  , ParentBasedOptions -> Sampler
localParentNotSampled :: Sampler
  -- ^ default: alwaysOff
  }


{- | A smart constructor for 'ParentBasedOptions' with reasonable starting
 defaults.

 @since 0.1.0.0
-}
parentBasedOptions
  :: Sampler
  -- ^ Root sampler
  -> ParentBasedOptions
parentBasedOptions :: Sampler -> ParentBasedOptions
parentBasedOptions Sampler
root =
  ParentBasedOptions
    { rootSampler :: Sampler
rootSampler = Sampler
root
    , remoteParentSampled :: Sampler
remoteParentSampled = Sampler
alwaysOn
    , remoteParentNotSampled :: Sampler
remoteParentNotSampled = Sampler
alwaysOff
    , localParentSampled :: Sampler
localParentSampled = Sampler
alwaysOn
    , localParentNotSampled :: Sampler
localParentNotSampled = Sampler
alwaysOff
    }


{- | A sampler which behaves differently based on the incoming sampling decision.

 In general, this will sample spans that have parents that were sampled, and will not sample spans whose parents were not sampled.

 @since 0.1.0.0
-}
parentBased :: ParentBasedOptions -> Sampler
parentBased :: ParentBasedOptions -> Sampler
parentBased ParentBasedOptions {Sampler
localParentNotSampled :: Sampler
localParentSampled :: Sampler
remoteParentNotSampled :: Sampler
remoteParentSampled :: Sampler
rootSampler :: Sampler
localParentNotSampled :: ParentBasedOptions -> Sampler
localParentSampled :: ParentBasedOptions -> Sampler
remoteParentNotSampled :: ParentBasedOptions -> Sampler
remoteParentSampled :: ParentBasedOptions -> Sampler
rootSampler :: ParentBasedOptions -> Sampler
..} =
  Sampler
    { getDescription :: Text
getDescription =
        Text
"ParentBased{root="
          forall a. Semigroup a => a -> a -> a
<> Sampler -> Text
getDescription Sampler
rootSampler
          forall a. Semigroup a => a -> a -> a
<> Text
", remoteParentSampled="
          forall a. Semigroup a => a -> a -> a
<> Sampler -> Text
getDescription Sampler
remoteParentSampled
          forall a. Semigroup a => a -> a -> a
<> Text
", remoteParentNotSampled="
          forall a. Semigroup a => a -> a -> a
<> Sampler -> Text
getDescription Sampler
remoteParentNotSampled
          forall a. Semigroup a => a -> a -> a
<> Text
", localParentSampled="
          forall a. Semigroup a => a -> a -> a
<> Sampler -> Text
getDescription Sampler
localParentSampled
          forall a. Semigroup a => a -> a -> a
<> Text
", localParentNotSampled="
          forall a. Semigroup a => a -> a -> a
<> Sampler -> Text
getDescription Sampler
localParentNotSampled
          forall a. Semigroup a => a -> a -> a
<> Text
"}"
    , shouldSample :: Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample = \Context
ctx TraceId
tid Text
name SpanArguments
csa -> do
        Maybe SpanContext
mspanCtxt <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Maybe Span
lookupSpan Context
ctx)
        case Maybe SpanContext
mspanCtxt of
          Maybe SpanContext
Nothing -> Sampler
-> Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample Sampler
rootSampler Context
ctx TraceId
tid Text
name SpanArguments
csa
          Just SpanContext
root ->
            if SpanContext -> Bool
OpenTelemetry.Internal.Trace.Types.isRemote SpanContext
root
              then
                if TraceFlags -> Bool
isSampled forall a b. (a -> b) -> a -> b
$ SpanContext -> TraceFlags
traceFlags SpanContext
root
                  then Sampler
-> Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample Sampler
remoteParentSampled Context
ctx TraceId
tid Text
name SpanArguments
csa
                  else Sampler
-> Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample Sampler
remoteParentNotSampled Context
ctx TraceId
tid Text
name SpanArguments
csa
              else
                if TraceFlags -> Bool
isSampled forall a b. (a -> b) -> a -> b
$ SpanContext -> TraceFlags
traceFlags SpanContext
root
                  then Sampler
-> Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample Sampler
localParentSampled Context
ctx TraceId
tid Text
name SpanArguments
csa
                  else Sampler
-> Context
-> TraceId
-> Text
-> SpanArguments
-> IO (SamplingResult, HashMap Text Attribute, TraceState)
shouldSample Sampler
localParentNotSampled Context
ctx TraceId
tid Text
name SpanArguments
csa
    }