{-# 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.IncreaseReplicaCount
-- 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 increases 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.IncreaseReplicaCount
  ( -- * Creating a Request
    IncreaseReplicaCount (..),
    newIncreaseReplicaCount,

    -- * Request Lenses
    increaseReplicaCount_newReplicaCount,
    increaseReplicaCount_replicaConfiguration,
    increaseReplicaCount_replicationGroupId,
    increaseReplicaCount_applyImmediately,

    -- * Destructuring the Response
    IncreaseReplicaCountResponse (..),
    newIncreaseReplicaCountResponse,

    -- * Response Lenses
    increaseReplicaCountResponse_replicationGroup,
    increaseReplicaCountResponse_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:/ 'newIncreaseReplicaCount' smart constructor.
data IncreaseReplicaCount = IncreaseReplicaCount'
  { -- | 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.
    IncreaseReplicaCount -> 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@.
    IncreaseReplicaCount -> Maybe [ConfigureShard]
replicaConfiguration :: Prelude.Maybe [ConfigureShard],
    -- | The id of the replication group to which you want to add replica nodes.
    IncreaseReplicaCount -> Text
replicationGroupId :: Prelude.Text,
    -- | If @True@, the number of replica nodes is increased immediately.
    -- @ApplyImmediately=False@ is not currently supported.
    IncreaseReplicaCount -> Bool
applyImmediately :: Prelude.Bool
  }
  deriving (IncreaseReplicaCount -> IncreaseReplicaCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncreaseReplicaCount -> IncreaseReplicaCount -> Bool
$c/= :: IncreaseReplicaCount -> IncreaseReplicaCount -> Bool
== :: IncreaseReplicaCount -> IncreaseReplicaCount -> Bool
$c== :: IncreaseReplicaCount -> IncreaseReplicaCount -> Bool
Prelude.Eq, ReadPrec [IncreaseReplicaCount]
ReadPrec IncreaseReplicaCount
Int -> ReadS IncreaseReplicaCount
ReadS [IncreaseReplicaCount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IncreaseReplicaCount]
$creadListPrec :: ReadPrec [IncreaseReplicaCount]
readPrec :: ReadPrec IncreaseReplicaCount
$creadPrec :: ReadPrec IncreaseReplicaCount
readList :: ReadS [IncreaseReplicaCount]
$creadList :: ReadS [IncreaseReplicaCount]
readsPrec :: Int -> ReadS IncreaseReplicaCount
$creadsPrec :: Int -> ReadS IncreaseReplicaCount
Prelude.Read, Int -> IncreaseReplicaCount -> ShowS
[IncreaseReplicaCount] -> ShowS
IncreaseReplicaCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncreaseReplicaCount] -> ShowS
$cshowList :: [IncreaseReplicaCount] -> ShowS
show :: IncreaseReplicaCount -> String
$cshow :: IncreaseReplicaCount -> String
showsPrec :: Int -> IncreaseReplicaCount -> ShowS
$cshowsPrec :: Int -> IncreaseReplicaCount -> ShowS
Prelude.Show, forall x. Rep IncreaseReplicaCount x -> IncreaseReplicaCount
forall x. IncreaseReplicaCount -> Rep IncreaseReplicaCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IncreaseReplicaCount x -> IncreaseReplicaCount
$cfrom :: forall x. IncreaseReplicaCount -> Rep IncreaseReplicaCount x
Prelude.Generic)

-- |
-- Create a value of 'IncreaseReplicaCount' 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'', 'increaseReplicaCount_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.
--
-- 'replicaConfiguration', 'increaseReplicaCount_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@.
--
-- 'replicationGroupId', 'increaseReplicaCount_replicationGroupId' - The id of the replication group to which you want to add replica nodes.
--
-- 'applyImmediately', 'increaseReplicaCount_applyImmediately' - If @True@, the number of replica nodes is increased immediately.
-- @ApplyImmediately=False@ is not currently supported.
newIncreaseReplicaCount ::
  -- | 'replicationGroupId'
  Prelude.Text ->
  -- | 'applyImmediately'
  Prelude.Bool ->
  IncreaseReplicaCount
newIncreaseReplicaCount :: Text -> Bool -> IncreaseReplicaCount
newIncreaseReplicaCount
  Text
pReplicationGroupId_
  Bool
pApplyImmediately_ =
    IncreaseReplicaCount'
      { $sel:newReplicaCount':IncreaseReplicaCount' :: Maybe Int
newReplicaCount' =
          forall a. Maybe a
Prelude.Nothing,
        $sel:replicaConfiguration:IncreaseReplicaCount' :: Maybe [ConfigureShard]
replicaConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:replicationGroupId:IncreaseReplicaCount' :: Text
replicationGroupId = Text
pReplicationGroupId_,
        $sel:applyImmediately:IncreaseReplicaCount' :: 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.
increaseReplicaCount_newReplicaCount :: Lens.Lens' IncreaseReplicaCount (Prelude.Maybe Prelude.Int)
increaseReplicaCount_newReplicaCount :: Lens' IncreaseReplicaCount (Maybe Int)
increaseReplicaCount_newReplicaCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicaCount' {Maybe Int
newReplicaCount' :: Maybe Int
$sel:newReplicaCount':IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe Int
newReplicaCount'} -> Maybe Int
newReplicaCount') (\s :: IncreaseReplicaCount
s@IncreaseReplicaCount' {} Maybe Int
a -> IncreaseReplicaCount
s {$sel:newReplicaCount':IncreaseReplicaCount' :: Maybe Int
newReplicaCount' = Maybe Int
a} :: IncreaseReplicaCount)

-- | 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@.
increaseReplicaCount_replicaConfiguration :: Lens.Lens' IncreaseReplicaCount (Prelude.Maybe [ConfigureShard])
increaseReplicaCount_replicaConfiguration :: Lens' IncreaseReplicaCount (Maybe [ConfigureShard])
increaseReplicaCount_replicaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicaCount' {Maybe [ConfigureShard]
replicaConfiguration :: Maybe [ConfigureShard]
$sel:replicaConfiguration:IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe [ConfigureShard]
replicaConfiguration} -> Maybe [ConfigureShard]
replicaConfiguration) (\s :: IncreaseReplicaCount
s@IncreaseReplicaCount' {} Maybe [ConfigureShard]
a -> IncreaseReplicaCount
s {$sel:replicaConfiguration:IncreaseReplicaCount' :: Maybe [ConfigureShard]
replicaConfiguration = Maybe [ConfigureShard]
a} :: IncreaseReplicaCount) 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 to which you want to add replica nodes.
increaseReplicaCount_replicationGroupId :: Lens.Lens' IncreaseReplicaCount Prelude.Text
increaseReplicaCount_replicationGroupId :: Lens' IncreaseReplicaCount Text
increaseReplicaCount_replicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicaCount' {Text
replicationGroupId :: Text
$sel:replicationGroupId:IncreaseReplicaCount' :: IncreaseReplicaCount -> Text
replicationGroupId} -> Text
replicationGroupId) (\s :: IncreaseReplicaCount
s@IncreaseReplicaCount' {} Text
a -> IncreaseReplicaCount
s {$sel:replicationGroupId:IncreaseReplicaCount' :: Text
replicationGroupId = Text
a} :: IncreaseReplicaCount)

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

instance Core.AWSRequest IncreaseReplicaCount where
  type
    AWSResponse IncreaseReplicaCount =
      IncreaseReplicaCountResponse
  request :: (Service -> Service)
-> IncreaseReplicaCount -> Request IncreaseReplicaCount
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 IncreaseReplicaCount
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse IncreaseReplicaCount)))
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
"IncreaseReplicaCountResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ReplicationGroup -> Int -> IncreaseReplicaCountResponse
IncreaseReplicaCountResponse'
            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 IncreaseReplicaCount where
  hashWithSalt :: Int -> IncreaseReplicaCount -> Int
hashWithSalt Int
_salt IncreaseReplicaCount' {Bool
Maybe Int
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:IncreaseReplicaCount' :: IncreaseReplicaCount -> Bool
$sel:replicationGroupId:IncreaseReplicaCount' :: IncreaseReplicaCount -> Text
$sel:replicaConfiguration:IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':IncreaseReplicaCount' :: IncreaseReplicaCount -> 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` Text
replicationGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
applyImmediately

instance Prelude.NFData IncreaseReplicaCount where
  rnf :: IncreaseReplicaCount -> ()
rnf IncreaseReplicaCount' {Bool
Maybe Int
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:IncreaseReplicaCount' :: IncreaseReplicaCount -> Bool
$sel:replicationGroupId:IncreaseReplicaCount' :: IncreaseReplicaCount -> Text
$sel:replicaConfiguration:IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':IncreaseReplicaCount' :: IncreaseReplicaCount -> 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 Text
replicationGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
applyImmediately

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

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

instance Data.ToQuery IncreaseReplicaCount where
  toQuery :: IncreaseReplicaCount -> QueryString
toQuery IncreaseReplicaCount' {Bool
Maybe Int
Maybe [ConfigureShard]
Text
applyImmediately :: Bool
replicationGroupId :: Text
replicaConfiguration :: Maybe [ConfigureShard]
newReplicaCount' :: Maybe Int
$sel:applyImmediately:IncreaseReplicaCount' :: IncreaseReplicaCount -> Bool
$sel:replicationGroupId:IncreaseReplicaCount' :: IncreaseReplicaCount -> Text
$sel:replicaConfiguration:IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe [ConfigureShard]
$sel:newReplicaCount':IncreaseReplicaCount' :: IncreaseReplicaCount -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"IncreaseReplicaCount" :: 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
"ReplicationGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
replicationGroupId,
        ByteString
"ApplyImmediately" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
applyImmediately
      ]

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

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

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

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

instance Prelude.NFData IncreaseReplicaCountResponse where
  rnf :: IncreaseReplicaCountResponse -> ()
rnf IncreaseReplicaCountResponse' {Int
Maybe ReplicationGroup
httpStatus :: Int
replicationGroup :: Maybe ReplicationGroup
$sel:httpStatus:IncreaseReplicaCountResponse' :: IncreaseReplicaCountResponse -> Int
$sel:replicationGroup:IncreaseReplicaCountResponse' :: IncreaseReplicaCountResponse -> 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