Retry requests on error about aws HOT 1 OPEN

-------------------------------------------------------------------------------
runAws
    :: (Transaction r b, MonadIO n,
        MonadReader AppEnv n, MonadCatch n)
    => ServiceConfiguration r NormalQuery
    -> Int
    -- ^ Number of retries
    -> r
    -- ^ Request
    -> ResourceT n b
runAws servConf n r = do
    mgr <- view appManager
    conf <- view appAwsConfig
    recovering (awsPolicy n) [kinesisH echo, httpRetryH, networkRetryH] $
      hoist liftIO $
      pureAws conf servConf mgr r

-------------------------------------------------------------------------------
kinesisH
    :: MonadIO m
    => (String -> m ())
    -- ^ How to (and whether to) report errors
    -> Int
    -- ^ Retry number
    -> Handler m Bool
kinesisH report n = handleLog chk report n
  where
    chk e = return $ case e of
        KinesisErrorResponse cd _msg -> case cd of
            "ProvisionedThroughputExceededException" -> True
            _ -> False
        KinesisOtherError stat _ -> case stat of
            Status _ "Internal Server Error" -> True
            Status _ "Service Unavailable" -> True
            _ -> False
        _ -> False


-------------------------------------------------------------------------------
awsPolicy :: Int -> RetryPolicy
awsPolicy n = capDelay 60000000 $
              mempty <> limitRetries n <> exponentialBackoff 25000



-------------------------------------------------------------------------------
-- | Which exceptions should we retry?
httpRetryH :: MonadIO m => Int -> Handler m Bool
httpRetryH n = handleLog (return . httpRetry) echo n


-------------------------------------------------------------------------------
-- | Should given exception be retried?
httpRetry :: HttpException -> Bool
httpRetry e =
    case e of
      TooManyRetries{} -> True
      ResponseTimeout{} -> True
      FailedConnectionException{} -> True
      FailedConnectionException2{} -> True
      InternalIOException{} -> True
      ProxyConnectException{} -> True
      StatusCodeException{} -> True
      NoResponseDataReceived{} -> True
      ResponseBodyTooShort{} -> True
      InvalidChunkHeaders{} -> True
      IncompleteHeaders{} -> True
      TlsException{} -> True
      _ -> False


-------------------------------------------------------------------------------
-- | 'IOException's should be retried
networkRetryH :: MonadIO m => Int -> Handler m Bool
networkRetryH n = handleLog chk echo n
    where
      chk (_ :: IOException) = return True


-------------------------------------------------------------------------------
-- | Handle exception while logging it.
handleLog
    :: (Monad m, Show e, Exception e)
    => (e -> m Bool)
    -- ^ Test for whether action is to be retried
    -> (String -> m ())
    -- ^ How ot report the generated warning message.
    -> Int
    -- ^ Retry number
    -> Handler m Bool
handleLog f report n = Handler $ \ e -> do
    res <- f e
    let msg = "[retry:" <> show n <> "] Encountered " <> show e <> ". " <>
              if res then "Retrying." else "Crashing."
    report msg
    return res