-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE RankNTypes #-}

{- | The domain-span tracing ports, and the bracket Pilot opens its own spans through.

The serve path, the mirror worker, and the advisory sync task reach their hand-added spans
through a port: bracket operations as a record, parametric in the bracketed action's result
and naming no OpenTelemetry tracer, so the application supplies the OTel-backed
implementations and a test a pass-through double. Pilot's passes run outside a request and
hold the 'TracerProvider' themselves, so they bracket through 'withOptionalSpan' instead.
Both consumers create their tracer under 'ecluseScope'.
-}
module Ecluse.Core.Telemetry.Span (
    -- * The serve-path tracing port
    TracingPort (..),

    -- * The worker tracing port
    WorkerTracingPort (..),
    JobSpanOutcome (..),

    -- * The advisory sync tracing port
    AdvisorySyncTracingPort (..),

    -- * Bracketing a span against an optional tracer
    ecluseScope,
    withOptionalSpan,
    openOptionalSpan,
    closeOptionalSpan,
) where

import OpenTelemetry.Context qualified as Ctx
import OpenTelemetry.Trace.Core (
    Span,
    SpanKind,
    TracerProvider,
    createSpan,
    defaultSpanArguments,
    endSpan,
    kind,
    makeTracer,
    tracerOptions,
 )
import UnliftIO (MonadUnliftIO, bracket)

import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Package (PackageName)
import Ecluse.Core.Queue (RemoteSpanContext)
import Ecluse.Core.Server.Response (ServeDecision)
import Ecluse.Core.Telemetry.Metrics (AdvisorySyncResult)
import Ecluse.Core.Version (Version)

{- | The domain-span tracing port: bracket operations over a backend whose closure captures its
tracer. The implementation is inert when tracing is off, so a call site brackets unconditionally.
-}
data TracingPort = TracingPort
    { TracingPort
-> forall a.
   PackageName -> Version -> IO (a, ServeDecision) -> IO a
spanRuleEval :: forall a. PackageName -> Version -> IO (a, ServeDecision) -> IO a
    {- ^ Bracket the per-version rule evaluation. The 'ServeDecision' the body yields goes on the
    span, so a refusal is explainable from the trace alone.
    -}
    , TracingPort
-> forall a.
   PackageName
   -> Version
   -> Text
   -> (a -> Maybe Text)
   -> (Maybe RemoteSpanContext -> IO a)
   -> IO a
spanMirrorEnqueue ::
        forall a.
        PackageName ->
        Version ->
        Text ->
        (a -> Maybe Text) ->
        (Maybe RemoteSpanContext -> IO a) ->
        IO a
    {- ^ Bracket the serve-time hand-off to the asynchronous mirror. The body stamps the
    supplied span context onto the job, linking the worker's span across the async hop.
    -}
    , TracingPort -> forall a. PackageName -> IO a -> IO a
spanPackumentGate ::
        forall a.
        PackageName ->
        IO a ->
        IO a
    {- ^ Bracket the gating phase of a packument request, which runs the rules and filter on
    the public upstream document.
    -}
    , TracingPort -> forall a. PackageName -> IO a -> IO a
spanMetadataFetch ::
        forall a.
        PackageName ->
        IO a ->
        IO a
    -- ^ Bracket one upstream metadata fetch, refusals included.
    , TracingPort -> forall a. PackageName -> IO a -> IO a
spanMetadataDecode ::
        forall a.
        PackageName ->
        IO a ->
        IO a
    -- ^ Bracket extraction after a successful metadata response. Streaming body reads can occur inside.
    }

{- | The mirror worker's domain-span tracing port: the worker analogue of 'TracingPort'. The
implementation is inert when tracing is off, so the worker brackets unconditionally.
-}
newtype WorkerTracingPort = WorkerTracingPort
    { WorkerTracingPort
-> forall a.
   PackageName
   -> Version
   -> Maybe RemoteSpanContext
   -> (a -> JobSpanOutcome)
   -> IO a
   -> IO a
wtpMirrorJobSpan ::
        forall a.
        PackageName ->
        Version ->
        Maybe RemoteSpanContext ->
        (a -> JobSpanOutcome) ->
        IO a ->
        IO a
    {- ^ Bracket the worker's per-job fetch, verify, and publish. The supplied context links
    the span back to the enqueueing request, and is 'Nothing' when the job carried none.
    -}
    }

{- | The outcome projection a caller supplies for the mirror-job span. It is its own record so
the tracing port does not depend on the worker loop.
-}
data JobSpanOutcome = JobSpanOutcome
    { JobSpanOutcome -> Text
jobSpanLabel :: Text
    -- ^ The bounded outcome label (e.g. @succeeded@ \/ @dropped@ \/ @retried@).
    , JobSpanOutcome -> Maybe Text
jobSpanError :: Maybe Text
    -- ^ The failure detail when the job did not publish. 'Nothing' on success.
    }
    deriving stock (JobSpanOutcome -> JobSpanOutcome -> Bool
(JobSpanOutcome -> JobSpanOutcome -> Bool)
-> (JobSpanOutcome -> JobSpanOutcome -> Bool) -> Eq JobSpanOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JobSpanOutcome -> JobSpanOutcome -> Bool
== :: JobSpanOutcome -> JobSpanOutcome -> Bool
$c/= :: JobSpanOutcome -> JobSpanOutcome -> Bool
/= :: JobSpanOutcome -> JobSpanOutcome -> Bool
Eq, Int -> JobSpanOutcome -> ShowS
[JobSpanOutcome] -> ShowS
JobSpanOutcome -> String
(Int -> JobSpanOutcome -> ShowS)
-> (JobSpanOutcome -> String)
-> ([JobSpanOutcome] -> ShowS)
-> Show JobSpanOutcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JobSpanOutcome -> ShowS
showsPrec :: Int -> JobSpanOutcome -> ShowS
$cshow :: JobSpanOutcome -> String
show :: JobSpanOutcome -> String
$cshowList :: [JobSpanOutcome] -> ShowS
showList :: [JobSpanOutcome] -> ShowS
Show)

{- | One span per advisory sync attempt. It carries the same 'AdvisorySyncResult' that labels
the attempt metrics, so a trace and a series join on one vocabulary.
-}
newtype AdvisorySyncTracingPort = AdvisorySyncTracingPort
    { AdvisorySyncTracingPort
-> forall a. Ecosystem -> (a -> AdvisorySyncResult) -> IO a -> IO a
astpSyncAttemptSpan ::
        forall a.
        Ecosystem ->
        (a -> AdvisorySyncResult) ->
        IO a ->
        IO a
    -- ^ Bracket one advisory sync attempt for an ecosystem, recording the projected result.
    }

{- | The instrumentation scope the hand-added spans and the WAI meter are created under, so the
signals are attributed to Écluse rather than to a third-party instrumentation library.
-}
ecluseScope :: (IsString s) => s
ecluseScope :: forall s. IsString s => s
ecluseScope = s
"ecluse"

{- | Run @body@ against a span opened on @mTracerProvider@, or against 'Nothing' when there is
none, which opens no span. The span roots its own trace: no ambient context is consulted.
-}
withOptionalSpan :: (MonadUnliftIO m) => Maybe TracerProvider -> SpanKind -> Text -> (Maybe Span -> m a) -> m a
withOptionalSpan :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe TracerProvider
-> SpanKind -> Text -> (Maybe Span -> m a) -> m a
withOptionalSpan Maybe TracerProvider
mTracerProvider SpanKind
spanKind Text
name =
    m (Maybe Span)
-> (Maybe Span -> m ()) -> (Maybe Span -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Maybe TracerProvider -> SpanKind -> Text -> m (Maybe Span)
forall (m :: * -> *).
MonadIO m =>
Maybe TracerProvider -> SpanKind -> Text -> m (Maybe Span)
openOptionalSpan Maybe TracerProvider
mTracerProvider SpanKind
spanKind Text
name) Maybe Span -> m ()
forall (m :: * -> *). MonadIO m => Maybe Span -> m ()
closeOptionalSpan

{- | The acquire half of 'withOptionalSpan', for a @conduit@ pass that brackets through
@bracketP@ rather than 'bracket'.
-}
openOptionalSpan :: (MonadIO m) => Maybe TracerProvider -> SpanKind -> Text -> m (Maybe Span)
openOptionalSpan :: forall (m :: * -> *).
MonadIO m =>
Maybe TracerProvider -> SpanKind -> Text -> m (Maybe Span)
openOptionalSpan Maybe TracerProvider
mTracerProvider SpanKind
spanKind Text
name = case Maybe TracerProvider
mTracerProvider of
    Maybe TracerProvider
Nothing -> Maybe Span -> m (Maybe Span)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Span
forall a. Maybe a
Nothing
    Just TracerProvider
tracerProvider ->
        let tracer :: Tracer
tracer = TracerProvider -> InstrumentationLibrary -> TracerOptions -> Tracer
makeTracer TracerProvider
tracerProvider InstrumentationLibrary
forall s. IsString s => s
ecluseScope TracerOptions
tracerOptions
         in Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> m Span -> m (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tracer -> Context -> Text -> SpanArguments -> m Span
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Tracer -> Context -> Text -> SpanArguments -> m Span
createSpan Tracer
tracer Context
Ctx.empty Text
name SpanArguments
defaultSpanArguments{kind = spanKind}

-- | The release half of 'withOptionalSpan'. Ending at the current instant, as 'Nothing' asks.
closeOptionalSpan :: (MonadIO m) => Maybe Span -> m ()
closeOptionalSpan :: forall (m :: * -> *). MonadIO m => Maybe Span -> m ()
closeOptionalSpan Maybe Span
mSpan = Maybe Span -> (Span -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Span
mSpan (Span -> Maybe Timestamp -> m ()
forall (m :: * -> *). MonadIO m => Span -> Maybe Timestamp -> m ()
`endSpan` Maybe Timestamp
forall a. Maybe a
Nothing)