{-# 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 qualified Network.HTTP.Client as HTTP
agentHostLookupRetryPolicy :: Retry.RetryPolicyM IO
agentHostLookupRetryPolicy :: RetryPolicyM IO
agentHostLookupRetryPolicy =
Int -> RetryPolicyM IO -> RetryPolicyM IO
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
Retry.capDelay Int
maxDelay (RetryPolicyM IO -> RetryPolicyM IO)
-> RetryPolicyM IO -> RetryPolicyM IO
forall a b. (a -> b) -> a -> b
$
Int -> RetryPolicy
Retry.fibonacciBackoff Int
minDelay
where
minDelay :: Int
minDelay = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
maxDelay :: Int
maxDelay = 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
announceRetryPolicy :: Retry.RetryPolicyM IO
announceRetryPolicy :: RetryPolicyM IO
announceRetryPolicy =
(Int -> RetryPolicy
Retry.constantDelay Int
delay) RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> (Int -> RetryPolicy
Retry.limitRetries Int
retries)
where
delay :: Int
delay = 200 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
retries :: Int
retries = 3
acceptDataRetryPolicy :: Retry.RetryPolicyM IO
acceptDataRetryPolicy :: RetryPolicyM IO
acceptDataRetryPolicy =
(Int -> RetryPolicy
Retry.constantDelay Int
delay) RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> (Int -> RetryPolicy
Retry.limitRetries Int
retries)
where
delay :: Int
delay = 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000
retries :: Int
retries = 10
retryRequest ::
Retry.RetryPolicyM IO
-> (HTTP.Response ByteString -> IO a)
-> IO (HTTP.Response ByteString)
-> IO a
retryRequest :: RetryPolicyM IO
-> (Response ByteString -> IO a)
-> IO (Response ByteString)
-> IO a
retryRequest retryPolicy :: RetryPolicyM IO
retryPolicy decoder :: Response ByteString -> IO a
decoder request :: IO (Response ByteString)
request =
let
reportHttpError :: Bool -> HTTP.HttpException -> Retry.RetryStatus -> IO ()
reportHttpError :: Bool -> HttpException -> RetryStatus -> IO ()
reportHttpError _ _ _ =
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
retryOnAnyHttpError :: HTTP.HttpException -> IO Bool
retryOnAnyHttpError :: HttpException -> IO Bool
retryOnAnyHttpError _ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
retryOnAnyStatus :: Retry.RetryStatus -> Handler IO Bool
retryOnAnyStatus :: RetryStatus -> Handler IO Bool
retryOnAnyStatus = (HttpException -> IO Bool)
-> (Bool -> HttpException -> RetryStatus -> IO ())
-> RetryStatus
-> Handler IO Bool
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> m Bool)
-> (Bool -> e -> RetryStatus -> m ())
-> RetryStatus
-> Handler m Bool
Retry.logRetries HttpException -> IO Bool
retryOnAnyHttpError Bool -> HttpException -> RetryStatus -> IO ()
reportHttpError
executeRequestAndParseResponse :: IO a
executeRequestAndParseResponse = do
Response ByteString
response <- IO (Response ByteString)
request
a
decoded <- Response ByteString -> IO a
decoder Response ByteString
response
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
decoded
in
RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO a)
-> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
Retry.recovering
RetryPolicyM IO
retryPolicy
[RetryStatus -> Handler IO Bool
retryOnAnyStatus]
(IO a -> RetryStatus -> IO a
forall a b. a -> b -> a
const IO a
executeRequestAndParseResponse)
retryUntilRight ::
forall a.
Show a =>
Retry.RetryPolicyM IO
-> IO (Either String a)
-> IO (Either String a)
retryUntilRight :: RetryPolicyM IO -> IO (Either String a) -> IO (Either String a)
retryUntilRight retryPolicy :: RetryPolicyM IO
retryPolicy action :: IO (Either String a)
action =
RetryPolicyM IO
-> (a -> Bool) -> IO (Either String a) -> IO (Either String a)
forall a.
Show a =>
RetryPolicyM IO
-> (a -> Bool) -> IO (Either String a) -> IO (Either String a)
retryUntil RetryPolicyM IO
retryPolicy (\_ -> Bool
True) IO (Either String a)
action
retryUntil ::
forall a.
Show a =>
Retry.RetryPolicyM IO
-> (a -> Bool)
-> IO (Either String a)
-> IO (Either String a)
retryUntil :: RetryPolicyM IO
-> (a -> Bool) -> IO (Either String a) -> IO (Either String a)
retryUntil retryPolicy :: RetryPolicyM IO
retryPolicy retryCheck :: a -> Bool
retryCheck action :: IO (Either String a)
action = do
let
check :: Retry.RetryStatus -> Either String a -> IO Bool
check :: RetryStatus -> Either String a -> IO Bool
check _ result :: Either String a
result = do
case Either String a
result of
Left _ ->
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Right value :: a
value ->
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
retryCheck a
value
Either String a
lastResult <- RetryPolicyM IO
-> (RetryStatus -> Either String a -> IO Bool)
-> (RetryStatus -> IO (Either String a))
-> IO (Either String a)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying
RetryPolicyM IO
retryPolicy
RetryStatus -> Either String a -> IO Bool
check
(IO (Either String a) -> RetryStatus -> IO (Either String a)
forall a b. a -> b -> a
const IO (Either String a)
action)
case Either String a
lastResult of
Left _ ->
Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String a
lastResult
Right lastValue :: a
lastValue ->
if a -> Bool
retryCheck a
lastValue
then
Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String a
lastResult
else
Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$
String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
"The retried action has not yielded the expected result " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"but: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
lastValue