{-# 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.DAX.DecreaseReplicationFactor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes one or more nodes from a DAX cluster.
--
-- You cannot use @DecreaseReplicationFactor@ to remove the last node in a
-- DAX cluster. If you need to do this, use @DeleteCluster@ instead.
module Amazonka.DAX.DecreaseReplicationFactor
  ( -- * Creating a Request
    DecreaseReplicationFactor (..),
    newDecreaseReplicationFactor,

    -- * Request Lenses
    decreaseReplicationFactor_availabilityZones,
    decreaseReplicationFactor_nodeIdsToRemove,
    decreaseReplicationFactor_clusterName,
    decreaseReplicationFactor_newReplicationFactor,

    -- * Destructuring the Response
    DecreaseReplicationFactorResponse (..),
    newDecreaseReplicationFactorResponse,

    -- * Response Lenses
    decreaseReplicationFactorResponse_cluster,
    decreaseReplicationFactorResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDecreaseReplicationFactor' smart constructor.
data DecreaseReplicationFactor = DecreaseReplicationFactor'
  { -- | The Availability Zone(s) from which to remove nodes.
    DecreaseReplicationFactor -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | The unique identifiers of the nodes to be removed from the cluster.
    DecreaseReplicationFactor -> Maybe [Text]
nodeIdsToRemove :: Prelude.Maybe [Prelude.Text],
    -- | The name of the DAX cluster from which you want to remove nodes.
    DecreaseReplicationFactor -> Text
clusterName :: Prelude.Text,
    -- | The new number of nodes for the DAX cluster.
    DecreaseReplicationFactor -> Int
newReplicationFactor' :: Prelude.Int
  }
  deriving (DecreaseReplicationFactor -> DecreaseReplicationFactor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreaseReplicationFactor -> DecreaseReplicationFactor -> Bool
$c/= :: DecreaseReplicationFactor -> DecreaseReplicationFactor -> Bool
== :: DecreaseReplicationFactor -> DecreaseReplicationFactor -> Bool
$c== :: DecreaseReplicationFactor -> DecreaseReplicationFactor -> Bool
Prelude.Eq, ReadPrec [DecreaseReplicationFactor]
ReadPrec DecreaseReplicationFactor
Int -> ReadS DecreaseReplicationFactor
ReadS [DecreaseReplicationFactor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreaseReplicationFactor]
$creadListPrec :: ReadPrec [DecreaseReplicationFactor]
readPrec :: ReadPrec DecreaseReplicationFactor
$creadPrec :: ReadPrec DecreaseReplicationFactor
readList :: ReadS [DecreaseReplicationFactor]
$creadList :: ReadS [DecreaseReplicationFactor]
readsPrec :: Int -> ReadS DecreaseReplicationFactor
$creadsPrec :: Int -> ReadS DecreaseReplicationFactor
Prelude.Read, Int -> DecreaseReplicationFactor -> ShowS
[DecreaseReplicationFactor] -> ShowS
DecreaseReplicationFactor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecreaseReplicationFactor] -> ShowS
$cshowList :: [DecreaseReplicationFactor] -> ShowS
show :: DecreaseReplicationFactor -> String
$cshow :: DecreaseReplicationFactor -> String
showsPrec :: Int -> DecreaseReplicationFactor -> ShowS
$cshowsPrec :: Int -> DecreaseReplicationFactor -> ShowS
Prelude.Show, forall x.
Rep DecreaseReplicationFactor x -> DecreaseReplicationFactor
forall x.
DecreaseReplicationFactor -> Rep DecreaseReplicationFactor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DecreaseReplicationFactor x -> DecreaseReplicationFactor
$cfrom :: forall x.
DecreaseReplicationFactor -> Rep DecreaseReplicationFactor x
Prelude.Generic)

-- |
-- Create a value of 'DecreaseReplicationFactor' 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:
--
-- 'availabilityZones', 'decreaseReplicationFactor_availabilityZones' - The Availability Zone(s) from which to remove nodes.
--
-- 'nodeIdsToRemove', 'decreaseReplicationFactor_nodeIdsToRemove' - The unique identifiers of the nodes to be removed from the cluster.
--
-- 'clusterName', 'decreaseReplicationFactor_clusterName' - The name of the DAX cluster from which you want to remove nodes.
--
-- 'newReplicationFactor'', 'decreaseReplicationFactor_newReplicationFactor' - The new number of nodes for the DAX cluster.
newDecreaseReplicationFactor ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'newReplicationFactor''
  Prelude.Int ->
  DecreaseReplicationFactor
newDecreaseReplicationFactor :: Text -> Int -> DecreaseReplicationFactor
newDecreaseReplicationFactor
  Text
pClusterName_
  Int
pNewReplicationFactor_ =
    DecreaseReplicationFactor'
      { $sel:availabilityZones:DecreaseReplicationFactor' :: Maybe [Text]
availabilityZones =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nodeIdsToRemove:DecreaseReplicationFactor' :: Maybe [Text]
nodeIdsToRemove = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterName:DecreaseReplicationFactor' :: Text
clusterName = Text
pClusterName_,
        $sel:newReplicationFactor':DecreaseReplicationFactor' :: Int
newReplicationFactor' = Int
pNewReplicationFactor_
      }

-- | The Availability Zone(s) from which to remove nodes.
decreaseReplicationFactor_availabilityZones :: Lens.Lens' DecreaseReplicationFactor (Prelude.Maybe [Prelude.Text])
decreaseReplicationFactor_availabilityZones :: Lens' DecreaseReplicationFactor (Maybe [Text])
decreaseReplicationFactor_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicationFactor' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: DecreaseReplicationFactor
s@DecreaseReplicationFactor' {} Maybe [Text]
a -> DecreaseReplicationFactor
s {$sel:availabilityZones:DecreaseReplicationFactor' :: Maybe [Text]
availabilityZones = Maybe [Text]
a} :: DecreaseReplicationFactor) 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 unique identifiers of the nodes to be removed from the cluster.
decreaseReplicationFactor_nodeIdsToRemove :: Lens.Lens' DecreaseReplicationFactor (Prelude.Maybe [Prelude.Text])
decreaseReplicationFactor_nodeIdsToRemove :: Lens' DecreaseReplicationFactor (Maybe [Text])
decreaseReplicationFactor_nodeIdsToRemove = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicationFactor' {Maybe [Text]
nodeIdsToRemove :: Maybe [Text]
$sel:nodeIdsToRemove:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
nodeIdsToRemove} -> Maybe [Text]
nodeIdsToRemove) (\s :: DecreaseReplicationFactor
s@DecreaseReplicationFactor' {} Maybe [Text]
a -> DecreaseReplicationFactor
s {$sel:nodeIdsToRemove:DecreaseReplicationFactor' :: Maybe [Text]
nodeIdsToRemove = Maybe [Text]
a} :: DecreaseReplicationFactor) 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 name of the DAX cluster from which you want to remove nodes.
decreaseReplicationFactor_clusterName :: Lens.Lens' DecreaseReplicationFactor Prelude.Text
decreaseReplicationFactor_clusterName :: Lens' DecreaseReplicationFactor Text
decreaseReplicationFactor_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicationFactor' {Text
clusterName :: Text
$sel:clusterName:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Text
clusterName} -> Text
clusterName) (\s :: DecreaseReplicationFactor
s@DecreaseReplicationFactor' {} Text
a -> DecreaseReplicationFactor
s {$sel:clusterName:DecreaseReplicationFactor' :: Text
clusterName = Text
a} :: DecreaseReplicationFactor)

-- | The new number of nodes for the DAX cluster.
decreaseReplicationFactor_newReplicationFactor :: Lens.Lens' DecreaseReplicationFactor Prelude.Int
decreaseReplicationFactor_newReplicationFactor :: Lens' DecreaseReplicationFactor Int
decreaseReplicationFactor_newReplicationFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicationFactor' {Int
newReplicationFactor' :: Int
$sel:newReplicationFactor':DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Int
newReplicationFactor'} -> Int
newReplicationFactor') (\s :: DecreaseReplicationFactor
s@DecreaseReplicationFactor' {} Int
a -> DecreaseReplicationFactor
s {$sel:newReplicationFactor':DecreaseReplicationFactor' :: Int
newReplicationFactor' = Int
a} :: DecreaseReplicationFactor)

instance Core.AWSRequest DecreaseReplicationFactor where
  type
    AWSResponse DecreaseReplicationFactor =
      DecreaseReplicationFactorResponse
  request :: (Service -> Service)
-> DecreaseReplicationFactor -> Request DecreaseReplicationFactor
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DecreaseReplicationFactor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DecreaseReplicationFactor)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Cluster -> Int -> DecreaseReplicationFactorResponse
DecreaseReplicationFactorResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Cluster")
            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 DecreaseReplicationFactor where
  hashWithSalt :: Int -> DecreaseReplicationFactor -> Int
hashWithSalt Int
_salt DecreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
nodeIdsToRemove :: Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Int
$sel:clusterName:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Text
$sel:nodeIdsToRemove:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
$sel:availabilityZones:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
availabilityZones
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
nodeIdsToRemove
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
newReplicationFactor'

instance Prelude.NFData DecreaseReplicationFactor where
  rnf :: DecreaseReplicationFactor -> ()
rnf DecreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
nodeIdsToRemove :: Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Int
$sel:clusterName:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Text
$sel:nodeIdsToRemove:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
$sel:availabilityZones:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
availabilityZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
nodeIdsToRemove
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
newReplicationFactor'

instance Data.ToHeaders DecreaseReplicationFactor where
  toHeaders :: DecreaseReplicationFactor -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonDAXV3.DecreaseReplicationFactor" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DecreaseReplicationFactor where
  toJSON :: DecreaseReplicationFactor -> Value
toJSON DecreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
nodeIdsToRemove :: Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Int
$sel:clusterName:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Text
$sel:nodeIdsToRemove:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
$sel:availabilityZones:DecreaseReplicationFactor' :: DecreaseReplicationFactor -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AvailabilityZones" 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 [Text]
availabilityZones,
            (Key
"NodeIdsToRemove" 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 [Text]
nodeIdsToRemove,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"NewReplicationFactor"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
newReplicationFactor'
              )
          ]
      )

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

instance Data.ToQuery DecreaseReplicationFactor where
  toQuery :: DecreaseReplicationFactor -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDecreaseReplicationFactorResponse' smart constructor.
data DecreaseReplicationFactorResponse = DecreaseReplicationFactorResponse'
  { -- | A description of the DAX cluster, after you have decreased its
    -- replication factor.
    DecreaseReplicationFactorResponse -> Maybe Cluster
cluster :: Prelude.Maybe Cluster,
    -- | The response's http status code.
    DecreaseReplicationFactorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DecreaseReplicationFactorResponse
-> DecreaseReplicationFactorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreaseReplicationFactorResponse
-> DecreaseReplicationFactorResponse -> Bool
$c/= :: DecreaseReplicationFactorResponse
-> DecreaseReplicationFactorResponse -> Bool
== :: DecreaseReplicationFactorResponse
-> DecreaseReplicationFactorResponse -> Bool
$c== :: DecreaseReplicationFactorResponse
-> DecreaseReplicationFactorResponse -> Bool
Prelude.Eq, ReadPrec [DecreaseReplicationFactorResponse]
ReadPrec DecreaseReplicationFactorResponse
Int -> ReadS DecreaseReplicationFactorResponse
ReadS [DecreaseReplicationFactorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreaseReplicationFactorResponse]
$creadListPrec :: ReadPrec [DecreaseReplicationFactorResponse]
readPrec :: ReadPrec DecreaseReplicationFactorResponse
$creadPrec :: ReadPrec DecreaseReplicationFactorResponse
readList :: ReadS [DecreaseReplicationFactorResponse]
$creadList :: ReadS [DecreaseReplicationFactorResponse]
readsPrec :: Int -> ReadS DecreaseReplicationFactorResponse
$creadsPrec :: Int -> ReadS DecreaseReplicationFactorResponse
Prelude.Read, Int -> DecreaseReplicationFactorResponse -> ShowS
[DecreaseReplicationFactorResponse] -> ShowS
DecreaseReplicationFactorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecreaseReplicationFactorResponse] -> ShowS
$cshowList :: [DecreaseReplicationFactorResponse] -> ShowS
show :: DecreaseReplicationFactorResponse -> String
$cshow :: DecreaseReplicationFactorResponse -> String
showsPrec :: Int -> DecreaseReplicationFactorResponse -> ShowS
$cshowsPrec :: Int -> DecreaseReplicationFactorResponse -> ShowS
Prelude.Show, forall x.
Rep DecreaseReplicationFactorResponse x
-> DecreaseReplicationFactorResponse
forall x.
DecreaseReplicationFactorResponse
-> Rep DecreaseReplicationFactorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DecreaseReplicationFactorResponse x
-> DecreaseReplicationFactorResponse
$cfrom :: forall x.
DecreaseReplicationFactorResponse
-> Rep DecreaseReplicationFactorResponse x
Prelude.Generic)

-- |
-- Create a value of 'DecreaseReplicationFactorResponse' 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:
--
-- 'cluster', 'decreaseReplicationFactorResponse_cluster' - A description of the DAX cluster, after you have decreased its
-- replication factor.
--
-- 'httpStatus', 'decreaseReplicationFactorResponse_httpStatus' - The response's http status code.
newDecreaseReplicationFactorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DecreaseReplicationFactorResponse
newDecreaseReplicationFactorResponse :: Int -> DecreaseReplicationFactorResponse
newDecreaseReplicationFactorResponse Int
pHttpStatus_ =
  DecreaseReplicationFactorResponse'
    { $sel:cluster:DecreaseReplicationFactorResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DecreaseReplicationFactorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the DAX cluster, after you have decreased its
-- replication factor.
decreaseReplicationFactorResponse_cluster :: Lens.Lens' DecreaseReplicationFactorResponse (Prelude.Maybe Cluster)
decreaseReplicationFactorResponse_cluster :: Lens' DecreaseReplicationFactorResponse (Maybe Cluster)
decreaseReplicationFactorResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseReplicationFactorResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:DecreaseReplicationFactorResponse' :: DecreaseReplicationFactorResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: DecreaseReplicationFactorResponse
s@DecreaseReplicationFactorResponse' {} Maybe Cluster
a -> DecreaseReplicationFactorResponse
s {$sel:cluster:DecreaseReplicationFactorResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: DecreaseReplicationFactorResponse)

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

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