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

{- | The ecosystem-neutral package model used by admission and rules.
Artifact entry keys retain source coordinates while adapters keep ownership of wire formats.
-}
module Ecluse.Core.Package (
    -- * Scopes
    Scope,
    mkScope,
    unScope,
    renderScope,

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

    -- * The name charset boundary
    isAsciiNameComponent,

    -- * Canonical keys
    canonicalise,

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

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

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

    -- * Digest computation
    computeDigest,
    isComputable,

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

    -- * Packument-level view
    PackageInfo (..),

    -- * Dropped entries
    InvalidEntry (invalidKind, invalidKey, invalidValue, invalidReason),
    mkInvalidEntry,
    InvalidEntryKind (..),
    renderInvalidEntryKind,
    dropCountsByKind,
) where

import Data.Char (isAscii, isControl)
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.Package.Entry (EntryKey)
import Ecluse.Core.Package.Hash (
    Hash,
    HashAlg (..),
    computeDigest,
    hashAlg,
    hashValue,
    isComputable,
    mkHash,
    mkSriHashes,
    parseHashAlg,
    renderHashAlg,
    sriAlgorithm,
    sriBody,
    sriPrefix,
 )
import Ecluse.Core.Package.InvalidEntry (
    InvalidEntry (invalidKey, invalidKind, invalidReason, invalidValue),
    InvalidEntryKind (..),
    dropCountsByKind,
    mkInvalidEntry,
    renderInvalidEntryKind,
 )
import Ecluse.Core.Package.Pep503 (normalisePyPI)
import Ecluse.Core.Version (Version)

{- | An npm scope, stored without its leading @\'\@\'@ (the scope of @\@myorg\/pkg@ is
@"myorg"@). 'mkScope' normalises away a leading @\'\@\'@, so equality does not depend on
how the scope was written.
-}
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 and built with
'mkPackageName'. Equality and ordering read @('pkgEcosystem', 'pkgNamespace',
'pkgCanonical')@ only, so @Flask@ and @flask@ are one PyPI package and two 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 matching key: PEP 503 for PyPI, verbatim for npm and RubyGems.
    , PackageName -> ShortText
pkgDisplay :: ShortText
    -- ^ The name as published, read back as 'Text' through 'renderPackageName'.
    , PackageName -> ShortText
pkgBaseName :: ShortText
    {- ^ The base name with any @\@scope\/@ prefix dropped. It is not part of identity. Read it
    back through 'unscopedName'.
    -}
    }
    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 not one of them.
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: PEP 503 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
        , pkgBaseName :: ShortText
pkgBaseName = Text -> ShortText
TS.fromText Text
raw
        }
  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. An
ecosystem with a normalisation grammar keeps it in its own module.
-}
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

-- | 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 as 'Text': @\@babel\/code-frame@ reads back as @code-frame@.
unscopedName :: PackageName -> Text
unscopedName :: PackageName -> Text
unscopedName = ShortText -> Text
TS.toText (ShortText -> Text)
-> (PackageName -> ShortText) -> PackageName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> ShortText
pkgBaseName

{- | Whether one component of a package name is ASCII with no control character: the boundary
every ecosystem's grammar rests on, because an invisible codepoint renders two names as one.
-}
isAsciiNameComponent :: Text -> Bool
isAsciiNameComponent :: Text -> Bool
isAsciiNameComponent = (Char -> Bool) -> Text -> Bool
T.all (\Char
ch -> Char -> Bool
isAscii Char
ch Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
ch))

{- | 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, for the audit trail.
      RunsCodeOnInstall Text
    | {- | Not yet determined (e.g. nothing has fetched the RubyGems gemspec yet).
      Pure rules abstain, and 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)

-- | 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)

{- | 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 -> EntryKey
artEntryKey :: EntryKey
    -- ^ The coordinate in its source snapshot. Admission preserves it unchanged.
    , Artifact -> Text
artFilename :: Text
    , Artifact -> Text
artUrl :: Text
    , Artifact -> [Hash]
artHashes :: [Hash]
    -- ^ Integrity digests. The client verifies the download against these.
    , Artifact -> Maybe Int
artSize :: Maybe Int
    {- ^ The registry-declared size, if reported. Not always the tarball byte count: npm populates
    it from @dist.unpackedSize@, the size of the unpacked tree.
    -}
    }
    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)

{- | The ecosystem-agnostic snapshot of one package /version/: the signals a rule sees and the
artifact facts that merge, admission, serving and the mirror read. Adapters project into it.
-}
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 -> 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).
    }
    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 ('PackageDetails' is the per-/version/ snapshot
embedded within it). A registry adapter projects its packument into this type, so the proxy
core never sees 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__. A 'Version' has no 'Ord',
    so ordering goes through 'Ecluse.Core.Version.compareVersions', never a derived instance.
    -}
    , 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, kept so the serve path can surface them to an operator.
    -}
    }
    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)