-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The instrument handle and the typed @record*@ helpers behind
"Ecluse.Runtime.Telemetry.Instruments", which documents the catalogue and re-exports the curated
surface. Importing this module opts out of that stability promise, the convention @text@ and
@bytestring@ use, so production code imports the public one.
-}
module Ecluse.Runtime.Telemetry.Instruments.Internal (
    -- * The instrument handle
    Metrics,
    newMetrics,

    -- * The core recording ports
    metricsPortOf,
    workerMetricsPortOf,
    dredgerMetricsPortOf,
    advisorySyncMetricsPortOf,
    advisoryCompileMetricsPortOf,

    -- * Serve decision
    recordServeDecision,

    -- * Rule gate
    recordRuleDenial,
    recordRuleEvalDuration,
    recordRuleEffectfulFailure,
    recordBreakerState,

    -- * Upstream fetch (data plane)
    recordUpstreamFetch,
    recordUpstreamFetchError,

    -- * Metadata cache
    recordCacheRequest,
    recordCacheEntries,

    -- * Mirror
    recordMirrorEnqueued,
    recordMirrorEnqueueFailure,
    recordMirrorJobProcessed,
    recordMirrorPublishDuration,

    -- * Credentials
    recordCredentialRefresh,
    registerCredentialTokenTtl,

    -- * Advisory sync
    recordAdvisorySyncAttempt,
    recordAdvisorySyncDuration,

    -- * Advisory ages (observable)
    registerAdvisoryDatabaseAge,
    reportAdvisoryDatabaseAge,
    registerAdvisorySourceAge,
    reportAdvisorySourceAge,

    -- * Memory budget (observable)
    registerMemoryMeter,

    -- * Advisory compile
    recordAdvisoryCompileAccepted,
    recordAdvisoryCompileDropped,
    recordAdvisoryCompileRun,
) where

import Data.Time (UTCTime, diffUTCTime, getCurrentTime)
import GHC.Clock (getMonotonicTime)
import OpenTelemetry.Metric.Core (
    Counter (counterAdd),
    Gauge (gaugeRecord),
    Histogram (histogramRecord),
    Meter,
    MeterProvider,
    ObservableGauge (observableGaugeRegisterCallback),
    ObservableResult (observe),
    UpDownCounter (upDownCounterAdd),
    defaultAdvisoryParameters,
    getMeter,
    meterCreateCounterInt64,
    meterCreateGaugeInt64,
    meterCreateHistogram,
    meterCreateObservableGaugeInt64,
    meterCreateUpDownCounterInt64,
    noopMeterProvider,
 )

import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Server.Admission.Types (MeterSnapshot (..), brakeLevelCode)
import Ecluse.Core.Telemetry.Catalogue (
    MetricName (..),
    metricName,
 )
import Ecluse.Core.Telemetry.Metrics (
    AdvisoryCompileResult,
    AdvisoryDropCause,
    AdvisorySyncResult,
    BreakerSource,
    BreakerState,
    CacheResult,
    Cause,
    CredentialResult,
    Decision,
    Label (LAdvisoryCompileResult, LAdvisoryDropCause, LAdvisorySyncResult, LBreakerSource, LCacheResult, LCacheStore, LCause, LCredentialResult, LDecision, LEcosystem, LMirrorResult, LPerimeterCause, LProvider, LReasonClass, LRelayAnomaly, LRule, LStatusClass, LSweepResult, LSweepTarget, LTier, LUpstream),
    MirrorResult,
    Provider,
    ReasonClass,
    RelayAnomaly,
    RequestFaultCause,
    StatusClass,
    SweepResult,
    SweepTarget,
    Tier,
    Upstream,
    breakerStateCode,
    metricAttributes,
 )
import Ecluse.Core.Telemetry.Record (AdvisoryCompileMetricsPort (..), AdvisorySyncMetricsPort (..), DredgerMetricsPort (..), MetricsPort (..), WorkerMetricsPort (..))
import Ecluse.Core.Telemetry.Span (ecluseScope)
import Ecluse.Runtime.Telemetry (Telemetry, telemetryMeterProvider)

-- | Domain instruments. WAI emits @http.server.request.duration@ from its own meter.
data Metrics = Metrics
    { Metrics -> Counter Int64
mServeDecision :: Counter Int64
    , Metrics -> UpDownCounter Int64
mServeAdmissionInFlight :: UpDownCounter Int64
    , Metrics -> Counter Int64
mServeAdmissionQueued :: Counter Int64
    , Metrics -> UpDownCounter Int64
mPublishBodyInFlightBytes :: UpDownCounter Int64
    , Metrics -> Counter Int64
mPublishBodyShed :: Counter Int64
    , Metrics -> Counter Int64
mMergeDivergence :: Counter Int64
    , Metrics -> Counter Int64
mRuleDenials :: Counter Int64
    , Metrics -> Histogram
mRuleEvalDuration :: Histogram
    , Metrics -> Counter Int64
mRuleEffectfulFailures :: Counter Int64
    , Metrics -> Gauge Int64
mRuleBreakerState :: Gauge Int64
    , Metrics -> Histogram
mUpstreamFetchDuration :: Histogram
    , Metrics -> Counter Int64
mUpstreamFetchErrors :: Counter Int64
    , Metrics -> Counter Int64
mMetadataCacheRequests :: Counter Int64
    , Metrics -> Counter Int64
mSingleVersionCacheRequests :: Counter Int64
    , Metrics -> Counter Int64
mAssembledCacheRequests :: Counter Int64
    , Metrics -> Counter Int64
mMetadataCacheRefused :: Counter Int64
    , Metrics -> Gauge Int64
mMetadataCacheEntries :: Gauge Int64
    , Metrics -> Gauge Int64
mMetadataCacheResidentBytes :: Gauge Int64
    , Metrics -> Gauge Int64
mSingleVersionCacheResidentBytes :: Gauge Int64
    , Metrics -> Gauge Int64
mAssembledCacheResidentBytes :: Gauge Int64
    , Metrics -> Counter Int64
mServeRelayAnomalies :: Counter Int64
    , Metrics -> Counter Int64
mServePerimeterFaults :: Counter Int64
    , Metrics -> Counter Int64
mMirrorEnqueued :: Counter Int64
    , Metrics -> Counter Int64
mMirrorEnqueueFailures :: Counter Int64
    , Metrics -> Counter Int64
mMirrorJobsProcessed :: Counter Int64
    , Metrics -> Histogram
mMirrorPublishDuration :: Histogram
    , Metrics -> Counter Int64
mDredgerVersions :: Counter Int64
    , Metrics -> Counter Int64
mCredentialRefresh :: Counter Int64
    , Metrics -> ObservableGauge Int64
mCredentialTokenTtlSeconds :: ObservableGauge Int64
    , Metrics -> Counter Int64
mAdvisorySyncAttempts :: Counter Int64
    , Metrics -> Histogram
mAdvisorySyncDuration :: Histogram
    , Metrics -> ObservableGauge Int64
mAdvisoryDatabaseAgeSeconds :: ObservableGauge Int64
    , Metrics -> ObservableGauge Int64
mAdvisorySourceAgeSeconds :: ObservableGauge Int64
    , Metrics -> Counter Int64
mAdvisoryCompileAccepted :: Counter Int64
    , Metrics -> Counter Int64
mAdvisoryCompileDropped :: Counter Int64
    , Metrics -> Counter Int64
mAdvisoryCompileRuns :: Counter Int64
    , Metrics -> ObservableGauge Int64
mMemoryAdmissionBudgetBytes :: ObservableGauge Int64
    , Metrics -> ObservableGauge Int64
mMemoryAdmissionChargedBytes :: ObservableGauge Int64
    , Metrics -> ObservableGauge Int64
mMemoryAdmissionBrakeLevel :: ObservableGauge Int64
    , Metrics -> ObservableGauge Int64
mMemoryAdmissionWaiting :: ObservableGauge Int64
    , Metrics -> ObservableGauge Int64
mMemoryAdmissionPausedNow :: ObservableGauge Int64
    , Metrics -> Counter Int64
mMemoryAdmissionQueued :: Counter Int64
    , Metrics -> Counter Int64
mMemoryAdmissionShed :: Counter Int64
    , Metrics -> Counter Int64
mMemoryAdmissionPauses :: Counter Int64
    , Metrics -> Counter Int64
mMemoryAdmissionOverdraws :: Counter Int64
    }

-- | Build instruments on the telemetry meter, or the SDK's no-op meter when disabled.
newMetrics :: Telemetry -> IO Metrics
newMetrics :: Telemetry -> IO Metrics
newMetrics Telemetry
telemetry = do
    let meterProvider :: MeterProvider
        meterProvider :: MeterProvider
meterProvider = MeterProvider -> Maybe MeterProvider -> MeterProvider
forall a. a -> Maybe a -> a
fromMaybe MeterProvider
noopMeterProvider (Telemetry -> Maybe MeterProvider
telemetryMeterProvider Telemetry
telemetry)
    meter <- MeterProvider -> InstrumentationLibrary -> IO Meter
getMeter MeterProvider
meterProvider InstrumentationLibrary
forall s. IsString s => s
ecluseScope
    Metrics
        <$> counter meter ServeDecision "{decision}" "serve decisions by admit/deny/unavailable"
        <*> upDownCounter meter ServeAdmissionInFlight "{request}" "in-flight metadata parses"
        <*> counter meter ServeAdmissionQueued "{request}" "admissions that waited for a slot"
        <*> upDownCounter meter PublishBodyInFlightBytes "By" "bytes reserved for buffered publish bodies"
        <*> counter meter PublishBodyShed "{request}" "publishes shed at the body-byte budget"
        <*> counter meter MergeDivergence "{divergence}" "cross-upstream integrity divergences detected in the packument merge"
        <*> counter meter RuleDenials "{denial}" "rule denials by rule and reason class"
        <*> histogram meter RuleEvalDuration "rule-evaluation latency by tier"
        <*> counter meter RuleEffectfulFailures "{failure}" "effectful-rule failures by cause"
        <*> gauge meter RuleBreakerState "circuit-breaker state by source (0 closed, 1 half-open, 2 open)"
        <*> histogram meter UpstreamFetchDuration "upstream metadata-fetch latency by upstream and status class"
        <*> counter meter UpstreamFetchErrors "{error}" "upstream metadata-fetch errors by upstream and cause"
        <*> counter meter MetadataCacheRequests "{request}" "full-store requests by hit/miss/collapsed"
        <*> counter meter SingleVersionCacheRequests "{request}" "selected-version requests by hit/miss/collapsed"
        <*> counter meter AssembledCacheRequests "{request}" "assembled-response requests by hit/miss/collapsed"
        <*> counter meter MetadataCacheRefused "{entry}" "capacity refusals and external backend failures by store"
        <*> gauge meter MetadataCacheEntries "metadata-cache occupancy"
        <*> gauge meter MetadataCacheResidentBytes "full-packument metadata-cache resident bytes"
        <*> gauge meter SingleVersionCacheResidentBytes "single-version metadata-cache resident bytes"
        <*> gauge meter AssembledCacheResidentBytes "assembled-representation store resident bytes"
        <*> counter meter ServeRelayAnomalies "{relay}" "public relays that were not the admitted artifact, by class"
        <*> counter meter ServePerimeterFaults "{fault}" "pre-commit handler escapes answered by the request perimeter, by cause"
        <*> counter meter MirrorEnqueued "{job}" "mirror jobs enqueued"
        <*> counter meter MirrorEnqueueFailures "{failure}" "mirror enqueue failures"
        <*> counter meter MirrorJobsProcessed "{job}" "mirror jobs processed by result"
        <*> histogram meter MirrorPublishDuration "mirror publish latency"
        <*> counter meter DredgerVersions "{version}" "versions a sweep cycle disposed of, by target and result"
        <*> counter meter CredentialRefresh "{refresh}" "credential refreshes by result and provider"
        <*> observableGauge meter CredentialTokenTtlSeconds "remaining outbound-token lifetime by provider"
        <*> counter meter AdvisorySyncAttempts "{attempt}" "advisory sync attempts by ecosystem and result"
        <*> histogram meter AdvisorySyncDuration "advisory sync attempt latency by ecosystem and result"
        <*> observableGauge meter AdvisoryDatabaseAgeSeconds "seconds since this ecosystem's serving advisory database was installed"
        <*> observableGauge meter AdvisorySourceAgeSeconds "seconds since this ecosystem's serving advisory artifact was published"
        <*> counter meter AdvisoryCompileAccepted "{advisory}" "advisory entries a compile pass accepted, by ecosystem"
        <*> counter meter AdvisoryCompileDropped "{advisory}" "advisory entries a compile pass dropped, by ecosystem and cause"
        <*> counter meter AdvisoryCompileRuns "{run}" "advisory compile passes by ecosystem and result"
        <*> observableGauge meter MemoryAdmissionBudgetBytes "the metadata memory budget in bytes"
        <*> observableGauge meter MemoryAdmissionChargedBytes "bytes metadata requests hold against the memory budget"
        <*> observableGauge meter MemoryAdmissionBrakeLevel "memory brake level (0 calm, 1 holding, 2 braking)"
        <*> observableGauge meter MemoryAdmissionWaiting "new requests waiting at the memory gate"
        <*> observableGauge meter MemoryAdmissionPausedNow "started requests paused for memory"
        <*> counter meter MemoryAdmissionQueued "{request}" "requests that waited for their memory entry step"
        <*> counter meter MemoryAdmissionShed "{request}" "requests shed at the memory gate"
        <*> counter meter MemoryAdmissionPauses "{pause}" "times a started request paused for memory"
        <*> counter meter MemoryAdmissionOverdraws "{step}" "steps the overdraw token holder took past the memory budget"

counter :: Meter -> MetricName -> Text -> Text -> IO (Counter Int64)
counter :: Meter -> MetricName -> Text -> Text -> IO (Counter Int64)
counter Meter
meter MetricName
name Text
unit Text
description =
    Meter
-> Text
-> Maybe Text
-> Maybe Text
-> AdvisoryParameters
-> IO (Counter Int64)
meterCreateCounterInt64 Meter
meter (MetricName -> Text
metricName MetricName
name) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
unit) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description) AdvisoryParameters
defaultAdvisoryParameters

histogram :: Meter -> MetricName -> Text -> IO Histogram
histogram :: Meter -> MetricName -> Text -> IO Histogram
histogram Meter
meter MetricName
name Text
description =
    Meter
-> Text
-> Maybe Text
-> Maybe Text
-> AdvisoryParameters
-> IO Histogram
meterCreateHistogram Meter
meter (MetricName -> Text
metricName MetricName
name) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"s") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description) AdvisoryParameters
defaultAdvisoryParameters

upDownCounter :: Meter -> MetricName -> Text -> Text -> IO (UpDownCounter Int64)
upDownCounter :: Meter -> MetricName -> Text -> Text -> IO (UpDownCounter Int64)
upDownCounter Meter
meter MetricName
name Text
unit Text
description =
    Meter
-> Text
-> Maybe Text
-> Maybe Text
-> AdvisoryParameters
-> IO (UpDownCounter Int64)
meterCreateUpDownCounterInt64 Meter
meter (MetricName -> Text
metricName MetricName
name) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
unit) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description) AdvisoryParameters
defaultAdvisoryParameters

gauge :: Meter -> MetricName -> Text -> IO (Gauge Int64)
gauge :: Meter -> MetricName -> Text -> IO (Gauge Int64)
gauge Meter
meter MetricName
name Text
description =
    Meter
-> Text
-> Maybe Text
-> Maybe Text
-> AdvisoryParameters
-> IO (Gauge Int64)
meterCreateGaugeInt64 Meter
meter (MetricName -> Text
metricName MetricName
name) Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description) AdvisoryParameters
defaultAdvisoryParameters

-- Reports nothing until a callback is registered.
observableGauge :: Meter -> MetricName -> Text -> IO (ObservableGauge Int64)
observableGauge :: Meter -> MetricName -> Text -> IO (ObservableGauge Int64)
observableGauge Meter
meter MetricName
name Text
description =
    Meter
-> Text
-> Maybe Text
-> Maybe Text
-> AdvisoryParameters
-> [ObservableResult Int64 -> IO ()]
-> IO (ObservableGauge Int64)
meterCreateObservableGaugeInt64 Meter
meter (MetricName -> Text
metricName MetricName
name) Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description) AdvisoryParameters
defaultAdvisoryParameters []

{- | Project the instruments onto the core 'MetricsPort' that "Ecluse.Core.Server.Pipeline" records
through. It is inert when telemetry is off, since the instruments are.
-}
metricsPortOf :: Metrics -> MetricsPort
metricsPortOf :: Metrics -> MetricsPort
metricsPortOf Metrics
m =
    MetricsPort
        { mpServeDecision :: Decision -> IO ()
mpServeDecision = Metrics -> Decision -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Decision -> m ()
recordServeDecision Metrics
m
        , mpServeAdmissionInFlight :: Int -> IO ()
mpServeAdmissionInFlight = Metrics -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordServeAdmissionInFlight Metrics
m
        , mpServeAdmissionQueued :: IO ()
mpServeAdmissionQueued = Metrics -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordServeAdmissionQueued Metrics
m
        , mpPublishBodyInFlightBytes :: Int -> IO ()
mpPublishBodyInFlightBytes = \Int
delta -> UpDownCounter Int64 -> Int64 -> [Label] -> IO ()
forall (m :: * -> *).
MonadIO m =>
UpDownCounter Int64 -> Int64 -> [Label] -> m ()
addDelta (Metrics -> UpDownCounter Int64
mPublishBodyInFlightBytes Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
delta) []
        , mpPublishBodyShed :: IO ()
mpPublishBodyShed = Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mPublishBodyShed Metrics
m) []
        , mpMemoryAdmissionQueued :: IO ()
mpMemoryAdmissionQueued = Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMemoryAdmissionQueued Metrics
m) []
        , mpMemoryAdmissionShed :: IO ()
mpMemoryAdmissionShed = Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMemoryAdmissionShed Metrics
m) []
        , mpMemoryAdmissionPause :: IO ()
mpMemoryAdmissionPause = Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMemoryAdmissionPauses Metrics
m) []
        , mpMemoryAdmissionOverdraw :: IO ()
mpMemoryAdmissionOverdraw = Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMemoryAdmissionOverdraws Metrics
m) []
        , mpMergeDivergence :: IO ()
mpMergeDivergence = Metrics -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMergeDivergence Metrics
m
        , mpRuleDenial :: Maybe Text -> ReasonClass -> IO ()
mpRuleDenial = Metrics -> Maybe Text -> ReasonClass -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Maybe Text -> ReasonClass -> m ()
recordRuleDenial Metrics
m
        , mpRuleEvalDuration :: Tier -> Double -> IO ()
mpRuleEvalDuration = Metrics -> Tier -> Double -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Tier -> Double -> m ()
recordRuleEvalDuration Metrics
m
        , mpRuleEffectfulFailure :: Cause -> IO ()
mpRuleEffectfulFailure = Metrics -> Cause -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Cause -> m ()
recordRuleEffectfulFailure Metrics
m
        , mpUpstreamFetch :: Upstream -> StatusClass -> Double -> IO ()
mpUpstreamFetch = Metrics -> Upstream -> StatusClass -> Double -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Upstream -> StatusClass -> Double -> m ()
recordUpstreamFetch Metrics
m
        , mpUpstreamFetchError :: Upstream -> Cause -> IO ()
mpUpstreamFetchError = Metrics -> Upstream -> Cause -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Upstream -> Cause -> m ()
recordUpstreamFetchError Metrics
m
        , mpCacheRequest :: CacheResult -> IO ()
mpCacheRequest = Metrics -> CacheResult -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> CacheResult -> m ()
recordCacheRequest Metrics
m
        , mpVersionCacheRequest :: CacheResult -> IO ()
mpVersionCacheRequest = \CacheResult
result -> Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mSingleVersionCacheRequests Metrics
m) [CacheResult -> Label
LCacheResult CacheResult
result]
        , mpAssembledCacheRequest :: CacheResult -> IO ()
mpAssembledCacheRequest = \CacheResult
result -> Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mAssembledCacheRequests Metrics
m) [CacheResult -> Label
LCacheResult CacheResult
result]
        , mpCacheRefused :: CacheStore -> IO ()
mpCacheRefused = \CacheStore
store -> Counter Int64 -> [Label] -> IO ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMetadataCacheRefused Metrics
m) [CacheStore -> Label
LCacheStore CacheStore
store]
        , mpCacheEntries :: Int -> IO ()
mpCacheEntries = Metrics -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordCacheEntries Metrics
m
        , mpCacheResidentBytes :: Int -> IO ()
mpCacheResidentBytes = Metrics -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordCacheResidentBytes Metrics
m
        , mpVersionCacheResidentBytes :: Int -> IO ()
mpVersionCacheResidentBytes = Metrics -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordVersionCacheResidentBytes Metrics
m
        , mpAssembledCacheResidentBytes :: Int -> IO ()
mpAssembledCacheResidentBytes = Metrics -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordAssembledCacheResidentBytes Metrics
m
        , mpMirrorEnqueued :: IO ()
mpMirrorEnqueued = Metrics -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMirrorEnqueued Metrics
m
        , mpPublicRelayAnomaly :: RelayAnomaly -> IO ()
mpPublicRelayAnomaly = Metrics -> RelayAnomaly -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> RelayAnomaly -> m ()
recordPublicRelayAnomaly Metrics
m
        , mpRequestPerimeterFault :: RequestFaultCause -> IO ()
mpRequestPerimeterFault = Metrics -> RequestFaultCause -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> RequestFaultCause -> m ()
recordRequestPerimeterFault Metrics
m
        , mpMirrorEnqueueFailure :: IO ()
mpMirrorEnqueueFailure = Metrics -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMirrorEnqueueFailure Metrics
m
        }

{- | Project the instruments onto the core 'WorkerMetricsPort' that "Ecluse.Core.Worker" records
through. It is inert when telemetry is off, since the instruments are.
-}
workerMetricsPortOf :: Metrics -> WorkerMetricsPort
workerMetricsPortOf :: Metrics -> WorkerMetricsPort
workerMetricsPortOf Metrics
m =
    WorkerMetricsPort
        { wmpMirrorJobProcessed :: MirrorResult -> IO ()
wmpMirrorJobProcessed = Metrics -> MirrorResult -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> MirrorResult -> m ()
recordMirrorJobProcessed Metrics
m
        , wmpMirrorPublishDuration :: Double -> IO ()
wmpMirrorPublishDuration = Metrics -> Double -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> Double -> m ()
recordMirrorPublishDuration Metrics
m
        }

{- | Project the instruments onto the core 'DredgerMetricsPort' that "Ecluse.Core.Registry.Sweep"
records through. It is inert when telemetry is off, since the instruments are.
-}
dredgerMetricsPortOf :: Metrics -> DredgerMetricsPort
dredgerMetricsPortOf :: Metrics -> DredgerMetricsPort
dredgerMetricsPortOf Metrics
m = DredgerMetricsPort{dmpSweptVersion :: SweepTarget -> SweepResult -> IO ()
dmpSweptVersion = Metrics -> SweepTarget -> SweepResult -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> SweepTarget -> SweepResult -> m ()
recordSweptVersion Metrics
m}

{- | Project the instruments onto the core 'AdvisorySyncMetricsPort' that "Ecluse.Runtime.Cve.Sync"
records through. It is inert when telemetry is off, since the instruments are.
-}
advisorySyncMetricsPortOf :: Metrics -> AdvisorySyncMetricsPort
advisorySyncMetricsPortOf :: Metrics -> AdvisorySyncMetricsPort
advisorySyncMetricsPortOf Metrics
m =
    AdvisorySyncMetricsPort
        { asmpSyncAttempt :: Ecosystem -> AdvisorySyncResult -> IO ()
asmpSyncAttempt = Metrics -> Ecosystem -> AdvisorySyncResult -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisorySyncResult -> m ()
recordAdvisorySyncAttempt Metrics
m
        , asmpSyncDuration :: Ecosystem -> AdvisorySyncResult -> Double -> IO ()
asmpSyncDuration = Metrics -> Ecosystem -> AdvisorySyncResult -> Double -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisorySyncResult -> Double -> m ()
recordAdvisorySyncDuration Metrics
m
        }

-- | Bind compile observations to an ecosystem. An unknown ecosystem records no series.
advisoryCompileMetricsPortOf :: Metrics -> Maybe Ecosystem -> AdvisoryCompileMetricsPort
advisoryCompileMetricsPortOf :: Metrics -> Maybe Ecosystem -> AdvisoryCompileMetricsPort
advisoryCompileMetricsPortOf Metrics
m = AdvisoryCompileMetricsPort
-> (Ecosystem -> AdvisoryCompileMetricsPort)
-> Maybe Ecosystem
-> AdvisoryCompileMetricsPort
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AdvisoryCompileMetricsPort
inertCompilePort Ecosystem -> AdvisoryCompileMetricsPort
boundPort
  where
    boundPort :: Ecosystem -> AdvisoryCompileMetricsPort
boundPort Ecosystem
eco =
        AdvisoryCompileMetricsPort
            { acmpCompileAccepted :: Int -> IO ()
acmpCompileAccepted = Metrics -> Ecosystem -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> Int -> m ()
recordAdvisoryCompileAccepted Metrics
m Ecosystem
eco
            , acmpCompileDropped :: AdvisoryDropCause -> Int -> IO ()
acmpCompileDropped = Metrics -> Ecosystem -> AdvisoryDropCause -> Int -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisoryDropCause -> Int -> m ()
recordAdvisoryCompileDropped Metrics
m Ecosystem
eco
            , acmpCompileRun :: AdvisoryCompileResult -> IO ()
acmpCompileRun = Metrics -> Ecosystem -> AdvisoryCompileResult -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisoryCompileResult -> m ()
recordAdvisoryCompileRun Metrics
m Ecosystem
eco
            }

-- No bounded label to record under, so nothing is recorded.
inertCompilePort :: AdvisoryCompileMetricsPort
inertCompilePort :: AdvisoryCompileMetricsPort
inertCompilePort =
    AdvisoryCompileMetricsPort
        { acmpCompileAccepted :: Int -> IO ()
acmpCompileAccepted = IO () -> Int -> IO ()
forall a b. a -> b -> a
const IO ()
forall (f :: * -> *). Applicative f => f ()
pass
        , acmpCompileDropped :: AdvisoryDropCause -> Int -> IO ()
acmpCompileDropped = \AdvisoryDropCause
_ Int
_ -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass
        , acmpCompileRun :: AdvisoryCompileResult -> IO ()
acmpCompileRun = IO () -> AdvisoryCompileResult -> IO ()
forall a b. a -> b -> a
const IO ()
forall (f :: * -> *). Applicative f => f ()
pass
        }

-- | Record one serve decision (@ecluse.serve.decision@): admit, deny, or unavailable.
recordServeDecision :: (MonadIO m) => Metrics -> Decision -> m ()
recordServeDecision :: forall (m :: * -> *). MonadIO m => Metrics -> Decision -> m ()
recordServeDecision Metrics
m Decision
decision =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mServeDecision Metrics
m) [Decision -> Label
LDecision Decision
decision]

-- Record a change in in-flight metadata parses (@ecluse.serve.admission.in_flight@).
recordServeAdmissionInFlight :: (MonadIO m) => Metrics -> Int -> m ()
recordServeAdmissionInFlight :: forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordServeAdmissionInFlight Metrics
m Int
delta =
    UpDownCounter Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
UpDownCounter Int64 -> Int64 -> [Label] -> m ()
addDelta (Metrics -> UpDownCounter Int64
mServeAdmissionInFlight Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
delta) []

-- Record one admission that waited for a slot before proceeding (@ecluse.serve.admission.queued@).
recordServeAdmissionQueued :: (MonadIO m) => Metrics -> m ()
recordServeAdmissionQueued :: forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordServeAdmissionQueued Metrics
m =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mServeAdmissionQueued Metrics
m) []

-- Count one divergence per contradicting version. Identifiers stay on the warning log, never labels.
recordMergeDivergence :: (MonadIO m) => Metrics -> m ()
recordMergeDivergence :: forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMergeDivergence Metrics
m =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMergeDivergence Metrics
m) []

{- | Record one rule denial (@ecluse.rule.denials@) by reason class and, for a policy denial, the
deciding rule. A non-policy refusal has no rule to attribute, so none is labelled.
-}
recordRuleDenial :: (MonadIO m) => Metrics -> Maybe Text -> ReasonClass -> m ()
recordRuleDenial :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Maybe Text -> ReasonClass -> m ()
recordRuleDenial Metrics
m Maybe Text
rule ReasonClass
reasonClass =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mRuleDenials Metrics
m) ([Label] -> (Text -> [Label]) -> Maybe Text -> [Label]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
name -> [Text -> Label
LRule Text
name]) Maybe Text
rule [Label] -> [Label] -> [Label]
forall a. Semigroup a => a -> a -> a
<> [ReasonClass -> Label
LReasonClass ReasonClass
reasonClass])

-- | Record a rule-evaluation latency sample (@ecluse.rule.eval.duration@) by tier.
recordRuleEvalDuration :: (MonadIO m) => Metrics -> Tier -> Double -> m ()
recordRuleEvalDuration :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Tier -> Double -> m ()
recordRuleEvalDuration Metrics
m Tier
tier Double
seconds =
    Histogram -> Double -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Histogram -> Double -> [Label] -> m ()
record (Metrics -> Histogram
mRuleEvalDuration Metrics
m) Double
seconds [Tier -> Label
LTier Tier
tier]

-- | Record one effectful-rule failure (@ecluse.rule.effectful.failures@) by cause.
recordRuleEffectfulFailure :: (MonadIO m) => Metrics -> Cause -> m ()
recordRuleEffectfulFailure :: forall (m :: * -> *). MonadIO m => Metrics -> Cause -> m ()
recordRuleEffectfulFailure Metrics
m Cause
cause =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mRuleEffectfulFailures Metrics
m) [Cause -> Label
LCause Cause
cause]

{- | Record the current circuit-breaker state (@ecluse.rule.breaker.state@) for a
source as the gauge's bounded ordinal (0 closed, 1 half-open, 2 open).
-}
recordBreakerState :: (MonadIO m) => Metrics -> BreakerSource -> BreakerState -> m ()
recordBreakerState :: forall (m :: * -> *).
MonadIO m =>
Metrics -> BreakerSource -> BreakerState -> m ()
recordBreakerState Metrics
m BreakerSource
source BreakerState
breakerState =
    Gauge Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set (Metrics -> Gauge Int64
mRuleBreakerState Metrics
m) (BreakerState -> Int64
breakerStateCode BreakerState
breakerState) [BreakerSource -> Label
LBreakerSource BreakerSource
source]

-- | Record an upstream metadata-fetch latency sample to @ecluse.upstream.fetch.duration@.
recordUpstreamFetch :: (MonadIO m) => Metrics -> Upstream -> StatusClass -> Double -> m ()
recordUpstreamFetch :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Upstream -> StatusClass -> Double -> m ()
recordUpstreamFetch Metrics
m Upstream
upstream StatusClass
statusClass Double
seconds =
    Histogram -> Double -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Histogram -> Double -> [Label] -> m ()
record (Metrics -> Histogram
mUpstreamFetchDuration Metrics
m) Double
seconds [Upstream -> Label
LUpstream Upstream
upstream, StatusClass -> Label
LStatusClass StatusClass
statusClass]

-- | Record one upstream metadata-fetch error to @ecluse.upstream.fetch.errors@.
recordUpstreamFetchError :: (MonadIO m) => Metrics -> Upstream -> Cause -> m ()
recordUpstreamFetchError :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Upstream -> Cause -> m ()
recordUpstreamFetchError Metrics
m Upstream
upstream Cause
cause =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mUpstreamFetchErrors Metrics
m) [Upstream -> Label
LUpstream Upstream
upstream, Cause -> Label
LCause Cause
cause]

-- | Record one metadata-cache lookup (@ecluse.metadata_cache.requests@) as hit, miss, or collapsed.
recordCacheRequest :: (MonadIO m) => Metrics -> CacheResult -> m ()
recordCacheRequest :: forall (m :: * -> *). MonadIO m => Metrics -> CacheResult -> m ()
recordCacheRequest Metrics
m CacheResult
result =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMetadataCacheRequests Metrics
m) [CacheResult -> Label
LCacheResult CacheResult
result]

-- | Record the metadata cache's current occupancy (@ecluse.metadata_cache.entries@).
recordCacheEntries :: (MonadIO m) => Metrics -> Int -> m ()
recordCacheEntries :: forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordCacheEntries Metrics
m Int
entries =
    Gauge Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set (Metrics -> Gauge Int64
mMetadataCacheEntries Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
entries) []

{- | Record the full-packument metadata cache's resident bytes
(@ecluse.metadata_cache.resident_bytes@).
-}
recordCacheResidentBytes :: (MonadIO m) => Metrics -> Int -> m ()
recordCacheResidentBytes :: forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordCacheResidentBytes Metrics
m Int
bytes =
    Gauge Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set (Metrics -> Gauge Int64
mMetadataCacheResidentBytes Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes) []

{- | Record the single-version metadata cache's resident bytes
(@ecluse.metadata_cache.version.resident_bytes@).
-}
recordVersionCacheResidentBytes :: (MonadIO m) => Metrics -> Int -> m ()
recordVersionCacheResidentBytes :: forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordVersionCacheResidentBytes Metrics
m Int
bytes =
    Gauge Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set (Metrics -> Gauge Int64
mSingleVersionCacheResidentBytes Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes) []

{- | Record the assembled-representation store's resident bytes
(@ecluse.metadata_cache.assembled.resident_bytes@).
-}
recordAssembledCacheResidentBytes :: (MonadIO m) => Metrics -> Int -> m ()
recordAssembledCacheResidentBytes :: forall (m :: * -> *). MonadIO m => Metrics -> Int -> m ()
recordAssembledCacheResidentBytes Metrics
m Int
bytes =
    Gauge Int64 -> Int64 -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set (Metrics -> Gauge Int64
mAssembledCacheResidentBytes Metrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes) []

-- | Record one mirror job enqueued (@ecluse.mirror.enqueued@).
recordMirrorEnqueued :: (MonadIO m) => Metrics -> m ()
recordMirrorEnqueued :: forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMirrorEnqueued Metrics
m = Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMirrorEnqueued Metrics
m) []

-- | Record one mirror enqueue failure (@ecluse.mirror.enqueue.failures@).
recordMirrorEnqueueFailure :: (MonadIO m) => Metrics -> m ()
recordMirrorEnqueueFailure :: forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMirrorEnqueueFailure Metrics
m = Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMirrorEnqueueFailures Metrics
m) []

-- Record one perimeter-answered handler escape (@ecluse.serve.perimeter.faults@) by cause.
recordRequestPerimeterFault :: (MonadIO m) => Metrics -> RequestFaultCause -> m ()
recordRequestPerimeterFault :: forall (m :: * -> *).
MonadIO m =>
Metrics -> RequestFaultCause -> m ()
recordRequestPerimeterFault Metrics
m RequestFaultCause
cause = Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mServePerimeterFaults Metrics
m) [RequestFaultCause -> Label
LPerimeterCause RequestFaultCause
cause]

-- Record one anomalous public relay (@ecluse.serve.relay.anomalies@) by class.
recordPublicRelayAnomaly :: (MonadIO m) => Metrics -> RelayAnomaly -> m ()
recordPublicRelayAnomaly :: forall (m :: * -> *). MonadIO m => Metrics -> RelayAnomaly -> m ()
recordPublicRelayAnomaly Metrics
m RelayAnomaly
cls = Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mServeRelayAnomalies Metrics
m) [RelayAnomaly -> Label
LRelayAnomaly RelayAnomaly
cls]

-- | Record one processed mirror job (@ecluse.mirror.jobs.processed@) by its result.
recordMirrorJobProcessed :: (MonadIO m) => Metrics -> MirrorResult -> m ()
recordMirrorJobProcessed :: forall (m :: * -> *). MonadIO m => Metrics -> MirrorResult -> m ()
recordMirrorJobProcessed Metrics
m MirrorResult
result =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mMirrorJobsProcessed Metrics
m) [MirrorResult -> Label
LMirrorResult MirrorResult
result]

-- | Record one disposition of one swept version (@ecluse.dredger.versions@).
recordSweptVersion :: (MonadIO m) => Metrics -> SweepTarget -> SweepResult -> m ()
recordSweptVersion :: forall (m :: * -> *).
MonadIO m =>
Metrics -> SweepTarget -> SweepResult -> m ()
recordSweptVersion Metrics
m SweepTarget
target SweepResult
result = Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mDredgerVersions Metrics
m) [SweepTarget -> Label
LSweepTarget SweepTarget
target, SweepResult -> Label
LSweepResult SweepResult
result]

-- | Record a mirror publish latency sample (@ecluse.mirror.publish.duration@).
recordMirrorPublishDuration :: (MonadIO m) => Metrics -> Double -> m ()
recordMirrorPublishDuration :: forall (m :: * -> *). MonadIO m => Metrics -> Double -> m ()
recordMirrorPublishDuration Metrics
m Double
seconds =
    Histogram -> Double -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Histogram -> Double -> [Label] -> m ()
record (Metrics -> Histogram
mMirrorPublishDuration Metrics
m) Double
seconds []

-- | Record one credential refresh (@ecluse.credential.refresh@) by result and provider.
recordCredentialRefresh :: (MonadIO m) => Metrics -> Provider -> CredentialResult -> m ()
recordCredentialRefresh :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Provider -> CredentialResult -> m ()
recordCredentialRefresh Metrics
m Provider
provider CredentialResult
result =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mCredentialRefresh Metrics
m) [Provider -> Label
LProvider Provider
provider, CredentialResult -> Label
LCredentialResult CredentialResult
result]

-- | Collect the shortest active expiry per provider as non-negative whole seconds remaining.
registerCredentialTokenTtl :: Metrics -> IO UTCTime -> IO [(Provider, UTCTime)] -> IO ()
registerCredentialTokenTtl :: Metrics -> IO UTCTime -> IO [(Provider, UTCTime)] -> IO ()
registerCredentialTokenTtl Metrics
m IO UTCTime
clock IO [(Provider, UTCTime)]
expiries =
    IO ObservableCallbackHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ObservableCallbackHandle -> IO ())
-> IO ObservableCallbackHandle -> IO ()
forall a b. (a -> b) -> a -> b
$ ObservableGauge Int64
-> (ObservableResult Int64 -> IO ()) -> IO ObservableCallbackHandle
forall a.
ObservableGauge a
-> (ObservableResult a -> IO ()) -> IO ObservableCallbackHandle
observableGaugeRegisterCallback (Metrics -> ObservableGauge Int64
mCredentialTokenTtlSeconds Metrics
m) ((ObservableResult Int64 -> IO ()) -> IO ObservableCallbackHandle)
-> (ObservableResult Int64 -> IO ()) -> IO ObservableCallbackHandle
forall a b. (a -> b) -> a -> b
$ \ObservableResult Int64
result -> do
        now <- IO UTCTime
clock
        current <- expiries
        for_ current $ \(Provider
provider, UTCTime
expiry) ->
            ObservableResult Int64 -> Int64 -> Attributes -> IO ()
forall a. ObservableResult a -> a -> Attributes -> IO ()
observe ObservableResult Int64
result (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 (NominalDiffTime -> Int64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
expiry UTCTime
now))) ([Label] -> Attributes
metricAttributes [Provider -> Label
LProvider Provider
provider])

-- | Record one advisory sync attempt to @ecluse.advisory.sync.attempts@.
recordAdvisorySyncAttempt :: (MonadIO m) => Metrics -> Ecosystem -> AdvisorySyncResult -> m ()
recordAdvisorySyncAttempt :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisorySyncResult -> m ()
recordAdvisorySyncAttempt Metrics
m Ecosystem
eco AdvisorySyncResult
result =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mAdvisorySyncAttempts Metrics
m) [Ecosystem -> Label
LEcosystem Ecosystem
eco, AdvisorySyncResult -> Label
LAdvisorySyncResult AdvisorySyncResult
result]

-- | Record one advisory sync attempt's latency in seconds (@ecluse.advisory.sync.duration@).
recordAdvisorySyncDuration :: (MonadIO m) => Metrics -> Ecosystem -> AdvisorySyncResult -> Double -> m ()
recordAdvisorySyncDuration :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisorySyncResult -> Double -> m ()
recordAdvisorySyncDuration Metrics
m Ecosystem
eco AdvisorySyncResult
result Double
seconds =
    Histogram -> Double -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Histogram -> Double -> [Label] -> m ()
record (Metrics -> Histogram
mAdvisorySyncDuration Metrics
m) Double
seconds [Ecosystem -> Label
LEcosystem Ecosystem
eco, AdvisorySyncResult -> Label
LAdvisorySyncResult AdvisorySyncResult
result]

{- | Attach one ecosystem's advisory-database age to @ecluse.advisory.database.age.seconds@. The
SDK calls back at each collection, so a sync task that dies cannot freeze or reset the age.
-}
registerAdvisoryDatabaseAge :: Metrics -> Ecosystem -> IO (Maybe Double) -> IO ()
registerAdvisoryDatabaseAge :: Metrics -> Ecosystem -> IO (Maybe Double) -> IO ()
registerAdvisoryDatabaseAge Metrics
m Ecosystem
eco IO (Maybe Double)
installedAt =
    IO ObservableCallbackHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ObservableGauge Int64
-> (ObservableResult Int64 -> IO ()) -> IO ObservableCallbackHandle
forall a.
ObservableGauge a
-> (ObservableResult a -> IO ()) -> IO ObservableCallbackHandle
observableGaugeRegisterCallback (Metrics -> ObservableGauge Int64
mAdvisoryDatabaseAgeSeconds Metrics
m) (Ecosystem -> IO (Maybe Double) -> ObservableResult Int64 -> IO ()
reportAdvisoryDatabaseAge Ecosystem
eco IO (Maybe Double)
installedAt))

{- | What one collection reports: whole seconds from the install stamp to now. With no generation
installed it observes nothing, so a never-filled slot never reads as fresh.
-}
reportAdvisoryDatabaseAge :: Ecosystem -> IO (Maybe Double) -> ObservableResult Int64 -> IO ()
reportAdvisoryDatabaseAge :: Ecosystem -> IO (Maybe Double) -> ObservableResult Int64 -> IO ()
reportAdvisoryDatabaseAge Ecosystem
eco IO (Maybe Double)
installedAt ObservableResult Int64
result = do
    mStamp <- IO (Maybe Double)
installedAt
    for_ mStamp $ \Double
stamp -> do
        now <- IO Double
getMonotonicTime
        observeAge result eco (floor (now - stamp))

{- | Attach one ecosystem's advisory-source age to @ecluse.advisory.source.age.seconds@: the age
the CVE-deny path expires on, where 'registerAdvisoryDatabaseAge' is an installation diagnostic.
-}
registerAdvisorySourceAge :: Metrics -> Ecosystem -> IO (Maybe UTCTime) -> IO ()
registerAdvisorySourceAge :: Metrics -> Ecosystem -> IO (Maybe UTCTime) -> IO ()
registerAdvisorySourceAge Metrics
m Ecosystem
eco IO (Maybe UTCTime)
pushedAt =
    IO ObservableCallbackHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ObservableGauge Int64
-> (ObservableResult Int64 -> IO ()) -> IO ObservableCallbackHandle
forall a.
ObservableGauge a
-> (ObservableResult a -> IO ()) -> IO ObservableCallbackHandle
observableGaugeRegisterCallback (Metrics -> ObservableGauge Int64
mAdvisorySourceAgeSeconds Metrics
m) (Ecosystem -> IO (Maybe UTCTime) -> ObservableResult Int64 -> IO ()
reportAdvisorySourceAge Ecosystem
eco IO (Maybe UTCTime)
pushedAt))

{- | What one collection reports: whole seconds from the publication time to now. With no push
time to measure, it observes nothing rather than a zero.
-}
reportAdvisorySourceAge :: Ecosystem -> IO (Maybe UTCTime) -> ObservableResult Int64 -> IO ()
reportAdvisorySourceAge :: Ecosystem -> IO (Maybe UTCTime) -> ObservableResult Int64 -> IO ()
reportAdvisorySourceAge Ecosystem
eco IO (Maybe UTCTime)
pushedAt ObservableResult Int64
result = do
    mStamp <- IO (Maybe UTCTime)
pushedAt
    for_ mStamp $ \UTCTime
stamp -> do
        now <- IO UTCTime
getCurrentTime
        observeAge result eco (floor (diffUTCTime now stamp))

-- An age is never negative, whatever a clock or a stamp says.
observeAge :: ObservableResult Int64 -> Ecosystem -> Int64 -> IO ()
observeAge :: ObservableResult Int64 -> Ecosystem -> Int64 -> IO ()
observeAge ObservableResult Int64
result Ecosystem
eco Int64
seconds = ObservableResult Int64 -> Int64 -> Attributes -> IO ()
forall a. ObservableResult a -> a -> Attributes -> IO ()
observe ObservableResult Int64
result (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 Int64
seconds) ([Label] -> Attributes
metricAttributes [Ecosystem -> Label
LEcosystem Ecosystem
eco])

-- | Attach the memory meter's figures to their gauges, read at each collection.
registerMemoryMeter :: Metrics -> IO MeterSnapshot -> IO ()
registerMemoryMeter :: Metrics -> IO MeterSnapshot -> IO ()
registerMemoryMeter Metrics
m IO MeterSnapshot
readMeter = do
    let observeWith :: (MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith MeterSnapshot -> a
pick ObservableGauge a
instrument =
            IO ObservableCallbackHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ObservableCallbackHandle -> IO ())
-> ((ObservableResult a -> IO ()) -> IO ObservableCallbackHandle)
-> (ObservableResult a -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObservableGauge a
-> (ObservableResult a -> IO ()) -> IO ObservableCallbackHandle
forall a.
ObservableGauge a
-> (ObservableResult a -> IO ()) -> IO ObservableCallbackHandle
observableGaugeRegisterCallback ObservableGauge a
instrument ((ObservableResult a -> IO ()) -> IO ())
-> (ObservableResult a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ObservableResult a
result -> do
                current <- IO MeterSnapshot
readMeter
                observe result (fromIntegral (pick current)) (metricAttributes [])
    (MeterSnapshot -> Int) -> ObservableGauge Int64 -> IO ()
forall {a} {a}.
(Integral a, Num a) =>
(MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith MeterSnapshot -> Int
snBudgetBytes (Metrics -> ObservableGauge Int64
mMemoryAdmissionBudgetBytes Metrics
m)
    (MeterSnapshot -> Int) -> ObservableGauge Int64 -> IO ()
forall {a} {a}.
(Integral a, Num a) =>
(MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith MeterSnapshot -> Int
snChargedBytes (Metrics -> ObservableGauge Int64
mMemoryAdmissionChargedBytes Metrics
m)
    (MeterSnapshot -> Int) -> ObservableGauge Int64 -> IO ()
forall {a} {a}.
(Integral a, Num a) =>
(MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith (BrakeLevel -> Int
brakeLevelCode (BrakeLevel -> Int)
-> (MeterSnapshot -> BrakeLevel) -> MeterSnapshot -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeterSnapshot -> BrakeLevel
snBrakeLevel) (Metrics -> ObservableGauge Int64
mMemoryAdmissionBrakeLevel Metrics
m)
    (MeterSnapshot -> Int) -> ObservableGauge Int64 -> IO ()
forall {a} {a}.
(Integral a, Num a) =>
(MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith MeterSnapshot -> Int
snWaiting (Metrics -> ObservableGauge Int64
mMemoryAdmissionWaiting Metrics
m)
    (MeterSnapshot -> Int) -> ObservableGauge Int64 -> IO ()
forall {a} {a}.
(Integral a, Num a) =>
(MeterSnapshot -> a) -> ObservableGauge a -> IO ()
observeWith MeterSnapshot -> Int
snPaused (Metrics -> ObservableGauge Int64
mMemoryAdmissionPausedNow Metrics
m)

-- | Record the advisory entries one compile pass accepted (@ecluse.advisory.compile.accepted@).
recordAdvisoryCompileAccepted :: (MonadIO m) => Metrics -> Ecosystem -> Int -> m ()
recordAdvisoryCompileAccepted :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> Int -> m ()
recordAdvisoryCompileAccepted Metrics
m Ecosystem
eco Int
entries =
    Counter Int64 -> Int -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Counter Int64 -> Int -> [Label] -> m ()
addCount (Metrics -> Counter Int64
mAdvisoryCompileAccepted Metrics
m) Int
entries [Ecosystem -> Label
LEcosystem Ecosystem
eco]

{- | Record the advisory entries one compile pass dropped for a bounded cause
(@ecluse.advisory.compile.dropped@).
-}
recordAdvisoryCompileDropped :: (MonadIO m) => Metrics -> Ecosystem -> AdvisoryDropCause -> Int -> m ()
recordAdvisoryCompileDropped :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisoryDropCause -> Int -> m ()
recordAdvisoryCompileDropped Metrics
m Ecosystem
eco AdvisoryDropCause
cause Int
entries =
    Counter Int64 -> Int -> [Label] -> m ()
forall (m :: * -> *).
MonadIO m =>
Counter Int64 -> Int -> [Label] -> m ()
addCount (Metrics -> Counter Int64
mAdvisoryCompileDropped Metrics
m) Int
entries [Ecosystem -> Label
LEcosystem Ecosystem
eco, AdvisoryDropCause -> Label
LAdvisoryDropCause AdvisoryDropCause
cause]

-- | Record how one compile pass concluded (@ecluse.advisory.compile.runs@).
recordAdvisoryCompileRun :: (MonadIO m) => Metrics -> Ecosystem -> AdvisoryCompileResult -> m ()
recordAdvisoryCompileRun :: forall (m :: * -> *).
MonadIO m =>
Metrics -> Ecosystem -> AdvisoryCompileResult -> m ()
recordAdvisoryCompileRun Metrics
m Ecosystem
eco AdvisoryCompileResult
result =
    Counter Int64 -> [Label] -> m ()
forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne (Metrics -> Counter Int64
mAdvisoryCompileRuns Metrics
m) [Ecosystem -> Label
LEcosystem Ecosystem
eco, AdvisoryCompileResult -> Label
LAdvisoryCompileResult AdvisoryCompileResult
result]

addOne :: (MonadIO m) => Counter Int64 -> [Label] -> m ()
addOne :: forall (m :: * -> *). MonadIO m => Counter Int64 -> [Label] -> m ()
addOne Counter Int64
instrument [Label]
labels = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Counter Int64 -> Int64 -> Attributes -> IO ()
forall a. Counter a -> a -> Attributes -> IO ()
counterAdd Counter Int64
instrument Int64
1 ([Label] -> Attributes
metricAttributes [Label]
labels))

-- A counter never goes backwards, so a negative tally adds nothing.
addCount :: (MonadIO m) => Counter Int64 -> Int -> [Label] -> m ()
addCount :: forall (m :: * -> *).
MonadIO m =>
Counter Int64 -> Int -> [Label] -> m ()
addCount Counter Int64
instrument Int
n [Label]
labels = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Counter Int64 -> Int64 -> Attributes -> IO ()
forall a. Counter a -> a -> Attributes -> IO ()
counterAdd Counter Int64
instrument (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n)) ([Label] -> Attributes
metricAttributes [Label]
labels))

addDelta :: (MonadIO m) => UpDownCounter Int64 -> Int64 -> [Label] -> m ()
addDelta :: forall (m :: * -> *).
MonadIO m =>
UpDownCounter Int64 -> Int64 -> [Label] -> m ()
addDelta UpDownCounter Int64
instrument Int64
delta [Label]
labels = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UpDownCounter Int64 -> Int64 -> Attributes -> IO ()
forall a. UpDownCounter a -> a -> Attributes -> IO ()
upDownCounterAdd UpDownCounter Int64
instrument Int64
delta ([Label] -> Attributes
metricAttributes [Label]
labels))

record :: (MonadIO m) => Histogram -> Double -> [Label] -> m ()
record :: forall (m :: * -> *).
MonadIO m =>
Histogram -> Double -> [Label] -> m ()
record Histogram
instrument Double
value [Label]
labels = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Histogram -> Double -> Attributes -> IO ()
histogramRecord Histogram
instrument Double
value ([Label] -> Attributes
metricAttributes [Label]
labels))

-- Set a gauge under the given bounded labels: the last value wins per collect.
set :: (MonadIO m) => Gauge Int64 -> Int64 -> [Label] -> m ()
set :: forall (m :: * -> *).
MonadIO m =>
Gauge Int64 -> Int64 -> [Label] -> m ()
set Gauge Int64
instrument Int64
value [Label]
labels = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Gauge Int64 -> Int64 -> Attributes -> IO ()
forall a. Gauge a -> a -> Attributes -> IO ()
gaugeRecord Gauge Int64
instrument Int64
value ([Label] -> Attributes
metricAttributes [Label]
labels))