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

{- | The single public-version admission gate: the rules engine decides the __version__, the
requested 'Filename' selects the __artifact__, and the integrity floor decides whether that
artifact's digests are __strong enough to gate__.

The serve path's tarball gate and the worker's ingest re-evaluation both call the one
'admitArtifact', so a version the worker would freeze into the rule-exempt mirror is exactly a
version the serve gate would admit. Neither decides for itself whether a retry could change a
refusal, which is 'admissionTransience', read by both.
-}
module Ecluse.Core.Package.Admission (
    ArtifactAdmission (..),
    admissionTransience,
    admitArtifact,
    admitArtifactWithEvidence,
) where

import Ecluse.Core.Package (Artifact, Hash, PackageDetails, artFilename, artHashes, pkgArtifacts)
import Ecluse.Core.Package.Integrity (
    MinIntegrity,
    VersionIntegrity (BelowFloor, MeetsFloor, NoIntegrity),
    classifyArtifacts,
 )
import Ecluse.Core.Rules (PreparedRule, evalRules)
import Ecluse.Core.Rules.Types (
    Decision (Admitted, Blocked, BlockedByDefault, Undecidable),
    EvalContext,
    SkippedCheck,
    Transience (WontResolve),
    completeEvidence,
    skippedChecks,
 )
import Ecluse.Core.Server.Path (Filename, unFilename)

{- | The admission verdict for one requested artifact. An inability to decide is no refusal: serve
renders @503@\/@500@, and the worker redelivers or drops per 'admissionTransience'.
-}
data ArtifactAdmission
    = {- | Admitted, with digests clearing the integrity floor. Carries the 'Filename' the gate
      matched against current metadata, and the floor-checked digest set.
      -}
      AdmissionAdmit Filename Artifact (NonEmpty Hash)
    | {- | A rule, or deny-by-default, blocked the version. Carries the 'Decision' so each consumer
      renders the deciding rule and reason on its own surface.
      -}
      AdmissionDenied Decision
    | {- | A fail-closed rule could not vet the version. Carries the 'Undecidable' 'Decision', whose
      transience 'admissionTransience' reads out for both consumers.
      -}
      AdmissionUndecidable Decision
    | {- | Admitted, but no artifact carries the requested filename: a forwarded miss on serve, a
      withdrawn-file drop at the worker, never a fabricated location.
      -}
      AdmissionFileAbsent
    | {- | The selected artifact carries no digest at all, so nothing ties its bytes to a
      fingerprint. Kept apart from 'AdmissionBelowFloor' so the refusal can say which.
      -}
      AdmissionIntegrityMissing
    | {- | The selected artifact carries digests, but none meets the configured public-integrity
      floor (a legacy SHA-1 shasum only, under a SHA-256 floor).
      -}
      AdmissionBelowFloor
    deriving stock (Int -> ArtifactAdmission -> ShowS
[ArtifactAdmission] -> ShowS
ArtifactAdmission -> String
(Int -> ArtifactAdmission -> ShowS)
-> (ArtifactAdmission -> String)
-> ([ArtifactAdmission] -> ShowS)
-> Show ArtifactAdmission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArtifactAdmission -> ShowS
showsPrec :: Int -> ArtifactAdmission -> ShowS
$cshow :: ArtifactAdmission -> String
show :: ArtifactAdmission -> String
$cshowList :: [ArtifactAdmission] -> ShowS
showList :: [ArtifactAdmission] -> ShowS
Show)

{- | Decide one requested artifact under current policy: the rules, then the filename, then the
integrity floor. Serve and worker pass the same inputs, so re-evaluation can only /narrow/.
-}
admitArtifact ::
    EvalContext ->
    [PreparedRule] ->
    MinIntegrity ->
    -- | The requested artifact filename (the client's, or the mirror job's).
    Filename ->
    PackageDetails ->
    IO ArtifactAdmission
admitArtifact :: EvalContext
-> [PreparedRule]
-> MinIntegrity
-> Filename
-> PackageDetails
-> IO ArtifactAdmission
admitArtifact EvalContext
ctx [PreparedRule]
rules MinIntegrity
minIntegrity Filename
file PackageDetails
details =
    (ArtifactAdmission, [SkippedCheck]) -> ArtifactAdmission
forall a b. (a, b) -> a
fst ((ArtifactAdmission, [SkippedCheck]) -> ArtifactAdmission)
-> IO (ArtifactAdmission, [SkippedCheck]) -> IO ArtifactAdmission
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalContext
-> [PreparedRule]
-> MinIntegrity
-> Filename
-> PackageDetails
-> IO (ArtifactAdmission, [SkippedCheck])
admitArtifactWithEvidence EvalContext
ctx [PreparedRule]
rules MinIntegrity
minIntegrity Filename
file PackageDetails
details

{- | 'admitArtifact' beside the skipped-check evidence its decision carried, empty unless the
version was admitted, for the audit line the gate emits once.
-}
admitArtifactWithEvidence ::
    EvalContext ->
    [PreparedRule] ->
    MinIntegrity ->
    Filename ->
    PackageDetails ->
    IO (ArtifactAdmission, [SkippedCheck])
admitArtifactWithEvidence :: EvalContext
-> [PreparedRule]
-> MinIntegrity
-> Filename
-> PackageDetails
-> IO (ArtifactAdmission, [SkippedCheck])
admitArtifactWithEvidence EvalContext
ctx [PreparedRule]
rules MinIntegrity
minIntegrity Filename
file PackageDetails
details = do
    decision <- EvalContext -> [PreparedRule] -> RuleEvidence -> IO Decision
evalRules EvalContext
ctx [PreparedRule]
rules (PackageDetails -> RuleEvidence
completeEvidence PackageDetails
details)
    pure (admissionOf minIntegrity file details decision, skippedChecks decision)

-- The filename and integrity steps over a settled rules decision.
admissionOf :: MinIntegrity -> Filename -> PackageDetails -> Decision -> ArtifactAdmission
admissionOf :: MinIntegrity
-> Filename -> PackageDetails -> Decision -> ArtifactAdmission
admissionOf MinIntegrity
minIntegrity Filename
file PackageDetails
details Decision
decision =
    case Decision
decision of
        Admitted{} -> MinIntegrity -> Filename -> PackageDetails -> ArtifactAdmission
admitFile MinIntegrity
minIntegrity Filename
file PackageDetails
details
        Blocked{} -> Decision -> ArtifactAdmission
AdmissionDenied Decision
decision
        BlockedByDefault{} -> Decision -> ArtifactAdmission
AdmissionDenied Decision
decision
        Undecidable{} -> Decision -> ArtifactAdmission
AdmissionUndecidable Decision
decision

-- The filename and integrity steps, once the rules engine has admitted the version.
admitFile :: MinIntegrity -> Filename -> PackageDetails -> ArtifactAdmission
admitFile :: MinIntegrity -> Filename -> PackageDetails -> ArtifactAdmission
admitFile MinIntegrity
minIntegrity Filename
file PackageDetails
details = case Filename -> PackageDetails -> Maybe Artifact
artifactFor Filename
file PackageDetails
details of
    Maybe Artifact
Nothing -> ArtifactAdmission
AdmissionFileAbsent
    Just Artifact
artifact -> case MinIntegrity -> NonEmpty Artifact -> VersionIntegrity
forall floor.
IntegrityFloor floor =>
floor -> NonEmpty Artifact -> VersionIntegrity
classifyArtifacts MinIntegrity
minIntegrity (Artifact
artifact Artifact -> [Artifact] -> NonEmpty Artifact
forall a. a -> [a] -> NonEmpty a
:| []) of
        VersionIntegrity
MeetsFloor ->
            -- 'MeetsFloor' guarantees a digest is present, but 'artHashes' is a plain list.
            -- The unreachable empty case fails closed, as if no digest existed.
            ArtifactAdmission
-> (NonEmpty Hash -> ArtifactAdmission)
-> Maybe (NonEmpty Hash)
-> ArtifactAdmission
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ArtifactAdmission
AdmissionIntegrityMissing (Filename -> Artifact -> NonEmpty Hash -> ArtifactAdmission
AdmissionAdmit Filename
file Artifact
artifact) ([Hash] -> Maybe (NonEmpty Hash)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Artifact -> [Hash]
artHashes Artifact
artifact))
        VersionIntegrity
BelowFloor -> ArtifactAdmission
AdmissionBelowFloor
        VersionIntegrity
NoIntegrity -> ArtifactAdmission
AdmissionIntegrityMissing

{- | The transience of a verdict no rule could decide, and 'Nothing' for a settled one. The
serve gate renders it as a @503@ or a @500@, and the mirror worker redelivers or drops on it.
-}
admissionTransience :: ArtifactAdmission -> Maybe Transience
admissionTransience :: ArtifactAdmission -> Maybe Transience
admissionTransience = \case
    AdmissionUndecidable (Undecidable Transience
transience Text
_) -> Transience -> Maybe Transience
forall a. a -> Maybe a
Just Transience
transience
    -- 'admitArtifact' carries only an 'Undecidable' here, so another decision is a
    -- construction fault. Fail closed: an inability no retry clears.
    AdmissionUndecidable Decision
_ -> Transience -> Maybe Transience
forall a. a -> Maybe a
Just Transience
WontResolve
    AdmissionAdmit{} -> Maybe Transience
forall a. Maybe a
Nothing
    AdmissionDenied{} -> Maybe Transience
forall a. Maybe a
Nothing
    ArtifactAdmission
AdmissionFileAbsent -> Maybe Transience
forall a. Maybe a
Nothing
    ArtifactAdmission
AdmissionIntegrityMissing -> Maybe Transience
forall a. Maybe a
Nothing
    ArtifactAdmission
AdmissionBelowFloor -> Maybe Transience
forall a. Maybe a
Nothing

-- 'Nothing' when no artifact carries the filename: a forwarded miss, never a fabricated location.
artifactFor :: Filename -> PackageDetails -> Maybe Artifact
artifactFor :: Filename -> PackageDetails -> Maybe Artifact
artifactFor Filename
file PackageDetails
details =
    (Artifact -> Bool) -> NonEmpty Artifact -> Maybe Artifact
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Filename -> Text
unFilename Filename
file) (Text -> Bool) -> (Artifact -> Text) -> Artifact -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Artifact -> Text
artFilename) (PackageDetails -> NonEmpty Artifact
pkgArtifacts PackageDetails
details)