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

import Amazonka.Core.Lens.Internal (to, (^?), _Just)
import Amazonka.Data.Body (isStreaming)
import Amazonka.Env hiding (auth)
import Amazonka.Env.Hooks (Finality (..))
import qualified Amazonka.Env.Hooks as Hooks
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 Data.Foldable (traverse_)
import qualified Data.Time as Time
import Data.Typeable (Typeable)
import qualified Network.HTTP.Conduit as Client.Conduit

retryRequest ::
  forall m a withAuth.
  ( MonadResource m,
    AWSRequest a,
    Typeable a,
    Typeable (AWSResponse a),
    Foldable withAuth
  ) =>
  Env' withAuth ->
  a ->
  m (Either Error (ClientResponse (AWSResponse a)))
retryRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Typeable a,
 Typeable (AWSResponse a), Foldable withAuth) =>
Env' withAuth
-> a -> m (Either Error (ClientResponse (AWSResponse a)))
retryRequest env :: Env' withAuth
env@Env {Hooks
hooks :: Hooks
$sel:hooks:Env :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks} a
rq = do
  a
rq' <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Hooks -> forall a. (AWSRequest a, Typeable a) => Hook a
Hooks.request Hooks
hooks Env' withAuth
env a
rq
  Request a
cfgRq <- Env' withAuth -> a -> m (Request a)
forall a (m :: * -> *) (withAuth :: * -> *).
(AWSRequest a, Typeable a, MonadIO m) =>
Env' withAuth -> a -> m (Request a)
configureRequest Env' withAuth
env a
rq'

  let 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, Typeable a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest Env' withAuth
env Request a
cfgRq
      policy :: RetryPolicyM m
policy = Request a -> RetryPolicy
forall a. Request a -> RetryPolicy
retryStream Request a
cfgRq RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Service -> RetryPolicy
retryService (Request a -> Service
forall a. Request a -> Service
service Request a
cfgRq)
      Request
        { $sel:service:Request :: forall a. Request a -> Service
service = Service {$sel:retry:Service :: Service -> Retry
retry = Exponential {$sel:check:Exponential :: Retry -> ServiceError -> Maybe Text
check = ServiceError -> Maybe Text
serviceRetryCheck}}
        } = Request a
cfgRq

      shouldRetry :: Retry.RetryStatus -> Either Error b -> m Bool
      shouldRetry :: forall b. RetryStatus -> Either Error b -> m Bool
shouldRetry RetryStatus
s =
        IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> (Either Error b -> IO Bool) -> Either Error b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \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 ->
                Bool
True Bool -> IO () -> IO Bool
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Text, RetryStatus)
Hooks.requestRetry Hooks
hooks Env' withAuth
env (Request a
cfgRq, Text
"http_error", RetryStatus
s)
            | Just Text
name <- 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 ->
                Bool
True Bool -> IO () -> IO Bool
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Text, RetryStatus)
Hooks.requestRetry Hooks
hooks Env' withAuth
env (Request a
cfgRq, Text
name, RetryStatus
s)
          Either Error b
_other -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
Prism' Error 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
retryCheck 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
Prism' Error 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
serviceRetryCheck 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 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

  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 RetryPolicyM m
policy RetryStatus
-> Either Error (ClientResponse (AWSResponse a)) -> m Bool
forall b. RetryStatus -> Either Error b -> m Bool
shouldRetry RetryStatus -> m (Either Error (ClientResponse (AWSResponse a)))
attempt m (Either Error (ClientResponse (AWSResponse a)))
-> (Either Error (ClientResponse (AWSResponse a))
    -> m (Either Error (ClientResponse (AWSResponse a))))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
e -> Error -> Either Error (ClientResponse (AWSResponse a))
forall a b. a -> Either a b
Left Error
e Either Error (ClientResponse (AWSResponse a))
-> m () -> m (Either Error (ClientResponse (AWSResponse a)))
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
Hooks.error Hooks
hooks Env' withAuth
env (Finality
Final, Request a
cfgRq, Error
e))
    Right ClientResponse (AWSResponse a)
a -> Either Error (ClientResponse (AWSResponse a))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (ClientResponse (AWSResponse a))
 -> m (Either Error (ClientResponse (AWSResponse a))))
-> Either Error (ClientResponse (AWSResponse a))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall a b. (a -> b) -> a -> b
$ ClientResponse (AWSResponse a)
-> Either Error (ClientResponse (AWSResponse a))
forall a b. b -> Either a b
Right ClientResponse (AWSResponse a)
a

awaitRequest ::
  ( MonadResource m,
    AWSRequest a,
    Typeable a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Wait a ->
  a ->
  m (Either Error Accept)
awaitRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Typeable a, Foldable withAuth) =>
Env' withAuth -> Wait a -> a -> m (Either Error Accept)
awaitRequest env :: Env' withAuth
env@Env {Hooks
$sel:hooks:Env :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks} Wait a
w a
rq = do
  a
rq' <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Hooks -> forall a. (AWSRequest a, Typeable a) => Hook a
Hooks.request Hooks
hooks Env' withAuth
env a
rq
  Request a
cfgRq <- Env' withAuth -> a -> m (Request a)
forall a (m :: * -> *) (withAuth :: * -> *).
(AWSRequest a, Typeable a, MonadIO m) =>
Env' withAuth -> a -> m (Request a)
configureRequest Env' withAuth
env a
rq'
  w' :: Wait a
w'@Wait {Int
[Acceptor a]
ByteString
Seconds
name :: ByteString
attempts :: Int
delay :: Seconds
acceptors :: [Acceptor a]
$sel:name:Wait :: forall a. Wait a -> ByteString
$sel:attempts:Wait :: forall a. Wait a -> Int
$sel:delay:Wait :: forall a. Wait a -> Seconds
$sel:acceptors:Wait :: forall a. Wait a -> [Acceptor a]
..} <- IO (Wait a) -> m (Wait a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Wait a) -> m (Wait a)) -> IO (Wait a) -> m (Wait a)
forall a b. (a -> b) -> a -> b
$ Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
Hooks.wait Hooks
hooks Env' withAuth
env Wait a
w

  let handleResult :: Either Error (ClientResponse (AWSResponse a))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
handleResult Either Error (ClientResponse (AWSResponse a))
res = (Accept -> Maybe Accept -> Accept
forall a. a -> Maybe a -> a
fromMaybe Accept
AcceptRetry (Maybe Accept -> Accept) -> Maybe Accept -> Accept
forall a b. (a -> b) -> a -> b
$ Wait a -> Acceptor a
forall a. Wait a -> Acceptor a
accept Wait a
w' Request a
cfgRq Either Error (ClientResponse (AWSResponse a))
res, Either Error (ClientResponse (AWSResponse a))
res)
      attempt :: RetryStatus
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
attempt RetryStatus
_ = Either Error (ClientResponse (AWSResponse a))
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
handleResult (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, Typeable a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest Env' withAuth
env Request a
cfgRq
      policy :: RetryPolicyM m
policy =
        Int -> RetryPolicy
Retry.limitRetries Int
attempts
          RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicyM m
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
Retry.constantDelay (Seconds -> Int
toMicroseconds Seconds
delay)

      check :: RetryStatus
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
-> m Bool
check RetryStatus
retryStatus (Accept
a, Either Error (ClientResponse (AWSResponse a))
_) = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Wait a, Accept, RetryStatus)
Hooks.awaitRetry Hooks
hooks Env' withAuth
env (Request a
cfgRq, Wait a
w', Accept
a, RetryStatus
retryStatus)
        Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Accept
a of
          Accept
AcceptSuccess -> Bool
False
          Accept
AcceptFailure -> Bool
False
          Accept
AcceptRetry -> Bool
True

  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 RetryStatus
-> (Accept, Either Error (ClientResponse (AWSResponse a)))
-> m Bool
check RetryStatus
-> m (Accept, Either Error (ClientResponse (AWSResponse a)))
attempt m (Accept, Either Error (ClientResponse (AWSResponse a)))
-> ((Accept, Either Error (ClientResponse (AWSResponse a)))
    -> m (Either Error Accept))
-> m (Either Error Accept)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Accept
AcceptSuccess, Either Error (ClientResponse (AWSResponse a))
_) -> Either Error Accept -> m (Either Error Accept)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error Accept -> m (Either Error Accept))
-> Either Error Accept -> m (Either Error Accept)
forall a b. (a -> b) -> a -> b
$ 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 Either Error Accept -> m () -> m (Either Error Accept)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
Hooks.error Hooks
hooks Env' withAuth
env (Finality
Final, Request a
cfgRq, Error
e))
    (Accept
a, Either Error (ClientResponse (AWSResponse a))
_) -> Either Error Accept -> m (Either Error Accept)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error Accept -> m (Either Error Accept))
-> Either Error Accept -> m (Either Error Accept)
forall a b. (a -> b) -> a -> b
$ Accept -> Either Error Accept
forall a b. b -> Either a b
Right Accept
a

-- | Make a one-shot request to AWS, using a configured 'Request'
-- (which contains the 'Service', plus any overrides).
httpRequest ::
  ( MonadResource m,
    AWSRequest a,
    Typeable a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Request a ->
  m (Either Error (ClientResponse (AWSResponse a)))
httpRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Typeable a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest env :: Env' withAuth
env@Env {Hooks
$sel:hooks:Env :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks, Manager
manager :: Manager
$sel:manager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
manager, Region
region :: Region
$sel:region:Env :: forall (withAuth :: * -> *). Env' withAuth -> Region
region} Request a
cfgRq =
  ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
-> m (Either Error (ClientResponse (AWSResponse a)))
forall a. ResourceT IO a -> m 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)))]
forall b. [Handler (Either Error b)]
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 a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime

      ClientRequest
clientRq :: ClientRequest <-
        IO ClientRequest -> ResourceT IO ClientRequest
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClientRequest -> ResourceT IO ClientRequest)
-> (ClientRequest -> IO ClientRequest)
-> ClientRequest
-> ResourceT IO ClientRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hooks -> Hook ClientRequest
Hooks.clientRequest Hooks
hooks Env' withAuth
env (ClientRequest -> ResourceT IO ClientRequest)
-> ResourceT IO ClientRequest -> ResourceT IO ClientRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Env' withAuth -> Maybe Auth
forall (withAuth :: * -> *).
Foldable withAuth =>
Env' withAuth -> Maybe Auth
authMaybe Env' withAuth
env of
          Maybe Auth
Nothing -> ClientRequest -> ResourceT IO ClientRequest
forall a. a -> ResourceT IO a
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
cfgRq Region
region
          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 s :: Signed a
s@(Signed Meta
_ ClientRequest
rq) = Algorithm a
forall a. Algorithm a
requestSign Request a
cfgRq AuthEnv
a Region
region UTCTime
time
            IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ Hooks -> forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
Hooks.signedRequest Hooks
hooks Env' withAuth
env Signed a
s
            ClientRequest -> ResourceT IO ClientRequest
forall a. a -> ResourceT IO a
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

      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
clientRq Manager
manager
      IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse ())
Hooks.clientResponse Hooks
hooks Env' withAuth
env (Request a
cfgRq, Response (ConduitM () ByteString (ResourceT IO) ())
-> ClientResponse ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response (ConduitM () ByteString (ResourceT IO) ())
rs)
      Either Error (ClientResponse (AWSResponse a))
parsedRs <-
        (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> m (Either Error (ClientResponse (AWSResponse a)))
forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> Response (ConduitM () ByteString (ResourceT IO) ())
-> m (Either Error (ClientResponse (AWSResponse a)))
response
          (Hooks -> Hook ByteStringLazy
Hooks.rawResponseBody Hooks
hooks Env' withAuth
env)
          (Request a -> Service
forall a. Request a -> Service
service Request a
cfgRq)
          (Request a -> Proxy a
forall a. Request a -> Proxy a
proxy Request a
cfgRq)
          Response (ConduitM () ByteString (ResourceT IO) ())
rs
      (ClientResponse (AWSResponse a) -> ResourceT IO ())
-> Either Error (ClientResponse (AWSResponse a)) -> ResourceT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ())
-> (ClientResponse (AWSResponse a) -> IO ())
-> ClientResponse (AWSResponse a)
-> ResourceT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse (AWSResponse a))
Hooks.response Hooks
hooks Env' withAuth
env ((Request a, ClientResponse (AWSResponse a)) -> IO ())
-> (ClientResponse (AWSResponse a)
    -> (Request a, ClientResponse (AWSResponse a)))
-> ClientResponse (AWSResponse a)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request a
cfgRq,)) Either Error (ClientResponse (AWSResponse a))
parsedRs
      Either Error (ClientResponse (AWSResponse a))
-> ResourceT IO (Either Error (ClientResponse (AWSResponse a)))
forall a. a -> ResourceT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Error (ClientResponse (AWSResponse a))
parsedRs

    handlers :: [Handler (Either Error b)]
    handlers :: forall b. [Handler (Either Error b)]
handlers =
      [ (Error -> IO (Either Error b)) -> Handler (Either Error b)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler Error -> IO (Either Error b)
err,
        (HttpException -> IO (Either Error b)) -> Handler (Either Error b)
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((HttpException -> IO (Either Error b))
 -> Handler (Either Error b))
-> (HttpException -> IO (Either Error b))
-> Handler (Either Error b)
forall a b. (a -> b) -> a -> b
$ Error -> IO (Either Error b)
err (Error -> IO (Either Error b))
-> (HttpException -> Error) -> HttpException -> IO (Either Error b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Error
TransportError
      ]
      where
        err :: Error -> IO (Either Error b)
err Error
e = Error -> Either Error b
forall a b. a -> Either a b
Left Error
e Either Error b -> IO () -> IO (Either Error b)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
Hooks.error Hooks
hooks Env' withAuth
env (Finality
NotFinal, Request a
cfgRq, Error
e)

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

-- Configures an AWS request `a` into its `Request a` form, applying
-- service overrides from `env` and running hooks on the configured
-- (Request a).
configureRequest ::
  (AWSRequest a, Typeable a, MonadIO m) => Env' withAuth -> a -> m (Request a)
configureRequest :: forall a (m :: * -> *) (withAuth :: * -> *).
(AWSRequest a, Typeable a, MonadIO m) =>
Env' withAuth -> a -> m (Request a)
configureRequest env :: Env' withAuth
env@Env {Service -> Service
overrides :: Service -> Service
$sel:overrides:Env :: forall (withAuth :: * -> *). Env' withAuth -> Service -> Service
overrides, Hooks
$sel:hooks:Env :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks} =
  IO (Request a) -> m (Request a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Request a) -> m (Request a))
-> (a -> IO (Request a)) -> a -> m (Request a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Request a)
Hooks.configuredRequest Hooks
hooks Env' withAuth
env
    (Request a -> IO (Request a))
-> (a -> Request a) -> a -> IO (Request a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Service -> Service) -> a -> Request a
forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides

retryStream :: Request a -> Retry.RetryPolicy
retryStream :: forall a. Request a -> RetryPolicy
retryStream Request {RequestBody
body :: RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body} =
  (RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
forall (m :: * -> *).
(RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
Retry.RetryPolicyM ((RetryStatus -> m (Maybe Int)) -> RetryPolicyM m)
-> (RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> Maybe Int -> m (Maybe Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> m (Maybe Int)) -> Maybe Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ if RequestBody -> Bool
isStreaming RequestBody
body then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0

retryService :: Service -> Retry.RetryPolicy
retryService :: Service -> RetryPolicy
retryService Service {$sel:retry:Service :: Service -> Retry
retry = Exponential {Double
Int
ServiceError -> Maybe Text
$sel:check:Exponential :: Retry -> ServiceError -> Maybe Text
base :: Double
growth :: Int
attempts :: Int
check :: ServiceError -> Maybe Text
$sel:base:Exponential :: Retry -> Double
$sel:growth:Exponential :: Retry -> Int
$sel:attempts:Exponential :: Retry -> Int
..}} =
  Int -> RetryPolicy
Retry.limitRetries Int
attempts 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 b. Integral b => Double -> b
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
base Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
growth 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))