{- | The package domain model -- ecosystem-agnostic vocabulary for the rules
engine.

These types capture everything the proxy needs to reason about a package
version while staying decoupled from any registry's wire format. Registry
adapters (npm, PyPI, RubyGems) are responsible for projecting their responses
into these types; nothing above the registry layer sees registry-specific
structures.

Two pieces of this vocabulary earn their own sibling module: the 'Ecosystem' tag
lives in "Ecluse.Core.Ecosystem" (shared with the version engine and the registry
adapters), and version identity and ordering live in "Ecluse.Core.Version" (a
'Version' is embedded here in 'PackageDetails'). Import those modules directly
when you need to name or build their types.

The design follows two principles synthesised from the protocol research (see
@docs\/research\/synthesis.md@):

* __Rules consume normalised signals, not raw fields.__ The risky behaviours
  differ on the wire (npm install scripts, PyPI sdist builds, RubyGems native
  extensions) but collapse to one signal -- 'CodeExecSignal'. Trust likewise
  collapses to 'Trust'. A rule never learns which ecosystem it is looking at.

* __Signal availability is explicit.__ A signal the adapter has not (or cannot
  cheaply) determine is 'CodeExecUnknown' \/ 'TrustUnknown' \/ 'Nothing', so a
  pure rule abstains rather than guessing and the effectful tier can resolve it
  later (see @docs\/architecture.md@ → "Rules Engine").
-}
module Ecluse.Core.Package (
    -- * Scopes
    Scope,
    mkScope,
    unScope,
    renderScope,

    -- * Package identity
    PackageName,
    mkPackageName,
    pkgEcosystem,
    pkgNamespace,
    pkgCanonical,
    pkgDisplay,
    renderPackageName,
    unscopedName,

    -- * Normalised signals
    CodeExecSignal (..),
    Trust (..),
    TrustEvidence (..),
    Availability (..),

    -- * Artifacts
    Artifact (..),
    ArtifactKind (..),
    Hash,
    hashAlg,
    hashValue,
    mkHash,
    HashAlg (..),

    -- * Algorithm vocabulary
    renderHashAlg,
    parseHashAlg,
    sriPrefix,
    sriBody,
    sriAlgorithm,

    -- * Digest computation
    computeDigest,
    isComputable,

    -- * Dependencies

    -- * People
    Person (..),

    -- * Per-version details
    PackageDetails (..),

    -- * Packument-level view
    PackageInfo (..),
    InvalidEntry (..),
    InvalidEntryKind (..),
) where

import Crypto.Hash (Blake2b_512, Digest, MD5, SHA1, SHA256, SHA384, SHA512, digestFromByteString, hashlazy)
import Data.Aeson (Value)
import Data.ByteArray (convert)
import Data.ByteArray.Encoding (Base (Base16, Base64), convertFromBase)
import Data.Text qualified as T
import Data.Text.Short (ShortText)
import Data.Text.Short qualified as TS
import Data.Time (UTCTime)

import Ecluse.Core.Ecosystem (Ecosystem (..))
import Ecluse.Core.Version (Version)

{- | An npm scope, stored without its leading @\'\@\'@ (the scope of
@\@myorg\/pkg@ is @"myorg"@). Construct via 'mkScope', which normalises away
a leading @\'\@\'@ so equality is independent of how the scope was written.

A scope is a bulk-stored, equality-only identifier (an allow-list key and part
of 'PackageName' identity), so it is held as 'ShortText': the @'Text' -> 'ShortText'@
conversion happens once in 'mkScope' and the reverse once in 'unScope'\/'renderScope',
never in a hot loop (see STYLE.md §6).
-}
newtype Scope = Scope ShortText
    deriving stock (Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$c< :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show)

-- | Build a 'Scope', tolerating an optional leading @\'\@\'@.
mkScope :: Text -> Scope
mkScope :: Text -> Scope
mkScope Text
raw = ShortText -> Scope
Scope (Text -> ShortText
TS.fromText (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
raw (Text -> Text -> Maybe Text
T.stripPrefix Text
"@" Text
raw)))

-- | The bare scope text, without the leading @\'\@\'@.
unScope :: Scope -> Text
unScope :: Scope -> Text
unScope (Scope ShortText
s) = ShortText -> Text
TS.toText ShortText
s

-- | Render a scope in npm wire form, with the leading @\'\@\'@.
renderScope :: Scope -> Text
renderScope :: Scope -> Text
renderScope (Scope ShortText
s) = Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShortText -> Text
TS.toText ShortText
s

{- | A package identity, decoupled from any registry's wire format.

Identity differs by ecosystem -- npm has scopes and is case-sensitive, PyPI
normalises per PEP 503, RubyGems is verbatim -- so the type is __opaque__:
build it with 'mkPackageName', which records the ecosystem, computes a
'pkgCanonical' key used for equality\/matching, and keeps a 'pkgDisplay' form
for faithful rendering. Equality and ordering are on
@('pkgEcosystem', 'pkgNamespace', 'pkgCanonical')@ only -- never the display
form -- so @Flask@ and @flask@ are the same PyPI package but different npm ones.
-}
data PackageName = PackageName
    { PackageName -> Ecosystem
pkgEcosystem :: Ecosystem
    -- ^ The ecosystem this name belongs to.
    , PackageName -> Maybe Scope
pkgNamespace :: Maybe Scope
    -- ^ The scope, if scoped (npm @\@scope\/name@). 'Nothing' for PyPI/RubyGems.
    , PackageName -> ShortText
pkgCanonical :: ShortText
    {- ^ The normalised key for equality and matching (PEP 503 for PyPI;
    verbatim for npm/RubyGems). Held as 'ShortText': it is an equality\/'Ord' key
    that is normalised once at 'mkPackageName' and never sliced afterwards.
    -}
    , PackageName -> ShortText
pkgDisplay :: ShortText
    {- ^ The name as published, for rendering and round-tripping. Held as
    'ShortText'; read it back as 'Text' through 'renderPackageName'.
    -}
    }
    deriving stock (Int -> PackageName -> ShowS
[PackageName] -> ShowS
PackageName -> String
(Int -> PackageName -> ShowS)
-> (PackageName -> String)
-> ([PackageName] -> ShowS)
-> Show PackageName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageName -> ShowS
showsPrec :: Int -> PackageName -> ShowS
$cshow :: PackageName -> String
show :: PackageName -> String
$cshowList :: [PackageName] -> ShowS
showList :: [PackageName] -> ShowS
Show)

-- The fields that constitute identity (the display form is excluded).
nameKey :: PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey :: PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey PackageName
n = (PackageName -> Ecosystem
pkgEcosystem PackageName
n, PackageName -> Maybe Scope
pkgNamespace PackageName
n, PackageName -> ShortText
pkgCanonical PackageName
n)

instance Eq PackageName where
    PackageName
a == :: PackageName -> PackageName -> Bool
== PackageName
b = PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey PackageName
a (Ecosystem, Maybe Scope, ShortText)
-> (Ecosystem, Maybe Scope, ShortText) -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey PackageName
b

instance Ord PackageName where
    compare :: PackageName -> PackageName -> Ordering
compare PackageName
a PackageName
b = (Ecosystem, Maybe Scope, ShortText)
-> (Ecosystem, Maybe Scope, ShortText) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey PackageName
a) (PackageName -> (Ecosystem, Maybe Scope, ShortText)
nameKey PackageName
b)

{- | Build a 'PackageName', normalising the canonical key for the ecosystem.

The display form is the scope-joined raw name (@\@scope\/name@ when scoped);
the canonical key is that form normalised: PEP 503 lower-casing and
@[-_.]+@→@-@ collapsing for PyPI, verbatim for npm and RubyGems.
-}
mkPackageName :: Ecosystem -> Maybe Scope -> Text -> PackageName
mkPackageName :: Ecosystem -> Maybe Scope -> Text -> PackageName
mkPackageName Ecosystem
eco Maybe Scope
ns Text
raw =
    PackageName
        { pkgEcosystem :: Ecosystem
pkgEcosystem = Ecosystem
eco
        , pkgNamespace :: Maybe Scope
pkgNamespace = Maybe Scope
ns
        , pkgCanonical :: ShortText
pkgCanonical = Text -> ShortText
TS.fromText (Ecosystem -> Text -> Text
canonicalise Ecosystem
eco Text
display)
        , pkgDisplay :: ShortText
pkgDisplay = Text -> ShortText
TS.fromText Text
display
        }
  where
    display :: Text
display = case Maybe Scope
ns of
        Just Scope
s -> Scope -> Text
renderScope Scope
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw
        Maybe Scope
Nothing -> Text
raw

-- Normalise a display name into its canonical matching key for an ecosystem.
canonicalise :: Ecosystem -> Text -> Text
canonicalise :: Ecosystem -> Text -> Text
canonicalise = \case
    Ecosystem
Npm -> Text -> Text
forall a. a -> a
id
    Ecosystem
RubyGems -> Text -> Text
forall a. a -> a
id
    Ecosystem
PyPI -> Text -> Text
normalisePyPI

{- PEP 503 name normalisation: lower-case, and collapse each run of
@\'-\'@\/@\'_\'@\/@\'.\'@ to a single @\'-\'@.
-}
normalisePyPI :: Text -> Text
normalisePyPI :: Text -> Text
normalisePyPI Text
t =
    Text -> [Text] -> Text
T.intercalate Text
"-"
        ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
        ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-"
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'-' else Char
c) (Text -> Text
T.toLower Text
t)

-- | Render a package name in its native wire form (the display name).
renderPackageName :: PackageName -> Text
renderPackageName :: PackageName -> Text
renderPackageName = ShortText -> Text
TS.toText (ShortText -> Text)
-> (PackageName -> ShortText) -> PackageName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> ShortText
pkgDisplay

{- | The unscoped (base) name: the display name with any @\@scope/@ prefix dropped
(@\@babel\/code-frame@ → @code-frame@). The single home for the bare-name derivation
the npm tarball/path layer and the mirror queue all need -- they previously each
reconstructed it by rendering then string-stripping the scope.
-}
unscopedName :: PackageName -> Text
unscopedName :: PackageName -> Text
unscopedName PackageName
name = case PackageName -> Maybe Scope
pkgNamespace PackageName
name of
    Just Scope
_ -> Int -> Text -> Text
T.drop Int
1 ((Text, Text) -> Text
forall a b. (a, b) -> b
snd (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"/" (PackageName -> Text
renderPackageName PackageName
name)))
    Maybe Scope
Nothing -> PackageName -> Text
renderPackageName PackageName
name

{- | Whether installing a version executes code (the cross-ecosystem unification
of npm install scripts, PyPI sdist builds, and RubyGems native extensions).
-}
data CodeExecSignal
    = -- | Determined: installation runs no code.
      NoCodeOnInstall
    | -- | Determined: installation runs code; the text says how (audit trail).
      RunsCodeOnInstall Text
    | {- | Not yet determined (e.g. the RubyGems gemspec has not been fetched).
      Pure rules abstain; the effectful tier may resolve it.
      -}
      CodeExecUnknown
    deriving stock (CodeExecSignal -> CodeExecSignal -> Bool
(CodeExecSignal -> CodeExecSignal -> Bool)
-> (CodeExecSignal -> CodeExecSignal -> Bool) -> Eq CodeExecSignal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeExecSignal -> CodeExecSignal -> Bool
== :: CodeExecSignal -> CodeExecSignal -> Bool
$c/= :: CodeExecSignal -> CodeExecSignal -> Bool
/= :: CodeExecSignal -> CodeExecSignal -> Bool
Eq, Int -> CodeExecSignal -> ShowS
[CodeExecSignal] -> ShowS
CodeExecSignal -> String
(Int -> CodeExecSignal -> ShowS)
-> (CodeExecSignal -> String)
-> ([CodeExecSignal] -> ShowS)
-> Show CodeExecSignal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeExecSignal -> ShowS
showsPrec :: Int -> CodeExecSignal -> ShowS
$cshow :: CodeExecSignal -> String
show :: CodeExecSignal -> String
$cshowList :: [CodeExecSignal] -> ShowS
showList :: [CodeExecSignal] -> ShowS
Show)

{- | The trust\/provenance signal for a version. The /how/ of trust differs by
ecosystem (npm @dist.signatures@, PyPI PEP 740 attestations, RubyGems signed
gems\/MFA) but is captured as 'TrustEvidence' so rules stay ecosystem-blind.
-}
data Trust
    = -- | Determined trusted, with the evidence supporting it.
      Trusted (NonEmpty TrustEvidence)
    | -- | Determined: no trust signal established.
      Untrusted
    | -- | Not yet determined (e.g. signature verification needs a fetch).
      TrustUnknown
    deriving stock (Trust -> Trust -> Bool
(Trust -> Trust -> Bool) -> (Trust -> Trust -> Bool) -> Eq Trust
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Trust -> Trust -> Bool
== :: Trust -> Trust -> Bool
$c/= :: Trust -> Trust -> Bool
/= :: Trust -> Trust -> Bool
Eq, Int -> Trust -> ShowS
[Trust] -> ShowS
Trust -> String
(Int -> Trust -> ShowS)
-> (Trust -> String) -> ([Trust] -> ShowS) -> Show Trust
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Trust -> ShowS
showsPrec :: Int -> Trust -> ShowS
$cshow :: Trust -> String
show :: Trust -> String
$cshowList :: [Trust] -> ShowS
showList :: [Trust] -> ShowS
Show)

{- | A normalised reason a version is trusted; the adapter maps its ecosystem's
mechanism onto this vocabulary.
-}
data TrustEvidence
    = -- | The artifact is cryptographically signed.
      Signed
    | -- | The artifact carries a provenance attestation (e.g. Sigstore).
      Attested
    | -- | The version was published under enforced multi-factor auth.
      MfaPublished
    | -- | An ecosystem mechanism not yet in this vocabulary (escape hatch).
      OtherEvidence Text
    deriving stock (TrustEvidence -> TrustEvidence -> Bool
(TrustEvidence -> TrustEvidence -> Bool)
-> (TrustEvidence -> TrustEvidence -> Bool) -> Eq TrustEvidence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TrustEvidence -> TrustEvidence -> Bool
== :: TrustEvidence -> TrustEvidence -> Bool
$c/= :: TrustEvidence -> TrustEvidence -> Bool
/= :: TrustEvidence -> TrustEvidence -> Bool
Eq, Int -> TrustEvidence -> ShowS
[TrustEvidence] -> ShowS
TrustEvidence -> String
(Int -> TrustEvidence -> ShowS)
-> (TrustEvidence -> String)
-> ([TrustEvidence] -> ShowS)
-> Show TrustEvidence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrustEvidence -> ShowS
showsPrec :: Int -> TrustEvidence -> ShowS
$cshow :: TrustEvidence -> String
show :: TrustEvidence -> String
$cshowList :: [TrustEvidence] -> ShowS
showList :: [TrustEvidence] -> ShowS
Show)

-- | Whether a version is offered, advisory-deprecated, or withdrawn.
data Availability
    = -- | Offered normally.
      Available
    | -- | Advisory deprecation (npm); still resolvable. Carries the message.
      Deprecated Text
    | {- | Withdrawn from resolution (PyPI yank keeps the file; RubyGems yank
      removes it). Carries the reason, if given.
      -}
      Yanked (Maybe Text)
    deriving stock (Availability -> Availability -> Bool
(Availability -> Availability -> Bool)
-> (Availability -> Availability -> Bool) -> Eq Availability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Availability -> Availability -> Bool
== :: Availability -> Availability -> Bool
$c/= :: Availability -> Availability -> Bool
/= :: Availability -> Availability -> Bool
Eq, Int -> Availability -> ShowS
[Availability] -> ShowS
Availability -> String
(Int -> Availability -> ShowS)
-> (Availability -> String)
-> ([Availability] -> ShowS)
-> Show Availability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Availability -> ShowS
showsPrec :: Int -> Availability -> ShowS
$cshow :: Availability -> String
show :: Availability -> String
$cshowList :: [Availability] -> ShowS
showList :: [Availability] -> ShowS
Show)

-- | A hash algorithm an integrity digest is computed with.
data HashAlg
    = SHA1
    | SHA256
    | SHA384
    | SHA512
    | MD5
    | Blake2b
    | {- | A Subresource-Integrity string (npm @dist.integrity@), e.g.
      @"sha512-…"@, carried whole.
      -}
      SRI
    deriving stock (HashAlg
HashAlg -> HashAlg -> Bounded HashAlg
forall a. a -> a -> Bounded a
$cminBound :: HashAlg
minBound :: HashAlg
$cmaxBound :: HashAlg
maxBound :: HashAlg
Bounded, Int -> HashAlg
HashAlg -> Int
HashAlg -> [HashAlg]
HashAlg -> HashAlg
HashAlg -> HashAlg -> [HashAlg]
HashAlg -> HashAlg -> HashAlg -> [HashAlg]
(HashAlg -> HashAlg)
-> (HashAlg -> HashAlg)
-> (Int -> HashAlg)
-> (HashAlg -> Int)
-> (HashAlg -> [HashAlg])
-> (HashAlg -> HashAlg -> [HashAlg])
-> (HashAlg -> HashAlg -> [HashAlg])
-> (HashAlg -> HashAlg -> HashAlg -> [HashAlg])
-> Enum HashAlg
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HashAlg -> HashAlg
succ :: HashAlg -> HashAlg
$cpred :: HashAlg -> HashAlg
pred :: HashAlg -> HashAlg
$ctoEnum :: Int -> HashAlg
toEnum :: Int -> HashAlg
$cfromEnum :: HashAlg -> Int
fromEnum :: HashAlg -> Int
$cenumFrom :: HashAlg -> [HashAlg]
enumFrom :: HashAlg -> [HashAlg]
$cenumFromThen :: HashAlg -> HashAlg -> [HashAlg]
enumFromThen :: HashAlg -> HashAlg -> [HashAlg]
$cenumFromTo :: HashAlg -> HashAlg -> [HashAlg]
enumFromTo :: HashAlg -> HashAlg -> [HashAlg]
$cenumFromThenTo :: HashAlg -> HashAlg -> HashAlg -> [HashAlg]
enumFromThenTo :: HashAlg -> HashAlg -> HashAlg -> [HashAlg]
Enum, HashAlg -> HashAlg -> Bool
(HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> Bool) -> Eq HashAlg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashAlg -> HashAlg -> Bool
== :: HashAlg -> HashAlg -> Bool
$c/= :: HashAlg -> HashAlg -> Bool
/= :: HashAlg -> HashAlg -> Bool
Eq, Eq HashAlg
Eq HashAlg =>
(HashAlg -> HashAlg -> Ordering)
-> (HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> Bool)
-> (HashAlg -> HashAlg -> HashAlg)
-> (HashAlg -> HashAlg -> HashAlg)
-> Ord HashAlg
HashAlg -> HashAlg -> Bool
HashAlg -> HashAlg -> Ordering
HashAlg -> HashAlg -> HashAlg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HashAlg -> HashAlg -> Ordering
compare :: HashAlg -> HashAlg -> Ordering
$c< :: HashAlg -> HashAlg -> Bool
< :: HashAlg -> HashAlg -> Bool
$c<= :: HashAlg -> HashAlg -> Bool
<= :: HashAlg -> HashAlg -> Bool
$c> :: HashAlg -> HashAlg -> Bool
> :: HashAlg -> HashAlg -> Bool
$c>= :: HashAlg -> HashAlg -> Bool
>= :: HashAlg -> HashAlg -> Bool
$cmax :: HashAlg -> HashAlg -> HashAlg
max :: HashAlg -> HashAlg -> HashAlg
$cmin :: HashAlg -> HashAlg -> HashAlg
min :: HashAlg -> HashAlg -> HashAlg
Ord, Int -> HashAlg -> ShowS
[HashAlg] -> ShowS
HashAlg -> String
(Int -> HashAlg -> ShowS)
-> (HashAlg -> String) -> ([HashAlg] -> ShowS) -> Show HashAlg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashAlg -> ShowS
showsPrec :: Int -> HashAlg -> ShowS
$cshow :: HashAlg -> String
show :: HashAlg -> String
$cshowList :: [HashAlg] -> ShowS
showList :: [HashAlg] -> ShowS
Show)

{- | An integrity digest of an artifact. __Opaque__: a 'Hash' is built only through
'mkHash', which validates that the digest is well-formed, so every value of this type
carries the proof that its digest could be a real digest of its algorithm. Read it
back through 'hashAlg' and 'hashValue'.
-}
data Hash = Hash
    { Hash -> HashAlg
hashAlg :: HashAlg
    -- ^ The algorithm the digest was computed with.
    , Hash -> Text
hashValue :: Text
    {- ^ The digest itself, in the algorithm's wire encoding (e.g. hex, or the
    whole @sha512-…@ string for 'SRI').
    -}
    }
    deriving stock (Hash -> Hash -> Bool
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
/= :: Hash -> Hash -> Bool
Eq, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash -> ShowS
showsPrec :: Int -> Hash -> ShowS
$cshow :: Hash -> String
show :: Hash -> String
$cshowList :: [Hash] -> ShowS
showList :: [Hash] -> ShowS
Show)

{- | Build a 'Hash', validating that the digest is __structurally well-formed__:
cleanly encoded and exactly the byte length its algorithm specifies. This is the only
way to construct a 'Hash', so the type itself is the proof that the digest could be a
real digest of that algorithm -- an empty, truncated, over-long, non-hex, or bad-base64
value is unconstructable and so can never reach an integrity gate as a degenerate
digest (the fail-open this closes is @docs\/architecture\/security.md@ invariant 5).

Well-formedness is __not__ admissibility: a well-formed but weak SHA-1 digest builds
fine; whether it clears the public-integrity floor is the separate decision of
"Ecluse.Core.Package.Integrity". 'mkHash' rejects a malformed digest, never a merely weak one.

A hex-tagged algorithm (everything but 'SRI') takes lower- or upper-case hex of the
algorithm's digest length. An 'SRI' takes one or more whitespace-separated
@\<alg\>-\<base64\>@ components, each naming a Subresource-Integrity algorithm
(@sha256@, @sha384@, @sha512@) whose base64 body decodes to that algorithm's digest
length; every component must be well-formed.

>>> import Ecluse.Core.Package (HashAlg (SHA1))
>>> fmap hashAlg (mkHash SHA1 "0a4d55a8d778e5022fab701977c5d840bbc486d0")
Right SHA1

>>> mkHash SHA1 "deadbeef"
Left "malformed sha1 digest"
-}
mkHash :: HashAlg -> Text -> Either Text Hash
mkHash :: HashAlg -> Text -> Either Text Hash
mkHash HashAlg
alg Text
value
    | HashAlg -> Text -> Bool
wellFormed HashAlg
alg Text
value = Hash -> Either Text Hash
forall a b. b -> Either a b
Right (HashAlg -> Text -> Hash
Hash HashAlg
alg Text
value)
    | Bool
otherwise = Text -> Either Text Hash
forall a b. a -> Either a b
Left (Text
"malformed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashAlg -> Text
renderHashAlg HashAlg
alg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" digest")

-- Whether a digest string is a well-formed digest of the given algorithm.
wellFormed :: HashAlg -> Text -> Bool
wellFormed :: HashAlg -> Text -> Bool
wellFormed = \case
    HashAlg
SRI -> Text -> Bool
wellFormedSri
    HashAlg
alg -> HashAlg -> Text -> Bool
wellFormedHex HashAlg
alg

-- A hex digest is well-formed when it decodes as hex (case-insensitively) to exactly
-- the algorithm's digest length -- which 'digestFromByteString' decides by accepting
-- only an input of the right size.
wellFormedHex :: HashAlg -> Text -> Bool
wellFormedHex :: HashAlg -> Text -> Bool
wellFormedHex HashAlg
alg Text
t =
    case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Text
T.toLower Text
t) :: ByteString) :: Either String ByteString of
        Left String
_ -> Bool
False
        Right ByteString
bytes -> HashAlg -> ByteString -> Bool
hexDigestOk HashAlg
alg ByteString
bytes

hexDigestOk :: HashAlg -> ByteString -> Bool
hexDigestOk :: HashAlg -> ByteString -> Bool
hexDigestOk HashAlg
alg ByteString
bytes = case HashAlg
alg of
    HashAlg
SHA1 -> Maybe (Digest SHA1) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA1 ByteString
bytes)
    HashAlg
SHA256 -> Maybe (Digest SHA256) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA256 ByteString
bytes)
    HashAlg
SHA384 -> Maybe (Digest SHA384) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA384 ByteString
bytes)
    HashAlg
SHA512 -> Maybe (Digest SHA512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA512 ByteString
bytes)
    HashAlg
MD5 -> Maybe (Digest MD5) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @MD5 ByteString
bytes)
    HashAlg
Blake2b -> Maybe (Digest Blake2b_512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @Blake2b_512 ByteString
bytes)
    HashAlg
SRI -> Bool
False

{- | Compute the digest of bytes in a given algorithm, as the raw digest bytes, or
'Nothing' for an algorithm Écluse will not verify against. The computable algorithms are
exactly the collision-resistant ones: 'SHA1', 'SHA256', 'SHA384', 'SHA512', and
Blake2b-512. 'MD5' is deliberately uncomputable here (a match on a broken hash cannot prove
the bytes were not substituted, so the tamper gate never verifies against it), as is the
bare 'SRI' wrapper, which names no algorithm of its own (resolve it with 'sriAlgorithm'
first).

This is the sibling of 'hexDigestOk': both dispatch on the same per-algorithm crypto type,
so they live together and a new 'HashAlg' must be given an arm in each (the 'case' is total,
and the package builds with @-Wincomplete-patterns@ as an error). It is the one place that
defines /which algorithms the worker can verify/; the integrity floor admits by /strength/
("Ecluse.Core.Package.Integrity"), and the invariant that every floor-clearing algorithm is
computable here keeps the worker able to verify whatever the floor admits.
-}
computeDigest :: HashAlg -> Maybe (LByteString -> ByteString)
computeDigest :: HashAlg -> Maybe (LByteString -> ByteString)
computeDigest = \case
    HashAlg
SHA1 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA1 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA1 -> ByteString)
-> (LByteString -> Digest SHA1) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA1)
    HashAlg
SHA256 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA256 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA256 -> ByteString)
-> (LByteString -> Digest SHA256) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA256)
    HashAlg
SHA384 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA384 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA384 -> ByteString)
-> (LByteString -> Digest SHA384) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA384)
    HashAlg
SHA512 -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest SHA512 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest SHA512 -> ByteString)
-> (LByteString -> Digest SHA512) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @SHA512)
    HashAlg
Blake2b -> (LByteString -> ByteString) -> Maybe (LByteString -> ByteString)
forall a. a -> Maybe a
Just (Digest Blake2b_512 -> ByteString
forall a. Digest a -> ByteString
digestBytes (Digest Blake2b_512 -> ByteString)
-> (LByteString -> Digest Blake2b_512) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
hashlazy @Blake2b_512)
    HashAlg
MD5 -> Maybe (LByteString -> ByteString)
forall a. Maybe a
Nothing
    HashAlg
SRI -> Maybe (LByteString -> ByteString)
forall a. Maybe a
Nothing
  where
    digestBytes :: Digest a -> ByteString
    digestBytes :: forall a. Digest a -> ByteString
digestBytes = Digest a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert

{- | Whether the worker can compute (and so verify a digest in) the given algorithm: the
predicate form of 'computeDigest', taken from the same single definition so the computable
set cannot drift from what 'computeDigest' actually computes.

>>> isComputable SHA256
True

>>> isComputable MD5
False
-}
isComputable :: HashAlg -> Bool
isComputable :: HashAlg -> Bool
isComputable = Maybe (LByteString -> ByteString) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (LByteString -> ByteString) -> Bool)
-> (HashAlg -> Maybe (LByteString -> ByteString))
-> HashAlg
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlg -> Maybe (LByteString -> ByteString)
computeDigest

{- A Subresource-Integrity string is one or more whitespace-separated
@\<alg\>-\<base64\>@ components (npm's @dist.integrity@ is usually one); every
component must be well-formed, and there must be at least one.
-}
wellFormedSri :: Text -> Bool
wellFormedSri :: Text -> Bool
wellFormedSri Text
t = case Text -> [Text]
T.words Text
t of
    [] -> Bool
False
    [Text]
comps -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
wellFormedSriComponent [Text]
comps

wellFormedSriComponent :: Text -> Bool
wellFormedSriComponent :: Text -> Bool
wellFormedSriComponent Text
comp
    -- An empty body means no @\<alg\>-\<base64\>@ shape (no separator, or nothing after it).
    | Text -> Bool
T.null (Text -> Text
sriBody Text
comp) = Bool
False
    | Bool
otherwise = Text -> Text -> Bool
sriBodyOk (Text -> Text
sriPrefix Text
comp) (Text -> Text
sriBody Text
comp)

-- The SRI algorithms recognised are exactly the Subresource-Integrity set
-- (sha256/sha384/sha512); the base64 body must decode to that algorithm's digest
-- length. Each is a modelled 'HashAlg', so a well-formed component both constructs and
-- resolves to an algorithm the strength tier ranks ('assertedAlg').
sriBodyOk :: Text -> Text -> Bool
sriBodyOk :: Text -> Text -> Bool
sriBodyOk Text
algName Text
body =
    case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
body :: ByteString) :: Either String ByteString of
        Left String
_ -> Bool
False
        Right ByteString
bytes -> case Text
algName of
            Text
"sha256" -> Maybe (Digest SHA256) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA256 ByteString
bytes)
            Text
"sha384" -> Maybe (Digest SHA384) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA384 ByteString
bytes)
            Text
"sha512" -> Maybe (Digest SHA512) -> Bool
forall a. Maybe a -> Bool
isJust (forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString @SHA512 ByteString
bytes)
            Text
_ -> Bool
False

-- This is the single home for the algorithm vocabulary: the wire name an algorithm
-- renders to and parses from, and how a Subresource-Integrity string is split and
-- resolved. It lives here, in the lowest layer, because 'mkHash' needs it and
-- "Ecluse.Core.Package" cannot import "Ecluse.Core.Package.Integrity". Everything that names an
-- algorithm or reads an SRI (the worker's tamper gate, the serve-admission floor, the
-- queue wire) defers here, so they share one notion of what @"sha512"@ means and what
-- an SRI asserts rather than each re-encoding it. "Ecluse.Core.Package.Integrity" re-exports
-- these names for its existing callers.

{- | The lower-case wire name of an algorithm -- the canonical spelling 'parseHashAlg'
reads back. Total and injective, so it doubles as config rendering and error text.

>>> renderHashAlg SHA256
"sha256"
-}
renderHashAlg :: HashAlg -> Text
renderHashAlg :: HashAlg -> Text
renderHashAlg = \case
    HashAlg
MD5 -> Text
"md5"
    HashAlg
SHA1 -> Text
"sha1"
    HashAlg
SHA256 -> Text
"sha256"
    HashAlg
SHA384 -> Text
"sha384"
    HashAlg
SHA512 -> Text
"sha512"
    HashAlg
Blake2b -> Text
"blake2b"
    HashAlg
SRI -> Text
"sri"

{- | Parse an algorithm name, tolerating case and an optional internal @\'-\'@ (so
@"SHA-256"@ and @"sha256"@ both parse). An unrecognised name is reported as such,
distinct from a recognised-but-too-weak floor. This admits only the named hash
algorithms; the @sri@ wrapper is not a config-selectable algorithm and is rejected.

>>> parseHashAlg "SHA-256"
Right SHA256

>>> parseHashAlg "frobnicate"
Left "unknown integrity algorithm: frobnicate"
-}
parseHashAlg :: Text -> Either Text HashAlg
parseHashAlg :: Text -> Either Text HashAlg
parseHashAlg Text
raw = case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (Text -> Text
T.toLower (Text -> Text
T.strip Text
raw)) of
    Text
"md5" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
MD5
    Text
"sha1" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA1
    Text
"sha256" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA256
    Text
"sha384" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA384
    Text
"sha512" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
SHA512
    Text
"blake2b" -> HashAlg -> Either Text HashAlg
forall a b. b -> Either a b
Right HashAlg
Blake2b
    Text
_ -> Text -> Either Text HashAlg
forall a b. a -> Either a b
Left (Text
"unknown integrity algorithm: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw)

{- | The algorithm-name token of a Subresource-Integrity string -- the @\<alg\>@ before
the first @\'-\'@ in @\<alg\>-\<base64\>@. A string with no @\'-\'@ is all prefix.

>>> sriPrefix "sha512-Zm9vYmFy"
"sha512"
-}
sriPrefix :: Text -> Text
sriPrefix :: Text -> Text
sriPrefix = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"-"

{- | The base64 digest body of a Subresource-Integrity string -- the @\<base64\>@ after
the first @\'-\'@ in @\<alg\>-\<base64\>@. A string with no @\'-\'@ has an empty body.

>>> sriBody "sha512-Zm9vYmFy"
"Zm9vYmFy"
-}
sriBody :: Text -> Text
sriBody :: Text -> Text
sriBody = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"-"

{- | The 'HashAlg' a Subresource-Integrity string names, read from its @\<alg\>@ prefix.
The prefixes resolved are the Subresource-Integrity set @sha256@, @sha384@ and @sha512@
(every long digest the model represents and a registry serves); an unrecognised or
malformed prefix yields 'Nothing', so the string asserts no algorithm and clears no
floor (the fail-closed reading).

>>> sriAlgorithm "sha512-Zm9vYmFy"
Just SHA512

>>> sriAlgorithm "sha384-Zm9vYmFy"
Just SHA384
-}
sriAlgorithm :: Text -> Maybe HashAlg
sriAlgorithm :: Text -> Maybe HashAlg
sriAlgorithm Text
sri = case Text -> Text
sriPrefix Text
sri of
    Text
"sha256" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA256
    Text
"sha384" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA384
    Text
"sha512" -> HashAlg -> Maybe HashAlg
forall a. a -> Maybe a
Just HashAlg
SHA512
    Text
_ -> Maybe HashAlg
forall a. Maybe a
Nothing

-- | What kind of distribution file an artifact is.
data ArtifactKind
    = -- | An npm tarball.
      Tarball
    | -- | A PyPI source distribution (building it may execute code).
      Sdist
    | -- | A PyPI wheel; carries its compatibility tag (e.g. @"cp310-…"@).
      Wheel Text
    | -- | A RubyGems gem; carries its platform (@"ruby"@ = pure).
      Gem Text
    deriving stock (ArtifactKind -> ArtifactKind -> Bool
(ArtifactKind -> ArtifactKind -> Bool)
-> (ArtifactKind -> ArtifactKind -> Bool) -> Eq ArtifactKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArtifactKind -> ArtifactKind -> Bool
== :: ArtifactKind -> ArtifactKind -> Bool
$c/= :: ArtifactKind -> ArtifactKind -> Bool
/= :: ArtifactKind -> ArtifactKind -> Bool
Eq, Int -> ArtifactKind -> ShowS
[ArtifactKind] -> ShowS
ArtifactKind -> String
(Int -> ArtifactKind -> ShowS)
-> (ArtifactKind -> String)
-> ([ArtifactKind] -> ShowS)
-> Show ArtifactKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArtifactKind -> ShowS
showsPrec :: Int -> ArtifactKind -> ShowS
$cshow :: ArtifactKind -> String
show :: ArtifactKind -> String
$cshowList :: [ArtifactKind] -> ShowS
showList :: [ArtifactKind] -> ShowS
Show)

{- | One distribution file for a version. A version owns a 'NonEmpty' list of
these: npm has exactly one, PyPI has an sdist plus many wheels, RubyGems has one
per platform.
-}
data Artifact = Artifact
    { Artifact -> Text
artFilename :: Text
    , Artifact -> Text
artUrl :: Text
    , Artifact -> ArtifactKind
artKind :: ArtifactKind
    , Artifact -> [Hash]
artHashes :: [Hash]
    -- ^ Integrity digests; the client verifies the download against these.
    , Artifact -> Maybe Int
artSize :: Maybe Int
    -- ^ Size in bytes, if known.
    , Artifact -> Maybe Text
artInterpreter :: Maybe Text
    -- ^ Interpreter constraint (@requires-python@ \/ @required_ruby_version@).
    , Artifact -> Bool
artYanked :: Bool
    {- ^ Whether this individual file is yanked (PyPI per-file yank). For
    ecosystems that yank whole versions this stays 'False' and
    'pkgAvailability' carries the status instead.
    -}
    , Artifact -> Maybe Text
artProvenance :: Maybe Text
    -- ^ URL of a provenance\/attestation bundle, if any.
    }
    deriving stock (Artifact -> Artifact -> Bool
(Artifact -> Artifact -> Bool)
-> (Artifact -> Artifact -> Bool) -> Eq Artifact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Artifact -> Artifact -> Bool
== :: Artifact -> Artifact -> Bool
$c/= :: Artifact -> Artifact -> Bool
/= :: Artifact -> Artifact -> Bool
Eq, Int -> Artifact -> ShowS
[Artifact] -> ShowS
Artifact -> String
(Int -> Artifact -> ShowS)
-> (Artifact -> String) -> ([Artifact] -> ShowS) -> Show Artifact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Artifact -> ShowS
showsPrec :: Int -> Artifact -> ShowS
$cshow :: Artifact -> String
show :: Artifact -> String
$cshowList :: [Artifact] -> ShowS
showList :: [Artifact] -> ShowS
Show)

-- | A person associated with a package (author, maintainer, or publisher).
data Person = Person
    { Person -> Text
personName :: Text
    -- ^ The person's name, as declared by the package.
    , Person -> Maybe Text
personEmail :: Maybe Text
    -- ^ Their email address, if given.
    , Person -> Maybe Text
personUrl :: Maybe Text
    -- ^ A homepage / profile URL, if given.
    }
    deriving stock (Person -> Person -> Bool
(Person -> Person -> Bool)
-> (Person -> Person -> Bool) -> Eq Person
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Person -> Person -> Bool
== :: Person -> Person -> Bool
$c/= :: Person -> Person -> Bool
/= :: Person -> Person -> Bool
Eq, Eq Person
Eq Person =>
(Person -> Person -> Ordering)
-> (Person -> Person -> Bool)
-> (Person -> Person -> Bool)
-> (Person -> Person -> Bool)
-> (Person -> Person -> Bool)
-> (Person -> Person -> Person)
-> (Person -> Person -> Person)
-> Ord Person
Person -> Person -> Bool
Person -> Person -> Ordering
Person -> Person -> Person
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Person -> Person -> Ordering
compare :: Person -> Person -> Ordering
$c< :: Person -> Person -> Bool
< :: Person -> Person -> Bool
$c<= :: Person -> Person -> Bool
<= :: Person -> Person -> Bool
$c> :: Person -> Person -> Bool
> :: Person -> Person -> Bool
$c>= :: Person -> Person -> Bool
>= :: Person -> Person -> Bool
$cmax :: Person -> Person -> Person
max :: Person -> Person -> Person
$cmin :: Person -> Person -> Person
min :: Person -> Person -> Person
Ord, Int -> Person -> ShowS
[Person] -> ShowS
Person -> String
(Int -> Person -> ShowS)
-> (Person -> String) -> ([Person] -> ShowS) -> Show Person
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Person -> ShowS
showsPrec :: Int -> Person -> ShowS
$cshow :: Person -> String
show :: Person -> String
$cshowList :: [Person] -> ShowS
showList :: [Person] -> ShowS
Show)

{- | The ecosystem-agnostic snapshot of a single package /version/ that the
rules engine evaluates. A registry adapter projects its wire format into this;
the rules engine never sees anything else, and never branches on the ecosystem.
-}
data PackageDetails = PackageDetails
    { PackageDetails -> PackageName
pkgName :: PackageName
    -- ^ The package identity this snapshot belongs to.
    , PackageDetails -> Version
pkgVersion :: Version
    -- ^ The specific version this snapshot describes.
    , PackageDetails -> Maybe UTCTime
pkgPublishedAt :: Maybe UTCTime
    {- ^ When this version was published, if known (absent from some cheap
    metadata views).
    -}
    , PackageDetails -> CodeExecSignal
pkgInstallCode :: CodeExecSignal
    -- ^ Whether installing the version executes code.
    , PackageDetails -> Trust
pkgTrust :: Trust
    -- ^ The trust\/provenance signal for the version.
    , PackageDetails -> Availability
pkgAvailability :: Availability
    -- ^ Whether the version is offered, deprecated, or withdrawn.
    , PackageDetails -> NonEmpty Artifact
pkgArtifacts :: NonEmpty Artifact
    -- ^ The version's distribution files (one for npm; many for PyPI/RubyGems).
    , PackageDetails -> [Text]
pkgLicenses :: [Text]
    -- ^ Declared licenses (SPDX expressions/ids); may be several.
    , PackageDetails -> Maybe Person
pkgPublisher :: Maybe Person
    {- ^ Who published __this__ version, if known (provenance).

    Dependencies and maintainers are __deliberately not modelled__ (architect
    ruling, 2026-07-02). Dependencies are structurally redundant on the decision
    surface: a dependency only ever matters when it is itself fetched, and that
    fetch comes back through this same gate and receives its own verdict, so
    gating a parent's dependency /list/ would duplicate the gate that already
    sits on every child request. Not modelling them means the wire layer does
    not even parse them (a heavy packument carries thousands of per-version
    dependency entries of pure parse cost on the hot path), and a malformed
    entry there can no longer drop the version -- it degrades, per the same
    ruling. The raw document still carries everything to the client untouched;
    the served surface is lossless regardless of what the decision surface
    models. If a dependency-reading rule ever genuinely lands, restore the
    @Dependency@\/@DepKind@ vocabulary from history and re-model then.
    -}
    }
    deriving stock (PackageDetails -> PackageDetails -> Bool
(PackageDetails -> PackageDetails -> Bool)
-> (PackageDetails -> PackageDetails -> Bool) -> Eq PackageDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDetails -> PackageDetails -> Bool
== :: PackageDetails -> PackageDetails -> Bool
$c/= :: PackageDetails -> PackageDetails -> Bool
/= :: PackageDetails -> PackageDetails -> Bool
Eq, Int -> PackageDetails -> ShowS
[PackageDetails] -> ShowS
PackageDetails -> String
(Int -> PackageDetails -> ShowS)
-> (PackageDetails -> String)
-> ([PackageDetails] -> ShowS)
-> Show PackageDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDetails -> ShowS
showsPrec :: Int -> PackageDetails -> ShowS
$cshow :: PackageDetails -> String
show :: PackageDetails -> String
$cshowList :: [PackageDetails] -> ShowS
showList :: [PackageDetails] -> ShowS
Show)

{- | The packument-level view of a package: the whole-package metadata document
('PackageDetails' is the per-/version/ snapshot embedded within it). A registry
adapter projects a registry's packument (the npm full-metadata document) into
this; the proxy core reasons over it without ever seeing the wire format.
-}
data PackageInfo = PackageInfo
    { PackageInfo -> PackageName
infoName :: PackageName
    -- ^ The package identity this document describes.
    , PackageInfo -> Map Text PackageDetails
infoVersions :: Map Text PackageDetails
    {- ^ Every published version, keyed by its __raw version string__ (the
    packument's own key). Each 'PackageDetails' still carries its parsed
    'Version'; the map is keyed by 'Text' because a 'Version' has no 'Ord'
    (ordering goes through 'Ecluse.Core.Version.compareVersions', never a derived
    instance) -- see "Ecluse.Core.Version".
    -}
    , PackageInfo -> Map Text Version
infoDistTags :: Map Text Version
    {- ^ Distribution tags (e.g. @"latest"@, @"next"@) to the 'Version' they
    point at.
    -}
    , PackageInfo -> [InvalidEntry]
infoInvalidEntries :: [InvalidEntry]
    {- ^ The malformed entries the projection __dropped__ rather than failing the
    whole document on, retained so the serve path can surface them to an operator.
    A version's publish time lives on its 'PackageDetails.pkgPublishedAt' (the npm
    @time@ object is reconstructed at serialisation), so it is __not__ duplicated
    here; only the /dropped/ entries are.
    -}
    }
    deriving stock (PackageInfo -> PackageInfo -> Bool
(PackageInfo -> PackageInfo -> Bool)
-> (PackageInfo -> PackageInfo -> Bool) -> Eq PackageInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageInfo -> PackageInfo -> Bool
== :: PackageInfo -> PackageInfo -> Bool
$c/= :: PackageInfo -> PackageInfo -> Bool
/= :: PackageInfo -> PackageInfo -> Bool
Eq, Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> String
(Int -> PackageInfo -> ShowS)
-> (PackageInfo -> String)
-> ([PackageInfo] -> ShowS)
-> Show PackageInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageInfo -> ShowS
showsPrec :: Int -> PackageInfo -> ShowS
$cshow :: PackageInfo -> String
show :: PackageInfo -> String
$cshowList :: [PackageInfo] -> ShowS
showList :: [PackageInfo] -> ShowS
Show)

{- | A single packument entry a registry projection __dropped__ as malformed rather
than failing the entire document, kept so the drop is observable rather than silent
(an operator can see that an upstream served a malformed entry, and which). Each
ecosystem's projection populates this from its own wire shape, so the
drop-and-track contract is the same across npm, PyPI, and RubyGems.
-}
data InvalidEntry = InvalidEntry
    { InvalidEntry -> InvalidEntryKind
invalidKind :: InvalidEntryKind
    -- ^ Which kind of packument entry was dropped.
    , InvalidEntry -> Text
invalidKey :: Text
    {- ^ The map key the dropped entry sat under: the raw version string for a
    version manifest or publish time, the tag name for a dist-tag.
    -}
    , InvalidEntry -> Value
invalidValue :: Value
    {- ^ The __raw offending value__, preserved verbatim ('Value' is lossless), so an
    operator can see exactly what the upstream sent rather than only a reason string. A
    dropped publish time keeps its raw bad date here even though the version's
    'pkgPublishedAt' folds to 'Nothing'; the gating value (absent) and the diagnostic
    (the raw bytes) are kept separate. Render it (truncating if large) at log time.
    -}
    , InvalidEntry -> Text
invalidReason :: Text
    -- ^ Why the entry could not be projected (the decode error), for the operator log.
    }
    deriving stock (InvalidEntry -> InvalidEntry -> Bool
(InvalidEntry -> InvalidEntry -> Bool)
-> (InvalidEntry -> InvalidEntry -> Bool) -> Eq InvalidEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidEntry -> InvalidEntry -> Bool
== :: InvalidEntry -> InvalidEntry -> Bool
$c/= :: InvalidEntry -> InvalidEntry -> Bool
/= :: InvalidEntry -> InvalidEntry -> Bool
Eq, Int -> InvalidEntry -> ShowS
[InvalidEntry] -> ShowS
InvalidEntry -> String
(Int -> InvalidEntry -> ShowS)
-> (InvalidEntry -> String)
-> ([InvalidEntry] -> ShowS)
-> Show InvalidEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidEntry -> ShowS
showsPrec :: Int -> InvalidEntry -> ShowS
$cshow :: InvalidEntry -> String
show :: InvalidEntry -> String
$cshowList :: [InvalidEntry] -> ShowS
showList :: [InvalidEntry] -> ShowS
Show)

{- | Which part of a packument a dropped 'InvalidEntry' came from. A version
manifest drop removes a serve candidate (fail-closed for that one version); a
dist-tag or publish-time drop loses only that advisory datum while the version it
referred to still resolves.
-}
data InvalidEntryKind
    = -- | A @versions@ entry whose manifest did not project (no @dist@\/@tarball@, an unusable @version@).
      InvalidVersionManifest
    | -- | A @dist-tags@ entry whose target was not a usable version string.
      InvalidDistTag
    | -- | A @time@ entry, keyed by a present version, that was not a decodable instant.
      InvalidPublishTime
    deriving stock (InvalidEntryKind -> InvalidEntryKind -> Bool
(InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> Eq InvalidEntryKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidEntryKind -> InvalidEntryKind -> Bool
== :: InvalidEntryKind -> InvalidEntryKind -> Bool
$c/= :: InvalidEntryKind -> InvalidEntryKind -> Bool
/= :: InvalidEntryKind -> InvalidEntryKind -> Bool
Eq, Int -> InvalidEntryKind -> ShowS
[InvalidEntryKind] -> ShowS
InvalidEntryKind -> String
(Int -> InvalidEntryKind -> ShowS)
-> (InvalidEntryKind -> String)
-> ([InvalidEntryKind] -> ShowS)
-> Show InvalidEntryKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidEntryKind -> ShowS
showsPrec :: Int -> InvalidEntryKind -> ShowS
$cshow :: InvalidEntryKind -> String
show :: InvalidEntryKind -> String
$cshowList :: [InvalidEntryKind] -> ShowS
showList :: [InvalidEntryKind] -> ShowS
Show)