{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppMesh.Types.GrpcRetryPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AppMesh.Types.GrpcRetryPolicy where

import Amazonka.AppMesh.Types.Duration
import Amazonka.AppMesh.Types.GrpcRetryPolicyEvent
import Amazonka.AppMesh.Types.TcpRetryPolicyEvent
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | An object that represents a retry policy. Specify at least one value for
-- at least one of the types of @RetryEvents@, a value for @maxRetries@,
-- and a value for @perRetryTimeout@. Both @server-error@ and
-- @gateway-error@ under @httpRetryEvents@ include the Envoy @reset@
-- policy. For more information on the @reset@ policy, see the
-- <https://www.envoyproxy.io/docs/envoy/latest/configuration/http/http_filters/router_filter#x-envoy-retry-on Envoy documentation>.
--
-- /See:/ 'newGrpcRetryPolicy' smart constructor.
data GrpcRetryPolicy = GrpcRetryPolicy'
  { -- | Specify at least one of the valid values.
    GrpcRetryPolicy -> Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents :: Prelude.Maybe (Prelude.NonEmpty GrpcRetryPolicyEvent),
    -- | Specify at least one of the following values.
    --
    -- -   __server-error__ – HTTP status codes 500, 501, 502, 503, 504, 505,
    --     506, 507, 508, 510, and 511
    --
    -- -   __gateway-error__ – HTTP status codes 502, 503, and 504
    --
    -- -   __client-error__ – HTTP status code 409
    --
    -- -   __stream-error__ – Retry on refused stream
    GrpcRetryPolicy -> Maybe (NonEmpty Text)
httpRetryEvents :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Specify a valid value. The event occurs before any processing of a
    -- request has started and is encountered when the upstream is temporarily
    -- or permanently unavailable.
    GrpcRetryPolicy -> Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents :: Prelude.Maybe (Prelude.NonEmpty TcpRetryPolicyEvent),
    -- | The maximum number of retry attempts.
    GrpcRetryPolicy -> Natural
maxRetries :: Prelude.Natural,
    -- | The timeout for each retry attempt.
    GrpcRetryPolicy -> Duration
perRetryTimeout :: Duration
  }
  deriving (GrpcRetryPolicy -> GrpcRetryPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrpcRetryPolicy -> GrpcRetryPolicy -> Bool
$c/= :: GrpcRetryPolicy -> GrpcRetryPolicy -> Bool
== :: GrpcRetryPolicy -> GrpcRetryPolicy -> Bool
$c== :: GrpcRetryPolicy -> GrpcRetryPolicy -> Bool
Prelude.Eq, ReadPrec [GrpcRetryPolicy]
ReadPrec GrpcRetryPolicy
Int -> ReadS GrpcRetryPolicy
ReadS [GrpcRetryPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GrpcRetryPolicy]
$creadListPrec :: ReadPrec [GrpcRetryPolicy]
readPrec :: ReadPrec GrpcRetryPolicy
$creadPrec :: ReadPrec GrpcRetryPolicy
readList :: ReadS [GrpcRetryPolicy]
$creadList :: ReadS [GrpcRetryPolicy]
readsPrec :: Int -> ReadS GrpcRetryPolicy
$creadsPrec :: Int -> ReadS GrpcRetryPolicy
Prelude.Read, Int -> GrpcRetryPolicy -> ShowS
[GrpcRetryPolicy] -> ShowS
GrpcRetryPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrpcRetryPolicy] -> ShowS
$cshowList :: [GrpcRetryPolicy] -> ShowS
show :: GrpcRetryPolicy -> String
$cshow :: GrpcRetryPolicy -> String
showsPrec :: Int -> GrpcRetryPolicy -> ShowS
$cshowsPrec :: Int -> GrpcRetryPolicy -> ShowS
Prelude.Show, forall x. Rep GrpcRetryPolicy x -> GrpcRetryPolicy
forall x. GrpcRetryPolicy -> Rep GrpcRetryPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrpcRetryPolicy x -> GrpcRetryPolicy
$cfrom :: forall x. GrpcRetryPolicy -> Rep GrpcRetryPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GrpcRetryPolicy' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'grpcRetryEvents', 'grpcRetryPolicy_grpcRetryEvents' - Specify at least one of the valid values.
--
-- 'httpRetryEvents', 'grpcRetryPolicy_httpRetryEvents' - Specify at least one of the following values.
--
-- -   __server-error__ – HTTP status codes 500, 501, 502, 503, 504, 505,
--     506, 507, 508, 510, and 511
--
-- -   __gateway-error__ – HTTP status codes 502, 503, and 504
--
-- -   __client-error__ – HTTP status code 409
--
-- -   __stream-error__ – Retry on refused stream
--
-- 'tcpRetryEvents', 'grpcRetryPolicy_tcpRetryEvents' - Specify a valid value. The event occurs before any processing of a
-- request has started and is encountered when the upstream is temporarily
-- or permanently unavailable.
--
-- 'maxRetries', 'grpcRetryPolicy_maxRetries' - The maximum number of retry attempts.
--
-- 'perRetryTimeout', 'grpcRetryPolicy_perRetryTimeout' - The timeout for each retry attempt.
newGrpcRetryPolicy ::
  -- | 'maxRetries'
  Prelude.Natural ->
  -- | 'perRetryTimeout'
  Duration ->
  GrpcRetryPolicy
newGrpcRetryPolicy :: Natural -> Duration -> GrpcRetryPolicy
newGrpcRetryPolicy Natural
pMaxRetries_ Duration
pPerRetryTimeout_ =
  GrpcRetryPolicy'
    { $sel:grpcRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:httpRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty Text)
httpRetryEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:tcpRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRetries:GrpcRetryPolicy' :: Natural
maxRetries = Natural
pMaxRetries_,
      $sel:perRetryTimeout:GrpcRetryPolicy' :: Duration
perRetryTimeout = Duration
pPerRetryTimeout_
    }

-- | Specify at least one of the valid values.
grpcRetryPolicy_grpcRetryEvents :: Lens.Lens' GrpcRetryPolicy (Prelude.Maybe (Prelude.NonEmpty GrpcRetryPolicyEvent))
grpcRetryPolicy_grpcRetryEvents :: Lens' GrpcRetryPolicy (Maybe (NonEmpty GrpcRetryPolicyEvent))
grpcRetryPolicy_grpcRetryEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrpcRetryPolicy' {Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents :: Maybe (NonEmpty GrpcRetryPolicyEvent)
$sel:grpcRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents} -> Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents) (\s :: GrpcRetryPolicy
s@GrpcRetryPolicy' {} Maybe (NonEmpty GrpcRetryPolicyEvent)
a -> GrpcRetryPolicy
s {$sel:grpcRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents = Maybe (NonEmpty GrpcRetryPolicyEvent)
a} :: GrpcRetryPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specify at least one of the following values.
--
-- -   __server-error__ – HTTP status codes 500, 501, 502, 503, 504, 505,
--     506, 507, 508, 510, and 511
--
-- -   __gateway-error__ – HTTP status codes 502, 503, and 504
--
-- -   __client-error__ – HTTP status code 409
--
-- -   __stream-error__ – Retry on refused stream
grpcRetryPolicy_httpRetryEvents :: Lens.Lens' GrpcRetryPolicy (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
grpcRetryPolicy_httpRetryEvents :: Lens' GrpcRetryPolicy (Maybe (NonEmpty Text))
grpcRetryPolicy_httpRetryEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrpcRetryPolicy' {Maybe (NonEmpty Text)
httpRetryEvents :: Maybe (NonEmpty Text)
$sel:httpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty Text)
httpRetryEvents} -> Maybe (NonEmpty Text)
httpRetryEvents) (\s :: GrpcRetryPolicy
s@GrpcRetryPolicy' {} Maybe (NonEmpty Text)
a -> GrpcRetryPolicy
s {$sel:httpRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty Text)
httpRetryEvents = Maybe (NonEmpty Text)
a} :: GrpcRetryPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specify a valid value. The event occurs before any processing of a
-- request has started and is encountered when the upstream is temporarily
-- or permanently unavailable.
grpcRetryPolicy_tcpRetryEvents :: Lens.Lens' GrpcRetryPolicy (Prelude.Maybe (Prelude.NonEmpty TcpRetryPolicyEvent))
grpcRetryPolicy_tcpRetryEvents :: Lens' GrpcRetryPolicy (Maybe (NonEmpty TcpRetryPolicyEvent))
grpcRetryPolicy_tcpRetryEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrpcRetryPolicy' {Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents :: Maybe (NonEmpty TcpRetryPolicyEvent)
$sel:tcpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents} -> Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents) (\s :: GrpcRetryPolicy
s@GrpcRetryPolicy' {} Maybe (NonEmpty TcpRetryPolicyEvent)
a -> GrpcRetryPolicy
s {$sel:tcpRetryEvents:GrpcRetryPolicy' :: Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents = Maybe (NonEmpty TcpRetryPolicyEvent)
a} :: GrpcRetryPolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The maximum number of retry attempts.
grpcRetryPolicy_maxRetries :: Lens.Lens' GrpcRetryPolicy Prelude.Natural
grpcRetryPolicy_maxRetries :: Lens' GrpcRetryPolicy Natural
grpcRetryPolicy_maxRetries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrpcRetryPolicy' {Natural
maxRetries :: Natural
$sel:maxRetries:GrpcRetryPolicy' :: GrpcRetryPolicy -> Natural
maxRetries} -> Natural
maxRetries) (\s :: GrpcRetryPolicy
s@GrpcRetryPolicy' {} Natural
a -> GrpcRetryPolicy
s {$sel:maxRetries:GrpcRetryPolicy' :: Natural
maxRetries = Natural
a} :: GrpcRetryPolicy)

-- | The timeout for each retry attempt.
grpcRetryPolicy_perRetryTimeout :: Lens.Lens' GrpcRetryPolicy Duration
grpcRetryPolicy_perRetryTimeout :: Lens' GrpcRetryPolicy Duration
grpcRetryPolicy_perRetryTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrpcRetryPolicy' {Duration
perRetryTimeout :: Duration
$sel:perRetryTimeout:GrpcRetryPolicy' :: GrpcRetryPolicy -> Duration
perRetryTimeout} -> Duration
perRetryTimeout) (\s :: GrpcRetryPolicy
s@GrpcRetryPolicy' {} Duration
a -> GrpcRetryPolicy
s {$sel:perRetryTimeout:GrpcRetryPolicy' :: Duration
perRetryTimeout = Duration
a} :: GrpcRetryPolicy)

instance Data.FromJSON GrpcRetryPolicy where
  parseJSON :: Value -> Parser GrpcRetryPolicy
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"GrpcRetryPolicy"
      ( \Object
x ->
          Maybe (NonEmpty GrpcRetryPolicyEvent)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty TcpRetryPolicyEvent)
-> Natural
-> Duration
-> GrpcRetryPolicy
GrpcRetryPolicy'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"grpcRetryEvents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpRetryEvents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tcpRetryEvents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"maxRetries")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"perRetryTimeout")
      )

instance Prelude.Hashable GrpcRetryPolicy where
  hashWithSalt :: Int -> GrpcRetryPolicy -> Int
hashWithSalt Int
_salt GrpcRetryPolicy' {Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty GrpcRetryPolicyEvent)
Maybe (NonEmpty TcpRetryPolicyEvent)
Duration
perRetryTimeout :: Duration
maxRetries :: Natural
tcpRetryEvents :: Maybe (NonEmpty TcpRetryPolicyEvent)
httpRetryEvents :: Maybe (NonEmpty Text)
grpcRetryEvents :: Maybe (NonEmpty GrpcRetryPolicyEvent)
$sel:perRetryTimeout:GrpcRetryPolicy' :: GrpcRetryPolicy -> Duration
$sel:maxRetries:GrpcRetryPolicy' :: GrpcRetryPolicy -> Natural
$sel:tcpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty TcpRetryPolicyEvent)
$sel:httpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty Text)
$sel:grpcRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty GrpcRetryPolicyEvent)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
httpRetryEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
maxRetries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Duration
perRetryTimeout

instance Prelude.NFData GrpcRetryPolicy where
  rnf :: GrpcRetryPolicy -> ()
rnf GrpcRetryPolicy' {Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty GrpcRetryPolicyEvent)
Maybe (NonEmpty TcpRetryPolicyEvent)
Duration
perRetryTimeout :: Duration
maxRetries :: Natural
tcpRetryEvents :: Maybe (NonEmpty TcpRetryPolicyEvent)
httpRetryEvents :: Maybe (NonEmpty Text)
grpcRetryEvents :: Maybe (NonEmpty GrpcRetryPolicyEvent)
$sel:perRetryTimeout:GrpcRetryPolicy' :: GrpcRetryPolicy -> Duration
$sel:maxRetries:GrpcRetryPolicy' :: GrpcRetryPolicy -> Natural
$sel:tcpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty TcpRetryPolicyEvent)
$sel:httpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty Text)
$sel:grpcRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty GrpcRetryPolicyEvent)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
httpRetryEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
maxRetries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Duration
perRetryTimeout

instance Data.ToJSON GrpcRetryPolicy where
  toJSON :: GrpcRetryPolicy -> Value
toJSON GrpcRetryPolicy' {Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty GrpcRetryPolicyEvent)
Maybe (NonEmpty TcpRetryPolicyEvent)
Duration
perRetryTimeout :: Duration
maxRetries :: Natural
tcpRetryEvents :: Maybe (NonEmpty TcpRetryPolicyEvent)
httpRetryEvents :: Maybe (NonEmpty Text)
grpcRetryEvents :: Maybe (NonEmpty GrpcRetryPolicyEvent)
$sel:perRetryTimeout:GrpcRetryPolicy' :: GrpcRetryPolicy -> Duration
$sel:maxRetries:GrpcRetryPolicy' :: GrpcRetryPolicy -> Natural
$sel:tcpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty TcpRetryPolicyEvent)
$sel:httpRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty Text)
$sel:grpcRetryEvents:GrpcRetryPolicy' :: GrpcRetryPolicy -> Maybe (NonEmpty GrpcRetryPolicyEvent)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"grpcRetryEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty GrpcRetryPolicyEvent)
grpcRetryEvents,
            (Key
"httpRetryEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
httpRetryEvents,
            (Key
"tcpRetryEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty TcpRetryPolicyEvent)
tcpRetryEvents,
            forall a. a -> Maybe a
Prelude.Just (Key
"maxRetries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
maxRetries),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"perRetryTimeout" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Duration
perRetryTimeout)
          ]
      )