{- | The outbound-credential handle: minting the bearer token Écluse uses to
__write__ approved packages to the mirror target.

This is one of the two cloud handles (the other is "Ecluse.Core.Queue"); it is separate
from the protocol handle "Ecluse.Core.Registry" because protocol and authentication are
orthogonal axes -- every managed npm registry (AWS CodeArtifact, GCP Artifact
Registry, a self-hosted Verdaccio) speaks the same npm protocol and differs only
in how its bearer token is obtained (see
@docs\/architecture\/cloud-backends.md@ → "Credential Provider").

A 'CredentialProvider' is used __only__ for the mirror-target write, never to
read on a user's behalf: private-upstream reads forward the /client's/ own
credential and public reads are anonymous (see
@docs\/architecture\/registry-model.md@ → "Credential flow and authority"). So a
deployment configures exactly one provider.

Like the other handles, the effectful field returns __'IO', not @App@__: an
adapter closes over its own backend state (an @amazonka@ env, an HTTP manager)
and never imports the proxy's @Env@\/@App@, so backends stay decoupled from the
core (see @docs\/architecture\/technology-stack.md@ → "Key Decisions").

This module provides the handle and its payload types. 'staticProvider' is the
in-memory leaf: a fixed token with no expiry. The generic refresh\/cache\/expiry
policy that wraps a per-cloud token mint lives in "Ecluse.Core.Credential.Refresh".
-}
module Ecluse.Core.Credential (
    -- * Provider handle
    CredentialProvider (..),

    -- * Tokens
    AuthToken (..),

    -- * Secrets
    Secret,
    mkSecret,
    unSecret,

    -- * In-memory double
    staticProvider,
) where

import Data.Aeson (FromJSON (..), ToJSON (..), Value (String), withText)
import Data.ByteArray qualified as BA
import Data.Time (UTCTime)
import Text.Show (showString, showsPrec)

{- | A short-lived bearer secret (an access token).

__Opaque, and its 'Show' is redacted__: the underlying token text is never
rendered, so a 'Secret' can be embedded in any value -- an 'AuthToken', a log
record, an error -- without risking disclosure (token material must never reach a
log, metric, or trace; see @docs\/architecture\/observability.md@). This
redaction is a load-bearing security property.

Build one with 'mkSecret' and read the real value back __only__ at the point of
use with 'unSecret' (e.g. when setting the @Authorization@ header).

__Equality is constant-time__: two secrets are compared over their UTF-8 bytes
without a content-dependent early out (see the 'Eq' instance). The default
derived equality would be 'Data.Text'\'s short-circuiting compare, which returns
as soon as two tokens first differ and so leaks, through timing, how long a
shared prefix is. Folding that property into the type itself means no comparison
on a 'Secret' -- the inbound edge-auth gate above all -- can accidentally become
non-constant-time. (A constant-time compare can still reveal the token /length/;
that residual leak is accepted, but the /content/ is never short-circuited on.)
-}
newtype Secret = Secret Text

{- | Constant-time equality over the UTF-8 encoding of the wrapped token.

'BA.constEq' compares every byte regardless of where the inputs first diverge,
so a near-miss token cannot be distinguished from a far-miss one by how long the
comparison takes. This is the security property the whole type exists to make
unmissable: the @ECLUSE_AUTH_TOKEN@ edge gate compares the client's bearer token
against the configured one through this instance, and a short-circuiting compare
there would leak the secret's prefix length to a remote attacker.
-}
instance Eq Secret where
    Secret Text
a == :: Secret -> Secret -> Bool
== Secret Text
b = ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
a :: ByteString) (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
b :: ByteString)

{- | Renders a fixed placeholder, __never__ the secret text. This is the whole
point of the type: it makes accidental disclosure through any @'show'@-based
signal (logs, errors, @deriving Show@ on an enclosing record) impossible.

Defined via 'showsPrec' (the 'Show' class method) rather than @show@, because
relude re-exports a polymorphic @show@ that is not the class method.
-}
instance Show Secret where
    showsPrec :: Int -> Secret -> ShowS
showsPrec Int
_ Secret
_ = String -> ShowS
showString String
"Secret <REDACTED>"

-- | Wrap raw token text as a 'Secret'.
mkSecret :: Text -> Secret
mkSecret :: Text -> Secret
mkSecret = Text -> Secret
Secret

{- | Recover the raw token text from a 'Secret'. Call this __only__ at the point
of use (setting the auth header); never log or otherwise render the result.
-}
unSecret :: Secret -> Text
unSecret :: Secret -> Text
unSecret (Secret Text
s) = Text
s

-- | Aeson encoding redacts the secret, ensuring it never leaks into JSON logs.
instance ToJSON Secret where
    toJSON :: Secret -> Value
toJSON Secret
_ = Text -> Value
String Text
"<REDACTED>"

-- | Aeson decoding allows parsing the secret from configuration (e.g. environment AST).
instance FromJSON Secret where
    parseJSON :: Value -> Parser Secret
parseJSON = String -> (Text -> Parser Secret) -> Value -> Parser Secret
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Secret" (Secret -> Parser Secret
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Secret -> Parser Secret)
-> (Text -> Secret) -> Text -> Parser Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Secret
mkSecret)

{- | A bearer token for a registry endpoint, with its expiry when known.

The expiry is what a refresh wrapper schedules against (cloud token lifetimes
range from CodeArtifact's ~12h to ADC's ~1h, so refresh is driven off the
token's own 'authExpiresAt' rather than a fixed interval). A static token has no
expiry ('Nothing').
-}
data AuthToken = AuthToken
    { AuthToken -> Secret
authSecret :: Secret
    -- ^ The bearer secret itself (redacted in 'Show').
    , AuthToken -> Maybe UTCTime
authExpiresAt :: Maybe UTCTime
    {- ^ When the token expires, if it does; 'Nothing' for a non-expiring
    (e.g. static) token.
    -}
    }
    deriving stock (AuthToken -> AuthToken -> Bool
(AuthToken -> AuthToken -> Bool)
-> (AuthToken -> AuthToken -> Bool) -> Eq AuthToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthToken -> AuthToken -> Bool
== :: AuthToken -> AuthToken -> Bool
$c/= :: AuthToken -> AuthToken -> Bool
/= :: AuthToken -> AuthToken -> Bool
Eq, Int -> AuthToken -> ShowS
[AuthToken] -> ShowS
AuthToken -> String
(Int -> AuthToken -> ShowS)
-> (AuthToken -> String)
-> ([AuthToken] -> ShowS)
-> Show AuthToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthToken -> ShowS
showsPrec :: Int -> AuthToken -> ShowS
$cshow :: AuthToken -> String
show :: AuthToken -> String
$cshowList :: [AuthToken] -> ShowS
showList :: [AuthToken] -> ShowS
Show)

{- | The credential handle: yields the bearer token currently valid for the mirror
target, refreshing it before expiry __internally__ (a caller never sees a stale
token in the common case, and never blocks on a mint on the request hot path).

It is a __record of functions__ (the Handle pattern): the single field is the
operation, and a backend's smart constructor returns a 'CredentialProvider'
whose closure captures that backend's private state. 'currentToken' returns
__'IO', not @App@__ so adapters stay decoupled from the core (see the module
header).
-}
newtype CredentialProvider = CredentialProvider
    { CredentialProvider -> IO AuthToken
currentToken :: IO AuthToken
    {- ^ The bearer token to use now. An adapter refreshes before expiry behind
    this field, so the caller just uses the returned token.
    -}
    }

{- | An in-memory 'CredentialProvider' that always returns a fixed token.

This is the @static@ leaf: it never expires and never refreshes, so it is the
right provider for a registry reached with a long-lived credential, and it is
the trivial double for tests of code that consumes a 'CredentialProvider'.
-}
staticProvider :: AuthToken -> CredentialProvider
staticProvider :: AuthToken -> CredentialProvider
staticProvider AuthToken
token = CredentialProvider{currentToken :: IO AuthToken
currentToken = AuthToken -> IO AuthToken
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthToken
token}