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

-- | Bridge boot-time reporters to installed instruments, retaining active credential expiries.
module Ecluse.Runtime.Telemetry.Reporters (
    DeferredMetrics,
    newDeferredMetrics,
    installMetrics,
    deferredBreakerReporter,
    deferredRefreshReporter,
    deferredMirrorEnqueueFailure,
) where

import Data.Foldable1 qualified as Foldable1
import Data.Map.Strict qualified as Map
import Data.Time (UTCTime)
import Data.Universe.Class qualified as Universe

import Ecluse.Core.Breaker (BreakerReporter (..), breakerState)
import Ecluse.Core.Credential.Refresh (RefreshReporter (..))
import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Telemetry.Metrics (
    BreakerSource,
    CredentialResult (RefreshFailed, Refreshed),
    Provider,
 )
import Ecluse.Runtime.Telemetry.Instruments (
    Metrics,
    recordBreakerState,
    recordCredentialRefresh,
    recordMirrorEnqueueFailure,
    registerCredentialTokenTtl,
 )

-- | Boot-time reporters retain expiry state before the metric instruments exist.
data DeferredMetrics = DeferredMetrics
    { DeferredMetrics -> IORef (Maybe Metrics)
dmMetrics :: IORef (Maybe Metrics)
    , DeferredMetrics -> IORef (Map Ecosystem (Provider, UTCTime))
dmExpiries :: IORef (Map Ecosystem (Provider, UTCTime))
    , DeferredMetrics -> IO UTCTime
dmClock :: IO UTCTime
    }

-- | Create deferred reporters with a clock read at metric collection.
newDeferredMetrics :: IO UTCTime -> IO DeferredMetrics
newDeferredMetrics :: IO UTCTime -> IO DeferredMetrics
newDeferredMetrics IO UTCTime
clock = IORef (Maybe Metrics)
-> IORef (Map Ecosystem (Provider, UTCTime))
-> IO UTCTime
-> DeferredMetrics
DeferredMetrics (IORef (Maybe Metrics)
 -> IORef (Map Ecosystem (Provider, UTCTime))
 -> IO UTCTime
 -> DeferredMetrics)
-> IO (IORef (Maybe Metrics))
-> IO
     (IORef (Map Ecosystem (Provider, UTCTime))
      -> IO UTCTime -> DeferredMetrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Metrics -> IO (IORef (Maybe Metrics))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe Metrics
forall a. Maybe a
Nothing IO
  (IORef (Map Ecosystem (Provider, UTCTime))
   -> IO UTCTime -> DeferredMetrics)
-> IO (IORef (Map Ecosystem (Provider, UTCTime)))
-> IO (IO UTCTime -> DeferredMetrics)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Ecosystem (Provider, UTCTime)
-> IO (IORef (Map Ecosystem (Provider, UTCTime)))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Map Ecosystem (Provider, UTCTime)
forall k a. Map k a
Map.empty IO (IO UTCTime -> DeferredMetrics)
-> IO (IO UTCTime) -> IO DeferredMetrics
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO UTCTime -> IO (IO UTCTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO UTCTime
clock

-- | Install instruments once after boot, including observations received before installation.
installMetrics :: DeferredMetrics -> Metrics -> IO ()
installMetrics :: DeferredMetrics -> Metrics -> IO ()
installMetrics DeferredMetrics
deferred Metrics
metrics = do
    Metrics -> IO UTCTime -> IO [(Provider, UTCTime)] -> IO ()
registerCredentialTokenTtl Metrics
metrics (DeferredMetrics -> IO UTCTime
dmClock DeferredMetrics
deferred) (Map Ecosystem (Provider, UTCTime) -> [(Provider, UTCTime)]
soonestExpiries (Map Ecosystem (Provider, UTCTime) -> [(Provider, UTCTime)])
-> IO (Map Ecosystem (Provider, UTCTime))
-> IO [(Provider, UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map Ecosystem (Provider, UTCTime))
-> IO (Map Ecosystem (Provider, UTCTime))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (DeferredMetrics -> IORef (Map Ecosystem (Provider, UTCTime))
dmExpiries DeferredMetrics
deferred))
    IORef (Maybe Metrics) -> Maybe Metrics -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef (DeferredMetrics -> IORef (Maybe Metrics)
dmMetrics DeferredMetrics
deferred) (Metrics -> Maybe Metrics
forall a. a -> Maybe a
Just Metrics
metrics)

-- The soonest expiry each provider holds, so a gauge reports the lifetime that runs out first.
-- A provider with no credential is absent rather than zero.
soonestExpiries :: Map Ecosystem (Provider, UTCTime) -> [(Provider, UTCTime)]
soonestExpiries :: Map Ecosystem (Provider, UTCTime) -> [(Provider, UTCTime)]
soonestExpiries Map Ecosystem (Provider, UTCTime)
expiries =
    [ (Provider
provider, UTCTime
expiry)
    | Provider
provider <- [Provider]
forall a. Universe a => [a]
Universe.universe
    , Just UTCTime
expiry <- [(NonEmpty UTCTime -> UTCTime) -> [UTCTime] -> Maybe UTCTime
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty UTCTime -> UTCTime
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
Foldable1.minimum [UTCTime
stamp | (Provider
label, UTCTime
stamp) <- Map Ecosystem (Provider, UTCTime) -> [(Provider, UTCTime)]
forall k a. Map k a -> [a]
Map.elems Map Ecosystem (Provider, UTCTime)
expiries, Provider
label Provider -> Provider -> Bool
forall a. Eq a => a -> a -> Bool
== Provider
provider]]
    ]

withDeferredMetrics :: DeferredMetrics -> (Metrics -> IO ()) -> IO ()
withDeferredMetrics :: DeferredMetrics -> (Metrics -> IO ()) -> IO ()
withDeferredMetrics DeferredMetrics
deferred Metrics -> IO ()
record = IORef (Maybe Metrics) -> IO (Maybe Metrics)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (DeferredMetrics -> IORef (Maybe Metrics)
dmMetrics DeferredMetrics
deferred) IO (Maybe Metrics) -> (Maybe Metrics -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (Metrics -> IO ()) -> Maybe Metrics -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
forall (f :: * -> *). Applicative f => f ()
pass Metrics -> IO ()
record

-- | Record a breaker's state under the given source.
deferredBreakerReporter :: DeferredMetrics -> BreakerSource -> BreakerReporter
deferredBreakerReporter :: DeferredMetrics -> BreakerSource -> BreakerReporter
deferredBreakerReporter DeferredMetrics
deferred BreakerSource
source =
    (Breaker -> IO ()) -> BreakerReporter
BreakerReporter ((Breaker -> IO ()) -> BreakerReporter)
-> (Breaker -> IO ()) -> BreakerReporter
forall a b. (a -> b) -> a -> b
$ \Breaker
breaker ->
        DeferredMetrics -> (Metrics -> IO ()) -> IO ()
withDeferredMetrics DeferredMetrics
deferred ((Metrics -> IO ()) -> IO ()) -> (Metrics -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Metrics
metrics ->
            Metrics -> BreakerSource -> BreakerState -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> BreakerSource -> BreakerState -> m ()
recordBreakerState Metrics
metrics BreakerSource
source (Breaker -> BreakerState
breakerState Breaker
breaker)

{- | Use the shared credential's canonical ecosystem as its bounded internal identity, never a label.
An absent expiry is no observation. Expired credentials remain until a reported replacement.
-}
deferredRefreshReporter :: DeferredMetrics -> Ecosystem -> Provider -> RefreshReporter
deferredRefreshReporter :: DeferredMetrics -> Ecosystem -> Provider -> RefreshReporter
deferredRefreshReporter DeferredMetrics
deferred Ecosystem
credentialIdentity Provider
provider =
    RefreshReporter
        { onRefreshSucceeded :: Maybe UTCTime -> IO ()
onRefreshSucceeded = CredentialResult -> Maybe UTCTime -> IO ()
report CredentialResult
Refreshed
        , onRefreshFailed :: Maybe UTCTime -> IO ()
onRefreshFailed = CredentialResult -> Maybe UTCTime -> IO ()
report CredentialResult
RefreshFailed
        }
  where
    report :: CredentialResult -> Maybe UTCTime -> IO ()
    report :: CredentialResult -> Maybe UTCTime -> IO ()
report CredentialResult
result Maybe UTCTime
expiry = do
        Maybe UTCTime -> (UTCTime -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe UTCTime
expiry ((UTCTime -> IO ()) -> IO ()) -> (UTCTime -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
stamp ->
            IORef (Map Ecosystem (Provider, UTCTime))
-> (Map Ecosystem (Provider, UTCTime)
    -> (Map Ecosystem (Provider, UTCTime), ()))
-> IO ()
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' (DeferredMetrics -> IORef (Map Ecosystem (Provider, UTCTime))
dmExpiries DeferredMetrics
deferred) ((Map Ecosystem (Provider, UTCTime)
  -> (Map Ecosystem (Provider, UTCTime), ()))
 -> IO ())
-> (Map Ecosystem (Provider, UTCTime)
    -> (Map Ecosystem (Provider, UTCTime), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Ecosystem (Provider, UTCTime)
expiries ->
                (Ecosystem
-> (Provider, UTCTime)
-> Map Ecosystem (Provider, UTCTime)
-> Map Ecosystem (Provider, UTCTime)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ecosystem
credentialIdentity (Provider
provider, UTCTime
stamp) Map Ecosystem (Provider, UTCTime)
expiries, ())
        DeferredMetrics -> (Metrics -> IO ()) -> IO ()
withDeferredMetrics DeferredMetrics
deferred ((Metrics -> IO ()) -> IO ()) -> (Metrics -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Metrics
metrics -> Metrics -> Provider -> CredentialResult -> IO ()
forall (m :: * -> *).
MonadIO m =>
Metrics -> Provider -> CredentialResult -> m ()
recordCredentialRefresh Metrics
metrics Provider
provider CredentialResult
result

-- | Record one mirror enqueue failure after instrument installation.
deferredMirrorEnqueueFailure :: DeferredMetrics -> IO ()
deferredMirrorEnqueueFailure :: DeferredMetrics -> IO ()
deferredMirrorEnqueueFailure DeferredMetrics
deferred =
    DeferredMetrics -> (Metrics -> IO ()) -> IO ()
withDeferredMetrics DeferredMetrics
deferred Metrics -> IO ()
forall (m :: * -> *). MonadIO m => Metrics -> m ()
recordMirrorEnqueueFailure