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

{- | npm's credential presentation: the @Bearer@ token an npm client sends on
@Authorization@, recovered at the edge and attached under the same scheme upstream.

The npm CLI turns an @.npmrc@ @\/\/host\/:_authToken=...@ entry into that one header, so a
mount serving npm accepts and presents that form alone. One 'CredentialMapping' declares
both directions, so the recovered token and the header it travels on cannot drift apart.
-}
module Ecluse.Core.Registry.Npm.Credential (
    npmCredential,
) where

import Data.Text qualified as T
import Network.HTTP.Types.Header (RequestHeaders, hAuthorization)

import Ecluse.Core.Credential (ClientCredential (credSecret), bareCredential, mkSecret, unSecret)
import Ecluse.Core.Registry.Request (CredentialMapping, authorizationUnder, credentialMapping)

{- | npm's credential mapping: @Bearer@ over @Authorization@ in both directions. The npm
adapter registers it on 'Ecluse.Core.Registry.Adapter.Types.serveCredential'.
-}
npmCredential :: CredentialMapping
npmCredential :: CredentialMapping
npmCredential = (RequestHeaders -> Maybe ClientCredential)
-> HeaderName
-> (ClientCredential -> ByteString)
-> CredentialMapping
credentialMapping RequestHeaders -> Maybe ClientCredential
recoverBearer HeaderName
hAuthorization ClientCredential -> ByteString
renderBearer

-- npm's scheme carries no username, so the recovered pair has none. Another scheme, a bare or
-- empty token, or no header yields 'Nothing'.
recoverBearer :: RequestHeaders -> Maybe ClientCredential
recoverBearer :: RequestHeaders -> Maybe ClientCredential
recoverBearer RequestHeaders
headers = do
    token <- Text -> RequestHeaders -> Maybe Text
authorizationUnder Text
"bearer" RequestHeaders
headers
    guard (not (T.null token))
    pure (bareCredential (mkSecret token))

-- The @Authorization@ value carrying a credential under npm's @Bearer@ scheme, whose
-- grammar has no username slot to render.
renderBearer :: ClientCredential -> ByteString
renderBearer :: ClientCredential -> ByteString
renderBearer ClientCredential
credential = ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Secret -> Text
unSecret (ClientCredential -> Secret
credSecret ClientCredential
credential))