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

{- | The per-request metadata handle and typed outcomes shared by registry adapters.
HTTP refusals retain their cause before projection. The serve pipeline owns fallback policy.
-}
module Ecluse.Core.Registry.Metadata (
    -- * The read handle
    MetadataClient (..),

    -- * The full-manifest result
    Manifest (..),
    ContentDigest,
    digestBytes,

    -- * One version's read
    VersionDoc (..),
    VersionRead (..),

    -- * Errors
    MetadataError (..),
    metadataResponse,

    -- * Single-version resolution
    VersionEvaluation (..),
    fetchVersionDetails,
    versionEvaluation,
    versionTransience,
) where

import Ecluse.Core.Package (PackageDetails, PackageInfo, PackageName)
import Ecluse.Core.Registry (BodyOutcome (SuccessBody, UnreadStatus), FetchFault (FetchBoundExceeded), isAuthorisationFailure)
import Ecluse.Core.Registry.CachedDocument (CachedDoc)
import Ecluse.Core.Rules.Types (Transience (WillResolve, WontResolve))
import Ecluse.Core.Security (LimitError (..))
import Ecluse.Core.Snapshot (ContentDigest, digestBytes)
import Ecluse.Core.Version (Version)

-- | A package snapshot with ecosystem-owned serving data and the original source digest.
data Manifest = Manifest
    { Manifest -> PackageInfo
manifestInfo :: PackageInfo
    -- ^ The typed packument view the rules and merge reason over.
    , Manifest -> CachedDoc
manifestRaw :: CachedDoc
    -- ^ The supported source fields ('CachedDoc') used to assemble the served body.
    , Manifest -> Int
manifestBodyBytes :: Int
    -- ^ Decompressed byte count from the source read, before projection.
    , Manifest -> ContentDigest
manifestDigest :: ContentDigest
    -- ^ Digest of the wire bytes behind 'manifestInfo' and 'manifestRaw'.
    }

-- | Per-origin metadata operations with typed failures and caller-selected caching.
data MetadataClient = MetadataClient
    { MetadataClient -> PackageName -> IO (Either MetadataError Manifest)
fetchFullManifest :: PackageName -> IO (Either MetadataError Manifest)
    -- ^ Return the full manifest or a typed failure, including explicit access refusal.
    , MetadataClient
-> PackageName -> Version -> IO (Either MetadataError VersionRead)
fetchVersionMetadata :: PackageName -> Version -> IO (Either MetadataError VersionRead)
    -- ^ One version's projection with the document's own @latest@. Errors retain the upstream failure.
    }

{- | One version's typed projection paired with the object the source declared it with, built
once from one body and never re-paired, so the mirror write republishes what the rules admitted.
-}
data VersionDoc = VersionDoc
    { VersionDoc -> PackageDetails
vdDetails :: PackageDetails
    -- ^ The typed view the rules engine decides on.
    , VersionDoc -> Maybe CachedDoc
vdRaw :: Maybe CachedDoc
    -- ^ Supported fields from the selected source version. 'Nothing' when the adapter retains none.
    }
    deriving stock (VersionDoc -> VersionDoc -> Bool
(VersionDoc -> VersionDoc -> Bool)
-> (VersionDoc -> VersionDoc -> Bool) -> Eq VersionDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionDoc -> VersionDoc -> Bool
== :: VersionDoc -> VersionDoc -> Bool
$c/= :: VersionDoc -> VersionDoc -> Bool
/= :: VersionDoc -> VersionDoc -> Bool
Eq, Int -> VersionDoc -> ShowS
[VersionDoc] -> ShowS
VersionDoc -> String
(Int -> VersionDoc -> ShowS)
-> (VersionDoc -> String)
-> ([VersionDoc] -> ShowS)
-> Show VersionDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionDoc -> ShowS
showsPrec :: Int -> VersionDoc -> ShowS
$cshow :: VersionDoc -> String
show :: VersionDoc -> String
$cshowList :: [VersionDoc] -> ShowS
showList :: [VersionDoc] -> ShowS
Show)

{- | The requested version and the @latest@ tag the same document declared. Both come from one
bounded read, so a caller needing the tag adds no second fetch.
-}
data VersionRead = VersionRead
    { VersionRead -> Maybe VersionDoc
vrVersion :: Maybe VersionDoc
    -- ^ The pair. 'Nothing' means the package resolved without this version.
    , VersionRead -> Int
vrBodyBytes :: Int
    -- ^ Decompressed size of the whole source document, including unselected versions.
    , VersionRead -> Maybe Version
vrUpstreamLatest :: Maybe Version
    -- ^ 'Nothing' when the document declares none, or the ecosystem has no such tag.
    }
    deriving stock (VersionRead -> VersionRead -> Bool
(VersionRead -> VersionRead -> Bool)
-> (VersionRead -> VersionRead -> Bool) -> Eq VersionRead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionRead -> VersionRead -> Bool
== :: VersionRead -> VersionRead -> Bool
$c/= :: VersionRead -> VersionRead -> Bool
/= :: VersionRead -> VersionRead -> Bool
Eq, Int -> VersionRead -> ShowS
[VersionRead] -> ShowS
VersionRead -> String
(Int -> VersionRead -> ShowS)
-> (VersionRead -> String)
-> ([VersionRead] -> ShowS)
-> Show VersionRead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionRead -> ShowS
showsPrec :: Int -> VersionRead -> ShowS
$cshow :: VersionRead -> String
show :: VersionRead -> String
$cshowList :: [VersionRead] -> ShowS
showList :: [VersionRead] -> ShowS
Show)

-- | Why a metadata fetch could not yield a usable result.
data MetadataError
    = -- | The upstream explicitly refused access. Carries the original 401 or 403.
      MetadataAuthorisationFailure Int
    | -- | The upstream answered 404. Its body cannot establish a package's identity.
      MetadataAbsent
    | -- | Another non-success HTTP status, retained for the consumer's retry policy.
      MetadataHttpFailure Int
    | -- | A failed exchange, with request-formation, bound, and transport causes kept distinct.
      MetadataFetch FetchFault
    | -- | The decoded structure crossed a limit, distinct from an exchange body-size failure.
      MetadataBoundExceeded LimitError
    | -- | Malformed bytes or a missing package identity prevented manifest decoding.
      MetadataUndecodable
    | -- | An invalid package identity, carried for diagnostics and excluded from the requested package.
      MetadataNameMismatch Text
    deriving stock (MetadataError -> MetadataError -> Bool
(MetadataError -> MetadataError -> Bool)
-> (MetadataError -> MetadataError -> Bool) -> Eq MetadataError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataError -> MetadataError -> Bool
== :: MetadataError -> MetadataError -> Bool
$c/= :: MetadataError -> MetadataError -> Bool
/= :: MetadataError -> MetadataError -> Bool
Eq, Int -> MetadataError -> ShowS
[MetadataError] -> ShowS
MetadataError -> String
(Int -> MetadataError -> ShowS)
-> (MetadataError -> String)
-> ([MetadataError] -> ShowS)
-> Show MetadataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataError -> ShowS
showsPrec :: Int -> MetadataError -> ShowS
$cshow :: MetadataError -> String
show :: MetadataError -> String
$cshowList :: [MetadataError] -> ShowS
showList :: [MetadataError] -> ShowS
Show)

-- | A version lookup result shared by public admission and mirror workers.
data VersionEvaluation
    = -- | The version resolved and projected. The second field is the same document's @latest@.
      VersionPresent VersionDoc (Maybe Version)
    | -- | The package exists but does not supply the requested version.
      VersionMissing
    | -- | Metadata was unavailable. Public admission and workers retain their retry policy.
      VersionMetadataUnavailable
    deriving stock (VersionEvaluation -> VersionEvaluation -> Bool
(VersionEvaluation -> VersionEvaluation -> Bool)
-> (VersionEvaluation -> VersionEvaluation -> Bool)
-> Eq VersionEvaluation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionEvaluation -> VersionEvaluation -> Bool
== :: VersionEvaluation -> VersionEvaluation -> Bool
$c/= :: VersionEvaluation -> VersionEvaluation -> Bool
/= :: VersionEvaluation -> VersionEvaluation -> Bool
Eq, Int -> VersionEvaluation -> ShowS
[VersionEvaluation] -> ShowS
VersionEvaluation -> String
(Int -> VersionEvaluation -> ShowS)
-> (VersionEvaluation -> String)
-> ([VersionEvaluation] -> ShowS)
-> Show VersionEvaluation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionEvaluation -> ShowS
showsPrec :: Int -> VersionEvaluation -> ShowS
$cshow :: VersionEvaluation -> String
show :: VersionEvaluation -> String
$cshowList :: [VersionEvaluation] -> ShowS
showList :: [VersionEvaluation] -> ShowS
Show)

-- | Classify a version lookup for public admission and workers, treating metadata failures as transient.
fetchVersionDetails :: MetadataClient -> PackageName -> Version -> IO VersionEvaluation
fetchVersionDetails :: MetadataClient -> PackageName -> Version -> IO VersionEvaluation
fetchVersionDetails MetadataClient
client PackageName
name Version
version =
    Either MetadataError VersionRead -> VersionEvaluation
versionEvaluation (Either MetadataError VersionRead -> VersionEvaluation)
-> IO (Either MetadataError VersionRead) -> IO VersionEvaluation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetadataClient
-> PackageName -> Version -> IO (Either MetadataError VersionRead)
fetchVersionMetadata MetadataClient
client PackageName
name Version
version

-- | Classify a resolved selected read without changing its acquisition lifetime.
versionEvaluation :: Either MetadataError VersionRead -> VersionEvaluation
versionEvaluation :: Either MetadataError VersionRead -> VersionEvaluation
versionEvaluation = \case
    Left MetadataError
_ -> VersionEvaluation
VersionMetadataUnavailable
    Right VersionRead
versionRead -> case VersionRead -> Maybe VersionDoc
vrVersion VersionRead
versionRead of
        Maybe VersionDoc
Nothing -> VersionEvaluation
VersionMissing
        Just VersionDoc
present -> VersionDoc -> Maybe Version -> VersionEvaluation
VersionPresent VersionDoc
present (VersionRead -> Maybe Version
vrUpstreamLatest VersionRead
versionRead)

-- | Classify unsuccessful lookups for retry. A resolved version has no transience.
versionTransience :: VersionEvaluation -> Maybe Transience
versionTransience :: VersionEvaluation -> Maybe Transience
versionTransience = \case
    VersionEvaluation
VersionMetadataUnavailable -> Transience -> Maybe Transience
forall a. a -> Maybe a
Just (Maybe RetryAfter -> Transience
WillResolve Maybe RetryAfter
forall a. Maybe a
Nothing)
    -- A withdrawn version is gone for good, so no consumer waits for it to come back.
    VersionEvaluation
VersionMissing -> Transience -> Maybe Transience
forall a. a -> Maybe a
Just Transience
WontResolve
    VersionPresent{} -> Maybe Transience
forall a. Maybe a
Nothing

-- | Classify a metadata exchange. A 404 cannot establish identity, and a refusal keeps its status.
metadataResponse :: Either FetchFault (BodyOutcome a) -> Either MetadataError a
metadataResponse :: forall a.
Either FetchFault (BodyOutcome a) -> Either MetadataError a
metadataResponse = \case
    Left FetchFault
fault -> MetadataError -> Either MetadataError a
forall a b. a -> Either a b
Left (FetchFault -> MetadataError
metadataFetchError FetchFault
fault)
    Right (SuccessBody Int
_ a
parsed) -> a -> Either MetadataError a
forall a b. b -> Either a b
Right a
parsed
    Right (UnreadStatus Int
404) -> MetadataError -> Either MetadataError a
forall a b. a -> Either a b
Left MetadataError
MetadataAbsent
    Right (UnreadStatus Int
code)
        | Int -> Bool
isAuthorisationFailure Int
code -> MetadataError -> Either MetadataError a
forall a b. a -> Either a b
Left (Int -> MetadataError
MetadataAuthorisationFailure Int
code)
        | Bool
otherwise -> MetadataError -> Either MetadataError a
forall a b. a -> Either a b
Left (Int -> MetadataError
MetadataHttpFailure Int
code)

-- Keep body and transport faults distinct from structural bounds enforced during incremental extraction.
metadataFetchError :: FetchFault -> MetadataError
metadataFetchError :: FetchFault -> MetadataError
metadataFetchError FetchFault
fault = case FetchFault
fault of
    FetchBoundExceeded LimitError
limit -> case LimitError
limit of
        BodyTooLarge BodyLimit
_ -> FetchFault -> MetadataError
MetadataFetch FetchFault
fault
        TooManyVersions Int
_ Int
_ -> LimitError -> MetadataError
MetadataBoundExceeded LimitError
limit
        TooManyArtifacts Int
_ Int
_ -> LimitError -> MetadataError
MetadataBoundExceeded LimitError
limit
        TooDeeplyNested Int
_ -> LimitError -> MetadataError
MetadataBoundExceeded LimitError
limit
    FetchFault
_ -> FetchFault -> MetadataError
MetadataFetch FetchFault
fault