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

{- | Registry payloads and typed failures shared by the protocol capabilities.
Read responses retain the HTTP status so metadata projection cannot erase access refusals.
-}
module Ecluse.Core.Registry (
    -- * Fetch payload
    RegistryResponse (..),
    BodyOutcome (..),
    isAuthorisationFailure,
    isSuccessStatus,

    -- * Publish descriptor
    MirrorArtifact (..),
    firstHashValue,

    -- * Errors
    ParseError (..),
    FetchFault (..),
    PublishError (..),
    PublishFault (..),
    UrlFormationError (..),
    renderUrlFormationError,
    PublishRelayResponse (..),
) where

import Ecluse.Core.Fault (TransportFault)
import Ecluse.Core.Package (Hash, HashAlg, hashAlg, hashValue)
import Ecluse.Core.Security (LimitError, authorityLabel)
import Ecluse.Core.Server.Path (Filename)

-- | Upstream status and bytes retained before protocol decoding.
data RegistryResponse = RegistryResponse
    { RegistryResponse -> Int
responseStatusCode :: Int
    -- ^ The upstream status, retained before body projection.
    , RegistryResponse -> Int
responseBodyBytes :: Int
    -- ^ Decompressed bytes consumed by the bounded read, zero when the body was omitted.
    , RegistryResponse -> ByteString
responseBody :: ByteString
    -- ^ The bounded response body, omitted for explicit access refusals.
    }
    deriving stock (RegistryResponse -> RegistryResponse -> Bool
(RegistryResponse -> RegistryResponse -> Bool)
-> (RegistryResponse -> RegistryResponse -> Bool)
-> Eq RegistryResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegistryResponse -> RegistryResponse -> Bool
== :: RegistryResponse -> RegistryResponse -> Bool
$c/= :: RegistryResponse -> RegistryResponse -> Bool
/= :: RegistryResponse -> RegistryResponse -> Bool
Eq, Int -> RegistryResponse -> ShowS
[RegistryResponse] -> ShowS
RegistryResponse -> String
(Int -> RegistryResponse -> ShowS)
-> (RegistryResponse -> String)
-> ([RegistryResponse] -> ShowS)
-> Show RegistryResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegistryResponse -> ShowS
showsPrec :: Int -> RegistryResponse -> ShowS
$cshow :: RegistryResponse -> String
show :: RegistryResponse -> String
$cshowList :: [RegistryResponse] -> ShowS
showList :: [RegistryResponse] -> ShowS
Show)

-- | The answer to a read that consumes only a 2xx body.
data BodyOutcome a
    = -- | The 2xx status and the consumer's result.
      SuccessBody Int a
    | -- | A status outside 2xx. The consumer never ran, so no result exists.
      UnreadStatus Int
    deriving stock (BodyOutcome a -> BodyOutcome a -> Bool
(BodyOutcome a -> BodyOutcome a -> Bool)
-> (BodyOutcome a -> BodyOutcome a -> Bool) -> Eq (BodyOutcome a)
forall a. Eq a => BodyOutcome a -> BodyOutcome a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BodyOutcome a -> BodyOutcome a -> Bool
== :: BodyOutcome a -> BodyOutcome a -> Bool
$c/= :: forall a. Eq a => BodyOutcome a -> BodyOutcome a -> Bool
/= :: BodyOutcome a -> BodyOutcome a -> Bool
Eq, Int -> BodyOutcome a -> ShowS
[BodyOutcome a] -> ShowS
BodyOutcome a -> String
(Int -> BodyOutcome a -> ShowS)
-> (BodyOutcome a -> String)
-> ([BodyOutcome a] -> ShowS)
-> Show (BodyOutcome a)
forall a. Show a => Int -> BodyOutcome a -> ShowS
forall a. Show a => [BodyOutcome a] -> ShowS
forall a. Show a => BodyOutcome a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BodyOutcome a -> ShowS
showsPrec :: Int -> BodyOutcome a -> ShowS
$cshow :: forall a. Show a => BodyOutcome a -> String
show :: BodyOutcome a -> String
$cshowList :: forall a. Show a => [BodyOutcome a] -> ShowS
showList :: [BodyOutcome a] -> ShowS
Show, (forall a b. (a -> b) -> BodyOutcome a -> BodyOutcome b)
-> (forall a b. a -> BodyOutcome b -> BodyOutcome a)
-> Functor BodyOutcome
forall a b. a -> BodyOutcome b -> BodyOutcome a
forall a b. (a -> b) -> BodyOutcome a -> BodyOutcome b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> BodyOutcome a -> BodyOutcome b
fmap :: forall a b. (a -> b) -> BodyOutcome a -> BodyOutcome b
$c<$ :: forall a b. a -> BodyOutcome b -> BodyOutcome a
<$ :: forall a b. a -> BodyOutcome b -> BodyOutcome a
Functor)

-- | Whether an upstream status explicitly refuses authentication or authorisation.
isAuthorisationFailure :: Int -> Bool
isAuthorisationFailure :: Int -> Bool
isAuthorisationFailure Int
code = Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
401 Bool -> Bool -> Bool
|| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
403

-- | Whether an upstream status reports success. Every leg reads this one test, so none can drift.
isSuccessStatus :: Int -> Bool
isSuccessStatus :: Int -> Bool
isSuccessStatus Int
code = Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300

-- | The artifact descriptor the mirror publish uses.
data MirrorArtifact = MirrorArtifact
    { MirrorArtifact -> Filename
maFilename :: Filename
    -- ^ The artifact's on-the-wire filename, the @_attachments@ key in the publish document.
    , MirrorArtifact -> NonEmpty Hash
maHashes :: NonEmpty Hash
    -- ^ The integrity digests, at least one. The tamper gate verified the fetched bytes against this floor-checked set.
    , MirrorArtifact -> Maybe Int
maSize :: Maybe Int
    -- ^ Registry-declared size, which may describe the unpacked tree rather than transferred bytes.
    }
    deriving stock (MirrorArtifact -> MirrorArtifact -> Bool
(MirrorArtifact -> MirrorArtifact -> Bool)
-> (MirrorArtifact -> MirrorArtifact -> Bool) -> Eq MirrorArtifact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MirrorArtifact -> MirrorArtifact -> Bool
== :: MirrorArtifact -> MirrorArtifact -> Bool
$c/= :: MirrorArtifact -> MirrorArtifact -> Bool
/= :: MirrorArtifact -> MirrorArtifact -> Bool
Eq, Int -> MirrorArtifact -> ShowS
[MirrorArtifact] -> ShowS
MirrorArtifact -> String
(Int -> MirrorArtifact -> ShowS)
-> (MirrorArtifact -> String)
-> ([MirrorArtifact] -> ShowS)
-> Show MirrorArtifact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MirrorArtifact -> ShowS
showsPrec :: Int -> MirrorArtifact -> ShowS
$cshow :: MirrorArtifact -> String
show :: MirrorArtifact -> String
$cshowList :: [MirrorArtifact] -> ShowS
showList :: [MirrorArtifact] -> ShowS
Show)

-- | The digest value of the first 'Hash' with the given 'HashAlg', or 'Nothing' when the artifact carries none.
firstHashValue :: HashAlg -> MirrorArtifact -> Maybe Text
firstHashValue :: HashAlg -> MirrorArtifact -> Maybe Text
firstHashValue HashAlg
alg MirrorArtifact
artifact =
    (Hash -> Text) -> Maybe Hash -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash -> Text
hashValue ((Hash -> Bool) -> NonEmpty Hash -> Maybe Hash
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((HashAlg -> HashAlg -> Bool
forall a. Eq a => a -> a -> Bool
== HashAlg
alg) (HashAlg -> Bool) -> (Hash -> HashAlg) -> Hash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> HashAlg
hashAlg) (MirrorArtifact -> NonEmpty Hash
maHashes MirrorArtifact
artifact))

-- | A protocol decode failure for the caller to classify.
newtype ParseError = ParseError
    { ParseError -> Text
parseErrorMessage :: Text
    -- ^ A human-readable description of what could not be parsed.
    }
    deriving stock (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

-- | Why publishing an artifact to a registry failed, the fault 'Ecluse.Core.Registry.Publish.mpPublishArtifact' reports.
newtype PublishError = PublishError
    { PublishError -> Text
publishErrorMessage :: Text
    -- ^ A human-readable description of why the publish failed.
    }
    deriving stock (PublishError -> PublishError -> Bool
(PublishError -> PublishError -> Bool)
-> (PublishError -> PublishError -> Bool) -> Eq PublishError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublishError -> PublishError -> Bool
== :: PublishError -> PublishError -> Bool
$c/= :: PublishError -> PublishError -> Bool
/= :: PublishError -> PublishError -> Bool
Eq, Int -> PublishError -> ShowS
[PublishError] -> ShowS
PublishError -> String
(Int -> PublishError -> ShowS)
-> (PublishError -> String)
-> ([PublishError] -> ShowS)
-> Show PublishError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishError -> ShowS
showsPrec :: Int -> PublishError -> ShowS
$cshow :: PublishError -> String
show :: PublishError -> String
$cshowList :: [PublishError] -> ShowS
showList :: [PublishError] -> ShowS
Show)

-- | Why an upstream request URL could not be formed from configuration and a parsed 'Ecluse.Core.Package.PackageName'.
data UrlFormationError
    = -- | The configured base URL is empty, so no request URL can be formed.
      EmptyBaseUrl
    | -- | The formed URL string could not be parsed into a request. Carries the offending URL.
      UnparseableUrl Text
    deriving stock (UrlFormationError -> UrlFormationError -> Bool
(UrlFormationError -> UrlFormationError -> Bool)
-> (UrlFormationError -> UrlFormationError -> Bool)
-> Eq UrlFormationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlFormationError -> UrlFormationError -> Bool
== :: UrlFormationError -> UrlFormationError -> Bool
$c/= :: UrlFormationError -> UrlFormationError -> Bool
/= :: UrlFormationError -> UrlFormationError -> Bool
Eq, Int -> UrlFormationError -> ShowS
[UrlFormationError] -> ShowS
UrlFormationError -> String
(Int -> UrlFormationError -> ShowS)
-> (UrlFormationError -> String)
-> ([UrlFormationError] -> ShowS)
-> Show UrlFormationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlFormationError -> ShowS
showsPrec :: Int -> UrlFormationError -> ShowS
$cshow :: UrlFormationError -> String
show :: UrlFormationError -> String
$cshowList :: [UrlFormationError] -> ShowS
showList :: [UrlFormationError] -> ShowS
Show)

-- | Render a URL formation failure with its URL reduced to an authority, excluding userinfo and queries.
renderUrlFormationError :: UrlFormationError -> Text
renderUrlFormationError :: UrlFormationError -> Text
renderUrlFormationError = \case
    UrlFormationError
EmptyBaseUrl -> Text
"EmptyBaseUrl"
    UnparseableUrl Text
url -> Text
"UnparseableUrl " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
url

-- | A request-formation, response-bound, or transport failure before a usable response.
data FetchFault
    = -- | The request URL could not be formed from the base URL and the package identity.
      FetchUrlUnformable UrlFormationError
    | -- | The peer's body crossed the response-size bound, and the read refused it fail-closed.
      FetchBoundExceeded LimitError
    | -- | The adapter classified a failed or interrupted exchange.
      FetchTransport TransportFault
    deriving stock (FetchFault -> FetchFault -> Bool
(FetchFault -> FetchFault -> Bool)
-> (FetchFault -> FetchFault -> Bool) -> Eq FetchFault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FetchFault -> FetchFault -> Bool
== :: FetchFault -> FetchFault -> Bool
$c/= :: FetchFault -> FetchFault -> Bool
/= :: FetchFault -> FetchFault -> Bool
Eq, Int -> FetchFault -> ShowS
[FetchFault] -> ShowS
FetchFault -> String
(Int -> FetchFault -> ShowS)
-> (FetchFault -> String)
-> ([FetchFault] -> ShowS)
-> Show FetchFault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FetchFault -> ShowS
showsPrec :: Int -> FetchFault -> ShowS
$cshow :: FetchFault -> String
show :: FetchFault -> String
$cshowList :: [FetchFault] -> ShowS
showList :: [FetchFault] -> ShowS
Show)

-- | The response from the publication target after relaying a publish document.
data PublishRelayResponse = PublishRelayResponse
    { PublishRelayResponse -> Int
relayStatus :: Int
    -- ^ The HTTP status code the publication target returned.
    , PublishRelayResponse -> LByteString
relayBody :: LByteString
    -- ^ The publication target's response body, relayed to the client unchanged.
    }
    deriving stock (PublishRelayResponse -> PublishRelayResponse -> Bool
(PublishRelayResponse -> PublishRelayResponse -> Bool)
-> (PublishRelayResponse -> PublishRelayResponse -> Bool)
-> Eq PublishRelayResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublishRelayResponse -> PublishRelayResponse -> Bool
== :: PublishRelayResponse -> PublishRelayResponse -> Bool
$c/= :: PublishRelayResponse -> PublishRelayResponse -> Bool
/= :: PublishRelayResponse -> PublishRelayResponse -> Bool
Eq, Int -> PublishRelayResponse -> ShowS
[PublishRelayResponse] -> ShowS
PublishRelayResponse -> String
(Int -> PublishRelayResponse -> ShowS)
-> (PublishRelayResponse -> String)
-> ([PublishRelayResponse] -> ShowS)
-> Show PublishRelayResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishRelayResponse -> ShowS
showsPrec :: Int -> PublishRelayResponse -> ShowS
$cshow :: PublishRelayResponse -> String
show :: PublishRelayResponse -> String
$cshowList :: [PublishRelayResponse] -> ShowS
showList :: [PublishRelayResponse] -> ShowS
Show)

-- | Separate exchange faults from registry rejections so workers can choose retry or drop.
data PublishFault
    = -- | An exchange failure whose retry disposition follows the shared fetch-fault model.
      PublishFetch FetchFault
    | -- | The registry answered and rejected the write (a non-2xx, non-@409@ status). Retryable.
      PublishRejected PublishError
    | -- | The writer had no usable source version object, so it formed no request. Not retryable.
      PublishSourceUnavailable Text
    deriving stock (PublishFault -> PublishFault -> Bool
(PublishFault -> PublishFault -> Bool)
-> (PublishFault -> PublishFault -> Bool) -> Eq PublishFault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublishFault -> PublishFault -> Bool
== :: PublishFault -> PublishFault -> Bool
$c/= :: PublishFault -> PublishFault -> Bool
/= :: PublishFault -> PublishFault -> Bool
Eq, Int -> PublishFault -> ShowS
[PublishFault] -> ShowS
PublishFault -> String
(Int -> PublishFault -> ShowS)
-> (PublishFault -> String)
-> ([PublishFault] -> ShowS)
-> Show PublishFault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishFault -> ShowS
showsPrec :: Int -> PublishFault -> ShowS
$cshow :: PublishFault -> String
show :: PublishFault -> String
$cshowList :: [PublishFault] -> ShowS
showList :: [PublishFault] -> ShowS
Show)