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

{- | Select names covered by advisories or explicit identity denies.
Other policy changes require a full store walk.
-}
module Ecluse.Core.Registry.Sweep.Candidates (
    CandidateSet,
    candidateSet,
    identityDenyNames,
    inCandidates,
) where

import Data.Set qualified as Set
import Data.Text qualified as T

import Ecluse.Core.Cve (CveLookup (cveCoveredNames))
import Ecluse.Core.Package (PackageName)
import Ecluse.Core.Registry.Adapter.Capability (ProjectName)
import Ecluse.Core.Rules.Types (Rule (DenyByIdentity))

{- | Canonical names let the artifact and store use different display spellings.
The ecosystem parser preserves their shared identity.
-}
newtype CandidateSet = CandidateSet (Set PackageName)
    deriving stock (CandidateSet -> CandidateSet -> Bool
(CandidateSet -> CandidateSet -> Bool)
-> (CandidateSet -> CandidateSet -> Bool) -> Eq CandidateSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CandidateSet -> CandidateSet -> Bool
== :: CandidateSet -> CandidateSet -> Bool
$c/= :: CandidateSet -> CandidateSet -> Bool
/= :: CandidateSet -> CandidateSet -> Bool
Eq, Int -> CandidateSet -> ShowS
[CandidateSet] -> ShowS
CandidateSet -> String
(Int -> CandidateSet -> ShowS)
-> (CandidateSet -> String)
-> ([CandidateSet] -> ShowS)
-> Show CandidateSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CandidateSet -> ShowS
showsPrec :: Int -> CandidateSet -> ShowS
$cshow :: CandidateSet -> String
show :: CandidateSet -> String
$cshowList :: [CandidateSet] -> ShowS
showList :: [CandidateSet] -> ShowS
Show)

{- | Every name a pinned lookup covers, plus the identity-denied names.
Later rule evaluations acquire their own lookups and can use a newer generation.
-}
candidateSet :: ProjectName -> [Rule] -> Maybe CveLookup -> IO CandidateSet
candidateSet :: ProjectName -> [Rule] -> Maybe CveLookup -> IO CandidateSet
candidateSet ProjectName
project [Rule]
rules Maybe CveLookup
mLookup = do
    covered <- IO [Text]
-> (CveLookup -> IO [Text]) -> Maybe CveLookup -> IO [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) CveLookup -> IO [Text]
cveCoveredNames Maybe CveLookup
mLookup
    pure (CandidateSet (Set.fromList (mapMaybe project covered <> identityDenyNames project rules)))

{- | The package names a rule set's identity denies pin. A deny spells @name@ or
@name\@version@, and a name may itself carry an @\@@, so the split is at the __last__ one.
-}
identityDenyNames :: ProjectName -> [Rule] -> [PackageName]
identityDenyNames :: ProjectName -> [Rule] -> [PackageName]
identityDenyNames ProjectName
project [Rule]
rules = ProjectName -> [Text] -> [PackageName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ProjectName
project ProjectName -> (Text -> Text) -> ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
beforeLastAt) [Text
ident | DenyByIdentity Text
ident <- [Rule]
rules]

{- Everything before the last @, where that leaves anything. A bare name has no @ to split on,
and a bare scoped name's only @ leads it, so both stand whole. -}
beforeLastAt :: Text -> Text
beforeLastAt :: Text -> Text
beforeLastAt Text
raw = case Text -> Text -> Maybe Text
T.stripSuffix Text
"@" ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"@" Text
raw)) of
    Just Text
name | Bool -> Bool
not (Text -> Bool
T.null Text
name) -> Text
name
    Maybe Text
_ -> Text
raw

-- | Whether a name the store listed is one this cycle decides.
inCandidates :: CandidateSet -> PackageName -> Bool
inCandidates :: CandidateSet -> PackageName -> Bool
inCandidates (CandidateSet Set PackageName
names) = (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
names)