graphql-engine/server/src-lib/Hasura/Tracing/Sampling.hs
Antoine Leblanc cf531b05cb Rewrite Tracing to allow for only one TraceT in the entire stack.
This PR is on top of #7789.

### Description

This PR entirely rewrites the API of the Tracing library, to make `interpTraceT` a thing of the past. Before this change, we ran traces by sticking a `TraceT` on top of whatever we were doing. This had several major drawbacks:
- we were carrying a bunch of `TraceT` across the codebase, and the entire codebase had to know about it
- we needed to carry a second class constraint around (`HasReporterM`) to be able to run all of those traces
- we kept having to do stack rewriting with `interpTraceT`, which went from inconvenient to horrible
- we had to declare several behavioral instances on `TraceT m`

This PR rewrite all of `Tracing` using a more conventional model: there is ONE `TraceT` at the bottom of the stack, and there is an associated class constraint `MonadTrace`: any part of the code that happens to satisfy `MonadTrace` is able to create new traces. We NEVER have to do stack rewriting, `interpTraceT` is gone, and `TraceT` and `Reporter` become  implementation details that 99% of the code is blissfully unaware of: code that needs to do tracing only needs to declare that the monad in which it operates implements `MonadTrace`.

In doing so, this PR revealed **several bugs in the codebase**: places where we were expecting to trace something, but due to the default instance of `HasReporterM IO` we would actually not do anything. This PR also splits the code of `Tracing` in more byte-sized modules, with the goal of potentially moving to `server/lib` down the line.

### Remaining work

This PR is a draft; what's left to do is:
- [x] make Pro compile; i haven't updated `HasuraPro/Main` yet
- [x] document Tracing by writing a note that explains how to use the library, and the meaning of "reporter", "trace" and "span", as well as the pitfalls
- [x] discuss some of the trade-offs in the implementation, which is why i'm opening this PR already despite it not fully building yet
- [x] it depends on #7789 being merged first

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7791
GitOrigin-RevId: cadd32d039134c93ddbf364599a2f4dd988adea8
2023-03-13 17:38:39 +00:00

89 lines
2.8 KiB
Haskell

module Hasura.Tracing.Sampling
( -- * SamplingState
SamplingState (..),
samplingStateToHeader,
samplingStateFromHeader,
-- * SamplingDecision
SamplingDecision (..),
-- * SamplingPolicy
SamplingPolicy,
sampleNever,
sampleAlways,
sampleRandomly,
sampleOneInN,
)
where
import Hasura.Prelude
import Refined (Positive, Refined, unrefine)
import System.Random.Stateful qualified as Random
--------------------------------------------------------------------------------
-- SamplingState
-- | B3 propagation sampling state.
--
-- Debug sampling state not represented.
data SamplingState = SamplingDefer | SamplingDeny | SamplingAccept
-- | Convert a sampling state to a value for the X-B3-Sampled header. A return
-- value of Nothing indicates that the header should not be set.
samplingStateToHeader :: IsString s => SamplingState -> Maybe s
samplingStateToHeader = \case
SamplingDefer -> Nothing
SamplingDeny -> Just "0"
SamplingAccept -> Just "1"
-- | Convert a X-B3-Sampled header value to a sampling state. An input of
-- Nothing indicates that the header was not set.
samplingStateFromHeader :: (IsString s, Eq s) => Maybe s -> SamplingState
samplingStateFromHeader = \case
Nothing -> SamplingDefer
Just "0" -> SamplingDeny
Just "1" -> SamplingAccept
Just _ -> SamplingDefer
--------------------------------------------------------------------------------
-- SamplingDecision
-- | A local decision about whether or not to sample spans.
data SamplingDecision = SampleNever | SampleAlways
--------------------------------------------------------------------------------
-- SamplingPolicy
-- | An IO action for deciding whether or not to sample a trace.
--
-- Currently restricted to deny access to the B3 sampling state, but we may
-- want to be more flexible in the future.
type SamplingPolicy = IO SamplingDecision
sampleNever :: SamplingPolicy
sampleNever = pure SampleNever
sampleAlways :: SamplingPolicy
sampleAlways = pure SampleAlways
-- @sampleRandomly p@ returns `SampleAlways` with probability @p@ and
-- `SampleNever` with probability @1 - p@.
sampleRandomly :: Double -> SamplingPolicy
sampleRandomly samplingProbability
| samplingProbability <= 0 = pure SampleNever
| samplingProbability >= 1 = pure SampleAlways
| otherwise = do
x <- Random.uniformRM (0, 1) Random.globalStdGen
pure $ if x < samplingProbability then SampleAlways else SampleNever
-- Like @sampleRandomly@, but with the probability expressed as the denominator
-- N of the fraction 1/N.
sampleOneInN :: Refined Positive Int -> SamplingPolicy
sampleOneInN denominator
| n == 1 = pure SampleAlways
| otherwise = do
x <- Random.uniformRM (0, n - 1) Random.globalStdGen
pure $ if x == 0 then SampleAlways else SampleNever
where
n = unrefine denominator