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

{- | The drop-tracking vocabulary a registry projection records a malformed entry in.

The record reaches an operator log line and an upstream-supplied value can carry a credential,
so 'mkInvalidEntry' is the only builder and the constructor stays hidden. The kinds span every
ecosystem, and the neutral serve diagnostics bucket them through 'dropCountsByKind' rather than
branching on them.
-}
module Ecluse.Core.Package.InvalidEntry (
    -- * A dropped entry
    InvalidEntry (invalidKind, invalidKey, invalidValue, invalidReason),
    mkInvalidEntry,

    -- * Which kind of entry dropped
    InvalidEntryKind (..),
    renderInvalidEntryKind,
    dropCountsByKind,
) where

import Data.Aeson (Value (Array, Object, String))
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Vector qualified as V

import Ecluse.Core.Security.Authority (authorityLabel)

{- | A single registry-document entry a projection __dropped__ as malformed rather than failing
the whole document, kept so an operator can see that an upstream served one, and which.
-}
data InvalidEntry = InvalidEntry
    { InvalidEntry -> InvalidEntryKind
invalidKind :: InvalidEntryKind
    -- ^ Which kind of document entry the projection dropped.
    , InvalidEntry -> Text
invalidKey :: Text
    {- ^ The key the dropped entry sat under: the raw version string for a version manifest
    or publish time, the tag name for a dist-tag, the file name for an index file.
    -}
    , InvalidEntry -> Value
invalidValue :: Value
    {- ^ The __offending value__, with every URL reduced to its authority by 'mkInvalidEntry'.
    Render it at log time, truncating if it is large.
    -}
    , InvalidEntry -> Text
invalidReason :: Text
    -- ^ Why the entry could not be projected (the decode error), for the operator log.
    }
    deriving stock (InvalidEntry -> InvalidEntry -> Bool
(InvalidEntry -> InvalidEntry -> Bool)
-> (InvalidEntry -> InvalidEntry -> Bool) -> Eq InvalidEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidEntry -> InvalidEntry -> Bool
== :: InvalidEntry -> InvalidEntry -> Bool
$c/= :: InvalidEntry -> InvalidEntry -> Bool
/= :: InvalidEntry -> InvalidEntry -> Bool
Eq, Int -> InvalidEntry -> ShowS
[InvalidEntry] -> ShowS
InvalidEntry -> String
(Int -> InvalidEntry -> ShowS)
-> (InvalidEntry -> String)
-> ([InvalidEntry] -> ShowS)
-> Show InvalidEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidEntry -> ShowS
showsPrec :: Int -> InvalidEntry -> ShowS
$cshow :: InvalidEntry -> String
show :: InvalidEntry -> String
$cshowList :: [InvalidEntry] -> ShowS
showList :: [InvalidEntry] -> ShowS
Show)

{- | Record a dropped entry, reducing every URL in the key and the value to its authority: an
upstream-supplied artifact location can carry a credential, and this record reaches a log line.
-}
mkInvalidEntry :: InvalidEntryKind -> Text -> Value -> Text -> InvalidEntry
mkInvalidEntry :: InvalidEntryKind -> Text -> Value -> Text -> InvalidEntry
mkInvalidEntry InvalidEntryKind
kind Text
key Value
value Text
reason =
    InvalidEntry
        { invalidKind :: InvalidEntryKind
invalidKind = InvalidEntryKind
kind
        , invalidKey :: Text
invalidKey = Text -> Text
redactUrlText Text
key
        , invalidValue :: Value
invalidValue = Value -> Value
redactUrls Value
value
        , invalidReason :: Text
invalidReason = Text
reason
        }

-- Reduce every URL-shaped string in a decoded value to its authority, walking containers.
redactUrls :: Value -> Value
redactUrls :: Value -> Value
redactUrls = \case
    String Text
s -> Text -> Value
String (Text -> Text
redactUrlText Text
s)
    Object Object
o -> Object -> Value
Object ((Value -> Value) -> Object -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
KeyMap.map Value -> Value
redactUrls Object
o)
    Array Array
xs -> Array -> Value
Array ((Value -> Value) -> Array -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Value
redactUrls Array
xs)
    Value
scalar -> Value
scalar

-- The scheme separator is what makes a string a URL that can carry userinfo, so it is the one
-- shape reduced. Anything else is recorded as the upstream wrote it.
redactUrlText :: Text -> Text
redactUrlText :: Text -> Text
redactUrlText Text
raw
    | Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
raw = Text -> Text
authorityLabel Text
raw
    | Bool
otherwise = Text
raw

{- | Which kind of registry-document entry a dropped 'InvalidEntry' came from. A dropped manifest
or index file loses a serve candidate, a dropped tag, time or listing only its own datum.
-}
data InvalidEntryKind
    = -- | A @versions@ entry whose manifest did not project (no @dist@\/@tarball@, an unusable @version@).
      InvalidVersionManifest
    | -- | A @dist-tags@ entry whose target was not a usable version string.
      InvalidDistTag
    | -- | A @time@ entry, keyed by a present version, that was not a decodable instant.
      InvalidPublishTime
    | -- | A Simple-index file entry that did not project (no name or location, an unusable digest).
      InvalidIndexFile
    | -- | A versions-listing entry that was not a usable version string.
      InvalidVersionListing
    deriving stock (InvalidEntryKind -> InvalidEntryKind -> Bool
(InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> Eq InvalidEntryKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidEntryKind -> InvalidEntryKind -> Bool
== :: InvalidEntryKind -> InvalidEntryKind -> Bool
$c/= :: InvalidEntryKind -> InvalidEntryKind -> Bool
/= :: InvalidEntryKind -> InvalidEntryKind -> Bool
Eq, Eq InvalidEntryKind
Eq InvalidEntryKind =>
(InvalidEntryKind -> InvalidEntryKind -> Ordering)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> Bool)
-> (InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind)
-> (InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind)
-> Ord InvalidEntryKind
InvalidEntryKind -> InvalidEntryKind -> Bool
InvalidEntryKind -> InvalidEntryKind -> Ordering
InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind
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 :: InvalidEntryKind -> InvalidEntryKind -> Ordering
compare :: InvalidEntryKind -> InvalidEntryKind -> Ordering
$c< :: InvalidEntryKind -> InvalidEntryKind -> Bool
< :: InvalidEntryKind -> InvalidEntryKind -> Bool
$c<= :: InvalidEntryKind -> InvalidEntryKind -> Bool
<= :: InvalidEntryKind -> InvalidEntryKind -> Bool
$c> :: InvalidEntryKind -> InvalidEntryKind -> Bool
> :: InvalidEntryKind -> InvalidEntryKind -> Bool
$c>= :: InvalidEntryKind -> InvalidEntryKind -> Bool
>= :: InvalidEntryKind -> InvalidEntryKind -> Bool
$cmax :: InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind
max :: InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind
$cmin :: InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind
min :: InvalidEntryKind -> InvalidEntryKind -> InvalidEntryKind
Ord, Int -> InvalidEntryKind -> ShowS
[InvalidEntryKind] -> ShowS
InvalidEntryKind -> String
(Int -> InvalidEntryKind -> ShowS)
-> (InvalidEntryKind -> String)
-> ([InvalidEntryKind] -> ShowS)
-> Show InvalidEntryKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidEntryKind -> ShowS
showsPrec :: Int -> InvalidEntryKind -> ShowS
$cshow :: InvalidEntryKind -> String
show :: InvalidEntryKind -> String
$cshowList :: [InvalidEntryKind] -> ShowS
showList :: [InvalidEntryKind] -> ShowS
Show)

{- | The operator-facing label for a drop kind. It is the bucket key an operator filters on, so
it is held stable as this text rather than the constructor name.
-}
renderInvalidEntryKind :: InvalidEntryKind -> Text
renderInvalidEntryKind :: InvalidEntryKind -> Text
renderInvalidEntryKind = \case
    InvalidEntryKind
InvalidVersionManifest -> Text
"version-manifest"
    InvalidEntryKind
InvalidDistTag -> Text
"dist-tag"
    InvalidEntryKind
InvalidPublishTime -> Text
"publish-time"
    InvalidEntryKind
InvalidIndexFile -> Text
"index-file"
    InvalidEntryKind
InvalidVersionListing -> Text
"version-listing"

{- | How many entries dropped under each kind's label. Only the kinds actually seen appear, so
a document's drop profile carries no bucket its ecosystem has no entries for.
-}
dropCountsByKind :: [InvalidEntry] -> Map Text Int
dropCountsByKind :: [InvalidEntry] -> Map Text Int
dropCountsByKind [InvalidEntry]
entries =
    (Int -> Int -> Int) -> [(Text, Int)] -> Map Text Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [(InvalidEntryKind -> Text
renderInvalidEntryKind (InvalidEntry -> InvalidEntryKind
invalidKind InvalidEntry
e), Int
1) | InvalidEntry
e <- [InvalidEntry]
entries]