{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Amazonka.HTTP
-- Copyright   : (c) 2013-2021 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)
module Amazonka.HTTP
  ( retryRequest,
    awaitRequest,
    httpRequest,
    configureRequest,
    retryService,
    retryStream,
  )
where

import Amazonka.Data.Body (isStreaming)
import Amazonka.Env
import Amazonka.Lens (to, (%~), (^.), (^?), _Just)
import Amazonka.Logger
import Amazonka.Prelude
import Amazonka.Types
import Amazonka.Waiter
import Control.Exception as Exception
import Control.Monad.Trans.Resource (liftResourceT, transResourceT)
import qualified Control.Retry as Retry
import qualified Data.List as List
import Data.Monoid (Dual (..), Endo (..))
import qualified Data.Time as Time
import qualified Network.HTTP.Conduit as Client.Conduit

retryRequest ::
  ( MonadResource m,
    AWSRequest a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  a ->
  m (Either Error (ClientResponse (AWSResponse a)))
retryRequest :: Env' withAuth
-> a -> m (Either Error (ClientResponse (AWSResponse a)))
retryRequest Env' withAuth
env a
x = do
  let rq :: Request a
rq = Env' withAuth -> a -> Request a
forall a (withAuth :: * -> *).
AWSRequest a =>
Env' withAuth -> a -> Request a
configureRequest Env' withAuth
env a
x
      attempt :: RetryStatus -> m (Either Error (ClientResponse (AWSResponse a)))
attempt RetryStatus
_ = Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest Env' withAuth
env Request a
rq

  RetryPolicyM m
-> (RetryStatus
    -> Either Error (ClientResponse (AWSResponse a)) -> m Bool)
-> (RetryStatus
    -> m (Either Error (ClientResponse (AWSResponse a))))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying (Request a -> RetryPolicyM m
forall (m :: * -> *) a. Monad m => Request a -> RetryPolicyM m
policy Request a
rq) (Request a
-> RetryStatus
-> Either Error (ClientResponse (AWSResponse a))
-> m Bool
check Request a
rq) RetryStatus -> m (Either Error (ClientResponse (AWSResponse a)))
attempt
  where
    policy :: Request a -> RetryPolicyM m
policy Request a
rq =
      Request a -> RetryPolicy
forall a. Request a -> RetryPolicy
retryStream Request a
rq RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Service -> RetryPolicy
retryService (Request a -> Service
forall a. Request a -> Service
_requestService Request a
rq)

    check :: Request a
-> RetryStatus
-> Either Error (ClientResponse (AWSResponse a))
-> m Bool
check Request a
rq RetryStatus
s = \case
      Left Error
r
        | Just Bool
True <- Error
r Error -> Getting (First Bool) Error Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Bool) Error Bool
transportErr -> Text -> RetryStatus -> m ()
logger Text
"http_error" RetryStatus
s m () -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        | Just Text
m <- Error
r Error -> Getting (First Text) Error Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) Error Text
serviceErr -> Text -> RetryStatus -> m ()
logger Text
m RetryStatus
s m () -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      Either Error (ClientResponse (AWSResponse a))
_other -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      where
        transportErr :: Getting (First Bool) Error Bool
transportErr =
          (HttpException -> Const (First Bool) HttpException)
-> Error -> Const (First Bool) Error
forall a. AsError a => Prism' a HttpException
_TransportError ((HttpException -> Const (First Bool) HttpException)
 -> Error -> Const (First Bool) Error)
-> ((Bool -> Const (First Bool) Bool)
    -> HttpException -> Const (First Bool) HttpException)
-> Getting (First Bool) Error Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpException -> Bool)
-> (Bool -> Const (First Bool) Bool)
-> HttpException
-> Const (First Bool) HttpException
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Env' withAuth -> Int -> HttpException -> Bool
forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
_envRetryCheck Env' withAuth
env (RetryStatus -> Int
Retry.rsIterNumber RetryStatus
s))

        serviceErr :: Getting (First Text) Error Text
serviceErr =
          (ServiceError -> Const (First Text) ServiceError)
-> Error -> Const (First Text) Error
forall a. AsError a => Prism' a ServiceError
_ServiceError ((ServiceError -> Const (First Text) ServiceError)
 -> Error -> Const (First Text) Error)
-> ((Text -> Const (First Text) Text)
    -> ServiceError -> Const (First Text) ServiceError)
-> Getting (First Text) Error Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServiceError -> Maybe Text)
-> Optic' (->) (Const (First Text)) ServiceError (Maybe Text)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ServiceError -> Maybe Text
rc Optic' (->) (Const (First Text)) ServiceError (Maybe Text)
-> ((Text -> Const (First Text) Text)
    -> Maybe Text -> Const (First Text) (Maybe Text))
-> (Text -> Const (First Text) Text)
-> ServiceError
-> Const (First Text) ServiceError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Maybe Text -> Const (First Text) (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just

        rc :: ServiceError -> Maybe Text
rc = Request a
rq Request a
-> Getting
     (ServiceError -> Maybe Text)
     (Request a)
     (ServiceError -> Maybe Text)
-> ServiceError
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. (Service -> Const (ServiceError -> Maybe Text) Service)
-> Request a -> Const (ServiceError -> Maybe Text) (Request a)
forall a. Lens' (Request a) Service
requestService ((Service -> Const (ServiceError -> Maybe Text) Service)
 -> Request a -> Const (ServiceError -> Maybe Text) (Request a))
-> (((ServiceError -> Maybe Text)
     -> Const (ServiceError -> Maybe Text) (ServiceError -> Maybe Text))
    -> Service -> Const (ServiceError -> Maybe Text) Service)
-> Getting
     (ServiceError -> Maybe Text)
     (Request a)
     (ServiceError -> Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Retry -> Const (ServiceError -> Maybe Text) Retry)
-> Service -> Const (ServiceError -> Maybe Text) Service
Lens' Service Retry
serviceRetry ((Retry -> Const (ServiceError -> Maybe Text) Retry)
 -> Service -> Const (ServiceError -> Maybe Text) Service)
-> (((ServiceError -> Maybe Text)
     -> Const (ServiceError -> Maybe Text) (ServiceError -> Maybe Text))
    -> Retry -> Const (ServiceError -> Maybe Text) Retry)
-> ((ServiceError -> Maybe Text)
    -> Const (ServiceError -> Maybe Text) (ServiceError -> Maybe Text))
-> Service
-> Const (ServiceError -> Maybe Text) Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ServiceError -> Maybe Text)
 -> Const (ServiceError -> Maybe Text) (ServiceError -> Maybe Text))
-> Retry -> Const (ServiceError -> Maybe Text) Retry
Lens' Retry (ServiceError -> Maybe Text)
retryCheck

    logger :: Text -> RetryStatus -> m ()
logger Text
m RetryStatus
s =
      Logger -> ByteStringBuilder -> m ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug (Env' withAuth -> Logger
forall (withAuth :: * -> *). Env' withAuth -> Logger
_envLogger Env' withAuth
env)
        (ByteStringBuilder -> m ())
-> ([ByteStringBuilder] -> ByteStringBuilder)
-> [ByteStringBuilder]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteStringBuilder] -> ByteStringBuilder
forall a. Monoid a => [a] -> a
mconcat
        ([ByteStringBuilder] -> ByteStringBuilder)
-> ([ByteStringBuilder] -> [ByteStringBuilder])
-> [ByteStringBuilder]
-> ByteStringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> [ByteStringBuilder] -> [ByteStringBuilder]
forall a. a -> [a] -> [a]
List.intersperse ByteStringBuilder
" "
        ([ByteStringBuilder] -> m ()) -> [ByteStringBuilder] -> m ()
forall a b. (a -> b) -> a -> b
$ [ ByteStringBuilder
"[Retry " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
m ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"]",
            ByteStringBuilder
"after",
            Int -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (RetryStatus -> Int
Retry.rsIterNumber RetryStatus
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),
            ByteStringBuilder
"attempts."
          ]

awaitRequest ::
  ( MonadResource m,
    AWSRequest a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Wait a ->
  a ->
  m (Either Error Accept)
awaitRequest :: Env' withAuth -> Wait a -> a -> m (Either Error Accept)
awaitRequest env :: Env' withAuth
env@Env {withAuth Auth
Dual (Endo Service)
Manager
Region
Int -> HttpException -> Bool
Logger
$sel:_envAuth:Env :: forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
$sel:_envManager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
$sel:_envOverride:Env :: forall (withAuth :: * -> *). Env' withAuth -> Dual (Endo Service)
$sel:_envRegion:Env :: forall (withAuth :: * -> *). Env' withAuth -> Region
_envAuth :: withAuth Auth
_envManager :: Manager
_envOverride :: Dual (Endo Service)
_envRetryCheck :: Int -> HttpException -> Bool
_envLogger :: Logger
_envRegion :: Region
$sel:_envLogger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
$sel:_envRetryCheck:Env :: forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
..} w :: Wait a
w@Wait {Int
[Acceptor a]
ByteString
Seconds
$sel:_waitName:Wait :: forall a. Wait a -> ByteString
$sel:_waitAttempts:Wait :: forall a. Wait a -> Int
$sel:_waitDelay:Wait :: forall a. Wait a -> Seconds
$sel:_waitAcceptors:Wait :: forall a. Wait a -> [Acceptor a]
_waitAcceptors :: [Acceptor a]
_waitDelay :: Seconds
_waitAttempts :: Int
_waitName :: ByteString
..} a
x = do
  let rq :: Request a
rq = Env' withAuth -> a -> Request a
forall a (withAuth :: * -> *).
AWSRequest a =>
Env' withAuth -> a -> Request a
configureRequest Env' withAuth
env a
x
      attempt :: RetryStatus
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
attempt RetryStatus
_ = Request a
-> Either Error (ClientResponse (AWSResponse a))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
handleResult Request a
rq (Either Error (ClientResponse (AWSResponse a))
 -> (Accept, Either Error (ClientResponse (AWSResponse a))))
-> m (Either Error (ClientResponse (AWSResponse a)))
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest Env' withAuth
env Request a
rq

  RetryPolicyM m
-> (RetryStatus
    -> (Accept, Either Error (ClientResponse (AWSResponse a)))
    -> m Bool)
-> (RetryStatus
    -> m (Accept, Either Error (ClientResponse (AWSResponse a))))
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying RetryPolicyM m
policy (Logger
-> RetryStatus
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
-> m Bool
check Logger
_envLogger) RetryStatus
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
attempt m (Accept, Either Error (ClientResponse (AWSResponse a)))
-> ((Accept, Either Error (ClientResponse (AWSResponse a)))
    -> Either Error Accept)
-> m (Either Error Accept)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    (Accept
AcceptSuccess, Either Error (ClientResponse (AWSResponse a))
_) -> Accept -> Either Error Accept
forall a b. b -> Either a b
Right Accept
AcceptSuccess
    (Accept
_, Left Error
e) -> Error -> Either Error Accept
forall a b. a -> Either a b
Left Error
e
    (Accept
a, Either Error (ClientResponse (AWSResponse a))
_) -> Accept -> Either Error Accept
forall a b. b -> Either a b
Right Accept
a
  where
    policy :: RetryPolicyM m
policy =
      Int -> RetryPolicy
Retry.limitRetries Int
_waitAttempts
        RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
Retry.constantDelay (Seconds -> Int
toMicroseconds Seconds
_waitDelay)

    check :: Logger
-> RetryStatus
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
-> m Bool
check Logger
e RetryStatus
n (Accept
a, Either Error (ClientResponse (AWSResponse a))
_) = Logger -> RetryStatus -> Accept -> m ()
logger Logger
e RetryStatus
n Accept
a m () -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Accept -> Bool
retry Accept
a)
      where
        retry :: Accept -> Bool
retry Accept
AcceptSuccess = Bool
False
        retry Accept
AcceptFailure = Bool
False
        retry Accept
AcceptRetry = Bool
True

    handleResult :: Request a
-> Either Error (ClientResponse (AWSResponse a))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
handleResult Request a
rq =
      (Either Error (ClientResponse (AWSResponse a)) -> Accept)
-> (Either Error (ClientResponse (AWSResponse a)),
    Either Error (ClientResponse (AWSResponse a)))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Accept -> Maybe Accept -> Accept
forall a. a -> Maybe a -> a
fromMaybe Accept
AcceptRetry (Maybe Accept -> Accept)
-> (Either Error (ClientResponse (AWSResponse a)) -> Maybe Accept)
-> Either Error (ClientResponse (AWSResponse a))
-> Accept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wait a -> Acceptor a
forall a. Wait a -> Acceptor a
accept Wait a
w Request a
rq)
        ((Either Error (ClientResponse (AWSResponse a)),
  Either Error (ClientResponse (AWSResponse a)))
 -> (Accept, Either Error (ClientResponse (AWSResponse a))))
-> (Either Error (ClientResponse (AWSResponse a))
    -> (Either Error (ClientResponse (AWSResponse a)),
        Either Error (ClientResponse (AWSResponse a))))
-> Either Error (ClientResponse (AWSResponse a))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Error (ClientResponse (AWSResponse a))
 -> Either Error (ClientResponse (AWSResponse a))
 -> (Either Error (ClientResponse (AWSResponse a)),
     Either Error (ClientResponse (AWSResponse a))))
-> Either Error (ClientResponse (AWSResponse a))
-> (Either Error (ClientResponse (AWSResponse a)),
    Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)

    logger :: Logger -> RetryStatus -> Accept -> m ()
logger Logger
l RetryStatus
s Accept
a =
      Logger -> ByteStringBuilder -> m ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
l
        (ByteStringBuilder -> m ())
-> ([ByteStringBuilder] -> ByteStringBuilder)
-> [ByteStringBuilder]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteStringBuilder] -> ByteStringBuilder
forall a. Monoid a => [a] -> a
mconcat
        ([ByteStringBuilder] -> ByteStringBuilder)
-> ([ByteStringBuilder] -> [ByteStringBuilder])
-> [ByteStringBuilder]
-> ByteStringBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> [ByteStringBuilder] -> [ByteStringBuilder]
forall a. a -> [a] -> [a]
List.intersperse ByteStringBuilder
" "
        ([ByteStringBuilder] -> m ()) -> [ByteStringBuilder] -> m ()
forall a b. (a -> b) -> a -> b
$ [ ByteStringBuilder
"[Await " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build ByteString
_waitName ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"]",
            Accept -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Accept
a,
            ByteStringBuilder
"after",
            Int -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (RetryStatus -> Int
Retry.rsIterNumber RetryStatus
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),
            ByteStringBuilder
"attempts."
          ]

-- | The 'Service' is configured + unwrapped at this point.
httpRequest ::
  ( MonadResource m,
    AWSRequest a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Request a ->
  m (Either Error (ClientResponse (AWSResponse a)))
httpRequest :: Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest env :: Env' withAuth
env@Env {withAuth Auth
Dual (Endo Service)
Manager
Region
Int -> HttpException -> Bool
Logger
_envAuth :: withAuth Auth
_envManager :: Manager
_envOverride :: Dual (Endo Service)
_envRetryCheck :: Int -> HttpException -> Bool
_envLogger :: Logger
_envRegion :: Region
$sel:_envAuth:Env :: forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
$sel:_envManager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
$sel:_envOverride:Env :: forall (withAuth :: * -> *). Env' withAuth -> Dual (Endo Service)
$sel:_envRegion:Env :: forall (withAuth :: * -> *). Env' withAuth -> Region
$sel:_envLogger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
$sel:_envRetryCheck:Env :: forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
..} Request a
x =
  ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT ((IO (Either Error (ClientResponse (AWSResponse a)))
 -> IO (Either Error (ClientResponse (AWSResponse a))))
-> ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
-> ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> ResourceT m a -> ResourceT n b
transResourceT (IO (Either Error (ClientResponse (AWSResponse a)))
-> [Handler (Either Error (ClientResponse (AWSResponse a)))]
-> IO (Either Error (ClientResponse (AWSResponse a)))
forall a. IO a -> [Handler a] -> IO a
`Exception.catches` [Handler (Either Error (ClientResponse (AWSResponse a)))]
handlers) ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
go)
  where
    go :: ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
go = do
      UTCTime
time <- IO UTCTime -> ResourceT IO UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime

      ClientRequest
rq <- case Env' withAuth -> Maybe Auth
forall (withAuth :: * -> *).
Foldable withAuth =>
Env' withAuth -> Maybe Auth
envAuthMaybe Env' withAuth
env of
        Maybe Auth
Nothing -> ClientRequest -> ResourceT IO ClientRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRequest -> ResourceT IO ClientRequest)
-> ClientRequest -> ResourceT IO ClientRequest
forall a b. (a -> b) -> a -> b
$! Request a -> Region -> ClientRequest
forall a. Request a -> Region -> ClientRequest
requestUnsigned Request a
x Region
_envRegion
        Just Auth
auth -> Auth
-> (AuthEnv -> ResourceT IO ClientRequest)
-> ResourceT IO ClientRequest
forall (m :: * -> *) a.
MonadIO m =>
Auth -> (AuthEnv -> m a) -> m a
withAuth Auth
auth ((AuthEnv -> ResourceT IO ClientRequest)
 -> ResourceT IO ClientRequest)
-> (AuthEnv -> ResourceT IO ClientRequest)
-> ResourceT IO ClientRequest
forall a b. (a -> b) -> a -> b
$ \AuthEnv
a -> do
          let Signed Meta
meta ClientRequest
rq = Algorithm a
forall a. Algorithm a
requestSign Request a
x AuthEnv
a Region
_envRegion UTCTime
time
          Logger -> Meta -> ResourceT IO ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logTrace Logger
_envLogger Meta
meta -- trace:Signing:Meta
          ClientRequest -> ResourceT IO ClientRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRequest -> ResourceT IO ClientRequest)
-> ClientRequest -> ResourceT IO ClientRequest
forall a b. (a -> b) -> a -> b
$! ClientRequest
rq

      Logger -> ClientRequest -> ResourceT IO ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
_envLogger ClientRequest
rq -- debug:ClientRequest
      Response (ConduitM () ByteString (ResourceT IO) ())
rs <- ClientRequest
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
ClientRequest
-> Manager -> m (Response (ConduitM i ByteString m ()))
Client.Conduit.http ClientRequest
rq Manager
_envManager

      Logger
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> ResourceT IO ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
_envLogger Response (ConduitM () ByteString (ResourceT IO) ())
rs -- debug:ClientResponse
      Logger
-> Service
-> Proxy a
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
Logger
-> Service
-> Proxy a
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> m (Either Error (ClientResponse (AWSResponse a)))
response Logger
_envLogger (Request a -> Service
forall a. Request a -> Service
_requestService Request a
x) (Request a -> Proxy a
forall a. Request a -> Proxy a
proxy Request a
x) Response (ConduitM () ByteString (ResourceT IO) ())
rs

    handlers :: [Handler (Either Error (ClientResponse (AWSResponse a)))]
handlers =
      [ (Error -> IO (Either Error (ClientResponse (AWSResponse a))))
-> Handler (Either Error (ClientResponse (AWSResponse a)))
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((Error -> IO (Either Error (ClientResponse (AWSResponse a))))
 -> Handler (Either Error (ClientResponse (AWSResponse a))))
-> (Error -> IO (Either Error (ClientResponse (AWSResponse a))))
-> Handler (Either Error (ClientResponse (AWSResponse a)))
forall a b. (a -> b) -> a -> b
$ Error -> IO (Either Error (ClientResponse (AWSResponse a)))
err,
        (HttpException
 -> IO (Either Error (ClientResponse (AWSResponse a))))
-> Handler (Either Error (ClientResponse (AWSResponse a)))
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((HttpException
  -> IO (Either Error (ClientResponse (AWSResponse a))))
 -> Handler (Either Error (ClientResponse (AWSResponse a))))
-> (HttpException
    -> IO (Either Error (ClientResponse (AWSResponse a))))
-> Handler (Either Error (ClientResponse (AWSResponse a)))
forall a b. (a -> b) -> a -> b
$ Error -> IO (Either Error (ClientResponse (AWSResponse a)))
err (Error -> IO (Either Error (ClientResponse (AWSResponse a))))
-> (HttpException -> Error)
-> HttpException
-> IO (Either Error (ClientResponse (AWSResponse a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Error
TransportError
      ]
      where
        err :: Error -> IO (Either Error (ClientResponse (AWSResponse a)))
err Error
e = Logger -> Error -> IO ()
forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logError Logger
_envLogger Error
e IO ()
-> IO (Either Error (ClientResponse (AWSResponse a)))
-> IO (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Error (ClientResponse (AWSResponse a))
-> IO (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Either Error (ClientResponse (AWSResponse a))
forall a b. a -> Either a b
Left Error
e)

    proxy :: Request a -> Proxy a
    proxy :: Request a -> Proxy a
proxy Request a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

configureRequest :: AWSRequest a => Env' withAuth -> a -> Request a
configureRequest :: Env' withAuth -> a -> Request a
configureRequest Env' withAuth
env a
x =
  let overrides :: Dual (Endo Service)
overrides = Env' withAuth -> Dual (Endo Service)
forall (withAuth :: * -> *). Env' withAuth -> Dual (Endo Service)
_envOverride Env' withAuth
env
   in a -> Request a
forall a. AWSRequest a => a -> Request a
request a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (Service -> Identity Service) -> Request a -> Identity (Request a)
forall a. Lens' (Request a) Service
requestService ((Service -> Identity Service)
 -> Request a -> Identity (Request a))
-> (Service -> Service) -> Request a -> Request a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Endo Service -> Service -> Service
forall a. Endo a -> a -> a
appEndo (Dual (Endo Service) -> Endo Service
forall a. Dual a -> a
getDual Dual (Endo Service)
overrides)

retryStream :: Request a -> Retry.RetryPolicy
retryStream :: Request a -> RetryPolicy
retryStream Request a
x =
  (RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
forall (m :: * -> *).
(RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
Retry.RetryPolicyM (\RetryStatus
_ -> Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int
0 | Bool -> Bool
not Bool
streaming]))
  where
    streaming :: Bool
streaming = RequestBody -> Bool
isStreaming (Request a -> RequestBody
forall a. Request a -> RequestBody
_requestBody Request a
x)

retryService :: Service -> Retry.RetryPolicy
retryService :: Service -> RetryPolicy
retryService Service
s =
  Int -> RetryPolicy
Retry.limitRetries Int
_retryAttempts RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> (RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
forall (m :: * -> *).
(RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
Retry.RetryPolicyM (Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int))
-> (RetryStatus -> Maybe Int) -> RetryStatus -> m (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetryStatus -> Maybe Int
delay)
  where
    delay :: RetryStatus -> Maybe Int
delay (RetryStatus -> Int
Retry.rsIterNumber -> Int
n)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
grow Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000)
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
      where
        grow :: Double
grow = Double
_retryBase Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
_retryGrowth Double -> Int -> Double
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

    Exponential {Double
Int
ServiceError -> Maybe Text
$sel:_retryBase:Exponential :: Retry -> Double
$sel:_retryGrowth:Exponential :: Retry -> Int
$sel:_retryAttempts:Exponential :: Retry -> Int
$sel:_retryCheck:Exponential :: Retry -> ServiceError -> Maybe Text
_retryCheck :: ServiceError -> Maybe Text
_retryGrowth :: Int
_retryBase :: Double
_retryAttempts :: Int
..} = Service -> Retry
_serviceRetry Service
s