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

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

-- |
-- Module      : Amazonka.ElastiCache.DecreaseReplicaCount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Dynamically decreases the number of replicas in a Redis (cluster mode
-- disabled) replication group or the number of replica nodes in one or
-- more node groups (shards) of a Redis (cluster mode enabled) replication
-- group. This operation is performed with no cluster down time.
module Amazonka.ElastiCache.DecreaseReplicaCount
  ( -- * Creating a Request
    DecreaseReplicaCount (..),
    newDecreaseReplicaCount,

    -- * Request Lenses
    decreaseReplicaCount_newReplicaCount,
    decreaseReplicaCount_replicaConfiguration,
    decreaseReplicaCount_replicasToRemove,
    decreaseReplicaCount_replicationGroupId,
    decreaseReplicaCount_applyImmediately,

    -- * Destructuring the Response
    DecreaseReplicaCountResponse (..),
    newDecreaseReplicaCountResponse,

    -- * Response Lenses
    decreaseReplicaCountResponse_replicationGroup,
    decreaseReplicaCountResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElastiCache.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDecreaseReplicaCount' smart constructor.
data DecreaseReplicaCount = DecreaseReplicaCount'
  { -- | The number of read replica nodes you want at the completion of this
    -- operation. For Redis (cluster mode disabled) replication groups, this is
    -- the number of replica nodes in the replication group. For Redis (cluster
    -- mode enabled) replication groups, this is the number of replica nodes in
    -- each of the replication group\'s node groups.
    --
    -- The minimum number of replicas in a shard or replication group is:
    --
    -- -   Redis (cluster mode disabled)
    --
    --     -   If Multi-AZ is enabled: 1
    --
    --     -   If Multi-AZ is not enabled: 0
    --
    -- -   Redis (cluster mode enabled): 0 (though you will not be able to
    --     failover to a replica if your primary node fails)
    DecreaseReplicaCount -> Maybe Int
newReplicaCount' :: Prelude.Maybe Prelude.Int,
    -- | A list of @ConfigureShard@ objects that can be used to configure each
    -- shard in a Redis (cluster mode enabled) replication group. The
    -- @ConfigureShard@ has three members: @NewReplicaCount@, @NodeGroupId@,
    -- and @PreferredAvailabilityZones@.
    DecreaseReplicaCount -> Maybe [ConfigureShard]
replicaConfiguration :: Prelude.Maybe [ConfigureShard],
    -- | A list of the node ids to remove from the replication group or node
    -- group (shard).
    DecreaseReplicaCount -> Maybe [Text]
replicasToRemove :: Prelude.Maybe [Prelude.Text],
    -- | The id of the replication group from which you want to remove replica
    -- nodes.
    DecreaseReplicaCount -> Text
replicationGroupId :: Prelude.Text,
    -- | If @True@, the number of replica nodes is decreased immediately.
    -- @ApplyImmediately=False@ is not currently supported.
    DecreaseReplicaCount -> Bool
applyImmediately :: Prelude.Bool
  }
  deriving (DecreaseReplicaCount -> DecreaseReplicaCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreaseReplicaCount -> DecreaseReplicaCount -> Bool
$c/= :: DecreaseReplicaCount -> DecreaseReplicaCount -> Bool
== :: DecreaseReplicaCount -> DecreaseReplicaCount -> Bool
$c== :: DecreaseReplicaCount -> DecreaseReplicaCount -> Bool
Prelude.Eq, ReadPrec [DecreaseReplicaCount]
ReadPrec DecreaseReplicaCount
Int -> ReadS DecreaseReplicaCount
ReadS [DecreaseReplicaCount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreaseReplicaCount]
$creadListPrec :: ReadPrec [DecreaseReplicaCount]
readPrec :: ReadPrec DecreaseReplicaCount
$creadPrec :: ReadPrec DecreaseReplicaCount
readList :: ReadS [DecreaseReplicaCount]
$creadList :: ReadS [DecreaseReplicaCount]
readsPrec :: Int -> ReadS DecreaseReplicaCount
$creadsPrec :: Int -> ReadS DecreaseReplicaCount
Prelude.Read, Int -> DecreaseReplicaCount -> ShowS
[DecreaseReplicaCount] -> ShowS
DecreaseReplicaCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecreaseReplicaCount] -> ShowS
$cshowList :: [DecreaseReplicaCount] -> ShowS
show :: DecreaseReplicaCount -> String
$cshow :: DecreaseReplicaCount -> String
showsPrec :: Int -> DecreaseReplicaCount -> ShowS
$cshowsPrec :: Int -> DecreaseReplicaCount -> ShowS
Prelude.Show, forall x. Rep DecreaseReplicaCount x -> DecreaseReplicaCount
forall x. DecreaseReplicaCount -> Rep DecreaseReplicaCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DecreaseReplicaCount x -> DecreaseReplicaCount
$cfrom :: forall x. DecreaseReplicaCount -> Rep DecreaseReplicaCount x
Prelude.Generic)

-- |
-- Create a value of 'DecreaseReplicaCount' 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:
--
-- 'newReplicaCount'', 'decreaseReplicaCount_newReplicaCount' - The number of read replica nodes you want at the completion of this
-- operation. For Redis (cluster mode disabled) replication groups, this is
-- the number of replica nodes in the replication group. For Redis (cluster
-- mode enabled) replication groups, this is the number of replica nodes in
-- each of the replication group\'s node groups.
--
-- The minimum number of replicas in a shard or replication group is:
--
-- -   Redis (cluster mode disabled)
--
--     -   If Multi-AZ is enabled: 1
--
--     -   If Multi-AZ is not enabled: 0
--
-- -   Redis (cluster mode enabled): 0 (though you will not be able to
--     failover to a replica if your primary node fails)
--
-- 'replicaConfiguration', 'decreaseReplicaCount_replicaConfiguration' - A list of @ConfigureShard@ objects that can be used to configure each
-- shard in a Redis (cluster mode enabled) replication group. The
-- @ConfigureShard@ has three members: @NewReplicaCount@, @NodeGroupId@,
-- and @PreferredAvailabilityZones@.
--
-- 'replicasToRemove', 'decreaseReplicaCount_replicasToRemove' - A list of the node ids to remove from the replication group or node
-- group (shard).
--
-- 'replicationGroupId', 'decreaseReplicaCount_replicationGroupId' - The id of the replication group from which you want to remove replica
-- nodes.
--
-- 'applyImmediately', 'decreaseReplicaCount_applyImmediately' - If @True@, the number of replica nodes is decreased immediately.
-- @ApplyImmediately=False@ is not currently supported.
newDecreaseReplicaCount ::
  -- | 'replicationGroupId'
  Prelude.Text ->
  -- | 'applyImmediately'
  Prelude.Bool ->
  DecreaseReplicaCount
newDecreaseReplicaCount :: Text -> Bool -> DecreaseReplicaCount
newDecreaseReplicaCount
  Text
pReplicationGroupId_
  Bool
pApplyImmediately_ =
    DecreaseReplicaCount'
      { $sel:newReplicaCount':DecreaseReplicaCount' :: Maybe Int
newReplicaCount' =
          forall a. Maybe a
Prelude.Nothing,
        $sel:replicaConfiguration:DecreaseReplicaCount' :: Maybe [ConfigureShard]
replicaConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:replicasToRemove:DecreaseReplicaCount' :: Maybe [Text]
replicasToRemove = forall a. Maybe a
Prelude.Nothing,
        $sel:replicationGroupId:DecreaseReplicaCount' :: Text
replicationGroupId = Text
pReplicationGroupId_,
        $sel:applyImmediately:DecreaseReplicaCount' :: Bool
applyImmediately = Bool
pApplyImmediately_
      }

-- | The number of read replica nodes you want at the completion of this
-- operation. For Redis (cluster mode disabled) replication groups, this is
-- the number of replica nodes in the replication group. For Redis (cluster
-- mode enabled) replication groups, this is the number of replica nodes in
-- each of the replication group\'s node groups.
--
-- The minimum number of replicas in a shard or replication group is:
--
-- -   Redis (cluster mode disabled)
--
--     -   If Multi-AZ is enabled: 1
--
--     -   If Multi-AZ is not enabled: 0
--
-- -   Redis (cluster mode enabled): 0 (though you will not be able to
--     failover to a replica if your primary node fails)
decreaseReplicaCount_newReplicaCount :: Lens.Lens' DecreaseReplicaCount (Prelude.Maybe Prelude.Int)
decreaseReplicaCount_newReplicaCount :: Lens' DecreaseReplicaCount (Maybe Int)
decreaseReplicaCount_newReplicaCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCount' {Maybe Int
newReplicaCount' :: Maybe Int
$sel:newReplicaCount':DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe Int
newReplicaCount'} -> Maybe Int
newReplicaCount') (\s :: DecreaseReplicaCount
s@DecreaseReplicaCount' {} Maybe Int
a -> DecreaseReplicaCount
s {$sel:newReplicaCount':DecreaseReplicaCount' :: Maybe Int
newReplicaCount' = Maybe Int
a} :: DecreaseReplicaCount)

-- | A list of @ConfigureShard@ objects that can be used to configure each
-- shard in a Redis (cluster mode enabled) replication group. The
-- @ConfigureShard@ has three members: @NewReplicaCount@, @NodeGroupId@,
-- and @PreferredAvailabilityZones@.
decreaseReplicaCount_replicaConfiguration :: Lens.Lens' DecreaseReplicaCount (Prelude.Maybe [ConfigureShard])
decreaseReplicaCount_replicaConfiguration :: Lens' DecreaseReplicaCount (Maybe [ConfigureShard])
decreaseReplicaCount_replicaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCount' {Maybe [ConfigureShard]
replicaConfiguration :: Maybe [ConfigureShard]
$sel:replicaConfiguration:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [ConfigureShard]
replicaConfiguration} -> Maybe [ConfigureShard]
replicaConfiguration) (\s :: DecreaseReplicaCount
s@DecreaseReplicaCount' {} Maybe [ConfigureShard]
a -> DecreaseReplicaCount
s {$sel:replicaConfiguration:DecreaseReplicaCount' :: Maybe [ConfigureShard]
replicaConfiguration = Maybe [ConfigureShard]
a} :: DecreaseReplicaCount) 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

-- | A list of the node ids to remove from the replication group or node
-- group (shard).
decreaseReplicaCount_replicasToRemove :: Lens.Lens' DecreaseReplicaCount (Prelude.Maybe [Prelude.Text])
decreaseReplicaCount_replicasToRemove :: Lens' DecreaseReplicaCount (Maybe [Text])
decreaseReplicaCount_replicasToRemove = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCount' {Maybe [Text]
replicasToRemove :: Maybe [Text]
$sel:replicasToRemove:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [Text]
replicasToRemove} -> Maybe [Text]
replicasToRemove) (\s :: DecreaseReplicaCount
s@DecreaseReplicaCount' {} Maybe [Text]
a -> DecreaseReplicaCount
s {$sel:replicasToRemove:DecreaseReplicaCount' :: Maybe [Text]
replicasToRemove = Maybe [Text]
a} :: DecreaseReplicaCount) 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 id of the replication group from which you want to remove replica
-- nodes.
decreaseReplicaCount_replicationGroupId :: Lens.Lens' DecreaseReplicaCount Prelude.Text
decreaseReplicaCount_replicationGroupId :: Lens' DecreaseReplicaCount Text
decreaseReplicaCount_replicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCount' {Text
replicationGroupId :: Text
$sel:replicationGroupId:DecreaseReplicaCount' :: DecreaseReplicaCount -> Text
replicationGroupId} -> Text
replicationGroupId) (\s :: DecreaseReplicaCount
s@DecreaseReplicaCount' {} Text
a -> DecreaseReplicaCount
s {$sel:replicationGroupId:DecreaseReplicaCount' :: Text
replicationGroupId = Text
a} :: DecreaseReplicaCount)

-- | If @True@, the number of replica nodes is decreased immediately.
-- @ApplyImmediately=False@ is not currently supported.
decreaseReplicaCount_applyImmediately :: Lens.Lens' DecreaseReplicaCount Prelude.Bool
decreaseReplicaCount_applyImmediately :: Lens' DecreaseReplicaCount Bool
decreaseReplicaCount_applyImmediately = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCount' {Bool
applyImmediately :: Bool
$sel:applyImmediately:DecreaseReplicaCount' :: DecreaseReplicaCount -> Bool
applyImmediately} -> Bool
applyImmediately) (\s :: DecreaseReplicaCount
s@DecreaseReplicaCount' {} Bool
a -> DecreaseReplicaCount
s {$sel:applyImmediately:DecreaseReplicaCount' :: Bool
applyImmediately = Bool
a} :: DecreaseReplicaCount)

instance Core.AWSRequest DecreaseReplicaCount where
  type
    AWSResponse DecreaseReplicaCount =
      DecreaseReplicaCountResponse
  request :: (Service -> Service)
-> DecreaseReplicaCount -> Request DecreaseReplicaCount
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DecreaseReplicaCount
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DecreaseReplicaCount)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DecreaseReplicaCountResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ReplicationGroup -> Int -> DecreaseReplicaCountResponse
DecreaseReplicaCountResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ReplicationGroup")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DecreaseReplicaCount where
  hashWithSalt :: Int -> DecreaseReplicaCount -> Int
hashWithSalt Int
_salt DecreaseReplicaCount' {Bool
Maybe Int
Maybe [Text]
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicasToRemove :: Maybe [Text]
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:DecreaseReplicaCount' :: DecreaseReplicaCount -> Bool
$sel:replicationGroupId:DecreaseReplicaCount' :: DecreaseReplicaCount -> Text
$sel:replicasToRemove:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [Text]
$sel:replicaConfiguration:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
newReplicaCount'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ConfigureShard]
replicaConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
replicasToRemove
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replicationGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
applyImmediately

instance Prelude.NFData DecreaseReplicaCount where
  rnf :: DecreaseReplicaCount -> ()
rnf DecreaseReplicaCount' {Bool
Maybe Int
Maybe [Text]
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicasToRemove :: Maybe [Text]
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:DecreaseReplicaCount' :: DecreaseReplicaCount -> Bool
$sel:replicationGroupId:DecreaseReplicaCount' :: DecreaseReplicaCount -> Text
$sel:replicasToRemove:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [Text]
$sel:replicaConfiguration:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
newReplicaCount'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ConfigureShard]
replicaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
replicasToRemove
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
replicationGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
applyImmediately

instance Data.ToHeaders DecreaseReplicaCount where
  toHeaders :: DecreaseReplicaCount -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DecreaseReplicaCount where
  toPath :: DecreaseReplicaCount -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery DecreaseReplicaCount where
  toQuery :: DecreaseReplicaCount -> QueryString
toQuery DecreaseReplicaCount' {Bool
Maybe Int
Maybe [Text]
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicasToRemove :: Maybe [Text]
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:DecreaseReplicaCount' :: DecreaseReplicaCount -> Bool
$sel:replicationGroupId:DecreaseReplicaCount' :: DecreaseReplicaCount -> Text
$sel:replicasToRemove:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [Text]
$sel:replicaConfiguration:DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':DecreaseReplicaCount' :: DecreaseReplicaCount -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DecreaseReplicaCount" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"NewReplicaCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
newReplicaCount',
        ByteString
"ReplicaConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"ConfigureShard"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ConfigureShard]
replicaConfiguration
            ),
        ByteString
"ReplicasToRemove"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
replicasToRemove
            ),
        ByteString
"ReplicationGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
replicationGroupId,
        ByteString
"ApplyImmediately" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
applyImmediately
      ]

-- | /See:/ 'newDecreaseReplicaCountResponse' smart constructor.
data DecreaseReplicaCountResponse = DecreaseReplicaCountResponse'
  { DecreaseReplicaCountResponse -> Maybe ReplicationGroup
replicationGroup :: Prelude.Maybe ReplicationGroup,
    -- | The response's http status code.
    DecreaseReplicaCountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DecreaseReplicaCountResponse
-> DecreaseReplicaCountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreaseReplicaCountResponse
-> DecreaseReplicaCountResponse -> Bool
$c/= :: DecreaseReplicaCountResponse
-> DecreaseReplicaCountResponse -> Bool
== :: DecreaseReplicaCountResponse
-> DecreaseReplicaCountResponse -> Bool
$c== :: DecreaseReplicaCountResponse
-> DecreaseReplicaCountResponse -> Bool
Prelude.Eq, ReadPrec [DecreaseReplicaCountResponse]
ReadPrec DecreaseReplicaCountResponse
Int -> ReadS DecreaseReplicaCountResponse
ReadS [DecreaseReplicaCountResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreaseReplicaCountResponse]
$creadListPrec :: ReadPrec [DecreaseReplicaCountResponse]
readPrec :: ReadPrec DecreaseReplicaCountResponse
$creadPrec :: ReadPrec DecreaseReplicaCountResponse
readList :: ReadS [DecreaseReplicaCountResponse]
$creadList :: ReadS [DecreaseReplicaCountResponse]
readsPrec :: Int -> ReadS DecreaseReplicaCountResponse
$creadsPrec :: Int -> ReadS DecreaseReplicaCountResponse
Prelude.Read, Int -> DecreaseReplicaCountResponse -> ShowS
[DecreaseReplicaCountResponse] -> ShowS
DecreaseReplicaCountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecreaseReplicaCountResponse] -> ShowS
$cshowList :: [DecreaseReplicaCountResponse] -> ShowS
show :: DecreaseReplicaCountResponse -> String
$cshow :: DecreaseReplicaCountResponse -> String
showsPrec :: Int -> DecreaseReplicaCountResponse -> ShowS
$cshowsPrec :: Int -> DecreaseReplicaCountResponse -> ShowS
Prelude.Show, forall x.
Rep DecreaseReplicaCountResponse x -> DecreaseReplicaCountResponse
forall x.
DecreaseReplicaCountResponse -> Rep DecreaseReplicaCountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DecreaseReplicaCountResponse x -> DecreaseReplicaCountResponse
$cfrom :: forall x.
DecreaseReplicaCountResponse -> Rep DecreaseReplicaCountResponse x
Prelude.Generic)

-- |
-- Create a value of 'DecreaseReplicaCountResponse' 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:
--
-- 'replicationGroup', 'decreaseReplicaCountResponse_replicationGroup' - Undocumented member.
--
-- 'httpStatus', 'decreaseReplicaCountResponse_httpStatus' - The response's http status code.
newDecreaseReplicaCountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DecreaseReplicaCountResponse
newDecreaseReplicaCountResponse :: Int -> DecreaseReplicaCountResponse
newDecreaseReplicaCountResponse Int
pHttpStatus_ =
  DecreaseReplicaCountResponse'
    { $sel:replicationGroup:DecreaseReplicaCountResponse' :: Maybe ReplicationGroup
replicationGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DecreaseReplicaCountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
decreaseReplicaCountResponse_replicationGroup :: Lens.Lens' DecreaseReplicaCountResponse (Prelude.Maybe ReplicationGroup)
decreaseReplicaCountResponse_replicationGroup :: Lens' DecreaseReplicaCountResponse (Maybe ReplicationGroup)
decreaseReplicaCountResponse_replicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCountResponse' {Maybe ReplicationGroup
replicationGroup :: Maybe ReplicationGroup
$sel:replicationGroup:DecreaseReplicaCountResponse' :: DecreaseReplicaCountResponse -> Maybe ReplicationGroup
replicationGroup} -> Maybe ReplicationGroup
replicationGroup) (\s :: DecreaseReplicaCountResponse
s@DecreaseReplicaCountResponse' {} Maybe ReplicationGroup
a -> DecreaseReplicaCountResponse
s {$sel:replicationGroup:DecreaseReplicaCountResponse' :: Maybe ReplicationGroup
replicationGroup = Maybe ReplicationGroup
a} :: DecreaseReplicaCountResponse)

-- | The response's http status code.
decreaseReplicaCountResponse_httpStatus :: Lens.Lens' DecreaseReplicaCountResponse Prelude.Int
decreaseReplicaCountResponse_httpStatus :: Lens' DecreaseReplicaCountResponse Int
decreaseReplicaCountResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicaCountResponse' {Int
httpStatus :: Int
$sel:httpStatus:DecreaseReplicaCountResponse' :: DecreaseReplicaCountResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DecreaseReplicaCountResponse
s@DecreaseReplicaCountResponse' {} Int
a -> DecreaseReplicaCountResponse
s {$sel:httpStatus:DecreaseReplicaCountResponse' :: Int
httpStatus = Int
a} :: DecreaseReplicaCountResponse)

instance Prelude.NFData DecreaseReplicaCountResponse where
  rnf :: DecreaseReplicaCountResponse -> ()
rnf DecreaseReplicaCountResponse' {Int
Maybe ReplicationGroup
httpStatus :: Int
replicationGroup :: Maybe ReplicationGroup
$sel:httpStatus:DecreaseReplicaCountResponse' :: DecreaseReplicaCountResponse -> Int
$sel:replicationGroup:DecreaseReplicaCountResponse' :: DecreaseReplicaCountResponse -> Maybe ReplicationGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationGroup
replicationGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus