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

{- | npm's client-facing error body, as a codec.

The agnostic serve layer decides the HTTP /status/ of a refusal; the /body/ shape is
npm's, and it lives here as one 'NpmError' type with an @autodocodec@ codec. That codec
is the single source of truth: the serve path encodes the wire denial from it, and the
capability manifest renders the /same/ codec to the documented schema (in its own tier,
so @openapi3@ never reaches the proxy). npm clients read the human-facing reason from a
JSON @{"error": …}@ object, matching npm's own denial bodies.

There is no separate renderer handle. A route's abstract
'Ecluse.Core.Server.Contract.ResponseContract' pairs each status with its body codec, the
handler receives only constructors for values admitted by that contract, and the emitted
body is therefore the documented body by construction.
-}
module Ecluse.Core.Registry.Npm.Serve (
    NpmError (..),
    npmErrorCodec,
    npmErrorKey,
    npmError,
) where

import Autodocodec (HasCodec (codec), JSONCodec, object, requiredField, (.=))

import Ecluse.Core.Server.Response (HelpMessage, appendHelp)

{- | npm's client-facing error body: a JSON object carrying the human-facing reason under
a single @error@ string ('npmErrorKey'). One codec backs both the wire encoding and the
documented schema, so the served body and its documentation cannot diverge.
-}
newtype NpmError = NpmError {NpmError -> Text
npmErrorReason :: Text}
    deriving stock (NpmError -> NpmError -> Bool
(NpmError -> NpmError -> Bool)
-> (NpmError -> NpmError -> Bool) -> Eq NpmError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NpmError -> NpmError -> Bool
== :: NpmError -> NpmError -> Bool
$c/= :: NpmError -> NpmError -> Bool
/= :: NpmError -> NpmError -> Bool
Eq, Int -> NpmError -> ShowS
[NpmError] -> ShowS
NpmError -> String
(Int -> NpmError -> ShowS)
-> (NpmError -> String) -> ([NpmError] -> ShowS) -> Show NpmError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NpmError -> ShowS
showsPrec :: Int -> NpmError -> ShowS
$cshow :: NpmError -> String
show :: NpmError -> String
$cshowList :: [NpmError] -> ShowS
showList :: [NpmError] -> ShowS
Show)

-- | The JSON key an npm denial body carries its reason under.
npmErrorKey :: Text
npmErrorKey :: Text
npmErrorKey = Text
"error"

instance HasCodec NpmError where
    codec :: JSONCodec NpmError
codec =
        Text -> ObjectCodec NpmError NpmError -> JSONCodec NpmError
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"NpmError" (ObjectCodec NpmError NpmError -> JSONCodec NpmError)
-> ObjectCodec NpmError NpmError -> JSONCodec NpmError
forall a b. (a -> b) -> a -> b
$
            Text -> NpmError
NpmError (Text -> NpmError)
-> Codec Object NpmError Text -> ObjectCodec NpmError NpmError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec Text Text
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
npmErrorKey Text
"The human-facing reason the request was refused." ObjectCodec Text Text
-> (NpmError -> Text) -> Codec Object NpmError Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= NpmError -> Text
npmErrorReason

-- | npm's error-body codec: the source of truth for its wire form and documented schema.
npmErrorCodec :: JSONCodec NpmError
npmErrorCodec :: JSONCodec NpmError
npmErrorCodec = JSONCodec NpmError
forall value. HasCodec value => JSONCodec value
codec

{- | Build an npm error body from the human-facing reason and the operator help message,
appending the help (if any) as the serve path has always done.
-}
npmError :: Maybe HelpMessage -> Text -> NpmError
npmError :: Maybe HelpMessage -> Text -> NpmError
npmError Maybe HelpMessage
help Text
message = Text -> NpmError
NpmError (Maybe HelpMessage -> Text -> Text
appendHelp Maybe HelpMessage
help Text
message)