{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.Retry
( acceptDataRetryPolicy
, agentHostLookupRetryPolicy
, announceRetryPolicy
, retryRequest
, retryUntil
, retryUntilRight
) where
import Control.Monad.Catch (Handler)
import qualified Control.Retry as Retry
import Data.ByteString.Lazy (ByteString)
import Data.Semigroup ((<>))
import qualified Network.HTTP.Client as HTTP
agentHostLookupRetryPolicy :: Retry.RetryPolicyM IO
agentHostLookupRetryPolicy =
Retry.capDelay maxDelay $
Retry.fibonacciBackoff minDelay
where
minDelay = 1 * 1000 * 1000
maxDelay = 60 * 1000 * 1000
announceRetryPolicy :: Retry.RetryPolicyM IO
announceRetryPolicy =
(Retry.constantDelay delay) <> (Retry.limitRetries retries)
where
delay = 200 * 1000
retries = 3
acceptDataRetryPolicy :: Retry.RetryPolicyM IO
acceptDataRetryPolicy =
(Retry.constantDelay delay) <> (Retry.limitRetries retries)
where
delay = 10 * 1000 * 1000
retries = 10
retryRequest ::
Retry.RetryPolicyM IO
-> (HTTP.Response ByteString -> IO a)
-> IO (HTTP.Response ByteString)
-> IO a
retryRequest retryPolicy decoder request =
let
reportHttpError :: Bool -> HTTP.HttpException -> Retry.RetryStatus -> IO ()
reportHttpError _ _ _ =
return ()
retryOnAnyHttpError :: HTTP.HttpException -> IO Bool
retryOnAnyHttpError _ = return True
retryOnAnyStatus :: Retry.RetryStatus -> Handler IO Bool
retryOnAnyStatus = Retry.logRetries retryOnAnyHttpError reportHttpError
executeRequestAndParseResponse = do
response <- request
decoded <- decoder response
return decoded
in
Retry.recovering
retryPolicy
[retryOnAnyStatus]
(const executeRequestAndParseResponse)
retryUntilRight ::
forall a.
Show a =>
Retry.RetryPolicyM IO
-> IO (Either String a)
-> IO (Either String a)
retryUntilRight retryPolicy action =
retryUntil retryPolicy (\_ -> True) action
retryUntil ::
forall a.
Show a =>
Retry.RetryPolicyM IO
-> (a -> Bool)
-> IO (Either String a)
-> IO (Either String a)
retryUntil retryPolicy retryCheck action = do
let
check :: Retry.RetryStatus -> Either String a -> IO Bool
check _ result = do
case result of
Left _ ->
return True
Right value ->
return $ not $ retryCheck value
lastResult <- Retry.retrying
retryPolicy
check
(const action)
case lastResult of
Left _ ->
return lastResult
Right lastValue ->
if retryCheck lastValue
then
return lastResult
else
return $
Left $
"The retried action has not yielded the expected result " ++
"but: " ++ show lastValue