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

{- | PyPI's credential presentation: the HTTP Basic pair a Python client sends on
@Authorization@, recovered here and attached under the same scheme going upstream.

The username is a client-side convention rather than an identity the index checks, so the
recovery admits any username and the edge gate compares the password half alone. A credential
Écluse holds rather than receives carries no username and travels under @__token__@, the name
PyPI's own tooling writes for a token. A pair a client sent travels verbatim, because rewriting
a username would authenticate as somebody else.
-}
module Ecluse.Core.Registry.PyPI.Credential (
    pypiCredential,
) where

import Data.ByteArray.Encoding (Base (Base64), convertFromBase, convertToBase)
import Data.Text qualified as T
import Network.HTTP.Types.Header (RequestHeaders, hAuthorization)

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

-- | PyPI's credential mapping: recover the client's Basic pair, re-present it upstream.
pypiCredential :: CredentialMapping
pypiCredential :: CredentialMapping
pypiCredential = (RequestHeaders -> Maybe ClientCredential)
-> HeaderName
-> (ClientCredential -> ByteString)
-> CredentialMapping
credentialMapping RequestHeaders -> Maybe ClientCredential
recoverBasic HeaderName
hAuthorization ClientCredential -> ByteString
renderBasic

-- The password half may itself carry a colon, so the split takes the first one. Another scheme,
-- undecodable base64, no colon, an empty password, or no header yields 'Nothing'.
recoverBasic :: RequestHeaders -> Maybe ClientCredential
recoverBasic :: RequestHeaders -> Maybe ClientCredential
recoverBasic RequestHeaders
headers = do
    encoded <- Text -> RequestHeaders -> Maybe Text
authorizationUnder Text
"basic" RequestHeaders
headers
    decoded <- decodeBase64 (encodeUtf8 encoded)
    let (username, afterUser) = T.break (== ':') (decodeUtf8 decoded)
    password <- T.stripPrefix ":" afterUser
    guard (not (T.null password))
    pure (ClientCredential (usernameGiven username) (mkSecret password))

renderBasic :: ClientCredential -> ByteString
renderBasic :: ClientCredential -> ByteString
renderBasic ClientCredential
credential =
    ByteString
"Basic " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
pair :: ByteString)
  where
    pair :: Text
pair = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
tokenUsername (ClientCredential -> Maybe Text
credUsername ClientCredential
credential) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Secret -> Text
unSecret (ClientCredential -> Secret
credSecret ClientCredential
credential)

tokenUsername :: Text
tokenUsername :: Text
tokenUsername = Text
"__token__"

-- An empty username is no username, which is how a client that names none presents itself.
usernameGiven :: Text -> Maybe Text
usernameGiven :: Text -> Maybe Text
usernameGiven Text
username = if Text -> Bool
T.null Text
username then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
username

decodeBase64 :: ByteString -> Maybe ByteString
decodeBase64 :: ByteString -> Maybe ByteString
decodeBase64 = Either String ByteString -> Maybe ByteString
forall l r. Either l r -> Maybe r
rightToMaybe (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64