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

{- | The composition root's credential build: turn each active mount's __resolved__
mirror-write credential into a live, process-global 'CredentialProvider'.

== Global providers, per-mount reference

A 'Ecluse.Core.Credential.CredentialProvider' is the service's own cloud identity,
built __once__ here from the resolved config and held process-global; a mount
references one by its ecosystem and never holds its own. Which credential each mount
uses is no longer selected here: it is __derived from the mirror-target URL at config
load__ ('Ecluse.Config.MirrorCredential.resolveMirrorCredential') and carried on the
mount as a 'Ecluse.Config.MirrorCredential', so a CodeArtifact token can only ever be
minted for the domain the worker actually writes to (issue #808). This module just
realises that resolved plan:

* 'MirrorStatic' -- a stateless static provider from the operator-supplied token.
* 'MirrorCodeArtifact' -- the refresh\/cache wrapper around the CodeArtifact mint leaf
  ('newCodeArtifactProvider'), which mints once eagerly, so a misconfigured identity or
  a missing permission fails loudly here at boot as a 'CodeArtifactMintFailed'. AWS
  credentials are the ambient container\/task role (the standard chain), never an Écluse
  key.

Provider granularity follows the credential's real scope, not the mount count: a
CodeArtifact token is minted per domain, so mounts whose resolved CodeArtifact
identities coincide ('codeArtifactIdentityGroups') share one provider -- one eager boot
mint, one refresh schedule, one breaker -- while each still looks its provider up by its
own ecosystem.

The 'CredentialReporters' are handed to the refreshing CodeArtifact provider so its mint
breaker and refresh outcomes record to telemetry; the static provider never refreshes,
so they do not concern it. The composition root supplies the deferred reporters that go
live once the telemetry substrate exists. Failures aggregate as
'Ecluse.Composition.BootError.BootError's, so one run reports every domain that failed
to mint.
-}
module Ecluse.Composition.Credential (
    -- * Global credential providers
    CredentialProviders,
    initCredentialProviders,
    initializedEcosystems,
    lookupProvider,

    -- * Internals exported for testing
    codeArtifactIdentityGroups,
) where

import Data.Map.Strict qualified as Map
import UnliftIO (tryAny)

import Ecluse.Composition.BootError (BootError (..))
import Ecluse.Config (
    Config (..),
    MirrorCredential (..),
    MirrorTarget (..),
    Mount (..),
    regMirrorTarget,
 )
import Ecluse.Core.Credential (AuthToken (..), CredentialProvider, Secret, staticProvider)
import Ecluse.Core.Credential.Refresh (CredentialReporters)
import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Text (displayExceptionT)
import Ecluse.Runtime.Credential.CodeArtifact (CodeArtifactConfig, newCodeArtifactProvider)

{- | The process-global credential providers, keyed by the ecosystem they
serve. Built __once__ at the composition root from the resolved config; a
mount references one by ecosystem and never holds its own.

The keyset (see 'initializedEcosystems') is the boot-check's pure surface -- a mount
that names an ecosystem absent from it has an unresolved credential reference.
-}
newtype CredentialProviders = CredentialProviders (Map Ecosystem CredentialProvider)

{- | Build the global credential providers from the resolved config, or the aggregated
boot errors that block them. Each __mirrored__ mount already carries its resolved
'MirrorCredential' (derived from its mirror-target URL at load), so this only realises
it: a 'MirrorStatic' becomes a stateless static provider; the 'MirrorCodeArtifact'
identities are grouped by domain and each built once, minting eagerly so a bad
identity, region, or permission is a fail-loud 'CodeArtifactMintFailed' here at boot
rather than a first-publish surprise. A serve-only mount holds no write credential and
contributes nothing; with zero mirrored mounts the provider map is empty and nothing
mints.
-}
initCredentialProviders :: CredentialReporters -> Config -> IO (Either [BootError] CredentialProviders)
initCredentialProviders :: CredentialReporters
-> Config -> IO (Either [BootError] CredentialProviders)
initCredentialProviders CredentialReporters
reporters Config
config = do
    let creds :: [(Ecosystem, MirrorCredential)]
creds =
            [ (Ecosystem
eco, MirrorTarget -> MirrorCredential
mtCredential MirrorTarget
target)
            | (Ecosystem
eco, Mount
mount) <- Map Ecosystem Mount -> [(Ecosystem, Mount)]
forall k a. Map k a -> [(k, a)]
Map.toList (Config -> Map Ecosystem Mount
configMounts Config
config)
            , Just MirrorTarget
target <- [MountRegistries -> Maybe MirrorTarget
regMirrorTarget (Mount -> MountRegistries
mountRegistries Mount
mount)]
            ]
    -- The static leaf is stateless, so it stays per mount; the CodeArtifact providers
    -- are built once per distinct resolved identity and fanned out to every ecosystem
    -- that resolved it.
    let statics :: [(Ecosystem, CredentialProvider)]
statics = [(Ecosystem
eco, Secret -> CredentialProvider
staticProviderFor Secret
token) | (Ecosystem
eco, MirrorStatic Secret
token) <- [(Ecosystem, MirrorCredential)]
creds]
    let caPlans :: [(Ecosystem, CodeArtifactConfig)]
caPlans = [(Ecosystem
eco, CodeArtifactConfig
ca) | (Ecosystem
eco, MirrorCodeArtifact CodeArtifactConfig
ca) <- [(Ecosystem, MirrorCredential)]
creds]
    results <- ((CodeArtifactConfig, NonEmpty Ecosystem)
 -> IO (Either [BootError] [(Ecosystem, CredentialProvider)]))
-> [(CodeArtifactConfig, NonEmpty Ecosystem)]
-> IO [Either [BootError] [(Ecosystem, CredentialProvider)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (CredentialReporters
-> (CodeArtifactConfig, NonEmpty Ecosystem)
-> IO (Either [BootError] [(Ecosystem, CredentialProvider)])
initSharedCodeArtifact CredentialReporters
reporters) ([(Ecosystem, CodeArtifactConfig)]
-> [(CodeArtifactConfig, NonEmpty Ecosystem)]
codeArtifactIdentityGroups [(Ecosystem, CodeArtifactConfig)]
caPlans)
    let (initErrs, shared) = partitionEithers results
    if not (null initErrs)
        then pure (Left (concat initErrs))
        else pure (Right (CredentialProviders (Map.fromList (statics <> concat shared))))

-- One shared CodeArtifact provider per distinct resolved identity: the generic
-- refresh/cache wrapper around the mint leaf is built once (minting once eagerly, a
-- throw rendered as a 'CodeArtifactMintFailed' boot error so it joins the aggregated
-- failure block) and fanned out to every ecosystem in the group, so a shared domain
-- carries one refresh schedule and one breaker rather than one per mount.
initSharedCodeArtifact :: CredentialReporters -> (CodeArtifactConfig, NonEmpty Ecosystem) -> IO (Either [BootError] [(Ecosystem, CredentialProvider)])
initSharedCodeArtifact :: CredentialReporters
-> (CodeArtifactConfig, NonEmpty Ecosystem)
-> IO (Either [BootError] [(Ecosystem, CredentialProvider)])
initSharedCodeArtifact CredentialReporters
reporters (CodeArtifactConfig
caConfig, NonEmpty Ecosystem
ecosystems) =
    IO CredentialProvider
-> IO (Either SomeException CredentialProvider)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (CredentialReporters -> CodeArtifactConfig -> IO CredentialProvider
newCodeArtifactProvider CredentialReporters
reporters CodeArtifactConfig
caConfig) IO (Either SomeException CredentialProvider)
-> (Either SomeException CredentialProvider
    -> Either [BootError] [(Ecosystem, CredentialProvider)])
-> IO (Either [BootError] [(Ecosystem, CredentialProvider)])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Left SomeException
err -> [BootError] -> Either [BootError] [(Ecosystem, CredentialProvider)]
forall a b. a -> Either a b
Left [Text -> BootError
CodeArtifactMintFailed (SomeException -> Text
forall e. Exception e => e -> Text
displayExceptionT SomeException
err)]
        Right CredentialProvider
provider -> [(Ecosystem, CredentialProvider)]
-> Either [BootError] [(Ecosystem, CredentialProvider)]
forall a b. b -> Either a b
Right [(Ecosystem
eco, CredentialProvider
provider) | Ecosystem
eco <- NonEmpty Ecosystem -> [Ecosystem]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Ecosystem
ecosystems]

{- | Group the mounts' resolved CodeArtifact identities: one group per distinct
'CodeArtifactConfig' (domain, owner, region, and the requested token duration),
carrying every ecosystem that resolved it. The mint's real scope is the domain,
not the repository endpoint, so ecosystems whose mirror targets live in one
domain legitimately share one provider; a differing duration is a different
requested credential and keeps its own. Pure, so the sharing decision is pinned
without touching AWS.
-}
codeArtifactIdentityGroups :: [(Ecosystem, CodeArtifactConfig)] -> [(CodeArtifactConfig, NonEmpty Ecosystem)]
codeArtifactIdentityGroups :: [(Ecosystem, CodeArtifactConfig)]
-> [(CodeArtifactConfig, NonEmpty Ecosystem)]
codeArtifactIdentityGroups [(Ecosystem, CodeArtifactConfig)]
plans =
    Map CodeArtifactConfig (NonEmpty Ecosystem)
-> [(CodeArtifactConfig, NonEmpty Ecosystem)]
forall k a. Map k a -> [(k, a)]
Map.toAscList ((NonEmpty Ecosystem -> NonEmpty Ecosystem -> NonEmpty Ecosystem)
-> [(CodeArtifactConfig, NonEmpty Ecosystem)]
-> Map CodeArtifactConfig (NonEmpty Ecosystem)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty Ecosystem -> NonEmpty Ecosystem -> NonEmpty Ecosystem
forall a. Semigroup a => a -> a -> a
(<>) [(CodeArtifactConfig
ca, Ecosystem
eco Ecosystem -> [Ecosystem] -> NonEmpty Ecosystem
forall a. a -> [a] -> NonEmpty a
:| []) | (Ecosystem
eco, CodeArtifactConfig
ca) <- [(Ecosystem, CodeArtifactConfig)]
plans])

-- A static mirror-target write provider from an operator-supplied token.
staticProviderFor :: Secret -> CredentialProvider
staticProviderFor :: Secret -> CredentialProvider
staticProviderFor Secret
token = AuthToken -> CredentialProvider
staticProvider AuthToken{authSecret :: Secret
authSecret = Secret
token, authExpiresAt :: Maybe UTCTime
authExpiresAt = Maybe UTCTime
forall a. Maybe a
Nothing}

{- | The set of ecosystems that resolved to an initialised provider -- the
pure surface the boot-time credential-reference check reasons over.
-}
initializedEcosystems :: CredentialProviders -> Set Ecosystem
initializedEcosystems :: CredentialProviders -> Set Ecosystem
initializedEcosystems (CredentialProviders Map Ecosystem CredentialProvider
ps) = Map Ecosystem CredentialProvider -> Set Ecosystem
forall k a. Map k a -> Set k
Map.keysSet Map Ecosystem CredentialProvider
ps

{- | Look up the initialised provider for an ecosystem, 'Nothing' when none is
initialised (the unresolved-reference case the boot check rejects).
-}
lookupProvider :: Ecosystem -> CredentialProviders -> Maybe CredentialProvider
lookupProvider :: Ecosystem -> CredentialProviders -> Maybe CredentialProvider
lookupProvider Ecosystem
eco (CredentialProviders Map Ecosystem CredentialProvider
ps) = Ecosystem
-> Map Ecosystem CredentialProvider -> Maybe CredentialProvider
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ecosystem
eco Map Ecosystem CredentialProvider
ps