-- |
-- 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 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
$cto :: forall (withAuth :: * -> *) x.
Rep (Env' withAuth) x -> Env' withAuth
$cfrom :: forall (withAuth :: * -> *) x.
Env' withAuth -> Rep (Env' withAuth) x
Generic)

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

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

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

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

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

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

{-# INLINE env_auth #-}
env_auth :: Lens (Env' withAuth) (Env' withAuth') (withAuth Auth) (withAuth' Auth)
env_auth :: forall (withAuth :: * -> *) (withAuth' :: * -> *).
Lens
  (Env' withAuth) (Env' withAuth') (withAuth Auth) (withAuth' Auth)
env_auth withAuth Auth -> f (withAuth' Auth)
f e :: Env' withAuth
e@Env {withAuth Auth
auth :: withAuth Auth
$sel:auth:Env :: forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
auth} = withAuth Auth -> f (withAuth' Auth)
f withAuth Auth
auth forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \withAuth' Auth
auth' -> Env' withAuth
e {$sel:auth:Env :: withAuth' Auth
auth = withAuth' 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 = (forall (m :: * -> *). MonadIO m => m EnvNoAuth
newEnvNoAuth 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 = (forall (m :: * -> *). MonadIO m => Manager -> m EnvNoAuth
newEnvNoAuthFromManager Manager
manager 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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
Client.newManager ManagerSettings
Client.Conduit.tlsManagerSettings)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 <- forall (m :: * -> *). MonadIO m => m (Maybe Region)
lookupRegion
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Env
      { $sel:region:Env :: Region
region = forall a. a -> Maybe a -> a
fromMaybe Region
NorthVirginia Maybe Region
mRegion,
        $sel:logger:Env :: Logger
logger = \LogLevel
_ ByteStringBuilder
_ -> 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 = forall a. a -> a
id,
        Manager
manager :: Manager
$sel:manager:Env :: Manager
manager,
        $sel:auth:Env :: Proxy Auth
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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    String -> IO (Maybe String)
Environment.lookupEnv String
"AWS_REGION" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe String
Nothing -> forall a. Maybe a
Nothing
      Just String
"" -> forall a. Maybe a
Nothing
      Just String
t -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Region
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 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 {$sel:overrides:Env :: Service -> Service
overrides = Service -> Service
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (withAuth :: * -> *). Env' withAuth -> Service -> Service
overrides Env' withAuth
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 = forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService Service -> Service
f
  where
    f :: Service -> Service
f Service
x
      | forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on 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 = forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService forall a b. (a -> b) -> a -> b
$ \Service
s -> Service
s {$sel:timeout:Service :: Maybe Seconds
Service.timeout = forall a. a -> Maybe a
Just Seconds
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 = forall (withAuth :: * -> *).
(Service -> Service) -> Env' withAuth -> Env' withAuth
overrideService forall a b. (a -> b) -> a -> b
$ \s :: Service
s@Service {Retry
$sel:retry:Service :: Service -> Retry
retry :: Retry
retry} -> Service
s {$sel:retry:Service :: Retry
retry = Retry
retry {$sel:attempts:Exponential :: Int
attempts = Int
0}}