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

{- | The mint closure and its @amazonka@ environment behind
"Ecluse.Runtime.Credential.CodeArtifact", which documents the leaf and re-exports the curated
surface. Importing this module opts out of that stability promise, the convention @text@ and
@bytestring@ use, so production code imports the public one.
-}
module Ecluse.Runtime.Credential.CodeArtifact.Internal (
    -- * Configuration
    CodeArtifactConfig (..),

    -- * The provider
    newCodeArtifactProvider,
    providerForEnv,
) where

import Amazonka qualified as AWS
import Amazonka.CodeArtifact.GetAuthorizationToken qualified as CA
import Amazonka.CodeArtifact.Types qualified as CAT
import Control.Monad.Trans.Resource (runResourceT)
import Data.Time (getCurrentTime)
import Lens.Micro (Lens', (?~), (^.))
import UnliftIO.Exception (throwIO)

import Ecluse.Core.Credential (AuthToken (..), CredentialProvider, mkSecret)
import Ecluse.Core.Credential.Refresh (
    CredentialReporters (..),
    RefreshConfig (..),
    defaultRefreshConfig,
    refreshingProvider,
 )
import Ecluse.Runtime.Aws.Env (newAwsEnv)

{- The mint's one failure: @GetAuthorizationToken@ succeeded but carried no token. The refresh
breaker catches 'SomeException' to count failures, so this unexported leaf throws
(docs/style.md section 11.4).
-}
data CodeArtifactMintError = AuthorizationTokenMissing
    deriving stock (CodeArtifactMintError -> CodeArtifactMintError -> Bool
(CodeArtifactMintError -> CodeArtifactMintError -> Bool)
-> (CodeArtifactMintError -> CodeArtifactMintError -> Bool)
-> Eq CodeArtifactMintError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeArtifactMintError -> CodeArtifactMintError -> Bool
== :: CodeArtifactMintError -> CodeArtifactMintError -> Bool
$c/= :: CodeArtifactMintError -> CodeArtifactMintError -> Bool
/= :: CodeArtifactMintError -> CodeArtifactMintError -> Bool
Eq, Int -> CodeArtifactMintError -> ShowS
[CodeArtifactMintError] -> ShowS
CodeArtifactMintError -> String
(Int -> CodeArtifactMintError -> ShowS)
-> (CodeArtifactMintError -> String)
-> ([CodeArtifactMintError] -> ShowS)
-> Show CodeArtifactMintError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeArtifactMintError -> ShowS
showsPrec :: Int -> CodeArtifactMintError -> ShowS
$cshow :: CodeArtifactMintError -> String
show :: CodeArtifactMintError -> String
$cshowList :: [CodeArtifactMintError] -> ShowS
showList :: [CodeArtifactMintError] -> ShowS
Show)

instance Exception CodeArtifactMintError

{- | What the CodeArtifact leaf needs to mint a token. The AWS /credentials/ are __not__ here:
'AWS.discover' finds them in the ambient environment, so the proxy never holds long-lived AWS keys.
-}
data CodeArtifactConfig = CodeArtifactConfig
    { CodeArtifactConfig -> Text
caRegion :: Text
    -- ^ The AWS region the CodeArtifact domain lives in (e.g. @"us-east-1"@).
    , CodeArtifactConfig -> Text
caDomain :: Text
    -- ^ The CodeArtifact domain that scopes the token.
    , CodeArtifactConfig -> Maybe Text
caDomainOwner :: Maybe Text
    {- ^ The 12-digit account number that owns the domain, when it differs from
    the calling account ('Nothing' to default to the caller's account).
    -}
    , CodeArtifactConfig -> Maybe Natural
caDurationSeconds :: Maybe Natural
    {- ^ Requested token lifetime in seconds (@900@-@43200@). 'Nothing' defaults it to the
    caller's role-credential expiry, and the refresh policy adapts to the minted expiry anyway.
    -}
    }
    deriving stock (CodeArtifactConfig -> CodeArtifactConfig -> Bool
(CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> (CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> Eq CodeArtifactConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
== :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
$c/= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
/= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
Eq, Eq CodeArtifactConfig
Eq CodeArtifactConfig =>
(CodeArtifactConfig -> CodeArtifactConfig -> Ordering)
-> (CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> (CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> (CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> (CodeArtifactConfig -> CodeArtifactConfig -> Bool)
-> (CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig)
-> (CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig)
-> Ord CodeArtifactConfig
CodeArtifactConfig -> CodeArtifactConfig -> Bool
CodeArtifactConfig -> CodeArtifactConfig -> Ordering
CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig
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 :: CodeArtifactConfig -> CodeArtifactConfig -> Ordering
compare :: CodeArtifactConfig -> CodeArtifactConfig -> Ordering
$c< :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
< :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
$c<= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
<= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
$c> :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
> :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
$c>= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
>= :: CodeArtifactConfig -> CodeArtifactConfig -> Bool
$cmax :: CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig
max :: CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig
$cmin :: CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig
min :: CodeArtifactConfig -> CodeArtifactConfig -> CodeArtifactConfig
Ord, Int -> CodeArtifactConfig -> ShowS
[CodeArtifactConfig] -> ShowS
CodeArtifactConfig -> String
(Int -> CodeArtifactConfig -> ShowS)
-> (CodeArtifactConfig -> String)
-> ([CodeArtifactConfig] -> ShowS)
-> Show CodeArtifactConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeArtifactConfig -> ShowS
showsPrec :: Int -> CodeArtifactConfig -> ShowS
$cshow :: CodeArtifactConfig -> String
show :: CodeArtifactConfig -> String
$cshowList :: [CodeArtifactConfig] -> ShowS
showList :: [CodeArtifactConfig] -> ShowS
Show)

{- | Build a refreshing 'CredentialProvider' backed by CodeArtifact @GetAuthorizationToken@. It
mints once eagerly, so a misconfiguration fails at construction, not on the first mirror write.
-}
newCodeArtifactProvider :: CredentialReporters -> CodeArtifactConfig -> IO CredentialProvider
newCodeArtifactProvider :: CredentialReporters -> CodeArtifactConfig -> IO CredentialProvider
newCodeArtifactProvider CredentialReporters
reporters CodeArtifactConfig
cfg =
    -- No region here: 'providerForEnv' scopes the env it is handed, so a test can supply
    -- its own env and get the same scoping.
    Maybe Text -> Maybe AwsEndpoint -> Service -> IO Env
newAwsEnv Maybe Text
forall a. Maybe a
Nothing Maybe AwsEndpoint
forall a. Maybe a
Nothing Service
CAT.defaultService IO Env -> (Env -> IO CredentialProvider) -> IO CredentialProvider
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env
env -> CredentialReporters
-> Env -> CodeArtifactConfig -> IO CredentialProvider
providerForEnv CredentialReporters
reporters Env
env CodeArtifactConfig
cfg

{- | Build the provider over a caller-supplied @amazonka@ 'Env', minting through the policy of
"Ecluse.Core.Credential.Refresh". Exposed so a test can drive the mint against a stub endpoint.
-}
providerForEnv :: CredentialReporters -> AWS.Env -> CodeArtifactConfig -> IO CredentialProvider
providerForEnv :: CredentialReporters
-> Env -> CodeArtifactConfig -> IO CredentialProvider
providerForEnv CredentialReporters
reporters Env
env CodeArtifactConfig
cfg =
    RefreshConfig -> IO CredentialProvider
refreshingProvider
        RefreshConfig
defaultRefreshConfig
            { rcMint = mintToken (regioned env) (tokenRequest cfg)
            , rcClock = getCurrentTime
            , rcReporters = reporters
            }
  where
    regioned :: AWS.Env -> AWS.Env
    regioned :: Env -> Env
regioned Env
e = Env
e{AWS.region = AWS.Region' (caRegion cfg)}

tokenRequest :: CodeArtifactConfig -> CA.GetAuthorizationToken
tokenRequest :: CodeArtifactConfig -> GetAuthorizationToken
tokenRequest CodeArtifactConfig
cfg =
    Lens' GetAuthorizationToken (Maybe Text)
-> Maybe Text -> GetAuthorizationToken -> GetAuthorizationToken
forall s a. Lens' s (Maybe a) -> Maybe a -> s -> s
setOptional (Maybe Text -> f (Maybe Text))
-> GetAuthorizationToken -> f GetAuthorizationToken
Lens' GetAuthorizationToken (Maybe Text)
CA.getAuthorizationToken_domainOwner (CodeArtifactConfig -> Maybe Text
caDomainOwner CodeArtifactConfig
cfg)
        (GetAuthorizationToken -> GetAuthorizationToken)
-> (GetAuthorizationToken -> GetAuthorizationToken)
-> GetAuthorizationToken
-> GetAuthorizationToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GetAuthorizationToken (Maybe Natural)
-> Maybe Natural -> GetAuthorizationToken -> GetAuthorizationToken
forall s a. Lens' s (Maybe a) -> Maybe a -> s -> s
setOptional (Maybe Natural -> f (Maybe Natural))
-> GetAuthorizationToken -> f GetAuthorizationToken
Lens' GetAuthorizationToken (Maybe Natural)
CA.getAuthorizationToken_durationSeconds (CodeArtifactConfig -> Maybe Natural
caDurationSeconds CodeArtifactConfig
cfg)
        (GetAuthorizationToken -> GetAuthorizationToken)
-> GetAuthorizationToken -> GetAuthorizationToken
forall a b. (a -> b) -> a -> b
$ Text -> GetAuthorizationToken
CA.newGetAuthorizationToken (CodeArtifactConfig -> Text
caDomain CodeArtifactConfig
cfg)

mintToken :: AWS.Env -> CA.GetAuthorizationToken -> IO AuthToken
mintToken :: Env -> GetAuthorizationToken -> IO AuthToken
mintToken Env
env GetAuthorizationToken
request = do
    response <- ResourceT IO GetAuthorizationTokenResponse
-> IO GetAuthorizationTokenResponse
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (Env
-> GetAuthorizationToken
-> ResourceT IO (AWSResponse GetAuthorizationToken)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
env GetAuthorizationToken
request)
    secret <- case response ^. CA.getAuthorizationTokenResponse_authorizationToken of
        Just Text
token -> Secret -> IO Secret
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Secret
mkSecret Text
token)
        Maybe Text
Nothing -> CodeArtifactMintError -> IO Secret
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO CodeArtifactMintError
AuthorizationTokenMissing
    pure
        AuthToken
            { authSecret = secret
            , authExpiresAt = response ^. CA.getAuthorizationTokenResponse_expiration
            }

-- | Set a request field only when the caller supplied a value.
setOptional :: Lens' s (Maybe a) -> Maybe a -> s -> s
setOptional :: forall s a. Lens' s (Maybe a) -> Maybe a -> s -> s
setOptional Lens' s (Maybe a)
l = (s -> s) -> (a -> s -> s) -> Maybe a -> s -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s -> s
forall a. a -> a
id ((Maybe a -> Identity (Maybe a)) -> s -> Identity s
Lens' s (Maybe a)
l ((Maybe a -> Identity (Maybe a)) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~)