{-# LANGUAGE ScopedTypeVariables #-}
module Bilge.Retry where
import Bilge.RPC (RPCException (..))
import Control.Monad.Catch
import Imports
import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), responseStatus)
import Network.HTTP.Types
httpHandlers :: (Monad m) => [a -> Handler m Bool]
httpHandlers :: forall (m :: * -> *) a. Monad m => [a -> Handler m Bool]
httpHandlers = [Handler m Bool -> a -> Handler m Bool
forall a b. a -> b -> a
const (Handler m Bool -> a -> Handler m Bool)
-> ((HttpException -> m Bool) -> Handler m Bool)
-> (HttpException -> m Bool)
-> a
-> Handler m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpException -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((HttpException -> m Bool) -> a -> Handler m Bool)
-> (HttpException -> m Bool) -> a -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool)
-> (HttpException -> Bool) -> HttpException -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Bool
canRetry]
rpcHandlers :: (Monad m) => [a -> Handler m Bool]
rpcHandlers :: forall (m :: * -> *) a. Monad m => [a -> Handler m Bool]
rpcHandlers =
[ Handler m Bool -> a -> Handler m Bool
forall a b. a -> b -> a
const (Handler m Bool -> a -> Handler m Bool)
-> ((RPCException -> m Bool) -> Handler m Bool)
-> (RPCException -> m Bool)
-> a
-> Handler m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPCException -> m Bool) -> Handler m Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((RPCException -> m Bool) -> a -> Handler m Bool)
-> (RPCException -> m Bool) -> a -> Handler m Bool
forall a b. (a -> b) -> a -> b
$ \(RPCException LText
_ Request
_ SomeException
cause) ->
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
$ Bool -> (HttpException -> Bool) -> Maybe HttpException -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False HttpException -> Bool
canRetry (SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
cause)
]
canRetry :: HttpException -> Bool
canRetry :: HttpException -> Bool
canRetry (HttpExceptionRequest Request
_ HttpExceptionContent
ResponseTimeout) = Bool
True
canRetry (HttpExceptionRequest Request
_ HttpExceptionContent
ConnectionClosed) = Bool
True
canRetry (HttpExceptionRequest Request
_ ConnectionFailure {}) = Bool
True
canRetry (HttpExceptionRequest Request
_ InternalException {}) = Bool
True
canRetry (HttpExceptionRequest Request
_ ProxyConnectException {}) = Bool
True
canRetry (HttpExceptionRequest Request
_ (StatusCodeException Response ()
rs ByteString
_)) = Status -> Bool
statusIsServerError (Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
rs)
canRetry HttpException
_ = Bool
False