{-# LANGUAGE AllowAmbiguousTypes #-}

-- |
-- Module      : Amazonka.Env.Hooks
-- Copyright   : (c) 2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : highly experimental
-- Portability : non-portable (GHC extensions)
--
-- Hooks carried within an 'Env', allowing ad-hoc injection of
-- different behaviour during Amazonka's request/response cycle.
-- Hooks are currently experimental, but Amazonka uses the 'Hooks' API
-- to implement its default logging, and you can add your own
-- behaviour here as well. Some examples of things hooks can do:
--
-- * Log all requests Amazonka makes to a separate log, in order to
--   audit which IAM permissions your program actually needs
--   (see 'requestHook');
--
--   @
--   {-# LANGAUGE OverloadedLabels #-}
--   import Amazonka
--   import Amazonka.Env.Hooks
--   import Data.Generics.Labels ()
--
--   main :: IO ()
--   main = do
--     env <- newEnv discover
--       \<&\> #hooks %~ 'requestHook' ('addAWSRequestHook' $ \\_env req -> req <$ logRequest req)
--     ...
--
--   logRequest :: AWSRequest a => a -> IO ()
--   logRequest = ...
--   @
--
-- * Inject a [Trace ID for AWS X-Ray](https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader),
--   into each request before it is signed and sent
--   (see 'configuredRequestHook'); and
--
--   @
--   {-# LANGAUGE OverloadedLabels #-}
--   import Amazonka
--   import Amazonka.Env.Hooks
--   import Data.Generics.Labels ()
--
--   main :: IO ()
--   main = do
--     env <- newEnv discover
--       \<&\> #hooks %~ 'configuredRequestHook' ('addHook' $ \\_env req -> req & #headers %~ addXRayIdHeader)
--     ...
--
--   -- The actual header would normally come from whatever calls into your program,
--   -- or you would randomly generate one yourself (hooks run in 'IO').
--   addXRayIdHeader :: ['Network.HTTP.Types.Header'] -> ['Network.HTTP.Types.Header']
--   addXRayIdHeader = ...
--   @
--
-- * Selectively silence certain expected errors, such as DynamoDB's
--   @ConditionalCheckFailedException@ ('errorHook' and 'silenceError')
--
--   @
--   {-# LANGAUGE OverloadedLabels #-}
--   import Amazonka
--   import Amazonka.Env.Hooks
--   import qualified Amazonka.DynamoDB as DynamoDB
--   import Data.Generics.Labels ()
--
--   main :: IO ()
--   main = do
--     env <- newEnv discover
--     putItemResponse <- runResourceT $
--       send
--         (env & #hooks %~ 'errorHook' ('silenceError' DynamoDB._ConditionalCheckFailedException))
--         (DynamoDB.newPutItem ...)
--     ...
--   @
--
-- Most functions with names ending in @Hook@ ('requestHook', etc.)
-- are intended for use with lenses: partially apply them to get a
-- function @'Hook' a -> 'Hook' a@ that can go on the RHS of @(%~)@
-- (the lens modify function). You then use functions like
-- 'addHookFor' to selectively extend the hooks used at any particular
-- time.
--
-- Names ending in @_@ ('Hook_', 'addHookFor_', etc.) concern hooks
-- that return @()@ instead of the hook's input type. These hooks
-- respond to some event but lack the ability to change Amazonka's
-- behaviour; either because it is unsafe to do so, or because it is
-- difficult to do anything meaningful with the updated value.
--
-- The request/response flow for a standard 'Amazonka.send' looks like
-- this:
--
-- @
--     send (req :: 'AWSRequest' a => a)
--                  |
--                  V
--         Run Hook: request
--                  |
--                  V
-- Amazonka: configure req into "Request a"
--  (Amazonka-specific HTTP request type)
--                  |
--                  V
--     Run Hook: configuredRequest
--                  |
--                  V
-- Amazonka: sign request, turn into standard
--     Network.HTTP.Client.'Network.HTTP.Client.Request'
--                  |
--                  +-<---------------------------------.
--                  V                                   |
--     Run Hook: signedRequest                          |
--                  |                                   |
--                  V                                   |
--     Run Hook: clientRequest                          |
--                  |                                   |
--                  V                                   |
--     Amazonka: send request to AWS           Run Hook: requestRetry
--                  |                                   ^
--                  V                                   |
--     Run Hook: clientResponse                         |
--                  |                                   |
--                  V                                   |
--     Run Hook: rawResponseBody                        |
--                  |                                   |
--                  V                                   |
--     Amazonka: was error? ------------------.         |
--                  |            Yes          |         |
--                  |                         V         |
--                  | No               Run Hook: error  |
--                  |                    ('NotFinal')     |
--                  |                         |         |
--                  +-<-----------------------\'         |
--                  V                                   |
--     Amazonka: should retry? -------------------------\'
--                  |            Yes
--                  | No
--                  V
--     Amazonka: was error? ------------------.
--                  |            Yes          |
--                  |                         V
--                  | No                      |
--                  |                         |
--     Run Hook: response              Run Hook: error
--                  |                     ('Final')
--                  |                         |
--                  V                         |
--     Amazonka: parse response               |
--                  |                         |
--                  +-<-----------------------\'
--                  V
--     Amazonka: return result
-- @
module Amazonka.Env.Hooks
  ( Hook,
    Hook_,
    Hooks (..),
    Finality (..),

    -- * Updating members of 'Hooks'
    requestHook,
    waitHook,
    configuredRequestHook,
    signedRequestHook,
    clientRequestHook,
    clientResponseHook,
    rawResponseBodyHook,
    requestRetryHook,
    awaitRetryHook,
    responseHook,
    errorHook,

    -- * Functions to use with the ones above
    noHook,
    noHook_,
    addHook,
    addHook_,
    addAWSRequestHook,
    addAWSRequestHook_,
    addHookFor,
    addHookFor_,
    removeHooksFor,
    removeHooksFor_,

    -- ** Specialty combinators
    silenceError,

    -- * Building 'Hooks'
    addLoggingHooks,
    noHooks,
  )
where

import {-# SOURCE #-} Amazonka.Env (Env' (..))
import Amazonka.Logger (build, logDebug, logError, logTrace)
import Amazonka.Prelude hiding (error)
import Amazonka.Types
  ( AWSRequest,
    AWSResponse,
    ClientRequest,
    ClientResponse,
    Error,
    Request,
    Signed (..),
  )
import Amazonka.Waiter (Accept, Wait (..))
import Control.Lens (Getting, has)
import qualified Control.Retry as Retry
import Data.List (intersperse)
import Data.Monoid (Any)
import Data.Typeable (Typeable, eqT, (:~:) (..))

-- | A hook that returns an updated version of its arguments.
type Hook a = forall withAuth. Env' withAuth -> a -> IO a

-- | A hook that cannot return an updated version of its argument.
type Hook_ a = forall withAuth. Env' withAuth -> a -> IO ()

-- | Indicates whether an error hook is potentially going to be
-- retried.
--
-- /See:/ 'error'
data Finality = NotFinal | Final
  deriving stock (Finality
forall a. a -> a -> Bounded a
maxBound :: Finality
$cmaxBound :: Finality
minBound :: Finality
$cminBound :: Finality
Bounded, Int -> Finality
Finality -> Int
Finality -> [Finality]
Finality -> Finality
Finality -> Finality -> [Finality]
Finality -> Finality -> Finality -> [Finality]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Finality -> Finality -> Finality -> [Finality]
$cenumFromThenTo :: Finality -> Finality -> Finality -> [Finality]
enumFromTo :: Finality -> Finality -> [Finality]
$cenumFromTo :: Finality -> Finality -> [Finality]
enumFromThen :: Finality -> Finality -> [Finality]
$cenumFromThen :: Finality -> Finality -> [Finality]
enumFrom :: Finality -> [Finality]
$cenumFrom :: Finality -> [Finality]
fromEnum :: Finality -> Int
$cfromEnum :: Finality -> Int
toEnum :: Int -> Finality
$ctoEnum :: Int -> Finality
pred :: Finality -> Finality
$cpred :: Finality -> Finality
succ :: Finality -> Finality
$csucc :: Finality -> Finality
Enum, Finality -> Finality -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finality -> Finality -> Bool
$c/= :: Finality -> Finality -> Bool
== :: Finality -> Finality -> Bool
$c== :: Finality -> Finality -> Bool
Eq, Eq Finality
Finality -> Finality -> Bool
Finality -> Finality -> Ordering
Finality -> Finality -> Finality
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Finality -> Finality -> Finality
$cmin :: Finality -> Finality -> Finality
max :: Finality -> Finality -> Finality
$cmax :: Finality -> Finality -> Finality
>= :: Finality -> Finality -> Bool
$c>= :: Finality -> Finality -> Bool
> :: Finality -> Finality -> Bool
$c> :: Finality -> Finality -> Bool
<= :: Finality -> Finality -> Bool
$c<= :: Finality -> Finality -> Bool
< :: Finality -> Finality -> Bool
$c< :: Finality -> Finality -> Bool
compare :: Finality -> Finality -> Ordering
$ccompare :: Finality -> Finality -> Ordering
Ord, Int -> Finality -> ShowS
[Finality] -> ShowS
Finality -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Finality] -> ShowS
$cshowList :: [Finality] -> ShowS
show :: Finality -> [Char]
$cshow :: Finality -> [Char]
showsPrec :: Int -> Finality -> ShowS
$cshowsPrec :: Int -> Finality -> ShowS
Show, forall x. Rep Finality x -> Finality
forall x. Finality -> Rep Finality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Finality x -> Finality
$cfrom :: forall x. Finality -> Rep Finality x
Generic)

data Hooks = Hooks
  { -- | Called at the start of request processing, before the request
    -- is configured. This is always the first hook that runs, and
    -- argument is usually a request record type like @amazonka-s3@'s
    -- @GetObjectRequest@.
    Hooks -> forall a. (AWSRequest a, Typeable a) => Hook a
request :: forall a. (AWSRequest a, Typeable a) => Hook a,
    -- | Called after the request has been configured into an abstract
    -- HTTP request, but before it is converted to a signed
    -- @Network.HTTP.Client.'Network.HTTP.Client.Request'@.
    --
    -- If you want to add additional headers (e.g., a
    -- [Trace ID for AWS X-Ray](https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader)),
    -- do it with this hook.
    Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest :: forall a. (AWSRequest a, Typeable a) => Hook (Request a),
    -- | Called at the start of waiter processing, just after the
    -- request is configured.
    Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait :: forall a. (AWSRequest a, Typeable a) => Hook (Wait a),
    -- | Called just after a request is signed, containing signature
    -- metadata and a
    -- @Network.HTTP.Client.'Network.HTTP.Client.Request'@.
    Hooks -> forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a),
    -- | Called on a
    -- @Network.HTTP.Client.'Network.HTTP.Client.Request'@, just
    -- before it is sent. While you can retrieve a 'ClientRequest'
    -- from the 'signedRequest' hook, this hook captures unsigned
    -- requests too.
    --
    -- Changing the contents of a signed request is highly likely to
    -- break its signature.
    Hooks -> Hook ClientRequest
clientRequest :: Hook ClientRequest,
    -- | Called on the raw
    -- @Network.HTTP.Client.'Network.HTTP.Client.Response'@, as soon
    -- as it comes back from the HTTP client. The body is replaced
    -- with @()@ to prevent its accidental consumption by hooks.
    Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse ())
clientResponse ::
      forall a.
      (AWSRequest a, Typeable a) =>
      Hook_ (Request a, ClientResponse ()),
    -- | Called on the raw response body, after it has been sunk from
    -- the @Network.HTTP.Client.'Network.HTTP.Client.Response'@.
    Hooks -> Hook ByteStringLazy
rawResponseBody :: Hook ByteStringLazy,
    -- | Called when Amazonka decides to retry a failed request. The
    -- 'Text' argument is an error code like @"http_error"@,
    -- @"request_throttled_exception"@. Check the retry check
    -- function for your particular 'Service', usually found somewhere
    -- like @Amazonka.S3.Types.defaultService@.
    Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Text, RetryStatus)
requestRetry ::
      forall a.
      (AWSRequest a, Typeable a) =>
      Hook_ (Request a, Text, Retry.RetryStatus),
    -- | Called when Amazonka decides to retry a request while
    -- resolving an 'Amazonka.await' operation.
    Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry ::
      forall a.
      (AWSRequest a, Typeable a) =>
      Hook_ (Request a, Wait a, Accept, Retry.RetryStatus),
    -- | Called when a response from AWS is successfully
    -- deserialised. Because the 'AWSResponse' type family is not
    -- injective, we include the original request.
    Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse (AWSResponse a))
response ::
      forall a.
      (AWSRequest a, Typeable a) =>
      Hook_ (Request a, ClientResponse (AWSResponse a)),
    -- | Called whenever an AWS request returns an 'Error', even when
    -- the corresponding request is retried.
    --
    -- On the final error after all retries, this hook will be called
    -- twice: once with @NotFinal@ and once with @Final@. This
    -- behavior may change in a future version.
    Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
error ::
      forall a.
      (AWSRequest a, Typeable a) =>
      Hook_ (Finality, Request a, Error)
  }

{-# INLINE requestHook #-}
requestHook ::
  (forall a. (AWSRequest a, Typeable a) => Hook a -> Hook a) ->
  Hooks ->
  Hooks
requestHook :: (forall a. (AWSRequest a, Typeable a) => Hook a -> Hook a)
-> Hooks -> Hooks
requestHook forall a. (AWSRequest a, Typeable a) => Hook a -> Hook a
f hooks :: Hooks
hooks@Hooks {forall a. (AWSRequest a, Typeable a) => Hook a
request :: forall a. (AWSRequest a, Typeable a) => Hook a
$sel:request:Hooks :: Hooks -> forall a. (AWSRequest a, Typeable a) => Hook a
request} =
  Hooks
hooks {$sel:request:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook a
request = forall a. (AWSRequest a, Typeable a) => Hook a -> Hook a
f forall a. (AWSRequest a, Typeable a) => Hook a
request}

{-# INLINE waitHook #-}
waitHook ::
  (forall a. (AWSRequest a, Typeable a) => Hook (Wait a) -> Hook (Wait a)) ->
  Hooks ->
  Hooks
waitHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook (Wait a) -> Hook (Wait a))
-> Hooks -> Hooks
waitHook forall a.
(AWSRequest a, Typeable a) =>
Hook (Wait a) -> Hook (Wait a)
f hooks :: Hooks
hooks@Hooks {forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait :: forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
$sel:wait:Hooks :: Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait} =
  Hooks
hooks {$sel:wait:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait = forall a.
(AWSRequest a, Typeable a) =>
Hook (Wait a) -> Hook (Wait a)
f forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait}

{-# INLINE configuredRequestHook #-}
configuredRequestHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook (Request a) ->
    Hook (Request a)
  ) ->
  Hooks ->
  Hooks
configuredRequestHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook (Request a) -> Hook (Request a))
-> Hooks -> Hooks
configuredRequestHook forall a.
(AWSRequest a, Typeable a) =>
Hook (Request a) -> Hook (Request a)
f hooks :: Hooks
hooks@Hooks {forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest :: forall a. (AWSRequest a, Typeable a) => Hook (Request a)
$sel:configuredRequest:Hooks :: Hooks -> forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest} =
  Hooks
hooks {$sel:configuredRequest:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest = forall a.
(AWSRequest a, Typeable a) =>
Hook (Request a) -> Hook (Request a)
f forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest}

{-# INLINE signedRequestHook #-}
signedRequestHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Signed a) ->
    Hook_ (Signed a)
  ) ->
  Hooks ->
  Hooks
signedRequestHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Signed a) -> Hook_ (Signed a))
-> Hooks -> Hooks
signedRequestHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Signed a) -> Hook_ (Signed a)
f hooks :: Hooks
hooks@Hooks {forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
$sel:signedRequest:Hooks :: Hooks -> forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest} =
  Hooks
hooks {$sel:signedRequest:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Signed a) -> Hook_ (Signed a)
f forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest}

{-# INLINE clientRequestHook #-}
clientRequestHook ::
  (Hook ClientRequest -> Hook ClientRequest) ->
  Hooks ->
  Hooks
clientRequestHook :: (Hook ClientRequest -> Hook ClientRequest) -> Hooks -> Hooks
clientRequestHook Hook ClientRequest -> Hook ClientRequest
f hooks :: Hooks
hooks@Hooks {Hook ClientRequest
clientRequest :: Hook ClientRequest
$sel:clientRequest:Hooks :: Hooks -> Hook ClientRequest
clientRequest} =
  Hooks
hooks {$sel:clientRequest:Hooks :: Hook ClientRequest
clientRequest = Hook ClientRequest -> Hook ClientRequest
f Hook ClientRequest
clientRequest}

{-# INLINE clientResponseHook #-}
clientResponseHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Request a, ClientResponse ()) ->
    Hook_ (Request a, ClientResponse ())
  ) ->
  Hooks ->
  Hooks
clientResponseHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Request a, ClientResponse ())
 -> Hook_ (Request a, ClientResponse ()))
-> Hooks -> Hooks
clientResponseHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
-> Hook_ (Request a, ClientResponse ())
f hooks :: Hooks
hooks@Hooks {forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
$sel:clientResponse:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse ())
clientResponse} =
  Hooks
hooks {$sel:clientResponse:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
-> Hook_ (Request a, ClientResponse ())
f forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse}

{-# INLINE rawResponseBodyHook #-}
rawResponseBodyHook ::
  (Hook ByteStringLazy -> Hook ByteStringLazy) ->
  Hooks ->
  Hooks
rawResponseBodyHook :: (Hook ByteStringLazy -> Hook ByteStringLazy) -> Hooks -> Hooks
rawResponseBodyHook Hook ByteStringLazy -> Hook ByteStringLazy
f hooks :: Hooks
hooks@Hooks {Hook ByteStringLazy
rawResponseBody :: Hook ByteStringLazy
$sel:rawResponseBody:Hooks :: Hooks -> Hook ByteStringLazy
rawResponseBody} =
  Hooks
hooks {$sel:rawResponseBody:Hooks :: Hook ByteStringLazy
rawResponseBody = Hook ByteStringLazy -> Hook ByteStringLazy
f Hook ByteStringLazy
rawResponseBody}

{-# INLINE requestRetryHook #-}
requestRetryHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Request a, Text, Retry.RetryStatus) ->
    Hook_ (Request a, Text, Retry.RetryStatus)
  ) ->
  Hooks ->
  Hooks
requestRetryHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Request a, Text, RetryStatus)
 -> Hook_ (Request a, Text, RetryStatus))
-> Hooks -> Hooks
requestRetryHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
-> Hook_ (Request a, Text, RetryStatus)
f hooks :: Hooks
hooks@Hooks {forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
$sel:requestRetry:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Text, RetryStatus)
requestRetry} =
  Hooks
hooks {$sel:requestRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
-> Hook_ (Request a, Text, RetryStatus)
f forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry}

{-# INLINE awaitRetryHook #-}
awaitRetryHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Request a, Wait a, Accept, Retry.RetryStatus) ->
    Hook_ (Request a, Wait a, Accept, Retry.RetryStatus)
  ) ->
  Hooks ->
  Hooks
awaitRetryHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Request a, Wait a, Accept, RetryStatus)
 -> Hook_ (Request a, Wait a, Accept, RetryStatus))
-> Hooks -> Hooks
awaitRetryHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
-> Hook_ (Request a, Wait a, Accept, RetryStatus)
f hooks :: Hooks
hooks@Hooks {forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
$sel:awaitRetry:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry} =
  Hooks
hooks {$sel:awaitRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
-> Hook_ (Request a, Wait a, Accept, RetryStatus)
f forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry}

{-# INLINE responseHook #-}
responseHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Request a, ClientResponse (AWSResponse a)) ->
    Hook_ (Request a, ClientResponse (AWSResponse a))
  ) ->
  Hooks ->
  Hooks
responseHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Request a, ClientResponse (AWSResponse a))
 -> Hook_ (Request a, ClientResponse (AWSResponse a)))
-> Hooks -> Hooks
responseHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
-> Hook_ (Request a, ClientResponse (AWSResponse a))
f hooks :: Hooks
hooks@Hooks {forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
response :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
$sel:response:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse (AWSResponse a))
response} =
  Hooks
hooks {$sel:response:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
response = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
-> Hook_ (Request a, ClientResponse (AWSResponse a))
f forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
response}

{-# INLINE errorHook #-}
errorHook ::
  ( forall a.
    (AWSRequest a, Typeable a) =>
    Hook_ (Finality, Request a, Error) ->
    Hook_ (Finality, Request a, Error)
  ) ->
  Hooks ->
  Hooks
errorHook :: (forall a.
 (AWSRequest a, Typeable a) =>
 Hook_ (Finality, Request a, Error)
 -> Hook_ (Finality, Request a, Error))
-> Hooks -> Hooks
errorHook forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
-> Hook_ (Finality, Request a, Error)
f hooks :: Hooks
hooks@Hooks {forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
$sel:error:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
error} =
  Hooks
hooks {$sel:error:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error = forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
-> Hook_ (Finality, Request a, Error)
f forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error}

-- | Turn a @'Hook' a@ into another @'Hook' a@ that does nothing.
--
-- -- Example: remove all request hooks:
-- @
-- requestHook noHook :: Hooks -> Hooks
-- @
noHook :: Hook a -> Hook a
noHook :: forall a. Hook a -> Hook a
noHook Hook a
_ Env' withAuth
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Turn a @'Hook_' a@ into another @'Hook_' a@ that does nothing.
--
-- @
-- -- Example: Remove all response hooks:
-- responseHook noHook_ :: Hooks -> Hooks
-- @
noHook_ :: Hook_ a -> Hook_ a
noHook_ :: forall a. Hook_ a -> Hook_ a
noHook_ Hook_ a
_ Env' withAuth
_ a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Unconditionally add a @'Hook' a@ to the chain of hooks. If you
-- need to do something with specific request types, you want
-- 'addHookFor', instead.
addHook :: Typeable a => Hook a -> Hook a -> Hook a
addHook :: forall a. Typeable a => Hook a -> Hook a -> Hook a
addHook Hook a
newHook Hook a
oldHook Env' withAuth
env = Hook a
oldHook Env' withAuth
env forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Hook a
newHook Env' withAuth
env

-- | Unconditionally add a @'Hook_' a@ to the chain of hooks. If you
-- need to do something with specific request types, you want
-- 'addHookFor_', instead.
addHook_ :: Typeable a => Hook_ a -> Hook_ a -> Hook_ a
addHook_ :: forall a. Typeable a => Hook_ a -> Hook_ a -> Hook_ a
addHook_ Hook_ a
newHook Hook_ a
oldHook Env' withAuth
env a
a = Hook_ a
oldHook Env' withAuth
env a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Hook_ a
newHook Env' withAuth
env a
a

-- | Like 'addHook', adds an unconditional hook, but it also captures
-- the @'AWSRequest' a@ constraint. Useful for handling every AWS
-- request type in a generic way.
addAWSRequestHook :: (AWSRequest a, Typeable a) => Hook a -> Hook a -> Hook a
addAWSRequestHook :: forall a. (AWSRequest a, Typeable a) => Hook a -> Hook a -> Hook a
addAWSRequestHook = forall a. Typeable a => Hook a -> Hook a -> Hook a
addHook

-- | 'addAWSRequestHook_' is 'addAWSRequestHook' but for 'Hook_'s.
addAWSRequestHook_ :: (AWSRequest a, Typeable a) => Hook_ a -> Hook_ a -> Hook_ a
addAWSRequestHook_ :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ a -> Hook_ a -> Hook_ a
addAWSRequestHook_ = forall a. Typeable a => Hook_ a -> Hook_ a -> Hook_ a
addHook_

-- | @addHookFor \@a newHook oldHook@ When @a@ and @b@ are the same
-- type, run the given 'Hook a' after all others, otherwise only run
-- the existing hooks.
--
-- @
-- -- Example: Run @getObjectRequestHook@ on anything that is a @GetObjectRequest@:
-- requestHook (addHookFor @GetObjectRequest getObjectRequestHook) :: Hooks -> Hooks
-- @
addHookFor ::
  forall a b. (Typeable a, Typeable b) => Hook a -> Hook b -> Hook b
addHookFor :: forall a b. (Typeable a, Typeable b) => Hook a -> Hook b -> Hook b
addHookFor Hook a
newHook Hook b
oldHook Env' withAuth
env =
  Hook b
oldHook Env' withAuth
env forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
    Just a :~: b
Refl -> Hook a
newHook Env' withAuth
env
    Maybe (a :~: b)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | When @a@ and @b@ are the same type, run the given 'Hook_ a' after
-- all other hooks have run.
--
-- @
-- -- Example: Run @aSignedRequestHook@ on anything that is a @Signed GetObjectRequest@:
-- requestHook (addHookFor_ @(Signed GetObjectRequest) aSignedRequestHook) :: Hooks -> Hooks
-- @
addHookFor_ ::
  forall a b. (Typeable a, Typeable b) => Hook_ a -> Hook_ b -> Hook_ b
addHookFor_ :: forall a b.
(Typeable a, Typeable b) =>
Hook_ a -> Hook_ b -> Hook_ b
addHookFor_ Hook_ a
newHook Hook_ b
oldHook Env' withAuth
env b
a = do
  Hook_ b
oldHook Env' withAuth
env b
a
  case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
    Just a :~: b
Refl -> Hook_ a
newHook Env' withAuth
env b
a
    Maybe (a :~: b)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | When @a@ and @b@ are the same type, do not call any more hooks.
--
-- @
-- -- Example: Prevent any request hooks from running against a @PutObjectRequest@:
-- requestHook (removeHooksFor @PutObjectRequest) :: Hooks -> Hooks
-- @
removeHooksFor :: forall a b. (Typeable a, Typeable b) => Hook b -> Hook b
removeHooksFor :: forall a b. (Typeable a, Typeable b) => Hook b -> Hook b
removeHooksFor Hook b
oldHook Env' withAuth
env = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
  Just a :~: b
Refl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Maybe (a :~: b)
Nothing -> Hook b
oldHook Env' withAuth
env

-- | When @a@ and @b@ are the same type, do not call any more hooks.
--
-- @
-- -- Example: Prevent any error hooks from running against errors caused by a @PutObjectRequest@:
-- errorHook (removeHooksFor @(Finality, Request PutObjectRequest, Error)) :: Hooks -> Hooks
-- @
removeHooksFor_ :: forall a b. (Typeable a, Typeable b) => Hook_ b -> Hook_ b
removeHooksFor_ :: forall a b. (Typeable a, Typeable b) => Hook_ b -> Hook_ b
removeHooksFor_ Hook_ b
oldHook Env' withAuth
env b
a = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
  Just a :~: b
Refl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Maybe (a :~: b)
Nothing -> Hook_ b
oldHook Env' withAuth
env b
a

-- | Run the wrapped hook unless the given 'Fold' or 'Traversal'
-- matches the error. You will probably want to use this with the
-- error matchers defined by each service binding, allowing you to
-- selectively silence specific errors:
--
-- @
-- -- Assuming `env :: Amazonka.Env` and `putRequest :: DynamoDB.PutRequest`,
-- -- this silences a single type of error for a single call:
-- send (env & #hooks %~ errorHook (silenceError DynamoDB._ConditionalCheckFailedException))
-- @
--
-- @
-- 'silenceError' :: Getter Error e     -> 'Hook_' ('Finality', Request a, Error) -> 'Hook_' ('Finality', Request a, Error)
-- 'silenceError' :: Fold Error e       -> 'Hook_' ('Finality', Request a, Error) -> 'Hook_' ('Finality', Request a, Error)
-- 'silenceError' :: Iso' Error e       -> 'Hook_' ('Finality', Request a, Error) -> 'Hook_' ('Finality', Request a, Error)
-- 'silenceError' :: Lens' Error e      -> 'Hook_' ('Finality', Request a, Error) -> 'Hook_' ('Finality', Request a, Error)
-- 'silenceError' :: Traversal' Error e -> 'Hook_' ('Finality', Request a, Error) -> 'Hook_' ('Finality', Request a, Error)
-- @
silenceError ::
  Getting Any Error e ->
  Hook_ (Finality, Request a, Error) ->
  Hook_ (Finality, Request a, Error)
silenceError :: forall e a.
Getting Any Error e
-> Hook_ (Finality, Request a, Error)
-> Hook_ (Finality, Request a, Error)
silenceError Getting Any Error e
g Hook_ (Finality, Request a, Error)
oldHook Env' withAuth
env t :: (Finality, Request a, Error)
t@(Finality
_, Request a
_, Error
err) =
  if forall s a. Getting Any s a -> s -> Bool
has Getting Any Error e
g Error
err then forall (f :: * -> *) a. Applicative f => a -> f a
pure () else Hook_ (Finality, Request a, Error)
oldHook Env' withAuth
env (Finality, Request a, Error)
t

-- | Add default logging hooks. The default 'Env'' from
-- 'Amazonka.Env.newEnv' already has logging hooks installed, so you
-- probably only want this if you are building your own 'Hooks' from
-- scratch.
addLoggingHooks :: Hooks -> Hooks
addLoggingHooks :: Hooks -> Hooks
addLoggingHooks
  hooks :: Hooks
hooks@Hooks
    { forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
$sel:signedRequest:Hooks :: Hooks -> forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest,
      Hook ClientRequest
clientRequest :: Hook ClientRequest
$sel:clientRequest:Hooks :: Hooks -> Hook ClientRequest
clientRequest,
      forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
$sel:clientResponse:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, ClientResponse ())
clientResponse,
      Hook ByteStringLazy
rawResponseBody :: Hook ByteStringLazy
$sel:rawResponseBody:Hooks :: Hooks -> Hook ByteStringLazy
rawResponseBody,
      forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
$sel:requestRetry:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Text, RetryStatus)
requestRetry,
      forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
$sel:awaitRetry:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry,
      forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
$sel:error:Hooks :: Hooks
-> forall a.
   (AWSRequest a, Typeable a) =>
   Hook_ (Finality, Request a, Error)
error
    } =
    Hooks
hooks
      { $sel:signedRequest:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest = \env :: Env' withAuth
env@Env {Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger :: Logger
logger} s :: Signed a
s@Signed {Meta
$sel:signedMeta:Signed :: forall a. Signed a -> Meta
signedMeta :: Meta
signedMeta} -> do
          forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest Env' withAuth
env Signed a
s
          forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logTrace Logger
logger Meta
signedMeta,
        $sel:clientRequest:Hooks :: Hook ClientRequest
clientRequest = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} ClientRequest
rq -> do
          ClientRequest
rq' <- Hook ClientRequest
clientRequest Env' withAuth
env ClientRequest
rq
          ClientRequest
rq' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
logger ClientRequest
rq',
        $sel:clientResponse:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} t :: (Request a, ClientResponse ())
t@(Request a
_, ClientResponse ()
rs) -> do
          forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse Env' withAuth
env (Request a, ClientResponse ())
t
          forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
logger ClientResponse ()
rs,
        $sel:rawResponseBody:Hooks :: Hook ByteStringLazy
rawResponseBody = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} ByteStringLazy
body -> do
          ByteStringLazy
body' <- Hook ByteStringLazy
rawResponseBody Env' withAuth
env ByteStringLazy
body
          ByteStringLazy
body' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logTrace Logger
logger (ByteStringLazy
"[Raw Response Body] {\n" forall a. Semigroup a => a -> a -> a
<> ByteStringLazy
body' forall a. Semigroup a => a -> a -> a
<> ByteStringLazy
"\n}"),
        $sel:requestRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} t :: (Request a, Text, RetryStatus)
t@(Request a
_, Text
name, RetryStatus
retryStatus) -> do
          forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry Env' withAuth
env (Request a, Text, RetryStatus)
t
          forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
logger forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteStringBuilder] -> ByteStringBuilder
munwords forall a b. (a -> b) -> a -> b
$
            [ ByteStringBuilder
"[Retry " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Text
name forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"]",
              ByteStringBuilder
"after",
              forall a. ToLog a => a -> ByteStringBuilder
build (RetryStatus -> Int
Retry.rsIterNumber RetryStatus
retryStatus forall a. Num a => a -> a -> a
+ Int
1),
              ByteStringBuilder
"attempt(s)."
            ],
        $sel:awaitRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} t :: (Request a, Wait a, Accept, RetryStatus)
t@(Request a
_, Wait {ByteString
$sel:name:Wait :: forall a. Wait a -> ByteString
name :: ByteString
name}, Accept
accept, RetryStatus
retryStatus) -> do
          forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry Env' withAuth
env (Request a, Wait a, Accept, RetryStatus)
t
          forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
logger forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteStringBuilder] -> ByteStringBuilder
munwords forall a b. (a -> b) -> a -> b
$
            [ ByteStringBuilder
"[Await " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build ByteString
name forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"]",
              forall a. ToLog a => a -> ByteStringBuilder
build Accept
accept,
              ByteStringBuilder
"after",
              forall a. ToLog a => a -> ByteStringBuilder
build (RetryStatus -> Int
Retry.rsIterNumber RetryStatus
retryStatus forall a. Num a => a -> a -> a
+ Int
1),
              ByteStringBuilder
"attempts."
            ],
        $sel:error:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error = \env :: Env' withAuth
env@Env {Logger
logger :: Logger
$sel:logger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
logger} t :: (Finality, Request a, Error)
t@(Finality
finality, Request a
_, Error
err) -> do
          forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error Env' withAuth
env (Finality, Request a, Error)
t
          case Finality
finality of
            Finality
NotFinal -> forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logDebug Logger
logger Error
err
            Finality
Final -> forall (m :: * -> *) a. (MonadIO m, ToLog a) => Logger -> a -> m ()
logError Logger
logger Error
err
      }
    where
      munwords :: [ByteStringBuilder] -> ByteStringBuilder
munwords = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse ByteStringBuilder
" "

-- | Empty 'Hooks' structure which returns everything unmodified.
noHooks :: Hooks
noHooks :: Hooks
noHooks =
  Hooks
    { $sel:request:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook a
request = forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      $sel:configuredRequest:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook (Request a)
configuredRequest = forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      $sel:wait:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook (Wait a)
wait = forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      $sel:signedRequest:Hooks :: forall a. (AWSRequest a, Typeable a) => Hook_ (Signed a)
signedRequest = \Env' withAuth
_ Signed a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:clientRequest:Hooks :: Hook ClientRequest
clientRequest = forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      $sel:clientResponse:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse ())
clientResponse = \Env' withAuth
_ (Request a, ClientResponse ())
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:rawResponseBody:Hooks :: Hook ByteStringLazy
rawResponseBody = forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure,
      $sel:requestRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Text, RetryStatus)
requestRetry = \Env' withAuth
_ (Request a, Text, RetryStatus)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:awaitRetry:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, Wait a, Accept, RetryStatus)
awaitRetry = \Env' withAuth
_ (Request a, Wait a, Accept, RetryStatus)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:response:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Request a, ClientResponse (AWSResponse a))
response = \Env' withAuth
_ (Request a, ClientResponse (AWSResponse a))
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:error:Hooks :: forall a.
(AWSRequest a, Typeable a) =>
Hook_ (Finality, Request a, Error)
error = \Env' withAuth
_ (Finality, Request a, Error)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }