-- |
-- 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 qualified Network.HTTP.Conduit as Client.Conduit

retryRequest ::
  forall m a withAuth.
  ( MonadResource m,
    AWSRequest a,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  a ->
  m (Either Error (ClientResponse (AWSResponse a)))
retryRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth
-> a -> m (Either Error (ClientResponse (AWSResponse a)))
retryRequest env :: Env' withAuth
env@Env {Hooks
hooks :: Hooks
hooks :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks} a
rq = do
  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 => Hook a
Hooks.request Hooks
hooks Env' withAuth
env a
rq
  cfgRq <- configureRequest env rq'

  let 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
cfgRq
      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
        { service = Service {retry = Exponential {check = serviceRetryCheck}}
        } = cfgRq

      shouldRetry :: Retry.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 => 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 => 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) -> Getter HttpException Bool
forall s a. (s -> a) -> Getter 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) -> Getter ServiceError (Maybe Text)
forall s a. (s -> a) -> Getter s a
to ServiceError -> Maybe Text
serviceRetryCheck ((Maybe Text -> Const (First Text) (Maybe Text))
 -> ServiceError -> Const (First Text) ServiceError)
-> ((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 a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just

  Retry.retrying policy shouldRetry attempt >>= \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 => 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,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Wait a ->
  a ->
  m (Either Error Accept)
awaitRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth -> Wait a -> a -> m (Either Error Accept)
awaitRequest env :: Env' withAuth
env@Env {Hooks
hooks :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks} Wait a
w a
rq = do
  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 => Hook a
Hooks.request Hooks
hooks Env' withAuth
env a
rq
  cfgRq <- configureRequest env rq'
  w'@Wait {..} <- liftIO $ Hooks.wait hooks env w

  let 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
_ = 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, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest Env' withAuth
env Request a
cfgRq
      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
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 =>
   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

  Retry.retrying policy check attempt >>= \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 => 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,
    Foldable withAuth
  ) =>
  Env' withAuth ->
  Request a ->
  m (Either Error (ClientResponse (AWSResponse a)))
httpRequest :: forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth
-> Request a -> m (Either Error (ClientResponse (AWSResponse a)))
httpRequest env :: Env' withAuth
env@Env {Hooks
hooks :: forall (withAuth :: * -> *). Env' withAuth -> Hooks
hooks :: Hooks
hooks, Manager
manager :: Manager
manager :: forall (withAuth :: * -> *). Env' withAuth -> Manager
manager, Region
region :: Region
region :: 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
      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

      clientRq :: ClientRequest <-
        liftIO . Hooks.clientRequest hooks env =<< case authMaybe 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 => 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

      rs <- Client.Conduit.http clientRq manager
      liftIO $ Hooks.clientResponse hooks env (cfgRq, void rs)
      parsedRs <-
        response
          (Hooks.rawResponseBody hooks env)
          (service cfgRq)
          (proxy cfgRq)
          rs
      traverse_ (liftIO . Hooks.response hooks env . (cfgRq,)) parsedRs
      pure 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 => 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, MonadIO m) => Env' withAuth -> a -> m (Request a)
configureRequest :: forall a (m :: * -> *) (withAuth :: * -> *).
(AWSRequest a, MonadIO m) =>
Env' withAuth -> a -> m (Request a)
configureRequest env :: Env' withAuth
env@Env {Service -> Service
overrides :: Service -> Service
overrides :: forall (withAuth :: * -> *). Env' withAuth -> Service -> Service
overrides, Hooks
hooks :: 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 => 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
body :: 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 {retry :: Service -> Retry
retry = Exponential {Double
Int
ServiceError -> Maybe Text
check :: Retry -> ServiceError -> Maybe Text
base :: Double
growth :: Int
attempts :: Int
check :: ServiceError -> Maybe Text
attempts :: Retry -> Int
growth :: Retry -> Int
base :: Retry -> Double
..}} =
  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))