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

{- | The refusals the artifact path can answer with, and their rendering onto the route's replies.

The leg dispatch and the public leg render through here, so one artifact outcome has one status and
one message wherever it was decided.
-}
module Ecluse.Core.Server.Pipeline.Tarball.Refusal (
    -- * Rendering a refusal
    artifactOutcomeStatus,
    artifactError,
    internalArtifactError,
    crossHostRefused,

    -- * The refusals themselves
    upstreamUnavailable,
    versionAbsent,
    firstPartyMissRefusal,
) where

import Network.HTTP.Types (ResponseHeaders, status403, status500)

import Ecluse.Core.Registry.Metadata (
    VersionEvaluation (VersionMetadataUnavailable, VersionMissing),
    versionTransience,
 )
import Ecluse.Core.Server.Context (PackumentDeps, pdHelp)
import Ecluse.Core.Server.Pipeline.Origin (OriginMiss (MissAbsent, MissUnresolved))
import Ecluse.Core.Server.Pipeline.Shared
import Ecluse.Core.Server.Pipeline.Tarball.Types (TarballReplies (tarballError))
import Ecluse.Core.Server.Response (
    ArtifactStatus (Forbidden, NotFound, Ok, ServerError, Unavailable'),
    RejectReason (ByPolicy),
    Rejection (Rejection, rejectionMessage),
    ServeDecision (Admit, Reject),
    Transience (WillResolve, WontResolve),
    artifactHttpStatus,
    artifactStatus,
    mkRefusal,
    rejectUnavailable,
 )

-- | Missing versions and a first-party absence map to 404. Other outcomes use 'artifactStatus'.
artifactOutcomeStatus :: ServeDecision -> ArtifactStatus
artifactOutcomeStatus :: ServeDecision -> ArtifactStatus
artifactOutcomeStatus ServeDecision
decision
    | ServeDecision
decision ServeDecision -> [ServeDecision] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [ServeDecision
versionAbsent, ServeDecision
firstPartyAbsent] = ArtifactStatus
NotFound
    | Bool
otherwise = ServeDecision -> ArtifactStatus
artifactStatus ServeDecision
decision

{- | Render a non-admit artifact outcome as the serve error model. A transient status carries no
suggested delay, because the single-artifact path has none to offer.
-}
artifactError :: TarballReplies response -> PackumentDeps -> ServeDecision -> response
artifactError :: forall response.
TarballReplies response
-> PackumentDeps -> ServeDecision -> response
artifactError TarballReplies response
replies PackumentDeps
deps ServeDecision
decision =
    TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
forall response.
TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
tarballError TarballReplies response
replies (ArtifactStatus -> Status
artifactHttpStatus ArtifactStatus
status) ResponseHeaders
retryHeaders (Maybe HelpMessage -> Text -> Refusal
mkRefusal (PackumentDeps -> Maybe HelpMessage
pdHelp PackumentDeps
deps) Text
message)
  where
    status :: ArtifactStatus
    status :: ArtifactStatus
status = ServeDecision -> ArtifactStatus
artifactOutcomeStatus ServeDecision
decision

    retryHeaders :: ResponseHeaders
    retryHeaders :: ResponseHeaders
retryHeaders = case ArtifactStatus
status of
        Unavailable' Maybe RetryAfter
retry -> Maybe RetryAfter -> ResponseHeaders
retryAfterHeaders Maybe RetryAfter
retry
        ArtifactStatus
Ok -> []
        ArtifactStatus
Forbidden -> []
        ArtifactStatus
ServerError -> []
        ArtifactStatus
NotFound -> []

    message :: Text
    message :: Text
message = case ServeDecision
decision of
        ServeDecision
Admit -> Text
"the artifact is available"
        Reject Rejection
rej -> Rejection -> Text
rejectionMessage Rejection
rej

-- | The @500@ for an artifact URL that configuration and the package name could not form.
internalArtifactError :: TarballReplies response -> response
internalArtifactError :: forall response. TarballReplies response -> response
internalArtifactError TarballReplies response
replies =
    TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
forall response.
TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
tarballError TarballReplies response
replies Status
status500 [] (Maybe HelpMessage -> Text -> Refusal
mkRefusal Maybe HelpMessage
forall a. Maybe a
Nothing Text
"could not form the upstream artifact URL")

-- | The @403@ for an artifact host the tarball-host policy does not permit.
crossHostRefused :: TarballReplies response -> response
crossHostRefused :: forall response. TarballReplies response -> response
crossHostRefused TarballReplies response
replies =
    TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
forall response.
TarballReplies response
-> Status -> ResponseHeaders -> Refusal -> response
tarballError TarballReplies response
replies Status
status403 [] (Maybe HelpMessage -> Text -> Refusal
mkRefusal Maybe HelpMessage
forall a. Maybe a
Nothing Text
"the upstream artifact host is not permitted by the tarball-host policy")

-- | A transient public-upstream outage (to @503@).
upstreamUnavailable :: ServeDecision
upstreamUnavailable :: ServeDecision
upstreamUnavailable =
    VersionEvaluation -> Text -> ServeDecision
versionUnresolved VersionEvaluation
VersionMetadataUnavailable Text
"the upstream registry was unavailable"

{- | A version absent from the public metadata. Its cause is terminal, and 'artifactOutcomeStatus'
overrides that status to a @404@ forwarded miss.
-}
versionAbsent :: ServeDecision
versionAbsent :: ServeDecision
versionAbsent =
    VersionEvaluation -> Text -> ServeDecision
versionUnresolved VersionEvaluation
VersionMissing Text
"the requested version was not found upstream"

-- | The refusal a first-party private miss renders: a settled absence @404@, an outage @503@.
firstPartyMissRefusal :: OriginMiss -> ServeDecision
firstPartyMissRefusal :: OriginMiss -> ServeDecision
firstPartyMissRefusal = \case
    OriginMiss
MissAbsent -> ServeDecision
firstPartyAbsent
    OriginMiss
MissUnresolved -> ServeDecision
firstPartyUnresolved

{- A first-party artifact the private upstream does not hold. No public artifact may stand in for
it, and 'artifactOutcomeStatus' renders it @404@. -}
firstPartyAbsent :: ServeDecision
firstPartyAbsent :: ServeDecision
firstPartyAbsent =
    Rejection -> ServeDecision
Reject
        ( RejectReason -> Text -> Rejection
Rejection
            (RuleName -> RejectReason
ByPolicy RuleName
firstPartyRule)
            Text
"the requested artifact is first-party to this deployment, so it is served from the private upstream only and is never fetched from the public registry"
        )

{- A first-party artifact whose private upstream could not be read. That upstream is the name's one
authority, so a retry may still resolve it. -}
firstPartyUnresolved :: ServeDecision
firstPartyUnresolved :: ServeDecision
firstPartyUnresolved =
    Transience -> Text -> ServeDecision
rejectUnavailable
        (Maybe RetryAfter -> Transience
WillResolve Maybe RetryAfter
forall a. Maybe a
Nothing)
        Text
"the private upstream for this first-party artifact was unavailable"

{- The refusal a version the single-version read could not resolve renders as. Its transience is
the shared projection's, the one the worker's retry-versus-drop reads. -}
versionUnresolved :: VersionEvaluation -> Text -> ServeDecision
versionUnresolved :: VersionEvaluation -> Text -> ServeDecision
versionUnresolved VersionEvaluation
eval = Transience -> Text -> ServeDecision
rejectUnavailable (Transience -> Maybe Transience -> Transience
forall a. a -> Maybe a -> a
fromMaybe Transience
WontResolve (VersionEvaluation -> Maybe Transience
versionTransience VersionEvaluation
eval))