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

{- | Project decoded PyPI files into releases keyed by canonical PEP 440 versions.
The same filename parser supplies coordinates for upstream projection and inbound routes.
-}
module Ecluse.Core.Registry.PyPI.Project (
    -- * Projection
    projectSimpleIndex,

    -- * File coordinates
    FileCoordinate (..),
    DistributionKind (..),
    fileCoordinate,
    FileProject,
    fileProject,
    fileVersionKey,
    FilenameMemo,
    filenameMemo,
    readCoordinate,

    -- * Name validation
    projectName,
    canonicalName,
    isCanonicalName,
    isNameSeparator,
    pypiNameLeadChars,
) where

import Data.Aeson (toJSON)
import Data.Char (isAlphaNum, isAscii)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Time (UTCTime)

import Ecluse.Core.Ecosystem (Ecosystem (PyPI))
import Ecluse.Core.Package (
    Artifact (..),
    Availability (Available, Yanked),
    CodeExecSignal (NoCodeOnInstall, RunsCodeOnInstall),
    Hash,
    InvalidEntry,
    InvalidEntryKind (InvalidIndexFile),
    PackageDetails (..),
    PackageInfo (..),
    PackageName,
    canonicalise,
    mkHash,
    mkInvalidEntry,
    mkPackageName,
    parseHashAlg,
    renderPackageName,
 )
import Ecluse.Core.Registry (ParseError (..))
import Ecluse.Core.Registry.PyPI.Wire (
    IndexFile (..),
    YankState (FileOffered, FileWithdrawn),
 )
import Ecluse.Core.Registry.WireSupport (
    nameComponentWith,
    withinNameLimit,
 )
import Ecluse.Core.Strict (strictElements)
import Ecluse.Core.Version (Version, canonicalPep440, mkVersion, selectLatest)

-- | A filename's canonical release and distribution kind.
data FileCoordinate = FileCoordinate
    { FileCoordinate -> Text
fcVersionKey :: Text
    -- ^ The release key: the file's version in canonical PEP 440 form.
    , FileCoordinate -> DistributionKind
fcKind :: DistributionKind
    }
    deriving stock (FileCoordinate -> FileCoordinate -> Bool
(FileCoordinate -> FileCoordinate -> Bool)
-> (FileCoordinate -> FileCoordinate -> Bool) -> Eq FileCoordinate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileCoordinate -> FileCoordinate -> Bool
== :: FileCoordinate -> FileCoordinate -> Bool
$c/= :: FileCoordinate -> FileCoordinate -> Bool
/= :: FileCoordinate -> FileCoordinate -> Bool
Eq, Int -> FileCoordinate -> ShowS
[FileCoordinate] -> ShowS
FileCoordinate -> [Char]
(Int -> FileCoordinate -> ShowS)
-> (FileCoordinate -> [Char])
-> ([FileCoordinate] -> ShowS)
-> Show FileCoordinate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileCoordinate -> ShowS
showsPrec :: Int -> FileCoordinate -> ShowS
$cshow :: FileCoordinate -> [Char]
show :: FileCoordinate -> [Char]
$cshowList :: [FileCoordinate] -> ShowS
showList :: [FileCoordinate] -> ShowS
Show)

-- | Whether a file is a source distribution, whose install runs its own build, or a wheel.
data DistributionKind = Sdist | Wheel
    deriving stock (DistributionKind -> DistributionKind -> Bool
(DistributionKind -> DistributionKind -> Bool)
-> (DistributionKind -> DistributionKind -> Bool)
-> Eq DistributionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistributionKind -> DistributionKind -> Bool
== :: DistributionKind -> DistributionKind -> Bool
$c/= :: DistributionKind -> DistributionKind -> Bool
/= :: DistributionKind -> DistributionKind -> Bool
Eq, Int -> DistributionKind -> ShowS
[DistributionKind] -> ShowS
DistributionKind -> [Char]
(Int -> DistributionKind -> ShowS)
-> (DistributionKind -> [Char])
-> ([DistributionKind] -> ShowS)
-> Show DistributionKind
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistributionKind -> ShowS
showsPrec :: Int -> DistributionKind -> ShowS
$cshow :: DistributionKind -> [Char]
show :: DistributionKind -> [Char]
$cshowList :: [DistributionKind] -> ShowS
showList :: [DistributionKind] -> ShowS
Show)

{- | Group decoded files by the coordinates their read produced. The decode's invalid entries come
first, then one for each file without a coordinate.
-}
projectSimpleIndex :: PackageName -> [InvalidEntry] -> [(IndexFile, Maybe FileCoordinate)] -> PackageInfo
projectSimpleIndex :: PackageName
-> [InvalidEntry]
-> [(IndexFile, Maybe FileCoordinate)]
-> PackageInfo
projectSimpleIndex PackageName
name [InvalidEntry]
invalid [(IndexFile, Maybe FileCoordinate)]
files =
    PackageInfo
        { infoName :: PackageName
infoName = PackageName
name
        , infoVersions :: Map Text PackageDetails
infoVersions = Map Text PackageDetails
versions
        , infoDistTags :: Map Text Version
infoDistTags = Map Text PackageDetails -> Map Text Version
latestTag Map Text PackageDetails
versions
        , infoInvalidEntries :: [InvalidEntry]
infoInvalidEntries = [InvalidEntry] -> [InvalidEntry]
forall (t :: * -> *) a. Foldable t => t a -> t a
strictElements ([InvalidEntry]
invalid [InvalidEntry] -> [InvalidEntry] -> [InvalidEntry]
forall a. Semigroup a => a -> a -> a
<> [InvalidEntry]
fileDrops)
        }
  where
    (Map Text PackageDetails
versions, [InvalidEntry]
fileDrops) = PackageName
-> [(IndexFile, Maybe FileCoordinate)]
-> (Map Text PackageDetails, [InvalidEntry])
projectVersions PackageName
name [(IndexFile, Maybe FileCoordinate)]
files

projectVersions :: PackageName -> [(IndexFile, Maybe FileCoordinate)] -> (Map Text PackageDetails, [InvalidEntry])
projectVersions :: PackageName
-> [(IndexFile, Maybe FileCoordinate)]
-> (Map Text PackageDetails, [InvalidEntry])
projectVersions PackageName
name [(IndexFile, Maybe FileCoordinate)]
files =
    ((NonEmpty (IndexFile, FileCoordinate) -> PackageDetails)
-> Map Text (NonEmpty (IndexFile, FileCoordinate))
-> Map Text PackageDetails
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (PackageName
-> NonEmpty (IndexFile, FileCoordinate) -> PackageDetails
projectDetails PackageName
name) Map Text (NonEmpty (IndexFile, FileCoordinate))
grouped, [InvalidEntry]
drops)
  where
    (Map Text (NonEmpty (IndexFile, FileCoordinate))
grouped, [InvalidEntry]
drops) = ((IndexFile, Maybe FileCoordinate)
 -> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
     [InvalidEntry])
 -> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
     [InvalidEntry]))
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
-> [(IndexFile, Maybe FileCoordinate)]
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IndexFile, Maybe FileCoordinate)
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
place (Map Text (NonEmpty (IndexFile, FileCoordinate))
forall k a. Map k a
Map.empty, []) [(IndexFile, Maybe FileCoordinate)]
files

    place :: (IndexFile, Maybe FileCoordinate)
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
-> (Map Text (NonEmpty (IndexFile, FileCoordinate)),
    [InvalidEntry])
place (IndexFile
file, Maybe FileCoordinate
found) (Map Text (NonEmpty (IndexFile, FileCoordinate))
byVersion, [InvalidEntry]
dropAcc) = case Maybe FileCoordinate
found of
        Just FileCoordinate
coordinate ->
            ( (NonEmpty (IndexFile, FileCoordinate)
 -> NonEmpty (IndexFile, FileCoordinate)
 -> NonEmpty (IndexFile, FileCoordinate))
-> Text
-> NonEmpty (IndexFile, FileCoordinate)
-> Map Text (NonEmpty (IndexFile, FileCoordinate))
-> Map Text (NonEmpty (IndexFile, FileCoordinate))
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonEmpty (IndexFile, FileCoordinate)
-> NonEmpty (IndexFile, FileCoordinate)
-> NonEmpty (IndexFile, FileCoordinate)
forall a. Semigroup a => a -> a -> a
(<>) (FileCoordinate -> Text
fcVersionKey FileCoordinate
coordinate) ((IndexFile
file, FileCoordinate
coordinate) (IndexFile, FileCoordinate)
-> [(IndexFile, FileCoordinate)]
-> NonEmpty (IndexFile, FileCoordinate)
forall a. a -> [a] -> NonEmpty a
:| []) Map Text (NonEmpty (IndexFile, FileCoordinate))
byVersion
            , [InvalidEntry]
dropAcc
            )
        Maybe FileCoordinate
Nothing -> (Map Text (NonEmpty (IndexFile, FileCoordinate))
byVersion, IndexFile -> InvalidEntry
uncoordinatedDrop IndexFile
file InvalidEntry -> [InvalidEntry] -> [InvalidEntry]
forall a. a -> [a] -> [a]
: [InvalidEntry]
dropAcc)

-- 'mkInvalidEntry' reduces the location to its authority before logging.
uncoordinatedDrop :: IndexFile -> InvalidEntry
uncoordinatedDrop :: IndexFile -> InvalidEntry
uncoordinatedDrop IndexFile
file =
    InvalidEntryKind -> Text -> Value -> Text -> InvalidEntry
mkInvalidEntry
        InvalidEntryKind
InvalidIndexFile
        (IndexFile -> Text
ifFilename IndexFile
file)
        (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (IndexFile -> Text
ifUrl IndexFile
file))
        Text
"file name names no PEP 440 release of this project"

latestTag :: Map Text PackageDetails -> Map Text Version
latestTag :: Map Text PackageDetails -> Map Text Version
latestTag Map Text PackageDetails
versions =
    Map Text Version
-> (Version -> Map Text Version)
-> Maybe Version
-> Map Text Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text Version
forall k a. Map k a
Map.empty (Text -> Version -> Map Text Version
forall k a. k -> a -> Map k a
Map.singleton Text
"latest") (Maybe Version -> [Version] -> Maybe Version
selectLatest Maybe Version
forall a. Maybe a
Nothing ((PackageDetails -> Version) -> [PackageDetails] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map PackageDetails -> Version
pkgVersion (Map Text PackageDetails -> [PackageDetails]
forall k a. Map k a -> [a]
Map.elems Map Text PackageDetails
versions)))

-- Every field is evaluated here, so a retained release never keeps its decoded files alive.
projectDetails :: PackageName -> NonEmpty (IndexFile, FileCoordinate) -> PackageDetails
projectDetails :: PackageName
-> NonEmpty (IndexFile, FileCoordinate) -> PackageDetails
projectDetails PackageName
name NonEmpty (IndexFile, FileCoordinate)
entries =
    PackageDetails
        { pkgName :: PackageName
pkgName = PackageName
name
        , pkgVersion :: Version
pkgVersion = Ecosystem -> Text -> Version
mkVersion Ecosystem
PyPI (FileCoordinate -> Text
fcVersionKey ((IndexFile, FileCoordinate) -> FileCoordinate
forall a b. (a, b) -> b
snd (NonEmpty (IndexFile, FileCoordinate) -> (IndexFile, FileCoordinate)
forall a. NonEmpty a -> a
NE.head NonEmpty (IndexFile, FileCoordinate)
entries)))
        , pkgPublishedAt :: Maybe UTCTime
pkgPublishedAt = NonEmpty IndexFile -> Maybe UTCTime
newestUpload NonEmpty IndexFile
files
        , pkgInstallCode :: CodeExecSignal
pkgInstallCode = NonEmpty (IndexFile, FileCoordinate) -> CodeExecSignal
releaseInstallCode NonEmpty (IndexFile, FileCoordinate)
entries
        , pkgAvailability :: Availability
pkgAvailability = NonEmpty IndexFile -> Availability
releaseAvailability NonEmpty IndexFile
files
        , pkgArtifacts :: NonEmpty Artifact
pkgArtifacts = NonEmpty Artifact -> NonEmpty Artifact
forall (t :: * -> *) a. Foldable t => t a -> t a
strictElements ((IndexFile -> Artifact) -> NonEmpty IndexFile -> NonEmpty Artifact
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IndexFile -> Artifact
projectArtifact NonEmpty IndexFile
files)
        }
  where
    files :: NonEmpty IndexFile
files = ((IndexFile, FileCoordinate) -> IndexFile)
-> NonEmpty (IndexFile, FileCoordinate) -> NonEmpty IndexFile
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IndexFile, FileCoordinate) -> IndexFile
forall a b. (a, b) -> a
fst NonEmpty (IndexFile, FileCoordinate)
entries

-- An unknown-age file cannot borrow a sibling's expired quarantine. A later wheel restarts
-- quarantine when every timestamp is known.
newestUpload :: NonEmpty IndexFile -> Maybe UTCTime
newestUpload :: NonEmpty IndexFile -> Maybe UTCTime
newestUpload NonEmpty IndexFile
files = (\(UTCTime
instant :| [UTCTime]
rest) -> (UTCTime -> UTCTime -> UTCTime) -> UTCTime -> [UTCTime] -> UTCTime
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UTCTime -> UTCTime -> UTCTime
forall a. Ord a => a -> a -> a
max UTCTime
instant [UTCTime]
rest) (NonEmpty UTCTime -> UTCTime)
-> Maybe (NonEmpty UTCTime) -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (IndexFile -> Maybe UTCTime)
-> NonEmpty IndexFile -> Maybe (NonEmpty UTCTime)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse IndexFile -> Maybe UTCTime
ifUploadTime NonEmpty IndexFile
files

releaseInstallCode :: NonEmpty (IndexFile, FileCoordinate) -> CodeExecSignal
releaseInstallCode :: NonEmpty (IndexFile, FileCoordinate) -> CodeExecSignal
releaseInstallCode NonEmpty (IndexFile, FileCoordinate)
entries
    | ((IndexFile, FileCoordinate) -> Bool)
-> NonEmpty (IndexFile, FileCoordinate) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((DistributionKind -> DistributionKind -> Bool
forall a. Eq a => a -> a -> Bool
== DistributionKind
Sdist) (DistributionKind -> Bool)
-> ((IndexFile, FileCoordinate) -> DistributionKind)
-> (IndexFile, FileCoordinate)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileCoordinate -> DistributionKind
fcKind (FileCoordinate -> DistributionKind)
-> ((IndexFile, FileCoordinate) -> FileCoordinate)
-> (IndexFile, FileCoordinate)
-> DistributionKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndexFile, FileCoordinate) -> FileCoordinate
forall a b. (a, b) -> b
snd) NonEmpty (IndexFile, FileCoordinate)
entries =
        Text -> CodeExecSignal
RunsCodeOnInstall Text
"offers a source distribution, which runs its own build"
    | Bool
otherwise = CodeExecSignal
NoCodeOnInstall

-- A release is withdrawn only when PEP 592 withdraws every file of it.
releaseAvailability :: NonEmpty IndexFile -> Availability
releaseAvailability :: NonEmpty IndexFile -> Availability
releaseAvailability NonEmpty IndexFile
files = case (IndexFile -> Maybe (Maybe Text))
-> NonEmpty IndexFile -> Maybe (NonEmpty (Maybe Text))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse IndexFile -> Maybe (Maybe Text)
withdrawnReason NonEmpty IndexFile
files of
    Just NonEmpty (Maybe Text)
reasons -> Maybe Text -> Availability
Yanked (NonEmpty (Maybe Text) -> Maybe Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum NonEmpty (Maybe Text)
reasons)
    Maybe (NonEmpty (Maybe Text))
Nothing -> Availability
Available

withdrawnReason :: IndexFile -> Maybe (Maybe Text)
withdrawnReason :: IndexFile -> Maybe (Maybe Text)
withdrawnReason IndexFile
file = case IndexFile -> YankState
ifYanked IndexFile
file of
    FileWithdrawn Maybe Text
reason -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
reason
    YankState
FileOffered -> Maybe (Maybe Text)
forall a. Maybe a
Nothing

-- The location stays verbatim. 'Ecluse.Core.Package.Filter' folds its scheme and authority
-- against the egress and host policies afterward.
projectArtifact :: IndexFile -> Artifact
projectArtifact :: IndexFile -> Artifact
projectArtifact IndexFile
file =
    Artifact
        { artEntryKey :: EntryKey
artEntryKey = IndexFile -> EntryKey
ifEntryKey IndexFile
file
        , artFilename :: Text
artFilename = IndexFile -> Text
ifFilename IndexFile
file
        , artUrl :: Text
artUrl = IndexFile -> Text
ifUrl IndexFile
file
        , artHashes :: [Hash]
artHashes = [Hash] -> [Hash]
forall (t :: * -> *) a. Foldable t => t a -> t a
strictElements (((Text, Text) -> Maybe Hash) -> [(Text, Text)] -> [Hash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Text) -> Maybe Hash
indexHash (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (IndexFile -> Map Text Text
ifHashes IndexFile
file)))
        , artSize :: Maybe Int
artSize = IndexFile -> Maybe Int
ifSize IndexFile
file
        }

indexHash :: (Text, Text) -> Maybe Hash
indexHash :: (Text, Text) -> Maybe Hash
indexHash (Text
algorithm, Text
digest) = do
    algo <- Either Text HashAlg -> Maybe HashAlg
forall l r. Either l r -> Maybe r
rightToMaybe (Text -> Either Text HashAlg
parseHashAlg Text
algorithm)
    rightToMaybe (mkHash algo digest)

-- | Read a filename's coordinate, rejecting another project, an unknown archive, or invalid PEP 440.
fileCoordinate :: PackageName -> Text -> Maybe FileCoordinate
fileCoordinate :: PackageName -> Text -> Maybe FileCoordinate
fileCoordinate PackageName
name Text
file = do
    (version, kind) <- FileProject -> Text -> Maybe (Text, DistributionKind)
filenameParts (PackageName -> FileProject
fileProject PackageName
name) Text
file
    canonical <- canonicalPep440 version
    pure (FileCoordinate canonical kind)

-- | A project's PEP 503 key, prepared once for reading many of its filenames.
data FileProject = FileProject
    { FileProject -> Text
fpCanonical :: Text
    , FileProject -> [Text]
fpChunks :: [Text]
    }

-- | Prepare a project for reading its filenames.
fileProject :: PackageName -> FileProject
fileProject :: PackageName -> FileProject
fileProject PackageName
name = Text -> [Text] -> FileProject
FileProject Text
canonical (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" Text
canonical)
  where
    canonical :: Text
canonical = PackageName -> Text
canonicalName PackageName
name

-- | Read a filename's release key, with the same refusals as 'fileCoordinate'.
fileVersionKey :: FileProject -> Text -> Maybe Text
fileVersionKey :: FileProject -> Text -> Maybe Text
fileVersionKey FileProject
project Text
file = Text -> Maybe Text
canonicalPep440 (Text -> Maybe Text)
-> ((Text, DistributionKind) -> Text)
-> (Text, DistributionKind)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, DistributionKind) -> Text
forall a b. (a, b) -> a
fst ((Text, DistributionKind) -> Maybe Text)
-> Maybe (Text, DistributionKind) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileProject -> Text -> Maybe (Text, DistributionKind)
filenameParts FileProject
project Text
file

-- | One read's PEP 440 results by version text, so the files of one release parse their version once.
data FilenameMemo = FilenameMemo
    { FilenameMemo -> FileProject
memoProject :: FileProject
    , FilenameMemo -> Map Text (Maybe Text)
memoVersions :: Map Text (Maybe Text)
    }

-- | Start a memo for one index read. It ends with the read, so no request inherits its versions.
filenameMemo :: PackageName -> FilenameMemo
filenameMemo :: PackageName -> FilenameMemo
filenameMemo PackageName
name = FileProject -> Map Text (Maybe Text) -> FilenameMemo
FilenameMemo (PackageName -> FileProject
fileProject PackageName
name) Map Text (Maybe Text)
forall k a. Map k a
Map.empty

-- | Read a coordinate as 'fileCoordinate' does, parsing each distinct version text once.
readCoordinate :: FilenameMemo -> Text -> (Maybe FileCoordinate, FilenameMemo)
readCoordinate :: FilenameMemo -> Text -> (Maybe FileCoordinate, FilenameMemo)
readCoordinate FilenameMemo
memo Text
file = (Maybe FileCoordinate, FilenameMemo)
-> ((Text, DistributionKind)
    -> (Maybe FileCoordinate, FilenameMemo))
-> Maybe (Text, DistributionKind)
-> (Maybe FileCoordinate, FilenameMemo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe FileCoordinate
forall a. Maybe a
Nothing, FilenameMemo
memo) (Text, DistributionKind) -> (Maybe FileCoordinate, FilenameMemo)
remember (FileProject -> Text -> Maybe (Text, DistributionKind)
filenameParts (FilenameMemo -> FileProject
memoProject FilenameMemo
memo) Text
file)
  where
    remember :: (Text, DistributionKind) -> (Maybe FileCoordinate, FilenameMemo)
remember (Text
version, DistributionKind
kind) = case Text -> Map Text (Maybe Text) -> Maybe (Maybe Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
version (FilenameMemo -> Map Text (Maybe Text)
memoVersions FilenameMemo
memo) of
        Just Maybe Text
known -> (DistributionKind -> Maybe Text -> Maybe FileCoordinate
forall {f :: * -> *}.
Functor f =>
DistributionKind -> f Text -> f FileCoordinate
coordinate DistributionKind
kind Maybe Text
known, FilenameMemo
memo)
        Maybe (Maybe Text)
Nothing ->
            let known :: Maybe Text
known = Text -> Maybe Text
canonicalPep440 Text
version
             in (DistributionKind -> Maybe Text -> Maybe FileCoordinate
forall {f :: * -> *}.
Functor f =>
DistributionKind -> f Text -> f FileCoordinate
coordinate DistributionKind
kind Maybe Text
known, FilenameMemo
memo{memoVersions = Map.insert version known (memoVersions memo)})
    coordinate :: DistributionKind -> f Text -> f FileCoordinate
coordinate DistributionKind
kind = (Text -> FileCoordinate) -> f Text -> f FileCoordinate
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> DistributionKind -> FileCoordinate
`FileCoordinate` DistributionKind
kind)

-- A filename's version text and distribution kind, before PEP 440 canonicalisation.
filenameParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
filenameParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
filenameParts FileProject
project Text
file = FileProject -> Text -> Maybe (Text, DistributionKind)
wheelParts FileProject
project Text
file Maybe (Text, DistributionKind)
-> Maybe (Text, DistributionKind) -> Maybe (Text, DistributionKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileProject -> Text -> Maybe (Text, DistributionKind)
sdistParts FileProject
project Text
file

-- @{project}-{version}(-{build})?-{python}-{abi}-{platform}.whl@. The project and version
-- parts escape @-@ as @_@, so the parts split exactly and the project part compares whole.
wheelParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
wheelParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
wheelParts FileProject
project Text
file = do
    stem <- Text -> Text -> Maybe Text
T.stripSuffix Text
".whl" Text
file
    parts <- nonEmpty (T.splitOn "-" stem)
    guard (length parts == 5 || length parts == 6)
    guard (canonicalise PyPI (NE.head parts) == fpCanonical project)
    version <- toList parts !!? 1
    pure (version, Wheel)

-- @{project}-{version}{archive suffix}@. A legacy project name can carry the separator a
-- version can, so the split takes the longest project part that canonicalises to this one.
sdistParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
sdistParts :: FileProject -> Text -> Maybe (Text, DistributionKind)
sdistParts FileProject
project Text
file = do
    stem <- [Maybe Text] -> Maybe Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Maybe Text
`T.stripSuffix` Text
file) [Text]
sdistSuffixes)
    version <- afterProjectName project stem
    pure (version, Sdist)

sdistSuffixes :: [Text]
sdistSuffixes :: [Text]
sdistSuffixes = [Text
".tar.gz", Text
".tgz", Text
".zip", Text
".tar.bz2", Text
".tar.xz"]

-- Compare disjoint chunks so unauthenticated filenames cannot trigger repeated prefix work.
afterProjectName :: FileProject -> Text -> Maybe Text
afterProjectName :: FileProject -> Text -> Maybe Text
afterProjectName FileProject
project Text
stem
    | Text -> Bool
T.null (FileProject -> Text
fpCanonical FileProject
project) = do
        (separator, _) <- Text -> Maybe (Char, Text)
T.uncons Text
stem
        guard (isNameSeparator separator)
        pure (T.dropWhile isNameSeparator stem)
    | Bool
otherwise = [Text] -> Text -> Maybe Text
matchProjectChunks (FileProject -> [Text]
fpChunks FileProject
project) ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isNameSeparator Text
stem)

matchProjectChunks :: [Text] -> Text -> Maybe Text
matchProjectChunks :: [Text] -> Text -> Maybe Text
matchProjectChunks [] Text
rest = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rest
matchProjectChunks (Text
expected : [Text]
remaining) Text
rest = do
    let (Text
chunk, Text
separated) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isNameSeparator Text
rest
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Ecosystem -> Text -> Text
canonicalise Ecosystem
PyPI Text
chunk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected)
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
T.null Text
separated))
    [Text] -> Text -> Maybe Text
matchProjectChunks [Text]
remaining ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isNameSeparator Text
separated)

-- | The characters PEP 503 treats as one separator when it normalises a name.
isNameSeparator :: Char -> Bool
isNameSeparator :: Char -> Bool
isNameSeparator Char
c = 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
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'

-- | The PEP 503 key used for filename comparison and upstream Simple-index URLs.
canonicalName :: PackageName -> Text
canonicalName :: PackageName -> Text
canonicalName = Ecosystem -> Text -> Text
canonicalise Ecosystem
PyPI (Text -> Text) -> (PackageName -> Text) -> PackageName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
renderPackageName

-- | Parse one PyPI name component under the shared floor and PEP 508 grammar.
projectName :: Text -> Either ParseError PackageName
projectName :: Text -> Either ParseError PackageName
projectName Text
raw = do
    Text -> Int -> Text -> Either ParseError ()
withinNameLimit Text
"PyPI project name" Int
pypiNameLimit Text
raw
    Ecosystem -> Maybe Scope -> Text -> PackageName
mkPackageName Ecosystem
PyPI Maybe Scope
forall a. Maybe a
Nothing (Text -> PackageName)
-> Either ParseError Text -> Either ParseError PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either ParseError Text
nameComponent Text
raw

-- | Whether the route can claim this name without a canonical-spelling redirect.
isCanonicalName :: Text -> Bool
isCanonicalName :: Text -> Bool
isCanonicalName Text
raw = Ecosystem -> Text -> Text
canonicalise Ecosystem
PyPI Text
raw Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
raw

nameComponent :: Text -> Either ParseError Text
nameComponent :: Text -> Either ParseError Text
nameComponent = Text -> (Text -> Bool) -> Text -> Either ParseError Text
nameComponentWith Text
"PyPI project name" Text -> Bool
usableComponent

-- | Initial characters for partitioning canonical PyPI names during a store walk.
pypiNameLeadChars :: [Char]
pypiNameLeadChars :: [Char]
pypiNameLeadChars = [Char
'a' .. Char
'z'] [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']

usableComponent :: Text -> Bool
usableComponent :: Text -> Bool
usableComponent Text
component =
    (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
nameChar Text
component
        Bool -> Bool -> Bool
&& Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
nameEdge (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Text -> Maybe (Char, Text)
T.uncons Text
component)
        Bool -> Bool -> Bool
&& Bool -> ((Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
nameEdge (Char -> Bool) -> ((Text, Char) -> Char) -> (Text, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Char) -> Char
forall a b. (a, b) -> b
snd) (Text -> Maybe (Text, Char)
T.unsnoc Text
component)

-- A separator is legal inside a name, never at either end.
nameChar :: Char -> Bool
nameChar :: Char -> Bool
nameChar Char
ch = Char -> Bool
nameEdge Char
ch Bool -> Bool -> Bool
|| Char -> Bool
isNameSeparator Char
ch

nameEdge :: Char -> Bool
nameEdge :: Char -> Bool
nameEdge Char
ch = Char -> Bool
isAscii Char
ch Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
ch

-- PyPI's own cap on a project name, the one its own validator applies.
pypiNameLimit :: Int
pypiNameLimit :: Int
pypiNameLimit = Int
100