{- | Wiring a per-request "Ecluse.Core.Registry.Metadata.MetadataClient" for the serve
path: the cross-cutting caching, metrics, and failure-logging policy wrapped around a
registry's raw fetch primitive.

The read boundary's /type/ lives in the registry layer (agnostic); a registry's raw
fetch primitive lives with that registry (npm's in
"Ecluse.Core.Registry.Npm.Metadata"). What lives __here__ is the serve-path policy
that is the same regardless of ecosystem: whether an origin is resolved through the
shared metadata cache, recording the upstream-fetch metrics, and logging a failure
once in the request's context. Keeping that policy in the serve layer is what lets the
registry layer stay free of the cache and telemetry.

The two operations differ in how they resolve. The full-manifest op resolves the whole
packument through the shared full-packument cache. The single-version op takes a
__hybrid__ path so a cold tarball gate need not pay a whole-packument decode to consult
one version (see 'newMetadataClient'): it consults a small @(package, version)@ cache, then
the warm full-packument cache __read-only__ (so a packument @GET@ followed by its tarball
gate still collapses to one upstream call), and only on a cold miss leads its own
__selective__ fetch -- parsing just the requested version out of the full bytes -- into the
@(package, version)@ cache, never writing the whole packument back to the shared cache.
-}
module Ecluse.Core.Server.Metadata (
    -- * Caching policy
    ManifestCaching (..),

    -- * Constructing a per-request read handle
    newMetadataClient,
    newNpmMetadataClient,
) where

import Data.Map.Strict qualified as Map
import Network.HTTP.Client qualified as HTTP
import UnliftIO.Exception (throwIO, try, tryAny)

import Ecluse.Core.Package (InvalidEntry, PackageDetails, PackageInfo (infoInvalidEntries, infoVersions), PackageName)
import Ecluse.Core.Registry.Metadata (
    Manifest (Manifest, manifestDigest, manifestInfo, manifestRaw),
    MetadataClient (..),
    MetadataError (MetadataBoundExceeded, MetadataNameMismatch, MetadataUndecodable),
 )
import Ecluse.Core.Registry.Npm (NpmClientConfig)
import Ecluse.Core.Registry.Npm.Metadata (fetchNpmManifest, fetchNpmVersion)

import Ecluse.Core.Server.Cache (
    CacheEntry (CacheEntry, entryDigest, entryInfo, entryRaw),
    MetadataCache,
    Source,
    cachedMetadata,
    cachedVersion,
    resolveMetadata,
    resolveVersion,
 )
import Ecluse.Core.Telemetry.Metrics qualified as Metric
import Ecluse.Core.Telemetry.Record (MetricsPort (..), timedSeconds)
import Ecluse.Core.Telemetry.Span (TracingPort)
import Ecluse.Core.Version (Version, renderVersion)

{- | How a read handle resolves the full manifest for one origin.

The two origins of a packument merge differ exactly here: the private origin is the
per-client authority and must not be shared, while the public origin is anonymous and
shared across every client.
-}
data ManifestCaching
    = {- | Resolve directly, uncached -- the per-client private origin, re-fetched every
      request so the upstream re-authorises each client's own forwarded credential.
      -}
      Uncached
    | {- | Resolve through the shared metadata cache under the origin's 'Source' key --
      the anonymous public origin, so concurrent and subsequent reads collapse to one
      upstream call. Both operations of the resulting handle share this one entry.
      -}
      Cached MetadataCache Source

{- | Build a per-request read handle from a registry's raw fetch primitives -- one that
fetches and projects the __full manifest__, one that fetches and __selectively__ projects a
__single version__ -- wiring them with the caching policy, the upstream-fetch metrics, and a
request-context failure log.

The full-manifest op resolves the whole packument through the shared full-packument cache.
The single-version op takes the __hybrid__ path that delivers the cheap cold tarball gate
while preserving the warm install one-call property:

  1. consult the small @(package, version)@ cache -- a hit (a positive snapshot, or a cached
     /determined absence/) returns at once;
  2. else consult the warm full-packument cache __read-only__ -- a hit selects the one version
     from the shared entry (so a packument @GET@ followed by its tarball gate is still one
     upstream call), and __does not__ populate the version cache;
  3. else (cold) lead the raw __single-version__ fetch -- which fetches the full bytes but
     parses only the requested version -- through the @(package, version)@ cache's
     single-flight, caching the resulting snapshot (or its determined absence) there, and
     __never__ writing the whole packument back to the shared cache.

For the 'Uncached' policy (the per-client private origin) there is no shared cache to
consult, so the single-version op is the raw selective fetch, uncached, re-run each request.

The failure log is invoked __once per real fetch__ (inside the cache's single-flight
leader), in the caller's logging context, so a coalesced follower never re-logs a
failure the leader already reported. The dropped-entry log ('logInvalid') is invoked the
same way (once per real full-manifest fetch, only when the projection dropped a
malformed entry), so an operator sees a degraded-but-served document without it
re-logging on every cache hit.
-}
newMetadataClient ::
    MetricsPort ->
    Metric.Upstream ->
    ManifestCaching ->
    (PackageName -> MetadataError -> IO ()) ->
    (PackageName -> [InvalidEntry] -> IO ()) ->
    (PackageName -> IO ()) ->
    (PackageName -> IO (Either MetadataError Manifest)) ->
    (PackageName -> Version -> IO (Either MetadataError (Maybe PackageDetails))) ->
    MetadataClient
newMetadataClient :: MetricsPort
-> Upstream
-> ManifestCaching
-> (PackageName -> MetadataError -> IO ())
-> (PackageName -> [InvalidEntry] -> IO ())
-> (PackageName -> IO ())
-> (PackageName -> IO (Either MetadataError Manifest))
-> (PackageName
    -> Version -> IO (Either MetadataError (Maybe PackageDetails)))
-> MetadataClient
newMetadataClient MetricsPort
metrics Upstream
upstream ManifestCaching
caching PackageName -> MetadataError -> IO ()
logFailure PackageName -> [InvalidEntry] -> IO ()
logInvalid PackageName -> IO ()
logFetch PackageName -> IO (Either MetadataError Manifest)
rawFetch PackageName
-> Version -> IO (Either MetadataError (Maybe PackageDetails))
rawFetchVersion =
    MetadataClient
        { fetchFullManifest :: PackageName -> IO (Either MetadataError Manifest)
fetchFullManifest = IO CacheEntry -> IO (Either MetadataError Manifest)
foldManifestCarrier (IO CacheEntry -> IO (Either MetadataError Manifest))
-> (PackageName -> IO CacheEntry)
-> PackageName
-> IO (Either MetadataError Manifest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> IO CacheEntry
resolveEntry
        , fetchVersionMetadata :: PackageName
-> Version -> IO (Either MetadataError (Maybe PackageDetails))
fetchVersionMetadata = PackageName
-> Version -> IO (Either MetadataError (Maybe PackageDetails))
resolveVersionHybrid
        }
  where
    resolveEntry :: PackageName -> IO CacheEntry
    resolveEntry :: PackageName -> IO CacheEntry
resolveEntry PackageName
name = case ManifestCaching
caching of
        ManifestCaching
Uncached -> PackageName -> IO CacheEntry
manifestLeader PackageName
name
        Cached MetadataCache
cache Source
source -> MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> IO CacheEntry
-> IO CacheEntry
resolveMetadata MetricsPort
metrics MetadataCache
cache Source
source PackageName
name (PackageName -> IO CacheEntry
manifestLeader PackageName
name)

    -- The full-manifest single-flight leader action: the real fetch, run only on a cache
    -- miss, metered, with any dropped malformed entries logged on success and a fetch
    -- failure logged once before the carrier is raised.
    manifestLeader :: PackageName -> IO CacheEntry
    manifestLeader :: PackageName -> IO CacheEntry
manifestLeader PackageName
name = do
        PackageName -> IO ()
logFetch PackageName
name
        MetricsPort -> Upstream -> IO CacheEntry -> IO CacheEntry
forall a. MetricsPort -> Upstream -> IO a -> IO a
recordedFetch MetricsPort
metrics Upstream
upstream (IO CacheEntry -> IO CacheEntry) -> IO CacheEntry -> IO CacheEntry
forall a b. (a -> b) -> a -> b
$
            PackageName -> IO (Either MetadataError Manifest)
rawFetch PackageName
name IO (Either MetadataError Manifest)
-> (Either MetadataError Manifest -> IO CacheEntry)
-> IO CacheEntry
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right Manifest
manifest -> do
                    let invalid :: [InvalidEntry]
invalid = PackageInfo -> [InvalidEntry]
infoInvalidEntries (Manifest -> PackageInfo
manifestInfo Manifest
manifest)
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InvalidEntry] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InvalidEntry]
invalid) (PackageName -> [InvalidEntry] -> IO ()
logInvalid PackageName
name [InvalidEntry]
invalid)
                    CacheEntry -> IO CacheEntry
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageInfo -> Value -> ContentDigest -> CacheEntry
CacheEntry (Manifest -> PackageInfo
manifestInfo Manifest
manifest) (Manifest -> Value
manifestRaw Manifest
manifest) (Manifest -> ContentDigest
manifestDigest Manifest
manifest))
                Left MetadataError
err -> PackageName -> MetadataError -> IO ()
logFailure PackageName
name MetadataError
err IO () -> IO CacheEntry -> IO CacheEntry
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ManifestFetchFailed -> IO CacheEntry
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MetadataError -> ManifestFetchFailed
ManifestFetchFailed MetadataError
err)

    -- The single-version hybrid: the small version cache, then the warm full cache
    -- read-only, then a cold selective fetch -- or, uncached, the raw selective fetch.
    resolveVersionHybrid :: PackageName -> Version -> IO (Either MetadataError (Maybe PackageDetails))
    resolveVersionHybrid :: PackageName
-> Version -> IO (Either MetadataError (Maybe PackageDetails))
resolveVersionHybrid PackageName
name Version
version = case ManifestCaching
caching of
        ManifestCaching
Uncached -> IO (Maybe PackageDetails)
-> IO (Either MetadataError (Maybe PackageDetails))
foldVersionCarrier (PackageName -> Version -> IO (Maybe PackageDetails)
versionLeader PackageName
name Version
version)
        Cached MetadataCache
cache Source
source -> do
            -- (1) The single-version cache: a positive snapshot or a cached determined
            -- absence both short-circuit.
            cached <- MetadataCache
-> Source
-> PackageName
-> Version
-> IO (Maybe (Maybe PackageDetails))
cachedVersion MetadataCache
cache Source
source PackageName
name Version
version
            case cached of
                Just Maybe PackageDetails
details -> Either MetadataError (Maybe PackageDetails)
-> IO (Either MetadataError (Maybe PackageDetails))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PackageDetails -> Either MetadataError (Maybe PackageDetails)
forall a b. b -> Either a b
Right Maybe PackageDetails
details)
                Maybe (Maybe PackageDetails)
Nothing -> do
                    -- (2) The warm full-packument cache, read-only: select the version from
                    -- the shared entry the packument @GET@ populated, never writing back to
                    -- the version cache (the install one-call property).
                    warm <- MetadataCache -> Source -> PackageName -> IO (Maybe CacheEntry)
cachedMetadata MetadataCache
cache Source
source PackageName
name
                    case warm of
                        Just CacheEntry
entry -> Either MetadataError (Maybe PackageDetails)
-> IO (Either MetadataError (Maybe PackageDetails))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PackageDetails -> Either MetadataError (Maybe PackageDetails)
forall a b. b -> Either a b
Right (Version -> PackageInfo -> Maybe PackageDetails
selectVersion Version
version (CacheEntry -> PackageInfo
entryInfo CacheEntry
entry)))
                        -- (3) Cold: lead the selective fetch through the version cache.
                        Maybe CacheEntry
Nothing -> IO (Maybe PackageDetails)
-> IO (Either MetadataError (Maybe PackageDetails))
foldVersionCarrier (MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> Version
-> IO (Maybe PackageDetails)
-> IO (Maybe PackageDetails)
resolveVersion MetricsPort
metrics MetadataCache
cache Source
source PackageName
name Version
version (PackageName -> Version -> IO (Maybe PackageDetails)
versionLeader PackageName
name Version
version))

    -- The single-version single-flight leader action: the real selective fetch, run only on
    -- a cold miss, metered and (on failure) logged once before the carrier is raised.
    versionLeader :: PackageName -> Version -> IO (Maybe PackageDetails)
    versionLeader :: PackageName -> Version -> IO (Maybe PackageDetails)
versionLeader PackageName
name Version
version = do
        PackageName -> IO ()
logFetch PackageName
name
        MetricsPort
-> Upstream
-> IO (Maybe PackageDetails)
-> IO (Maybe PackageDetails)
forall a. MetricsPort -> Upstream -> IO a -> IO a
recordedFetch MetricsPort
metrics Upstream
upstream (IO (Maybe PackageDetails) -> IO (Maybe PackageDetails))
-> IO (Maybe PackageDetails) -> IO (Maybe PackageDetails)
forall a b. (a -> b) -> a -> b
$
            PackageName
-> Version -> IO (Either MetadataError (Maybe PackageDetails))
rawFetchVersion PackageName
name Version
version IO (Either MetadataError (Maybe PackageDetails))
-> (Either MetadataError (Maybe PackageDetails)
    -> IO (Maybe PackageDetails))
-> IO (Maybe PackageDetails)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right Maybe PackageDetails
details -> Maybe PackageDetails -> IO (Maybe PackageDetails)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PackageDetails
details
                Left MetadataError
err -> PackageName -> MetadataError -> IO ()
logFailure PackageName
name MetadataError
err IO () -> IO (Maybe PackageDetails) -> IO (Maybe PackageDetails)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VersionFetchFailed -> IO (Maybe PackageDetails)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MetadataError -> VersionFetchFailed
VersionFetchFailed MetadataError
err)

{- | Build a per-request read handle for the npm protocol over one origin's fetch
configuration: the npm full-manifest and single-version fetches as the raw primitives, with
the serve-path caching, metrics, and the failure and dropped-entry logs wired by
'newMetadataClient'.
-}
newNpmMetadataClient ::
    TracingPort ->
    MetricsPort ->
    Metric.Upstream ->
    ManifestCaching ->
    (PackageName -> MetadataError -> IO ()) ->
    (PackageName -> [InvalidEntry] -> IO ()) ->
    (PackageName -> IO ()) ->
    NpmClientConfig ->
    MetadataClient
newNpmMetadataClient :: TracingPort
-> MetricsPort
-> Upstream
-> ManifestCaching
-> (PackageName -> MetadataError -> IO ())
-> (PackageName -> [InvalidEntry] -> IO ())
-> (PackageName -> IO ())
-> NpmClientConfig
-> MetadataClient
newNpmMetadataClient TracingPort
tracing MetricsPort
metrics Upstream
upstream ManifestCaching
caching PackageName -> MetadataError -> IO ()
logFailure PackageName -> [InvalidEntry] -> IO ()
logInvalid PackageName -> IO ()
logFetch NpmClientConfig
config =
    MetricsPort
-> Upstream
-> ManifestCaching
-> (PackageName -> MetadataError -> IO ())
-> (PackageName -> [InvalidEntry] -> IO ())
-> (PackageName -> IO ())
-> (PackageName -> IO (Either MetadataError Manifest))
-> (PackageName
    -> Version -> IO (Either MetadataError (Maybe PackageDetails)))
-> MetadataClient
newMetadataClient MetricsPort
metrics Upstream
upstream ManifestCaching
caching PackageName -> MetadataError -> IO ()
logFailure PackageName -> [InvalidEntry] -> IO ()
logInvalid PackageName -> IO ()
logFetch (TracingPort
-> NpmClientConfig
-> PackageName
-> IO (Either MetadataError Manifest)
fetchNpmManifest TracingPort
tracing NpmClientConfig
config) (TracingPort
-> NpmClientConfig
-> PackageName
-> Version
-> IO (Either MetadataError (Maybe PackageDetails))
fetchNpmVersion TracingPort
tracing NpmClientConfig
config)

-- Select one version's details out of a parsed packument, by its rendered form.
selectVersion :: Version -> PackageInfo -> Maybe PackageDetails
selectVersion :: Version -> PackageInfo -> Maybe PackageDetails
selectVersion Version
version PackageInfo
info = Text -> Map Text PackageDetails -> Maybe PackageDetails
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Version -> Text
renderVersion Version
version) (PackageInfo -> Map Text PackageDetails
infoVersions PackageInfo
info)

{- The in-band failure carrier for a full-manifest leader fetch: a 'MetadataError' raised
so the shared metadata cache caches nothing on failure and re-raises it to coalesced
followers, then converted back to a 'Left' at the resolve boundary. Internal -- the
serve path only ever sees the returned 'Either' (or a genuine transport throw). -}
newtype ManifestFetchFailed = ManifestFetchFailed MetadataError
    deriving stock (Int -> ManifestFetchFailed -> ShowS
[ManifestFetchFailed] -> ShowS
ManifestFetchFailed -> String
(Int -> ManifestFetchFailed -> ShowS)
-> (ManifestFetchFailed -> String)
-> ([ManifestFetchFailed] -> ShowS)
-> Show ManifestFetchFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManifestFetchFailed -> ShowS
showsPrec :: Int -> ManifestFetchFailed -> ShowS
$cshow :: ManifestFetchFailed -> String
show :: ManifestFetchFailed -> String
$cshowList :: [ManifestFetchFailed] -> ShowS
showList :: [ManifestFetchFailed] -> ShowS
Show)

instance Exception ManifestFetchFailed

{- Fold a full-manifest resolve run's carrier back to a 'Left': a leader's parse\/policy
failure is raised as the carrier so the cache stores nothing and re-raises to followers,
and is recovered here. A transport fault is a different type, so it is not caught and
propagates to the serve path's bracket, exactly as before. -}
foldManifestCarrier :: IO CacheEntry -> IO (Either MetadataError Manifest)
foldManifestCarrier :: IO CacheEntry -> IO (Either MetadataError Manifest)
foldManifestCarrier IO CacheEntry
resolve = do
    outcome <- IO CacheEntry -> IO (Either ManifestFetchFailed CacheEntry)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try IO CacheEntry
resolve
    pure $ case outcome of
        Right CacheEntry
entry ->
            Manifest -> Either MetadataError Manifest
forall a b. b -> Either a b
Right
                Manifest
                    { manifestInfo :: PackageInfo
manifestInfo = CacheEntry -> PackageInfo
entryInfo CacheEntry
entry
                    , manifestRaw :: Value
manifestRaw = CacheEntry -> Value
entryRaw CacheEntry
entry
                    , manifestDigest :: ContentDigest
manifestDigest = CacheEntry -> ContentDigest
entryDigest CacheEntry
entry
                    }
        Left (ManifestFetchFailed MetadataError
err) -> MetadataError -> Either MetadataError Manifest
forall a b. a -> Either a b
Left MetadataError
err

{- The single-version analogue of 'ManifestFetchFailed': the carrier a single-version
leader raises so the version cache stores nothing on failure and re-raises to coalesced
followers, recovered to a 'Left' by 'newMetadataClient'. Distinct from
'ManifestFetchFailed' only so each leg's carrier is unambiguous; both wrap a
'MetadataError'. -}
newtype VersionFetchFailed = VersionFetchFailed MetadataError
    deriving stock (Int -> VersionFetchFailed -> ShowS
[VersionFetchFailed] -> ShowS
VersionFetchFailed -> String
(Int -> VersionFetchFailed -> ShowS)
-> (VersionFetchFailed -> String)
-> ([VersionFetchFailed] -> ShowS)
-> Show VersionFetchFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionFetchFailed -> ShowS
showsPrec :: Int -> VersionFetchFailed -> ShowS
$cshow :: VersionFetchFailed -> String
show :: VersionFetchFailed -> String
$cshowList :: [VersionFetchFailed] -> ShowS
showList :: [VersionFetchFailed] -> ShowS
Show)

instance Exception VersionFetchFailed

{- Fold a single-version resolve run's carrier back to a 'Left', mirroring
'foldManifestCarrier': a leader's parse\/policy failure is raised through the cache (which
stores nothing and re-raises to followers) and recovered here; a transport fault is a
different type and propagates to the serve path's bracket. -}
foldVersionCarrier :: IO (Maybe PackageDetails) -> IO (Either MetadataError (Maybe PackageDetails))
foldVersionCarrier :: IO (Maybe PackageDetails)
-> IO (Either MetadataError (Maybe PackageDetails))
foldVersionCarrier IO (Maybe PackageDetails)
resolve = do
    outcome <- IO (Maybe PackageDetails)
-> IO (Either VersionFetchFailed (Maybe PackageDetails))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try IO (Maybe PackageDetails)
resolve
    pure $ case outcome of
        Right Maybe PackageDetails
details -> Maybe PackageDetails -> Either MetadataError (Maybe PackageDetails)
forall a b. b -> Either a b
Right Maybe PackageDetails
details
        Left (VersionFetchFailed MetadataError
err) -> MetadataError -> Either MetadataError (Maybe PackageDetails)
forall a b. a -> Either a b
Left MetadataError
err

{- Record one upstream metadata fetch around the leader action: its latency on a
successful resolve, or the bounded error cause otherwise, before re-raising so the
caller's degrade is unchanged. Wrapping the leader -- which runs only on a cache miss --
means the public path records real upstream calls, not cache hits. Value-agnostic, so it
wraps either leg's leader (a full-manifest 'CacheEntry' or a single-version snapshot). -}
recordedFetch :: MetricsPort -> Metric.Upstream -> IO a -> IO a
recordedFetch :: forall a. MetricsPort -> Upstream -> IO a -> IO a
recordedFetch MetricsPort
metrics Upstream
upstream IO a
action = do
    (result, seconds) <- IO (Either SomeException a) -> IO (Either SomeException a, Double)
forall (m :: * -> *) a. MonadIO m => m a -> m (a, Double)
timedSeconds (IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny IO a
action)
    case result of
        Right a
entry -> do
            MetricsPort -> Upstream -> StatusClass -> Double -> IO ()
mpUpstreamFetch MetricsPort
metrics Upstream
upstream StatusClass
Metric.Status2xx Double
seconds
            a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
entry
        Left SomeException
err -> do
            MetricsPort -> Upstream -> Cause -> IO ()
mpUpstreamFetchError MetricsPort
metrics Upstream
upstream (SomeException -> Cause
fetchCause SomeException
err)
            SomeException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
err

{- Classify a leader-fetch failure into the bounded @ecluse.upstream.fetch.errors@
cause: a decode or name failure is a decode fault, a transport error a connection
fault, a bound breach or anything else the catch-all other. Read off the typed
'MetadataError' the carrier holds rather than any stringly error text, so the cause
stays bounded by construction. -}
fetchCause :: SomeException -> Metric.Cause
fetchCause :: SomeException -> Cause
fetchCause SomeException
err
    | Just (ManifestFetchFailed MetadataError
me) <- SomeException -> Maybe ManifestFetchFailed
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = MetadataError -> Cause
metadataErrorCause MetadataError
me
    | Just (VersionFetchFailed MetadataError
me) <- SomeException -> Maybe VersionFetchFailed
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = MetadataError -> Cause
metadataErrorCause MetadataError
me
    | Just (HttpException
_ :: HTTP.HttpException) <- SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = Cause
Metric.Connection
    | Bool
otherwise = Cause
Metric.OtherCause

metadataErrorCause :: MetadataError -> Metric.Cause
metadataErrorCause :: MetadataError -> Cause
metadataErrorCause = \case
    MetadataError
MetadataUndecodable -> Cause
Metric.Decode
    MetadataNameMismatch Text
_ -> Cause
Metric.Decode
    MetadataBoundExceeded LimitError
_ -> Cause
Metric.OtherCause