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

{- | Target-bound credential providers built at the composition root.
CodeArtifact consumers with the same mint identity share one refresh provider and breaker.
-}
module Ecluse.Composition.Credential (
    -- * Global credential providers
    CredentialProviders,
    noCredentialProviders,
    BuildCredentials,
    initCredentialProviders,
    initTargetCredentialProviders,
    CredentialTarget (..),
    lookupTargetProvider,
    initializedEcosystems,
    lookupProvider,

    -- * The telemetry label a store carries
    providerLabel,

    -- * Internals exported for testing
    mirrorBackends,
    codeArtifactIdentityGroups,
    codeArtifactMintFailure,
) where

import Data.Foldable1 qualified as Foldable1
import Data.Map.Strict qualified as Map

import Ecluse.Composition.BootError (BootError (..), refuseOnThrow)
import Ecluse.Config (
    MintPlan (..),
    MirrorTarget (..),
    Mount (..),
    StoreBackend,
    StoreTag (..),
    regMirrorTarget,
    sbMint,
    sbTag,
 )
import Ecluse.Config.Resolve (mountKeyRef)
import Ecluse.Core.Credential (AuthToken (..), CredentialProvider, Secret, staticProvider)
import Ecluse.Core.Credential.Refresh (CredentialReporters)
import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Telemetry.Metrics (Provider (ProviderCodeArtifact, ProviderRegistry, ProviderVerdaccio))
import Ecluse.Runtime.Credential.CodeArtifact (CodeArtifactConfig, newCodeArtifactProvider)

-- | A credential consumer within one mount. Private-cache reads never use the mirror slot.
data CredentialTarget = MirrorCredential | PrivateCacheCredential
    deriving stock (CredentialTarget -> CredentialTarget -> Bool
(CredentialTarget -> CredentialTarget -> Bool)
-> (CredentialTarget -> CredentialTarget -> Bool)
-> Eq CredentialTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CredentialTarget -> CredentialTarget -> Bool
== :: CredentialTarget -> CredentialTarget -> Bool
$c/= :: CredentialTarget -> CredentialTarget -> Bool
/= :: CredentialTarget -> CredentialTarget -> Bool
Eq, Eq CredentialTarget
Eq CredentialTarget =>
(CredentialTarget -> CredentialTarget -> Ordering)
-> (CredentialTarget -> CredentialTarget -> Bool)
-> (CredentialTarget -> CredentialTarget -> Bool)
-> (CredentialTarget -> CredentialTarget -> Bool)
-> (CredentialTarget -> CredentialTarget -> Bool)
-> (CredentialTarget -> CredentialTarget -> CredentialTarget)
-> (CredentialTarget -> CredentialTarget -> CredentialTarget)
-> Ord CredentialTarget
CredentialTarget -> CredentialTarget -> Bool
CredentialTarget -> CredentialTarget -> Ordering
CredentialTarget -> CredentialTarget -> CredentialTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CredentialTarget -> CredentialTarget -> Ordering
compare :: CredentialTarget -> CredentialTarget -> Ordering
$c< :: CredentialTarget -> CredentialTarget -> Bool
< :: CredentialTarget -> CredentialTarget -> Bool
$c<= :: CredentialTarget -> CredentialTarget -> Bool
<= :: CredentialTarget -> CredentialTarget -> Bool
$c> :: CredentialTarget -> CredentialTarget -> Bool
> :: CredentialTarget -> CredentialTarget -> Bool
$c>= :: CredentialTarget -> CredentialTarget -> Bool
>= :: CredentialTarget -> CredentialTarget -> Bool
$cmax :: CredentialTarget -> CredentialTarget -> CredentialTarget
max :: CredentialTarget -> CredentialTarget -> CredentialTarget
$cmin :: CredentialTarget -> CredentialTarget -> CredentialTarget
min :: CredentialTarget -> CredentialTarget -> CredentialTarget
Ord, Int -> CredentialTarget -> ShowS
[CredentialTarget] -> ShowS
CredentialTarget -> String
(Int -> CredentialTarget -> ShowS)
-> (CredentialTarget -> String)
-> ([CredentialTarget] -> ShowS)
-> Show CredentialTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CredentialTarget -> ShowS
showsPrec :: Int -> CredentialTarget -> ShowS
$cshow :: CredentialTarget -> String
show :: CredentialTarget -> String
$cshowList :: [CredentialTarget] -> ShowS
showList :: [CredentialTarget] -> ShowS
Show)

-- | Providers keyed by the mount and the target that declared their authentication identity.
newtype CredentialProviders = CredentialProviders (Map (Ecosystem, CredentialTarget) CredentialProvider)

{- | No initialised providers: what a boot half that refused before it built any carries onward,
so the halves after it still plan and still report what they refuse.
-}
noCredentialProviders :: CredentialProviders
noCredentialProviders :: CredentialProviders
noCredentialProviders = Map (Ecosystem, CredentialTarget) CredentialProvider
-> CredentialProviders
CredentialProviders Map (Ecosystem, CredentialTarget) CredentialProvider
forall k a. Map k a
Map.empty

{- | The @provider@ metric label a store's credential signals record under. It reads as the
configuration spells the tag, so a dashboard series and a mount's declaration are one word.
-}
providerLabel :: StoreTag -> Provider
providerLabel :: StoreTag -> Provider
providerLabel = \case
    StoreTag
TagRegistry -> Provider
ProviderRegistry
    StoreTag
TagCodeArtifact -> Provider
ProviderCodeArtifact
    StoreTag
TagVerdaccio -> Provider
ProviderVerdaccio

-- | Build only credentials for the targets cleared by this boot role.
type BuildCredentials = (Ecosystem -> StoreTag -> CredentialReporters) -> [((Ecosystem, CredentialTarget), StoreBackend)] -> IO (Either [BootError] CredentialProviders)

{- | Build each mirroring mount's write-credential provider through the injected builder. The mint
is eager, so a bad identity fails here as 'CodeArtifactMintFailed'.
-}
initCredentialProviders :: BuildCredentials -> (Ecosystem -> StoreTag -> CredentialReporters) -> [Mount] -> IO (Either [BootError] CredentialProviders)
initCredentialProviders :: BuildCredentials
-> (Ecosystem -> StoreTag -> CredentialReporters)
-> [Mount]
-> IO (Either [BootError] CredentialProviders)
initCredentialProviders BuildCredentials
build Ecosystem -> StoreTag -> CredentialReporters
reportersFor [Mount]
mounts =
    BuildCredentials
build Ecosystem -> StoreTag -> CredentialReporters
reportersFor [((Ecosystem
eco, CredentialTarget
MirrorCredential), StoreBackend
backend) | (Ecosystem
eco, StoreBackend
backend) <- [Mount] -> [(Ecosystem, StoreBackend)]
mirrorBackends [Mount]
mounts]

-- | Build target-bound providers, sharing only matching CodeArtifact mint identities.
initTargetCredentialProviders ::
    (Ecosystem -> StoreTag -> CredentialReporters) ->
    [((Ecosystem, CredentialTarget), StoreBackend)] ->
    IO (Either [BootError] CredentialProviders)
initTargetCredentialProviders :: BuildCredentials
initTargetCredentialProviders Ecosystem -> StoreTag -> CredentialReporters
reportersFor [((Ecosystem, CredentialTarget), StoreBackend)]
backends = do
    let creds :: [((Ecosystem, CredentialTarget), StoreTag, MintPlan)]
creds = [((Ecosystem, CredentialTarget)
key, StoreBackend -> StoreTag
sbTag StoreBackend
backend, StoreBackend -> MintPlan
sbMint StoreBackend
backend) | ((Ecosystem, CredentialTarget)
key, StoreBackend
backend) <- [((Ecosystem, CredentialTarget), StoreBackend)]
backends]
    -- The static leaf is stateless, so it stays per mount, unlike a CodeArtifact provider.
    let statics :: [((Ecosystem, CredentialTarget), CredentialProvider)]
statics = [((Ecosystem, CredentialTarget)
eco, Secret -> CredentialProvider
staticProviderFor Secret
token) | ((Ecosystem, CredentialTarget)
eco, StoreTag
_, MintStatic Secret
token) <- [((Ecosystem, CredentialTarget), StoreTag, MintPlan)]
creds]
    let caPlans :: [((Ecosystem, CredentialTarget), StoreTag, CodeArtifactConfig)]
caPlans = [((Ecosystem, CredentialTarget)
eco, StoreTag
tag, CodeArtifactConfig
ca) | ((Ecosystem, CredentialTarget)
eco, StoreTag
tag, MintCodeArtifact CodeArtifactConfig
ca) <- [((Ecosystem, CredentialTarget), StoreTag, MintPlan)]
creds]
    results <- ((CodeArtifactConfig,
  (StoreTag, NonEmpty (Ecosystem, CredentialTarget)))
 -> IO
      (Either
         [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)]))
-> [(CodeArtifactConfig,
     (StoreTag, NonEmpty (Ecosystem, CredentialTarget)))]
-> IO
     [Either
        [BootError] [((Ecosystem, CredentialTarget), 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 (((Ecosystem, CredentialTarget) -> StoreTag -> CredentialReporters)
-> (CodeArtifactConfig,
    (StoreTag, NonEmpty (Ecosystem, CredentialTarget)))
-> IO
     (Either
        [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)])
initSharedCodeArtifact (Ecosystem -> StoreTag -> CredentialReporters
reportersFor (Ecosystem -> StoreTag -> CredentialReporters)
-> ((Ecosystem, CredentialTarget) -> Ecosystem)
-> (Ecosystem, CredentialTarget)
-> StoreTag
-> CredentialReporters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ecosystem, CredentialTarget) -> Ecosystem
forall a b. (a, b) -> a
fst)) ([((Ecosystem, CredentialTarget), StoreTag, CodeArtifactConfig)]
-> [(CodeArtifactConfig,
     (StoreTag, NonEmpty (Ecosystem, CredentialTarget)))]
forall key.
[(key, StoreTag, CodeArtifactConfig)]
-> [(CodeArtifactConfig, (StoreTag, NonEmpty key))]
codeArtifactIdentityGroups [((Ecosystem, CredentialTarget), StoreTag, 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))))

{- | Each mirroring mount's ecosystem and the store its mirror write authenticates to. A mount
declaring no mirror target contributes no mirror provider.
-}
mirrorBackends :: [Mount] -> [(Ecosystem, StoreBackend)]
mirrorBackends :: [Mount] -> [(Ecosystem, StoreBackend)]
mirrorBackends [Mount]
mounts =
    [ (Mount -> Ecosystem
mountEcosystem Mount
mount, MirrorTarget -> StoreBackend
mtBackend MirrorTarget
target)
    | Mount
mount <- [Mount]
mounts
    , Just MirrorTarget
target <- [MountRegistries -> Maybe MirrorTarget
regMirrorTarget (Mount -> MountRegistries
mountRegistries Mount
mount)]
    ]

-- Disjoint groups use their smallest ecosystem as a bounded identity for expiry replacement.
-- Each group shares one provider, refresh schedule and breaker.
initSharedCodeArtifact ::
    ((Ecosystem, CredentialTarget) -> StoreTag -> CredentialReporters) ->
    (CodeArtifactConfig, (StoreTag, NonEmpty (Ecosystem, CredentialTarget))) ->
    IO (Either [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)])
initSharedCodeArtifact :: ((Ecosystem, CredentialTarget) -> StoreTag -> CredentialReporters)
-> (CodeArtifactConfig,
    (StoreTag, NonEmpty (Ecosystem, CredentialTarget)))
-> IO
     (Either
        [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)])
initSharedCodeArtifact (Ecosystem, CredentialTarget) -> StoreTag -> CredentialReporters
reportersFor (CodeArtifactConfig
caConfig, (StoreTag
tag, NonEmpty (Ecosystem, CredentialTarget)
ecosystems)) =
    (CredentialProvider
 -> [((Ecosystem, CredentialTarget), CredentialProvider)])
-> Either [BootError] CredentialProvider
-> Either
     [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)]
forall a b.
(a -> b) -> Either [BootError] a -> Either [BootError] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CredentialProvider
-> [((Ecosystem, CredentialTarget), CredentialProvider)]
forall {b}. b -> [((Ecosystem, CredentialTarget), b)]
fannedOut (Either [BootError] CredentialProvider
 -> Either
      [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)])
-> IO (Either [BootError] CredentialProvider)
-> IO
     (Either
        [BootError] [((Ecosystem, CredentialTarget), CredentialProvider)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> BootError)
-> IO CredentialProvider
-> IO (Either [BootError] CredentialProvider)
forall a. (Text -> BootError) -> IO a -> IO (Either [BootError] a)
refuseOnThrow (NonEmpty (Ecosystem, CredentialTarget) -> Text -> BootError
codeArtifactMintFailure NonEmpty (Ecosystem, CredentialTarget)
ecosystems) (CredentialReporters -> CodeArtifactConfig -> IO CredentialProvider
newCodeArtifactProvider ((Ecosystem, CredentialTarget) -> StoreTag -> CredentialReporters
reportersFor (NonEmpty (Ecosystem, CredentialTarget)
-> (Ecosystem, CredentialTarget)
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
Foldable1.minimum NonEmpty (Ecosystem, CredentialTarget)
ecosystems) StoreTag
tag) CodeArtifactConfig
caConfig)
  where
    fannedOut :: b -> [((Ecosystem, CredentialTarget), b)]
fannedOut b
provider = [((Ecosystem, CredentialTarget)
eco, b
provider) | (Ecosystem, CredentialTarget)
eco <- NonEmpty (Ecosystem, CredentialTarget)
-> [(Ecosystem, CredentialTarget)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Ecosystem, CredentialTarget)
ecosystems]

-- | Attribute a failed shared mint to every configured credential consumer.
codeArtifactMintFailure :: NonEmpty (Ecosystem, CredentialTarget) -> Text -> BootError
codeArtifactMintFailure :: NonEmpty (Ecosystem, CredentialTarget) -> Text -> BootError
codeArtifactMintFailure NonEmpty (Ecosystem, CredentialTarget)
targets = NonEmpty Text -> Text -> BootError
CodeArtifactMintFailed (((Ecosystem, CredentialTarget) -> Text)
-> NonEmpty (Ecosystem, CredentialTarget) -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ecosystem, CredentialTarget) -> Text
targetKey NonEmpty (Ecosystem, CredentialTarget)
targets)
  where
    targetKey :: (Ecosystem, CredentialTarget) -> Text
targetKey (Ecosystem
eco, CredentialTarget
target) = Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ case CredentialTarget
target of
        CredentialTarget
MirrorCredential -> Text
"mirrorTarget"
        CredentialTarget
PrivateCacheCredential -> Text
"privateUpstream"

{- | Group the mounts' resolved CodeArtifact identities by distinct 'CodeArtifactConfig'. One
domain shares a provider, its reporters, and its breaker, and a differing duration keeps its own.
-}
codeArtifactIdentityGroups :: [(key, StoreTag, CodeArtifactConfig)] -> [(CodeArtifactConfig, (StoreTag, NonEmpty key))]
codeArtifactIdentityGroups :: forall key.
[(key, StoreTag, CodeArtifactConfig)]
-> [(CodeArtifactConfig, (StoreTag, NonEmpty key))]
codeArtifactIdentityGroups [(key, StoreTag, CodeArtifactConfig)]
plans =
    Map CodeArtifactConfig (StoreTag, NonEmpty key)
-> [(CodeArtifactConfig, (StoreTag, NonEmpty key))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (((StoreTag, NonEmpty key)
 -> (StoreTag, NonEmpty key) -> (StoreTag, NonEmpty key))
-> [(CodeArtifactConfig, (StoreTag, NonEmpty key))]
-> Map CodeArtifactConfig (StoreTag, NonEmpty key)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (StoreTag, NonEmpty key)
-> (StoreTag, NonEmpty key) -> (StoreTag, NonEmpty key)
forall {b} {a} {a}. Semigroup b => (a, b) -> (a, b) -> (a, b)
merge [(CodeArtifactConfig
ca, (StoreTag
tag, key
eco key -> [key] -> NonEmpty key
forall a. a -> [a] -> NonEmpty a
:| [])) | (key
eco, StoreTag
tag, CodeArtifactConfig
ca) <- [(key, StoreTag, CodeArtifactConfig)]
plans])
  where
    -- One identity resolves under one tag, so every member agrees and either labels the group.
    merge :: (a, b) -> (a, b) -> (a, b)
merge (a
tag, b
ecosystems) (a
_, b
more) = (a
tag, b
ecosystems b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
more)

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, CredentialTarget) CredentialProvider
ps) = [Item (Set Ecosystem)] -> Set Ecosystem
forall l. IsList l => [Item l] -> l
fromList [Item (Set Ecosystem)
Ecosystem
eco | (Ecosystem
eco, CredentialTarget
MirrorCredential) <- Map (Ecosystem, CredentialTarget) CredentialProvider
-> [(Ecosystem, CredentialTarget)]
forall k a. Map k a -> [k]
Map.keys Map (Ecosystem, CredentialTarget) 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 = CredentialTarget
-> Ecosystem -> CredentialProviders -> Maybe CredentialProvider
lookupTargetProvider CredentialTarget
MirrorCredential

-- | Look up only the declared target's credential.
lookupTargetProvider :: CredentialTarget -> Ecosystem -> CredentialProviders -> Maybe CredentialProvider
lookupTargetProvider :: CredentialTarget
-> Ecosystem -> CredentialProviders -> Maybe CredentialProvider
lookupTargetProvider CredentialTarget
target Ecosystem
eco (CredentialProviders Map (Ecosystem, CredentialTarget) CredentialProvider
ps) = (Ecosystem, CredentialTarget)
-> Map (Ecosystem, CredentialTarget) CredentialProvider
-> Maybe CredentialProvider
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Ecosystem
eco, CredentialTarget
target) Map (Ecosystem, CredentialTarget) CredentialProvider
ps