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

{- | Decode PEP 691 metadata with per-entry drops.
Raw array positions survive malformed entries so admission and assembly identify the same files.
-}
module Ecluse.Core.Registry.PyPI.Wire (
    -- * The media type this shape travels under
    simpleIndexMediaType,

    -- * The Simple index
    SimpleIndex (..),
    checkApiVersion,

    -- * One distribution file
    IndexFile (..),
    YankState (..),
    decodeIndexFiles,
) where

import Data.Aeson (
    FromJSON (parseJSON),
    Object,
    Value (Bool, Object, String),
    withObject,
    (.!=),
    (.:),
    (.:?),
 )
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser, parseEither)
import Data.Text qualified as T
import Data.Time (UTCTime)

import Ecluse.Core.Json.Lenient (lenientOptional)
import Ecluse.Core.Package (
    InvalidEntry,
    InvalidEntryKind (InvalidIndexFile, InvalidVersionListing),
 )
import Ecluse.Core.Package.Entry (EntryKey (..))
import Ecluse.Core.Registry.WireSupport (partitionLenientList)

-- | The PEP 691 media type used for index requests and responses.
simpleIndexMediaType :: ByteString
simpleIndexMediaType :: ByteString
simpleIndexMediaType = ByteString
"application/vnd.pypi.simple.v1+json"

-- | A project's index records malformed file and version entries as drops.
data SimpleIndex = SimpleIndex
    { SimpleIndex -> Text
siName :: Text
    -- ^ The project name the index reports, verbatim. Empty when the key is absent.
    , SimpleIndex -> [IndexFile]
siFiles :: [IndexFile]
    -- ^ The offered distribution files, in the order the index listed them.
    , SimpleIndex -> [InvalidEntry]
siInvalidEntries :: [InvalidEntry]
    -- ^ The malformed @files@ and @versions@ entries the decode dropped.
    }
    deriving stock (SimpleIndex -> SimpleIndex -> Bool
(SimpleIndex -> SimpleIndex -> Bool)
-> (SimpleIndex -> SimpleIndex -> Bool) -> Eq SimpleIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleIndex -> SimpleIndex -> Bool
== :: SimpleIndex -> SimpleIndex -> Bool
$c/= :: SimpleIndex -> SimpleIndex -> Bool
/= :: SimpleIndex -> SimpleIndex -> Bool
Eq, Int -> SimpleIndex -> ShowS
[SimpleIndex] -> ShowS
SimpleIndex -> String
(Int -> SimpleIndex -> ShowS)
-> (SimpleIndex -> String)
-> ([SimpleIndex] -> ShowS)
-> Show SimpleIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleIndex -> ShowS
showsPrec :: Int -> SimpleIndex -> ShowS
$cshow :: SimpleIndex -> String
show :: SimpleIndex -> String
$cshowList :: [SimpleIndex] -> ShowS
showList :: [SimpleIndex] -> ShowS
Show)

instance FromJSON SimpleIndex where
    parseJSON :: Value -> Parser SimpleIndex
parseJSON = String
-> (Object -> Parser SimpleIndex) -> Value -> Parser SimpleIndex
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PyPI Simple index" ((Object -> Parser SimpleIndex) -> Value -> Parser SimpleIndex)
-> (Object -> Parser SimpleIndex) -> Value -> Parser SimpleIndex
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Object -> Parser ()
checkApiVersion Object
o
        name <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
        (files, fileDrops) <- lenientFiles o
        versionDrops <- lenientVersionListing o
        pure
            SimpleIndex
                { siName = name
                , siFiles = files
                , siInvalidEntries = fileDrops <> versionDrops
                }

-- | A distribution file encodes its release in 'ifFilename'.
data IndexFile = IndexFile
    { IndexFile -> EntryKey
ifEntryKey :: EntryKey
    , IndexFile -> Text
ifFilename :: Text
    -- ^ The distribution file name, which encodes the project, the release, and a wheel's tags.
    , IndexFile -> Text
ifUrl :: Text
    -- ^ The file's absolute upstream location, on the ecosystem's files host or the index's own.
    , IndexFile -> Map Text Text
ifHashes :: Map Text Text
    -- ^ Unknown digest algorithms drop during projection.
    , IndexFile -> Maybe Text
ifRequiresPython :: Maybe Text
    -- ^ The PEP 440 interpreter specifier a client filters on, if the file declares one.
    , IndexFile -> Maybe Int
ifSize :: Maybe Int
    -- ^ The file's byte count, if reported. Advisory, so a hostile value reads as absent.
    , IndexFile -> Maybe UTCTime
ifUploadTime :: Maybe UTCTime
    -- ^ The per-file publication instant used to compute release age.
    , IndexFile -> YankState
ifYanked :: YankState
    -- ^ Whether PEP 592 withdraws this file from resolution, and why.
    , IndexFile -> Maybe Text
ifProvenance :: Maybe Text
    -- ^ The URL of a PEP 740 attestation bundle, if the index names one.
    }
    deriving stock (IndexFile -> IndexFile -> Bool
(IndexFile -> IndexFile -> Bool)
-> (IndexFile -> IndexFile -> Bool) -> Eq IndexFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexFile -> IndexFile -> Bool
== :: IndexFile -> IndexFile -> Bool
$c/= :: IndexFile -> IndexFile -> Bool
/= :: IndexFile -> IndexFile -> Bool
Eq, Int -> IndexFile -> ShowS
[IndexFile] -> ShowS
IndexFile -> String
(Int -> IndexFile -> ShowS)
-> (IndexFile -> String)
-> ([IndexFile] -> ShowS)
-> Show IndexFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexFile -> ShowS
showsPrec :: Int -> IndexFile -> ShowS
$cshow :: IndexFile -> String
show :: IndexFile -> String
$cshowList :: [IndexFile] -> ShowS
showList :: [IndexFile] -> ShowS
Show)

instance FromJSON IndexFile where
    parseJSON :: Value -> Parser IndexFile
parseJSON = String -> (Object -> Parser IndexFile) -> Value -> Parser IndexFile
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PyPI index file" ((Object -> Parser IndexFile) -> Value -> Parser IndexFile)
-> (Object -> Parser IndexFile) -> Value -> Parser IndexFile
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        EntryKey
-> Text
-> Text
-> Map Text Text
-> Maybe Text
-> Maybe Int
-> Maybe UTCTime
-> YankState
-> Maybe Text
-> IndexFile
IndexFile EntryKey
SingletonEntry
            (Text
 -> Text
 -> Map Text Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe UTCTime
 -> YankState
 -> Maybe Text
 -> IndexFile)
-> Parser Text
-> Parser
     (Text
      -> Map Text Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe UTCTime
      -> YankState
      -> Maybe Text
      -> IndexFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filename"
            Parser
  (Text
   -> Map Text Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe UTCTime
   -> YankState
   -> Maybe Text
   -> IndexFile)
-> Parser Text
-> Parser
     (Map Text Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe UTCTime
      -> YankState
      -> Maybe Text
      -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
            Parser
  (Map Text Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe UTCTime
   -> YankState
   -> Maybe Text
   -> IndexFile)
-> Parser (Map Text Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe UTCTime
      -> YankState
      -> Maybe Text
      -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Map Text Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hashes" Parser (Maybe (Map Text Text))
-> Map Text Text -> Parser (Map Text Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text Text
forall a. Monoid a => a
mempty
            Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe UTCTime
   -> YankState
   -> Maybe Text
   -> IndexFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe UTCTime -> YankState -> Maybe Text -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requires-python"
            Parser
  (Maybe Int
   -> Maybe UTCTime -> YankState -> Maybe Text -> IndexFile)
-> Parser (Maybe Int)
-> Parser (Maybe UTCTime -> YankState -> Maybe Text -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe Int)
forall a.
(FromJSON a, NFData a) =>
Object -> Key -> Parser (Maybe a)
lenientOptional Object
o Key
"size"
            Parser (Maybe UTCTime -> YankState -> Maybe Text -> IndexFile)
-> Parser (Maybe UTCTime)
-> Parser (YankState -> Maybe Text -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe UTCTime)
forall a.
(FromJSON a, NFData a) =>
Object -> Key -> Parser (Maybe a)
lenientOptional Object
o Key
"upload-time"
            Parser (YankState -> Maybe Text -> IndexFile)
-> Parser YankState -> Parser (Maybe Text -> IndexFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Value -> YankState
yankState (Maybe Value -> YankState)
-> Parser (Maybe Value) -> Parser YankState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"yanked")
            Parser (Maybe Text -> IndexFile)
-> Parser (Maybe Text) -> Parser IndexFile
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"provenance"

-- | A PEP 592 yank withdraws a file from ranges while allowing exact pins.
data YankState
    = -- | The file resolves normally.
      FileOffered
    | -- | The file is withdrawn from resolution, with the reason the index gave.
      FileWithdrawn (Maybe Text)
    deriving stock (YankState -> YankState -> Bool
(YankState -> YankState -> Bool)
-> (YankState -> YankState -> Bool) -> Eq YankState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YankState -> YankState -> Bool
== :: YankState -> YankState -> Bool
$c/= :: YankState -> YankState -> Bool
/= :: YankState -> YankState -> Bool
Eq, Int -> YankState -> ShowS
[YankState] -> ShowS
YankState -> String
(Int -> YankState -> ShowS)
-> (YankState -> String)
-> ([YankState] -> ShowS)
-> Show YankState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YankState -> ShowS
showsPrec :: Int -> YankState -> ShowS
$cshow :: YankState -> String
show :: YankState -> String
$cshowList :: [YankState] -> ShowS
showList :: [YankState] -> ShowS
Show)

yankState :: Maybe Value -> YankState
yankState :: Maybe Value -> YankState
yankState = \case
    Just (Bool Bool
True) -> Maybe Text -> YankState
FileWithdrawn Maybe Text
forall a. Maybe a
Nothing
    Just (String Text
reason) -> Maybe Text -> YankState
FileWithdrawn (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reason)
    Maybe Value
_ -> YankState
FileOffered

-- | Refuse malformed or unsupported API declarations. An absent declaration uses the supported API.
checkApiVersion :: Object -> Parser ()
checkApiVersion :: Object -> Parser ()
checkApiVersion Object
o = do
    meta <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"meta" Parser (Maybe Object) -> Object -> Parser Object
forall a. Parser (Maybe a) -> a -> Parser a
.!= Object
forall a. Monoid a => a
mempty
    declared <- meta .:? "api-version"
    case T.breakOn "." <$> declared of
        Just (Text
major, Text
_) | Text
major Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
supportedApiMajor -> String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unsupported PEP 691 api-version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
major)
        Maybe (Text, Text)
_ -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

supportedApiMajor :: Text
supportedApiMajor :: Text
supportedApiMajor = Text
"1"

lenientFiles :: Object -> Parser ([IndexFile], [InvalidEntry])
lenientFiles :: Object -> Parser ([IndexFile], [InvalidEntry])
lenientFiles Object
o = do
    raw <- Object
o Object -> Key -> Parser (Maybe [Value])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"files" Parser (Maybe [Value]) -> [Value] -> Parser [Value]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    pure (decodeIndexFiles (zip [0 ..] raw))

-- | Decode indexed files without renumbering entries that survive lenient parsing.
decodeIndexFiles :: [(Int, Value)] -> ([IndexFile], [InvalidEntry])
decodeIndexFiles :: [(Int, Value)] -> ([IndexFile], [InvalidEntry])
decodeIndexFiles = ((Int, Value) -> ([IndexFile], [InvalidEntry]))
-> [(Int, Value)] -> ([IndexFile], [InvalidEntry])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Value) -> ([IndexFile], [InvalidEntry])
decodeIndexedFile

decodeIndexedFile :: (Int, Value) -> ([IndexFile], [InvalidEntry])
decodeIndexedFile :: (Int, Value) -> ([IndexFile], [InvalidEntry])
decodeIndexedFile (Int
position, Value
value) =
    ([(Text, IndexFile)] -> [IndexFile])
-> ([(Text, IndexFile)], [InvalidEntry])
-> ([IndexFile], [InvalidEntry])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Text, IndexFile) -> IndexFile)
-> [(Text, IndexFile)] -> [IndexFile]
forall a b. (a -> b) -> [a] -> [b]
map (Text, IndexFile) -> IndexFile
forall a b. (a, b) -> b
snd) (([(Text, IndexFile)], [InvalidEntry])
 -> ([IndexFile], [InvalidEntry]))
-> ([(Text, IndexFile)], [InvalidEntry])
-> ([IndexFile], [InvalidEntry])
forall a b. (a -> b) -> a -> b
$
        InvalidEntryKind
-> (Value -> Either String IndexFile)
-> [(Text, Value)]
-> ([(Text, IndexFile)], [InvalidEntry])
forall a.
InvalidEntryKind
-> (Value -> Either String a)
-> [(Text, Value)]
-> ([(Text, a)], [InvalidEntry])
partitionLenientList
            InvalidEntryKind
InvalidIndexFile
            ((IndexFile -> IndexFile)
-> Either String IndexFile -> Either String IndexFile
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IndexFile
file -> IndexFile
file{ifEntryKey = ArrayEntry position}) (Either String IndexFile -> Either String IndexFile)
-> (Value -> Either String IndexFile)
-> Value
-> Either String IndexFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser IndexFile) -> Value -> Either String IndexFile
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser IndexFile
forall a. FromJSON a => Value -> Parser a
parseJSON)
            [(Int -> Value -> Text
fileKey Int
position Value
value, Value
value)]

lenientVersionListing :: Object -> Parser [InvalidEntry]
lenientVersionListing :: Object -> Parser [InvalidEntry]
lenientVersionListing Object
o = do
    raw <- Object
o Object -> Key -> Parser (Maybe [Value])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"versions" Parser (Maybe [Value]) -> [Value] -> Parser [Value]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    pure (snd (partitionLenientList InvalidVersionListing decodeVersion (zip (map show [0 :: Int ..]) raw)))

decodeVersion :: Value -> Either String Text
decodeVersion :: Value -> Either String Text
decodeVersion = (Value -> Parser Text) -> Value -> Either String Text
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

fileKey :: Int -> Value -> Text
fileKey :: Int -> Value -> Text
fileKey Int
position = \case
    Object Object
file | Just (String Text
name) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"filename" Object
file -> Text
name
    Value
_ -> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
position