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

{- | The ambient cloud-SDK environment: the handful of @AWS_*@ variables Écluse itself consults,
read straight from the process environment at boot rather than from the config document.

Keeping them out of the document makes "secrets never live in the structured config" structural,
because a key like @awsSecretAccessKey@ is then an unknown key and a loud parse failure. Nothing
here touches the AWS SDK's own credential discovery.
-}
module Ecluse.Config.Ambient (
    AmbientAws (..),
    ambientAwsFromEnv,
    parseEndpointUrl,
    ambientS3Endpoint,
) where

import Data.List (lookup)
import Data.Text qualified as T

import Ecluse.Config.Types (HttpScheme (..), splitHttpScheme)
import Ecluse.Core.Credential (Secret, mkSecret)
import Ecluse.Core.Security (HostPort (..), hostPortAddressWithDefault, refuseCredentialMaterial)
import Ecluse.Core.Text (nonBlank)
import Ecluse.Runtime.Aws.Env (AwsEndpoint (..))

{- | The @AWS_*@ values Écluse consults directly: region scoping and endpoint overrides. A
field is 'Nothing' when its variable is unset, and each consumer handles a blank value itself.
-}
data AmbientAws = AmbientAws
    { AmbientAws -> Maybe Text
ambientAwsRegion :: Maybe Text
    {- ^ @AWS_REGION@: read here only to scope SQS under an @AWS_ENDPOINT_URL_SQS@ override,
    because a real SQS URL carries its own. The SDK reads it itself to region every other client.
    -}
    , AmbientAws -> Maybe Text
ambientAwsEndpointUrlSqs :: Maybe Text
    {- ^ @AWS_ENDPOINT_URL_SQS@: the SQS endpoint override (a local emulator or a
    VPC endpoint).
    -}
    , AmbientAws -> Maybe Text
ambientAwsEndpointUrl :: Maybe Text
    {- ^ @AWS_ENDPOINT_URL@: the generic endpoint override, consulted by the S3
    advisory-database client (the proxy's sync and Pilot's export).
    -}
    }
    deriving stock (AmbientAws -> AmbientAws -> Bool
(AmbientAws -> AmbientAws -> Bool)
-> (AmbientAws -> AmbientAws -> Bool) -> Eq AmbientAws
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmbientAws -> AmbientAws -> Bool
== :: AmbientAws -> AmbientAws -> Bool
$c/= :: AmbientAws -> AmbientAws -> Bool
/= :: AmbientAws -> AmbientAws -> Bool
Eq, Int -> AmbientAws -> ShowS
[AmbientAws] -> ShowS
AmbientAws -> String
(Int -> AmbientAws -> ShowS)
-> (AmbientAws -> String)
-> ([AmbientAws] -> ShowS)
-> Show AmbientAws
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmbientAws -> ShowS
showsPrec :: Int -> AmbientAws -> ShowS
$cshow :: AmbientAws -> String
show :: AmbientAws -> String
$cshowList :: [AmbientAws] -> ShowS
showList :: [AmbientAws] -> ShowS
Show)

-- | Read the ambient AWS values from the process environment, as @getEnvironment@ returns it.
ambientAwsFromEnv :: [(String, String)] -> AmbientAws
ambientAwsFromEnv :: [(String, String)] -> AmbientAws
ambientAwsFromEnv [(String, String)]
env =
    AmbientAws
        { ambientAwsRegion :: Maybe Text
ambientAwsRegion = String -> Maybe Text
look String
"AWS_REGION"
        , ambientAwsEndpointUrlSqs :: Maybe Text
ambientAwsEndpointUrlSqs = String -> Maybe Text
look String
"AWS_ENDPOINT_URL_SQS"
        , ambientAwsEndpointUrl :: Maybe Text
ambientAwsEndpointUrl = String -> Maybe Text
look String
"AWS_ENDPOINT_URL"
        }
  where
    look :: String -> Maybe Text
look String
name = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
env

{- | Parse an endpoint override, reading the authority the way the egress gate reads one. Userinfo,
a query, a fragment, or a port outside its grammar refuses.
-}
parseEndpointUrl :: Text -> Either Secret AwsEndpoint
parseEndpointUrl :: Text -> Either Secret AwsEndpoint
parseEndpointUrl Text
raw = Secret -> Maybe AwsEndpoint -> Either Secret AwsEndpoint
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> Secret
mkSecret Text
raw) (Maybe AwsEndpoint -> Either Secret AwsEndpoint)
-> Maybe AwsEndpoint -> Either Secret AwsEndpoint
forall a b. (a -> b) -> a -> b
$ do
    (scheme, _) <- Text -> Maybe (HttpScheme, Text)
splitHttpScheme Text
raw
    guard (isRight (refuseCredentialMaterial "endpoint override" raw))
    let (secure, portless) = schemeDial scheme
    HostPort host port <- hostPortAddressWithDefault portless raw
    pure AwsEndpoint{endpointSecure = secure, endpointHost = host, endpointPort = fromIntegral port}

{- | The S3 advisory client's endpoint override, parsed once at boot. 'Nothing' is an unset or
blank @AWS_ENDPOINT_URL@, and a set-but-refused value is the 'Left', never a silent 'Nothing'.
-}
ambientS3Endpoint :: AmbientAws -> Either Secret (Maybe AwsEndpoint)
ambientS3Endpoint :: AmbientAws -> Either Secret (Maybe AwsEndpoint)
ambientS3Endpoint = (Text -> Either Secret AwsEndpoint)
-> Maybe Text -> Either Secret (Maybe AwsEndpoint)
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) -> Maybe a -> f (Maybe b)
traverse Text -> Either Secret AwsEndpoint
parseEndpointUrl (Maybe Text -> Either Secret (Maybe AwsEndpoint))
-> (AmbientAws -> Maybe Text)
-> AmbientAws
-> Either Secret (Maybe AwsEndpoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text
nonBlank (Text -> Maybe Text)
-> (AmbientAws -> Maybe Text) -> AmbientAws -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< AmbientAws -> Maybe Text
ambientAwsEndpointUrl)

-- The TLS flag and the port a scheme dials when the URL writes no port.
schemeDial :: HttpScheme -> (Bool, Word16)
schemeDial :: HttpScheme -> (Bool, Word16)
schemeDial = \case
    HttpScheme
Https -> (Bool
True, Word16
443)
    HttpScheme
Http -> (Bool
False, Word16
80)