-- |
-- Module      : Amazonka.Env
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Environment and AWS specific configuration needed to perform AWS
-- requests.
module Amazonka.Env
  ( -- * Creating the Environment
    newEnv,
    newEnvFromManager,
    newEnvNoAuth,
    newEnvNoAuthFromManager,
    Env' (..),
    Env,
    EnvNoAuth,
    authMaybe,
    lookupRegion,

    -- ** Lenses
    env_region,
    env_logger,
    env_hooks,
    env_retryCheck,
    env_overrides,
    env_manager,
    env_auth,

    -- * Overriding Default Configuration
    overrideService,
    configureService,

    -- * 'Env' override helpers
    globalTimeout,
    once,

    -- * Retry HTTP Exceptions
    retryConnectionFailure,
  )
where

import Amazonka.Core.Lens.Internal (Lens)
import Amazonka.Env.Hooks (Hooks, addLoggingHooks, noHooks)
import Amazonka.Logger (Logger)
import Amazonka.Prelude
import Amazonka.Types hiding (timeout)
import qualified Amazonka.Types as Service (Service (..))
import qualified Data.Function as Function
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Conduit as Client.Conduit
import System.Environment as Environment

-- | An environment with auth credentials. Most AWS requests need one
-- of these, and you can create one with 'Amazonka.Env.newEnv'.
type Env = Env' Identity

-- | An environment with no auth credentials. Used for certain
-- requests which need to be unsigned, like
-- @sts:AssumeRoleWithWebIdentity@, and you can create one with
-- 'Amazonka.Env.newEnvNoAuth' if you need it.
type EnvNoAuth = Env' Proxy

-- | The environment containing the parameters required to make AWS requests.
--
-- This type tracks whether or not we have credentials at the type
-- level, to avoid "presigning" requests when we lack auth
-- information.
data Env' withAuth = Env
  { forall (withAuth :: * -> *). Env' withAuth -> Region
region :: Region,
    forall (withAuth :: * -> *). Env' withAuth -> Logger
logger :: Logger,
    forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: ~Hooks,
    forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
retryCheck :: Int -> Client.HttpException -> Bool,
    forall (withAuth :: * -> *). Env' withAuth -> Service -> Service
overrides :: Service -> Service,
    forall (withAuth :: * -> *). Env' withAuth -> Manager
manager :: Client.Manager,
    forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
auth :: withAuth Auth
  }
  deriving stock ((forall x. Env' withAuth -> Rep (Env' withAuth) x)
-> (forall x. Rep (Env' withAuth) x -> Env' withAuth)
-> Generic (Env' withAuth)
forall x. Rep (Env' withAuth) x -> Env' withAuth
forall x. Env' withAuth -> Rep (Env' withAuth) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (withAuth :: * -> *) x.
Rep (Env' withAuth) x -> Env' withAuth
forall (withAuth :: * -> *) x.
Env' withAuth -> Rep (Env' withAuth) x
$cfrom :: forall (withAuth :: * -> *) x.
Env' withAuth -> Rep (Env' withAuth) x
from :: forall x. Env' withAuth -> Rep (Env' withAuth) x
$cto :: forall (withAuth :: * -> *) x.
Rep (Env' withAuth) x -> Env' withAuth
to :: forall x. Rep (Env' withAuth) x -> Env' withAuth
Generic)

{-# INLINE env_region #-}
env_region :: Lens' (Env' withAuth) Region
env_region :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
(Region -> f Region) -> Env' withAuth -> f (Env' withAuth)
env_region Region -> f Region
f e :: Env' withAuth
e@Env {Region
$sel:region:Env :: forall (withAuth :: * -> *). Env' withAuth -> Region
region :: Region
region} = Region -> f Region
f Region
region f Region -> (Region -> Env' withAuth) -> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Region
region' -> Env' withAuth
e {region = region'}

{-# INLINE env_logger #-}
env_logger :: Lens' (Env' withAuth) Logger
env_logger :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
(Logger -> f Logger) -> Env' withAuth -> f (Env' withAuth)
env_logger Logger -> f Logger
f e :: Env' withAuth
e@Env {Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger :: Logger
logger} = Logger -> f Logger
f Logger
logger f Logger -> (Logger -> Env' withAuth) -> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Logger
logger' -> Env' withAuth
e {logger = logger'}

{-# INLINE env_hooks #-}
env_hooks :: Lens' (Env' withAuth) Hooks
env_hooks :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
(Hooks -> f Hooks) -> Env' withAuth -> f (Env' withAuth)
env_hooks Hooks -> f Hooks
f e :: Env' withAuth
e@Env {Hooks
$sel:hooks:Env :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks} = Hooks -> f Hooks
f Hooks
hooks f Hooks -> (Hooks -> Env' withAuth) -> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Hooks
hooks' -> Env' withAuth
e {hooks = hooks'}

{-# INLINE env_retryCheck #-}
env_retryCheck :: Lens' (Env' withAuth) (Int -> Client.HttpException -> Bool)
env_retryCheck :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
((Int -> HttpException -> Bool)
 -> f (Int -> HttpException -> Bool))
-> Env' withAuth -> f (Env' withAuth)
env_retryCheck (Int -> HttpException -> Bool) -> f (Int -> HttpException -> Bool)
f e :: Env' withAuth
e@Env {Int -> HttpException -> Bool
$sel:retryCheck:Env :: forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
retryCheck :: Int -> HttpException -> Bool
retryCheck} = (Int -> HttpException -> Bool) -> f (Int -> HttpException -> Bool)
f Int -> HttpException -> Bool
retryCheck f (Int -> HttpException -> Bool)
-> ((Int -> HttpException -> Bool) -> Env' withAuth)
-> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int -> HttpException -> Bool
retryCheck' -> Env' withAuth
e {retryCheck = retryCheck'}

{-# INLINE env_overrides #-}
env_overrides :: Lens' (Env' withAuth) (Service -> Service)
env_overrides :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
((Service -> Service) -> f (Service -> Service))
-> Env' withAuth -> f (Env' withAuth)
env_overrides (Service -> Service) -> f (Service -> Service)
f e :: Env' withAuth
e@Env {Service -> Service
$sel:overrides:Env :: forall (withAuth :: * -> *). Env' withAuth -> Service -> Service
overrides :: Service -> Service
overrides} = (Service -> Service) -> f (Service -> Service)
f Service -> Service
overrides f (Service -> Service)
-> ((Service -> Service) -> Env' withAuth) -> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Service -> Service
overrides' -> Env' withAuth
e {overrides = overrides'}

{-# INLINE env_manager #-}
env_manager :: Lens' (Env' withAuth) Client.Manager
env_manager :: forall (withAuth :: * -> *) (f :: * -> *).
Functor f =>
(Manager -> f Manager) -> Env' withAuth -> f (Env' withAuth)
env_manager Manager -> f Manager
f e :: Env' withAuth
e@Env {Manager
$sel:manager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
manager :: Manager
manager} = Manager -> f Manager
f Manager
manager f Manager -> (Manager -> Env' withAuth) -> f (Env' withAuth)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Manager
manager' -> Env' withAuth
e {manager = manager'}

{-# INLINE env_auth #-}
env_auth :: Lens (Env' withAuth) (Env' withAuth') (withAuth Auth) (withAuth' Auth)
env_auth :: forall (withAuth :: * -> *) (withAuth' :: * -> *) (f :: * -> *).
Functor f =>
(withAuth Auth -> f (withAuth' Auth))
-> Env' withAuth -> f (Env' withAuth')
env_auth withAuth Auth -> f (withAuth' Auth)
f e :: Env' withAuth
e@Env {withAuth Auth
$sel:auth:Env :: forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
auth :: withAuth Auth
auth} = withAuth Auth -> f (withAuth' Auth)
f withAuth Auth
auth f (withAuth' Auth)
-> (withAuth' Auth -> Env' withAuth') -> f (Env' withAuth')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \withAuth' Auth
auth' -> Env' withAuth
e {auth = auth'}

-- | Creates a new environment with a new 'Client.Manager' without
-- debug logging and uses the provided function to expand/discover
-- credentials. Record updates or lenses can be used to further
-- configure the resulting 'Env'.
--
-- /Since:/ @1.5.0@ - The region is now retrieved from the @AWS_REGION@ environment
-- variable (identical to official SDKs), or defaults to @us-east-1@.
-- You can override the 'Env' region by updating its 'region' field.
--
-- /Since:/ @1.3.6@ - The default logic for retrying 'HttpException's now uses
-- 'retryConnectionFailure' to retry specific connection failure conditions up to 3 times.
-- Previously only service specific errors were automatically retried.
-- This can be reverted to the old behaviour by resetting the 'Env''s
-- 'retryCheck' field to @(\\_ _ -> False)@.
--
-- Throws 'AuthError' when environment variables or IAM profiles cannot be read.
--
-- /See:/ 'newEnvFromManager'.
newEnv ::
  MonadIO m =>
  -- | Credential discovery mechanism, often 'Amazonka.Auth.discover'.
  (EnvNoAuth -> m Env) ->
  m Env
newEnv :: forall (m :: * -> *). MonadIO m => (EnvNoAuth -> m Env) -> m Env
newEnv = (m EnvNoAuth
forall (m :: * -> *). MonadIO m => m EnvNoAuth
newEnvNoAuth m EnvNoAuth -> (EnvNoAuth -> m Env) -> m Env
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)

-- | Creates a new environment, but with an existing 'Client.Manager'.
newEnvFromManager ::
  MonadIO m =>
  Client.Manager ->
  -- | Credential discovery mechanism.
  (EnvNoAuth -> m Env) ->
  m Env
newEnvFromManager :: forall (m :: * -> *).
MonadIO m =>
Manager -> (EnvNoAuth -> m Env) -> m Env
newEnvFromManager Manager
manager = (Manager -> m EnvNoAuth
forall (m :: * -> *). MonadIO m => Manager -> m EnvNoAuth
newEnvNoAuthFromManager Manager
manager m EnvNoAuth -> (EnvNoAuth -> m Env) -> m Env
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)

-- | Generate an environment without credentials, which may only make
-- unsigned requests. Sets the region based on the @AWS_REGION@
-- environment variable, or 'NorthVirginia' if unset.
--
-- This lets us support calls like the
-- <https://docs.aws.amazon.com/STS/latest/APIReference/API_AssumeRoleWithWebIdentity.html sts:AssumeRoleWithWebIdentity>
-- operation, which needs to make an unsigned request to pass the
-- token from an identity provider.
newEnvNoAuth :: MonadIO m => m EnvNoAuth
newEnvNoAuth :: forall (m :: * -> *). MonadIO m => m EnvNoAuth
newEnvNoAuth =
  IO Manager -> m Manager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
Client.newManager ManagerSettings
Client.Conduit.tlsManagerSettings)
    m Manager -> (Manager -> m EnvNoAuth) -> m EnvNoAuth
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> m EnvNoAuth
forall (m :: * -> *). MonadIO m => Manager -> m EnvNoAuth
newEnvNoAuthFromManager

-- | Generate an environment without credentials, passing in an
-- explicit 'Client.Manager'.
newEnvNoAuthFromManager :: MonadIO m => Client.Manager -> m EnvNoAuth
newEnvNoAuthFromManager :: forall (m :: * -> *). MonadIO m => Manager -> m EnvNoAuth
newEnvNoAuthFromManager Manager
manager = do
  Maybe Region
mRegion <- m (Maybe Region)
forall (m :: * -> *). MonadIO m => m (Maybe Region)
lookupRegion
  EnvNoAuth -> m EnvNoAuth
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Env
      { $sel:region:Env :: Region
region = Region -> Maybe Region -> Region
forall a. a -> Maybe a -> a
fromMaybe Region
NorthVirginia Maybe Region
mRegion,
        $sel:logger:Env :: Logger
logger = \LogLevel
_ ByteStringBuilder
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
        $sel:hooks:Env :: Hooks
hooks = Hooks -> Hooks
addLoggingHooks Hooks
noHooks,
        $sel:retryCheck:Env :: Int -> HttpException -> Bool
retryCheck = Int -> Int -> HttpException -> Bool
retryConnectionFailure Int
3,
        $sel:overrides:Env :: Service -> Service
overrides = Service -> Service
forall a. a -> a
id,
        Manager
$sel:manager:Env :: Manager
manager :: Manager
manager,
        $sel:auth:Env :: Proxy Auth
auth = Proxy Auth
forall {k} (t :: k). Proxy t
Proxy
      }

-- | Get "the" 'Auth' from an 'Env'', if we can.
authMaybe :: Foldable withAuth => Env' withAuth -> Maybe Auth
authMaybe :: forall (withAuth :: * -> *).
Foldable withAuth =>
Env' withAuth -> Maybe Auth
authMaybe = (Auth -> Maybe Auth -> Maybe Auth)
-> Maybe Auth -> withAuth Auth -> Maybe Auth
forall a b. (a -> b -> b) -> b -> withAuth a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Auth -> Maybe Auth -> Maybe Auth
forall a b. a -> b -> a
const (Maybe Auth -> Maybe Auth -> Maybe Auth)
-> (Auth -> Maybe Auth) -> Auth -> Maybe Auth -> Maybe Auth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Auth -> Maybe Auth
forall a. a -> Maybe a
Just) Maybe Auth
forall a. Maybe a
Nothing (withAuth Auth -> Maybe Auth)
-> (Env' withAuth -> withAuth Auth) -> Env' withAuth -> Maybe Auth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env' withAuth -> withAuth Auth
forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
auth

-- | Look up the region in the @AWS_REGION@ environment variable.
lookupRegion :: MonadIO m => m (Maybe Region)
lookupRegion :: forall (m :: * -> *). MonadIO m => m (Maybe Region)
lookupRegion =
  IO (Maybe Region) -> m (Maybe Region)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Region) -> m (Maybe Region))
-> IO (Maybe Region) -> m (Maybe Region)
forall a b. (a -> b) -> a -> b
$
    String -> IO (Maybe String)
Environment.lookupEnv String
"AWS_REGION" IO (Maybe String)
-> (Maybe String -> Maybe Region) -> IO (Maybe Region)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe String
Nothing -> Maybe Region
forall a. Maybe a
Nothing
      Just String
"" -> Maybe Region
forall a. Maybe a
Nothing
      Just String
t -> Region -> Maybe Region
forall a. a -> Maybe a
Just (Region -> Maybe Region)
-> (Text -> Region) -> Text -> Maybe Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Region
Region' (Text -> Maybe Region) -> Text -> Maybe Region
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t

-- | Retry the subset of transport specific errors encompassing connection
-- failure up to the specific number of times.
retryConnectionFailure :: Int -> Int -> Client.HttpException -> Bool
retryConnectionFailure :: Int -> Int -> HttpException -> Bool
retryConnectionFailure Int
limit Int
n = \case
  Client.InvalidUrlException {} -> Bool
False
  Client.HttpExceptionRequest Request
_ HttpExceptionContent
ex
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit -> Bool
False
    | Bool
otherwise ->
        case HttpExceptionContent
ex of
          HttpExceptionContent
Client.NoResponseDataReceived -> Bool
True
          HttpExceptionContent
Client.ConnectionTimeout -> Bool
True
          HttpExceptionContent
Client.ConnectionClosed -> Bool
True
          Client.ConnectionFailure {} -> Bool
True
          Client.InternalException {} -> Bool
True
          HttpExceptionContent
_other -> Bool
False

-- | Provide a function which will be added to the existing stack
-- of overrides applied to all service configurations.
overrideService :: (Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService :: forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService Service -> Service
f Env' withAuth
env = Env' withAuth
env {overrides = f . overrides env}

-- | Configure a specific service. All requests belonging to the
-- supplied service will use this configuration instead of the default.
--
-- It's suggested you modify the default service configuration,
-- such as @Amazonka.DynamoDB.defaultService@.
configureService :: Service -> Env' withAuth -> Env' withAuth
configureService :: forall (withAuth :: * -> *).
Service -> Env' withAuth -> Env' withAuth
configureService Service
s = (Service -> Service) -> Env' withAuth -> Env' withAuth
forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService Service -> Service
f
  where
    f :: Service -> Service
f Service
x
      | (Abbrev -> Abbrev -> Bool)
-> (Service -> Abbrev) -> Service -> Service -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on Abbrev -> Abbrev -> Bool
forall a. Eq a => a -> a -> Bool
(==) Service -> Abbrev
Service.abbrev Service
s Service
x = Service
s
      | Bool
otherwise = Service
x

-- | Override the timeout value for this 'Env'.
--
-- Default timeouts are chosen by considering:
--
-- * This 'timeout', if set.
--
-- * The related 'Service' timeout for the sent request if set. (Usually 70s)
--
-- * The 'manager' timeout if set.
--
-- * The default 'ClientRequest' timeout. (Approximately 30s)
globalTimeout :: Seconds -> Env' withAuth -> Env' withAuth
globalTimeout :: forall (withAuth :: * -> *).
Seconds -> Env' withAuth -> Env' withAuth
globalTimeout Seconds
n = (Service -> Service) -> Env' withAuth -> Env' withAuth
forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService ((Service -> Service) -> Env' withAuth -> Env' withAuth)
-> (Service -> Service) -> Env' withAuth -> Env' withAuth
forall a b. (a -> b) -> a -> b
$ \Service
s -> Service
s {Service.timeout = Just n}

-- | Disable any retry logic for an 'Env', so that any requests will
-- at most be sent once.
once :: Env' withAuth -> Env' withAuth
once :: forall (withAuth :: * -> *). Env' withAuth -> Env' withAuth
once = (Service -> Service) -> Env' withAuth -> Env' withAuth
forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService ((Service -> Service) -> Env' withAuth -> Env' withAuth)
-> (Service -> Service) -> Env' withAuth -> Env' withAuth
forall a b. (a -> b) -> a -> b
$ \s :: Service
s@Service {Retry
retry :: Retry
$sel:retry:Service :: Service -> Retry
retry} -> Service
s {retry = retry {attempts = 0}}