diff --git a/lib/amazonka-core/src/Amazonka/Endpoint.hs b/lib/amazonka-core/src/Amazonka/Endpoint.hs index e835befa513..66780dfce2c 100644 --- a/lib/amazonka-core/src/Amazonka/Endpoint.hs +++ b/lib/amazonka-core/src/Amazonka/Endpoint.hs @@ -9,13 +9,21 @@ module Amazonka.Endpoint ( -- * Endpoint setEndpoint, defaultEndpoint, + customEndpoints, ) where import Amazonka.Data.ByteString +import Amazonka.Data.Text (toText) import Amazonka.Prelude import Amazonka.Types +import qualified Amazonka.Types as Service (Service (abbrev)) import qualified Data.CaseInsensitive as CI +import qualified Data.Char as Char +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Network.HTTP.Client as Client +import qualified System.Environment as Environment -- | A convenience function for overriding the 'Service' 'Endpoint'. -- @@ -95,3 +103,32 @@ defaultEndpoint Service {endpointPrefix = p} r = go (CI.mk p) } reg = toBS r + +-- | Retrieve custom endpoints from environment variables: +-- +-- * @AWS_ENDPOINT_URL@ +-- * @AWS_ENDPOINT_URL_@ +-- +-- The latter takes precedence over the former. +customEndpoints :: (MonadIO m) => m (Service -> Service) +customEndpoints = do + environment <- liftIO Environment.getEnvironment + let globalUrl = lookup "AWS_ENDPOINT_URL" environment >>= Client.parseUrlThrow + let serviceUrls = mapMaybe (\(k, v) -> (,v) . map Char.toLower <$> removePrefix "AWS_ENDPOINT_URL_" k) environment + let override s = + case lookup (Text.unpack . Text.toLower . toText $ Service.abbrev s) serviceUrls of + Just x -> setEndpointMaybe (Client.parseUrlThrow x) s + Nothing -> setEndpointMaybe globalUrl s + pure override + where + 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 -> setEndpoint (Client.secure req) (Client.host req) (Client.port req) s + Nothing -> s