{-# LANGUAGE BangPatterns #-}
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."
]
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
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
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
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