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

{- | Derive a mount's mirror-write credential from its mirror-target URL.

The mirror-target URL is the single source of truth for how the mirror write is
authenticated. A CodeArtifact endpoint
(@{domain}-{owner}.d.codeartifact.{region}.amazonaws.com@) encodes its whole mint
identity in its host, so a CodeArtifact target dictates a minted token scoped to
exactly the domain the worker writes to. Any other host is written with an
operator-supplied static bearer.

Because the credential is derived from the very URL it will be sent to, a token can
never be paired with an endpoint it was not minted for: the divergence class is
unrepresentable rather than merely guarded (issue #808). Two arrangements are refused
at load so neither degrades silently: a non-CodeArtifact target with no static token,
and a CodeArtifact target that also carries a static token.
-}
module Ecluse.Config.MirrorCredential (
    resolveMirrorCredential,
    parseCodeArtifactHost,
    isAccountId,
) where

import Data.Char (isDigit)
import Data.Text qualified as T

import Ecluse.Config.Types (ConfigError (..), MirrorCredential (..))
import Ecluse.Core.Credential (Secret)
import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Security (hostAddress)
import Ecluse.Core.Security.Egress (RegistryUrl, registryUrlText)
import Ecluse.Core.Text (nonBlank)
import Ecluse.Runtime.Credential.CodeArtifact (CodeArtifactConfig (..))

{- | Derive the mirror-write credential from the resolved mirror-target URL, its
optional static token, and the optional token-duration. A CodeArtifact host yields a
'MirrorCodeArtifact' whose identity is parsed straight from the host (so the mint is
scoped to the domain the worker writes to); any other host yields a 'MirrorStatic'
from the supplied token. The two refusals keep a "derived" credential from ever
meaning a silent one.
-}
resolveMirrorCredential ::
    Ecosystem ->
    RegistryUrl ->
    Maybe Secret ->
    Maybe Natural ->
    Either ConfigError MirrorCredential
resolveMirrorCredential :: Ecosystem
-> RegistryUrl
-> Maybe Secret
-> Maybe Natural
-> Either ConfigError MirrorCredential
resolveMirrorCredential Ecosystem
eco RegistryUrl
url Maybe Secret
mToken Maybe Natural
mDuration =
    case Text -> Maybe (Text, Text, Text)
parseCodeArtifactHost (Text -> Text
hostAddress (RegistryUrl -> Text
registryUrlText RegistryUrl
url)) of
        Just (Text
domain, Text
owner, Text
region) -> case Maybe Secret
mToken of
            Just Secret
_ -> ConfigError -> Either ConfigError MirrorCredential
forall a b. a -> Either a b
Left (Ecosystem -> ConfigError
MirrorCredentialConflict Ecosystem
eco)
            Maybe Secret
Nothing ->
                MirrorCredential -> Either ConfigError MirrorCredential
forall a b. b -> Either a b
Right
                    ( CodeArtifactConfig -> MirrorCredential
MirrorCodeArtifact
                        CodeArtifactConfig
                            { caRegion :: Text
caRegion = Text
region
                            , caDomain :: Text
caDomain = Text
domain
                            , caDomainOwner :: Maybe Text
caDomainOwner = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
owner
                            , caDurationSeconds :: Maybe Natural
caDurationSeconds = Maybe Natural
mDuration
                            }
                    )
        Maybe (Text, Text, Text)
Nothing -> case Maybe Secret
mToken of
            Just Secret
token -> MirrorCredential -> Either ConfigError MirrorCredential
forall a b. b -> Either a b
Right (Secret -> MirrorCredential
MirrorStatic Secret
token)
            Maybe Secret
Nothing -> ConfigError -> Either ConfigError MirrorCredential
forall a b. a -> Either a b
Left (Ecosystem -> ConfigError
MirrorCredentialTokenMissing Ecosystem
eco)

{- | Parse a CodeArtifact npm endpoint host into its (domain, owner, region). The host
shape is @{domain}-{owner}.d.codeartifact.{region}.amazonaws.com@; the @{owner}@ is the
12-digit account id after the __last__ hyphen of the first label, so a domain may
itself contain hyphens. 'Nothing' for any host that is not this shape -- including one
whose tail after the last hyphen is not an account id, so a hyphen-bearing
non-CodeArtifact host never mis-parses into a bogus owner (and so is treated as a
static-token target, not a CodeArtifact one).
-}
parseCodeArtifactHost :: Text -> Maybe (Text, Text, Text)
parseCodeArtifactHost :: Text -> Maybe (Text, Text, Text)
parseCodeArtifactHost Text
host =
    -- The accepted shape is exactly one @.d.codeartifact.@ marker, splitting the host
    -- into its @{domain}-{owner}@ label and its @{region}.amazonaws.com@ tail; any
    -- other number of parts (none, or a host carrying the marker twice) is not a
    -- CodeArtifact endpoint and is rejected here rather than via an implicit
    -- pattern-match failure in the 'Maybe' monad.
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
".d.codeartifact." Text
host of
        [Text
domainOwner, Text
regionTail] -> do
            region <- Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripSuffix Text
".amazonaws.com" Text
regionTail
            let (domainDash, owner) = T.breakOnEnd "-" domainOwner
            domain <- nonBlank (T.dropEnd 1 domainDash)
            guard (isAccountId owner)
            pure (domain, owner, region)
        [Text]
_ -> Maybe (Text, Text, Text)
forall a. Maybe a
Nothing

{- | Whether a value is a 12-digit AWS account id (shared with the SQS queue-URL
shape validation in "Ecluse.Config.QueueTarget").
-}
isAccountId :: Text -> Bool
isAccountId :: Text -> Bool
isAccountId Text
t = Text -> Int -> Ordering
T.compareLength Text
t Int
12 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t