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

{- | Shared metadata validation for full documents and selective adapter reads.
Ecosystem callbacks own wire projection and package-name parsing.
-}
module Ecluse.Core.Registry.Metadata.Projection (
    validateReportedName,
    projectionResult,
    streamError,
) where

import Data.Aeson (Value, parseJSON)
import Data.Aeson.Types (parseMaybe)

import Ecluse.Core.Package (PackageName)
import Ecluse.Core.Registry (ParseError (ParseError))
import Ecluse.Core.Registry.Metadata (MetadataError (MetadataBoundExceeded, MetadataNameMismatch, MetadataUndecodable))
import Ecluse.Core.Registry.WireSupport (Projection (NameMismatch, Projected))
import Ecluse.Core.Security (
    LimitError (TooDeeplyNested),
    Limits,
    maxNestingDepth,
 )

-- | An absent, non-string, or rejected name is an undecodable document.
validateReportedName :: (Text -> Either ParseError PackageName) -> Maybe Value -> Either MetadataError PackageName
validateReportedName :: (Text -> Either ParseError PackageName)
-> Maybe Value -> Either MetadataError PackageName
validateReportedName Text -> Either ParseError PackageName
parseName = \case
    Maybe Value
Nothing -> MetadataError -> Either MetadataError PackageName
forall a b. a -> Either a b
Left MetadataError
MetadataUndecodable
    Just Value
nameValue -> case (Value -> Parser Text) -> Value -> Maybe Text
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
nameValue of
        Maybe Text
Nothing -> MetadataError -> Either MetadataError PackageName
forall a b. a -> Either a b
Left MetadataError
MetadataUndecodable
        Just Text
raw -> (ParseError -> MetadataError)
-> Either ParseError PackageName
-> Either MetadataError PackageName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MetadataError -> ParseError -> MetadataError
forall a b. a -> b -> a
const MetadataError
MetadataUndecodable) (Text -> Either ParseError PackageName
parseName Text
raw)

-- | Preserve the reported name when refusing a mismatched origin.
projectionResult :: Projection a -> Either MetadataError a
projectionResult :: forall a. Projection a -> Either MetadataError a
projectionResult = \case
    NameMismatch Text
reported -> MetadataError -> Either MetadataError a
forall a b. a -> Either a b
Left (Text -> MetadataError
MetadataNameMismatch Text
reported)
    Projected a
projected -> a -> Either MetadataError a
forall a b. b -> Either a b
Right a
projected

-- | Translate incremental parser bounds without requiring validity of skipped data.
streamError :: Limits -> ParseError -> MetadataError
streamError :: Limits -> ParseError -> MetadataError
streamError Limits
limits = \case
    ParseError Text
"retained JSON nesting limit" -> LimitError -> MetadataError
MetadataBoundExceeded (Int -> LimitError
TooDeeplyNested (Limits -> Int
maxNestingDepth Limits
limits))
    ParseError
_ -> MetadataError
MetadataUndecodable