{-# LANGUAGE ScopedTypeVariables #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

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