diff --git a/lib/amazonka/CHANGELOG.md b/lib/amazonka/CHANGELOG.md index 0a1aaa50453..92e9f602e93 100644 --- a/lib/amazonka/CHANGELOG.md +++ b/lib/amazonka/CHANGELOG.md @@ -4,6 +4,7 @@ ### Changed +- `amazonka`: Add support for `AWS_ENDPOINT_URL*` environment variables to override service-specific endpoints. [\#1046](https://github.com/brendanhay/amazonka/pull/1046) - The hooks interface is now much harder to misuse. [\#1042](https://github.com/brendanhay/amazonka/pull/1042) It was previously extremely easy to write hook-using functions that typechecked but did not ever run. The main change is to provide specialised hook-changing functions named for each field in the `Hooks` record, so that it is much easier to get the types correct. diff --git a/lib/amazonka/src/Amazonka/Env.hs b/lib/amazonka/src/Amazonka/Env.hs index 769d7b4a7b2..1a37a7f8fa8 100644 --- a/lib/amazonka/src/Amazonka/Env.hs +++ b/lib/amazonka/src/Amazonka/Env.hs @@ -43,12 +43,15 @@ module Amazonka.Env where import Amazonka.Core.Lens.Internal (Lens) +import Amazonka.Data.Text (toText) import Amazonka.Env.Hooks (Hooks, addLoggingHooks, noHooks) import Amazonka.Logger (Logger) import Amazonka.Prelude import Amazonka.Types hiding (timeout) +import qualified Amazonka.Endpoint as Endpoint import qualified Amazonka.Types as Service (Service (..)) import qualified Data.Function as Function +import qualified Data.List as List import qualified Data.Text as Text import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Conduit as Client.Conduit @@ -160,17 +163,62 @@ newEnvNoAuth = newEnvNoAuthFromManager :: (MonadIO m) => Client.Manager -> m EnvNoAuth newEnvNoAuthFromManager manager = do mRegion <- lookupRegion + endpointOverrides <- customEndpoints pure Env { region = fromMaybe NorthVirginia mRegion, logger = \_ _ -> pure (), hooks = addLoggingHooks noHooks, retryCheck = retryConnectionFailure 3, - overrides = id, + overrides = endpointOverrides, manager, auth = Proxy } +-- | Retrieve custom endpoints from environment variables: +-- +-- * @AWS_ENDPOINT_URL@ +-- * @AWS_ENDPOINT_URL_@ +-- +-- The latter takes precedence over the former. +-- +-- If @AWS_IGNORE_CONFIGURED_ENDPOINT_URLS@ is set, all other custom endpoint +-- settings are ignored. +-- +-- See +-- +customEndpoints :: (MonadIO m) => m (Service -> Service) +customEndpoints = do + environment <- liftIO Environment.getEnvironment + pure $ case lookup "AWS_IGNORE_CONFIGURED_ENDPOINT_URLS" environment of + Just _ -> id + _ -> go environment + where + go environment = + let globalUrl = lookup "AWS_ENDPOINT_URL" environment >>= Client.parseRequest + serviceUrls = environment + & mapMaybe getEndpoint + & map (first (Text.toLower . Text.pack)) + override s = + case lookup (Text.toLower . toText $ Service.abbrev s) serviceUrls of + Just x -> setEndpointMaybe (Client.parseRequest x) s + Nothing -> setEndpointMaybe globalUrl s + in override + + getEndpoint (k, v) = (,v) <$> removePrefix "AWS_ENDPOINT_URL_" k + + removePrefix :: String -> String -> Maybe String + removePrefix prefix s = + if prefix `List.isPrefixOf` s + then Just $ drop (length prefix) s + else Nothing + + setEndpointMaybe :: Maybe Client.Request -> Service -> Service + setEndpointMaybe mreq s = + case mreq of + Just req -> Endpoint.setEndpoint (Client.secure req) (Client.host req) (Client.port req) s + Nothing -> s + -- | Get "the" 'Auth' from an 'Env'', if we can. authMaybe :: (Foldable withAuth) => Env' withAuth -> Maybe Auth authMaybe = foldr (const . Just) Nothing . auth