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

{- | A __selective__ decode of an npm packument: pull __one version's__ pieces out of
the document bytes without materialising the other versions.

The whole-packument decode (@aeson@'s @eitherDecodeStrict@) builds a 'Value' for /every/
version -- and on a heavy packument (thousands of versions, multiple megabytes) that
decode dominates the serve-path cost. But the tarball gate consults a __single__
version: it needs that version's manifest object, its @time[version]@ publish stamp, and
the document's self-reported @name@ -- nothing of the other versions. This module walks
the registry's own JSON token stream (@aeson@'s @Data.Aeson.Decoding@, no new
dependency) and materialises a 'Value' only for those few pieces, __skipping every other
version's tokens without allocating them__. The win is on the /parse/, not the fetch:
the full bytes are still read (npm carries @time@ only in the full document), but they
are parsed selectively -- O(1 version) work and residency rather than O(N).

The generic bounded token-walk engine this decode drives lives in
"Ecluse.Core.Json.Selective"; this module adds npm's packument key selection on top.

== Faithful to the whole-document decode

The skip is not a shortcut past validation. The walk consumes the __entire__ token
stream, so:

  * malformed JSON __anywhere__ surfaces as 'SelectiveUndecodable' -- the lexer reaches
    the offending bytes whether or not they sit in the requested version (matching
    @eitherDecodeStrict@ failing the whole body);
  * trailing non-whitespace after the top-level object is rejected likewise (the same
    end-of-input check @eitherDecodeStrict@ applies);
  * every value is depth-bounded at the same budget
    'Ecluse.Core.Security.checkNestingDepth' would apply to it, so a deeply-nested
    sub-tree __anywhere__ is a 'SelectiveTooDeeplyNested' breach, not a serve.

The two pieces it /does/ build -- the requested version object and the document @name@ --
are produced by the same @aeson@ 'Value' decoder the whole-document path uses, so
projecting them yields a byte-for-byte identical 'Ecluse.Core.Package.PackageDetails'
(the projection is "Ecluse.Core.Registry.Npm.Project.projectVersionEntry", run over the
same 'Value').

== What it deliberately does not re-validate

The selective walk reaches only the requested version's @time@ entry: a structurally
malformed-JSON one anywhere is still 'SelectiveUndecodable' (the lexer reaches it), but a
__schema-invalid__ sibling (a non-ISO @time@ string for /another/ version, a non-string
@dist-tags@ value) is __skipped unallocated__ and never inspected. The whole-document
decode degrades the same way: it drops a malformed @time@\/@dist-tags@ entry per-entry
(graceful per-entry degradation) rather than failing the document, so neither path
refuses a sound version over an unrelated sibling malformation. The two paths agree on
__what is served__ (the one sound version, identically projected) and differ only in
__tracking__: the whole-document projection records each dropped sibling as an
'Ecluse.Core.Package.InvalidEntry' for the serve-path log, while this walk, skipping the
siblings unallocated, cannot report them (the degenerate tracking a single-version read
inherently has). The requested version's /own/ schema-invalid stamp folds, on both paths,
to a version with no known publish time (the projecting caller's lenient parse), never a
document failure.
-}
module Ecluse.Core.Registry.Npm.SelectiveDecode (
    -- * The selective decode
    SelectedVersion (..),
    SelectiveError (..),
    selectVersionFromPackument,
) where

import Data.Aeson (Value)
import Data.Aeson.Decoding.ByteString (bsToTokens)
import Data.Aeson.Decoding.Tokens (TkRecord (..), Tokens (TkRecordOpen))
import Data.Aeson.Key qualified as Key

import Ecluse.Core.Json.Selective (
    SelectiveError (..),
    findInRecord,
    materialiseWithinBudget,
    skipValue,
    trailingWhitespace,
    withRecord,
 )
import Ecluse.Core.Version (Version, renderVersion)

{- | The pieces a selective decode pulls out of a packument for one requested version:
the document's self-reported @name@, the requested version's manifest object and publish
stamp (each as the raw 'Value' the same projection the whole-document path uses then
consumes), and the __raw__ number of entries in the @versions@ object.

Each value field is 'Nothing' when its key is absent from the document, so the caller
reproduces the whole-document outcome: an absent @name@ is the empty-name decode failure,
an absent version object is a genuine miss, an absent @time@ entry is a version with no
known publish stamp. The 'svVersionCount' is the count the caller bounds against
'Ecluse.Core.Security.maxVersionCount'.

When a key appears more than once -- a duplicate top-level @name@, @versions@ or @time@, or
a duplicate version key inside @versions@ -- the __first__ occurrence is kept and the later
ones are consumed only for validation, matching @aeson@'s duplicate-key resolution (the
first of a duplicate wins), so neither the chosen value nor the count diverges from the
whole-document decode.
-}
data SelectedVersion = SelectedVersion
    { SelectedVersion -> Maybe Value
svName :: Maybe Value
    -- ^ The top-level @name@ value, if the key was present (else 'Nothing').
    , SelectedVersion -> Maybe Value
svVersion :: Maybe Value
    -- ^ The requested version's object from @versions@, if that key was present.
    , SelectedVersion -> Maybe Value
svTime :: Maybe Value
    -- ^ The requested version's @time[version]@ value, if that key was present.
    , SelectedVersion -> Int
svVersionCount :: Int
    -- ^ The number of entries in the @versions@ object (@0@ when @versions@ is absent).
    }
    deriving stock (SelectedVersion -> SelectedVersion -> Bool
(SelectedVersion -> SelectedVersion -> Bool)
-> (SelectedVersion -> SelectedVersion -> Bool)
-> Eq SelectedVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectedVersion -> SelectedVersion -> Bool
== :: SelectedVersion -> SelectedVersion -> Bool
$c/= :: SelectedVersion -> SelectedVersion -> Bool
/= :: SelectedVersion -> SelectedVersion -> Bool
Eq, Int -> SelectedVersion -> ShowS
[SelectedVersion] -> ShowS
SelectedVersion -> String
(Int -> SelectedVersion -> ShowS)
-> (SelectedVersion -> String)
-> ([SelectedVersion] -> ShowS)
-> Show SelectedVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectedVersion -> ShowS
showsPrec :: Int -> SelectedVersion -> ShowS
$cshow :: SelectedVersion -> String
show :: SelectedVersion -> String
$cshowList :: [SelectedVersion] -> ShowS
showList :: [SelectedVersion] -> ShowS
Show)

{- | Selectively decode a packument's bytes for one version: walk the token stream,
extracting the document @name@, the requested version's object and @time@ entry, and the
@versions@ count, while skipping every other version's tokens unallocated and bounding
every value at @maxDepth@ levels (the 'Ecluse.Core.Security.maxNestingDepth' budget, so
the depth bound matches 'Ecluse.Core.Security.checkNestingDepth' over the whole
document).

The body must be a well-formed JSON object with nothing but whitespace after it, or the
result is 'SelectiveUndecodable' -- exactly as @eitherDecodeStrict@ would fail it.
-}
selectVersionFromPackument :: Int -> Version -> ByteString -> Either SelectiveError SelectedVersion
selectVersionFromPackument :: Int
-> Version -> ByteString -> Either SelectiveError SelectedVersion
selectVersionFromPackument Int
maxDepth Version
version ByteString
body
    -- The top-level value is itself a container occupying one level, so a zero (or
    -- negative) budget refuses it before the walk -- mirroring @within cap@ requiring
    -- @cap >= 1@ for the document object.
    | Int
maxDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveTooDeeplyNested
    | Bool
otherwise = case ByteString -> Tokens ByteString String
bsToTokens ByteString
body of
        TkRecordOpen TkRecord ByteString String
rec -> Int
-> Text
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
walkTop (Int
maxDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Version -> Text
renderVersion Version
version) TkRecord ByteString String
rec
        -- A well-formed non-object body decodes but never projects to a packument, and a
        -- malformed body never decodes; the whole-document path renders both as the same
        -- "unobtainable metadata", so neither is distinguished here.
        Tokens ByteString String
_ -> SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable

-- The starting accumulator: nothing found, no versions counted.
emptySelection :: SelectedVersion
emptySelection :: SelectedVersion
emptySelection = Maybe Value -> Maybe Value -> Maybe Value -> Int -> SelectedVersion
SelectedVersion Maybe Value
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Int
0

{- The walk's threaded state: the selection built so far, plus whether each captured
top-level key has already been seen. @aeson@ keeps the __first__ occurrence of a duplicate
key, so once a @name@, @versions@ or @time@ key is captured a later duplicate is consumed
for validation but never overwrites the first. The flags carry that "already captured"
signal, which the selection alone cannot: a captured @versions@\/@time@ whose target was
absent leaves its value field 'Nothing', indistinguishable from "not yet seen". -}
data WalkState = WalkState
    { WalkState -> SelectedVersion
wsSelection :: SelectedVersion
    , WalkState -> Bool
wsSeenName :: Bool
    , WalkState -> Bool
wsSeenVersions :: Bool
    , WalkState -> Bool
wsSeenTime :: Bool
    }

initialWalk :: WalkState
initialWalk :: WalkState
initialWalk = SelectedVersion -> Bool -> Bool -> Bool -> WalkState
WalkState SelectedVersion
emptySelection Bool
False Bool
False Bool
False

{- Walk the top-level packument record to its end, threading the walk state. @childBudget@
is the depth budget each top-level value sits at (one below the document object's own
budget). @name@, @versions@ and @time@ are each captured at their first occurrence (the
requested version and the count come from that first @versions@ object); every other value
is skipped unallocated. The trailing bytes after the record must be whitespace only. -}
walkTop :: Int -> Text -> TkRecord ByteString String -> Either SelectiveError SelectedVersion
walkTop :: Int
-> Text
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
walkTop Int
childBudget Text
target = (WalkState -> SelectedVersion)
-> Either SelectiveError WalkState
-> Either SelectiveError SelectedVersion
forall a b.
(a -> b) -> Either SelectiveError a -> Either SelectiveError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalkState -> SelectedVersion
wsSelection (Either SelectiveError WalkState
 -> Either SelectiveError SelectedVersion)
-> (TkRecord ByteString String -> Either SelectiveError WalkState)
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalkState
-> TkRecord ByteString String -> Either SelectiveError WalkState
go WalkState
initialWalk
  where
    go :: WalkState
-> TkRecord ByteString String -> Either SelectiveError WalkState
go WalkState
st = \case
        TkRecordEnd ByteString
leftover
            | ByteString -> Bool
trailingWhitespace ByteString
leftover -> WalkState -> Either SelectiveError WalkState
forall a b. b -> Either a b
Right WalkState
st
            | Bool
otherwise -> SelectiveError -> Either SelectiveError WalkState
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
        TkRecordErr String
_ -> SelectiveError -> Either SelectiveError WalkState
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
        TkPair Key
key Tokens (TkRecord ByteString String) String
valueToks -> case Key -> Text
Key.toText Key
key of
            Text
"versions" -> (WalkState -> Bool)
-> (WalkState
    -> Tokens (TkRecord ByteString String) String
    -> Either SelectiveError (WalkState, TkRecord ByteString String))
-> WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError WalkState
adoptFirst WalkState -> Bool
wsSeenVersions WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (WalkState, TkRecord ByteString String)
forall {b}.
WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureVersions WalkState
st Tokens (TkRecord ByteString String) String
valueToks
            Text
"time" -> (WalkState -> Bool)
-> (WalkState
    -> Tokens (TkRecord ByteString String) String
    -> Either SelectiveError (WalkState, TkRecord ByteString String))
-> WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError WalkState
adoptFirst WalkState -> Bool
wsSeenTime WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (WalkState, TkRecord ByteString String)
forall {b}.
WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureTime WalkState
st Tokens (TkRecord ByteString String) String
valueToks
            Text
"name" -> (WalkState -> Bool)
-> (WalkState
    -> Tokens (TkRecord ByteString String) String
    -> Either SelectiveError (WalkState, TkRecord ByteString String))
-> WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError WalkState
adoptFirst WalkState -> Bool
wsSeenName WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (WalkState, TkRecord ByteString String)
forall {b}.
WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureName WalkState
st Tokens (TkRecord ByteString String) String
valueToks
            Text
_ -> Int
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (TkRecord ByteString String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
childBudget Tokens (TkRecord ByteString String) String
valueToks Either SelectiveError (TkRecord ByteString String)
-> (TkRecord ByteString String -> Either SelectiveError WalkState)
-> Either SelectiveError WalkState
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalkState
-> TkRecord ByteString String -> Either SelectiveError WalkState
go WalkState
st

    {- Adopt a captured top-level key at its first occurrence, or skip a later duplicate:
    @aeson@ keeps the first of a duplicate key, so once captured a repeat must not overwrite
    it. Either branch still walks the value to its end (its tokens consumed, depth-bounded),
    so a malformed or over-deep sibling anywhere still breaches; a skipped value is never
    materialised. Continues the walk from the value's continuation. -}
    adoptFirst :: (WalkState -> Bool)
-> (WalkState
    -> Tokens (TkRecord ByteString String) String
    -> Either SelectiveError (WalkState, TkRecord ByteString String))
-> WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError WalkState
adoptFirst WalkState -> Bool
captured WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (WalkState, TkRecord ByteString String)
capture WalkState
st Tokens (TkRecord ByteString String) String
valueToks
        | WalkState -> Bool
captured WalkState
st = Int
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (TkRecord ByteString String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
childBudget Tokens (TkRecord ByteString String) String
valueToks Either SelectiveError (TkRecord ByteString String)
-> (TkRecord ByteString String -> Either SelectiveError WalkState)
-> Either SelectiveError WalkState
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalkState
-> TkRecord ByteString String -> Either SelectiveError WalkState
go WalkState
st
        | Bool
otherwise = WalkState
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (WalkState, TkRecord ByteString String)
capture WalkState
st Tokens (TkRecord ByteString String) String
valueToks Either SelectiveError (WalkState, TkRecord ByteString String)
-> ((WalkState, TkRecord ByteString String)
    -> Either SelectiveError WalkState)
-> Either SelectiveError WalkState
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WalkState
 -> TkRecord ByteString String -> Either SelectiveError WalkState)
-> (WalkState, TkRecord ByteString String)
-> Either SelectiveError WalkState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WalkState
-> TkRecord ByteString String -> Either SelectiveError WalkState
go

    -- Capture the first @versions@ object: the requested version (first-wins within the
    -- object) and its raw entry count, then mark @versions@ seen.
    captureVersions :: WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureVersions WalkState
st Tokens b String
valueToks =
        Int
-> Tokens b String
-> (TkRecord b String -> Either SelectiveError (WalkState, b))
-> Either SelectiveError (WalkState, b)
forall k a.
Int
-> Tokens k String
-> (TkRecord k String -> Either SelectiveError a)
-> Either SelectiveError a
withRecord Int
childBudget Tokens b String
valueToks ((TkRecord b String -> Either SelectiveError (WalkState, b))
 -> Either SelectiveError (WalkState, b))
-> (TkRecord b String -> Either SelectiveError (WalkState, b))
-> Either SelectiveError (WalkState, b)
forall a b. (a -> b) -> a -> b
$ \TkRecord b String
versionsRec -> do
            (found, count, cont) <- Int
-> Text
-> TkRecord b String
-> Either SelectiveError (Maybe Value, Int, b)
forall k.
Int
-> Text
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
findInRecord (Int
childBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
target TkRecord b String
versionsRec
            pure (st{wsSelection = (wsSelection st){svVersion = found, svVersionCount = count}, wsSeenVersions = True}, cont)

    -- Capture the first @time@ object: the requested version's publish stamp (first-wins),
    -- then mark @time@ seen. The entry count is the version count's concern, not @time@'s.
    captureTime :: WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureTime WalkState
st Tokens b String
valueToks =
        Int
-> Tokens b String
-> (TkRecord b String -> Either SelectiveError (WalkState, b))
-> Either SelectiveError (WalkState, b)
forall k a.
Int
-> Tokens k String
-> (TkRecord k String -> Either SelectiveError a)
-> Either SelectiveError a
withRecord Int
childBudget Tokens b String
valueToks ((TkRecord b String -> Either SelectiveError (WalkState, b))
 -> Either SelectiveError (WalkState, b))
-> (TkRecord b String -> Either SelectiveError (WalkState, b))
-> Either SelectiveError (WalkState, b)
forall a b. (a -> b) -> a -> b
$ \TkRecord b String
timeRec -> do
            (found, _count, cont) <- Int
-> Text
-> TkRecord b String
-> Either SelectiveError (Maybe Value, Int, b)
forall k.
Int
-> Text
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
findInRecord (Int
childBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
target TkRecord b String
timeRec
            pure (st{wsSelection = (wsSelection st){svTime = found}, wsSeenTime = True}, cont)

    -- Capture the first top-level @name@ value, then mark @name@ seen.
    captureName :: WalkState
-> Tokens b String -> Either SelectiveError (WalkState, b)
captureName WalkState
st Tokens b String
valueToks = do
        (nameValue, cont) <- Int -> Tokens b String -> Either SelectiveError (Value, b)
forall k.
Int -> Tokens k String -> Either SelectiveError (Value, k)
materialiseWithinBudget Int
childBudget Tokens b String
valueToks
        pure (st{wsSelection = (wsSelection st){svName = Just nameValue}, wsSeenName = True}, cont)