{-# 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.IncreaseReplicationFactor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more nodes to a DAX cluster.
module Amazonka.DAX.IncreaseReplicationFactor
  ( -- * Creating a Request
    IncreaseReplicationFactor (..),
    newIncreaseReplicationFactor,

    -- * Request Lenses
    increaseReplicationFactor_availabilityZones,
    increaseReplicationFactor_clusterName,
    increaseReplicationFactor_newReplicationFactor,

    -- * Destructuring the Response
    IncreaseReplicationFactorResponse (..),
    newIncreaseReplicationFactorResponse,

    -- * Response Lenses
    increaseReplicationFactorResponse_cluster,
    increaseReplicationFactorResponse_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:/ 'newIncreaseReplicationFactor' smart constructor.
data IncreaseReplicationFactor = IncreaseReplicationFactor'
  { -- | The Availability Zones (AZs) in which the cluster nodes will be created.
    -- All nodes belonging to the cluster are placed in these Availability
    -- Zones. Use this parameter if you want to distribute the nodes across
    -- multiple AZs.
    IncreaseReplicationFactor -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | The name of the DAX cluster that will receive additional nodes.
    IncreaseReplicationFactor -> Text
clusterName :: Prelude.Text,
    -- | The new number of nodes for the DAX cluster.
    IncreaseReplicationFactor -> Int
newReplicationFactor' :: Prelude.Int
  }
  deriving (IncreaseReplicationFactor -> IncreaseReplicationFactor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncreaseReplicationFactor -> IncreaseReplicationFactor -> Bool
$c/= :: IncreaseReplicationFactor -> IncreaseReplicationFactor -> Bool
== :: IncreaseReplicationFactor -> IncreaseReplicationFactor -> Bool
$c== :: IncreaseReplicationFactor -> IncreaseReplicationFactor -> Bool
Prelude.Eq, ReadPrec [IncreaseReplicationFactor]
ReadPrec IncreaseReplicationFactor
Int -> ReadS IncreaseReplicationFactor
ReadS [IncreaseReplicationFactor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IncreaseReplicationFactor]
$creadListPrec :: ReadPrec [IncreaseReplicationFactor]
readPrec :: ReadPrec IncreaseReplicationFactor
$creadPrec :: ReadPrec IncreaseReplicationFactor
readList :: ReadS [IncreaseReplicationFactor]
$creadList :: ReadS [IncreaseReplicationFactor]
readsPrec :: Int -> ReadS IncreaseReplicationFactor
$creadsPrec :: Int -> ReadS IncreaseReplicationFactor
Prelude.Read, Int -> IncreaseReplicationFactor -> ShowS
[IncreaseReplicationFactor] -> ShowS
IncreaseReplicationFactor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IncreaseReplicationFactor] -> ShowS
$cshowList :: [IncreaseReplicationFactor] -> ShowS
show :: IncreaseReplicationFactor -> String
$cshow :: IncreaseReplicationFactor -> String
showsPrec :: Int -> IncreaseReplicationFactor -> ShowS
$cshowsPrec :: Int -> IncreaseReplicationFactor -> ShowS
Prelude.Show, forall x.
Rep IncreaseReplicationFactor x -> IncreaseReplicationFactor
forall x.
IncreaseReplicationFactor -> Rep IncreaseReplicationFactor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep IncreaseReplicationFactor x -> IncreaseReplicationFactor
$cfrom :: forall x.
IncreaseReplicationFactor -> Rep IncreaseReplicationFactor x
Prelude.Generic)

-- |
-- Create a value of 'IncreaseReplicationFactor' 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', 'increaseReplicationFactor_availabilityZones' - The Availability Zones (AZs) in which the cluster nodes will be created.
-- All nodes belonging to the cluster are placed in these Availability
-- Zones. Use this parameter if you want to distribute the nodes across
-- multiple AZs.
--
-- 'clusterName', 'increaseReplicationFactor_clusterName' - The name of the DAX cluster that will receive additional nodes.
--
-- 'newReplicationFactor'', 'increaseReplicationFactor_newReplicationFactor' - The new number of nodes for the DAX cluster.
newIncreaseReplicationFactor ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'newReplicationFactor''
  Prelude.Int ->
  IncreaseReplicationFactor
newIncreaseReplicationFactor :: Text -> Int -> IncreaseReplicationFactor
newIncreaseReplicationFactor
  Text
pClusterName_
  Int
pNewReplicationFactor_ =
    IncreaseReplicationFactor'
      { $sel:availabilityZones:IncreaseReplicationFactor' :: Maybe [Text]
availabilityZones =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clusterName:IncreaseReplicationFactor' :: Text
clusterName = Text
pClusterName_,
        $sel:newReplicationFactor':IncreaseReplicationFactor' :: Int
newReplicationFactor' = Int
pNewReplicationFactor_
      }

-- | The Availability Zones (AZs) in which the cluster nodes will be created.
-- All nodes belonging to the cluster are placed in these Availability
-- Zones. Use this parameter if you want to distribute the nodes across
-- multiple AZs.
increaseReplicationFactor_availabilityZones :: Lens.Lens' IncreaseReplicationFactor (Prelude.Maybe [Prelude.Text])
increaseReplicationFactor_availabilityZones :: Lens' IncreaseReplicationFactor (Maybe [Text])
increaseReplicationFactor_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicationFactor' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: IncreaseReplicationFactor
s@IncreaseReplicationFactor' {} Maybe [Text]
a -> IncreaseReplicationFactor
s {$sel:availabilityZones:IncreaseReplicationFactor' :: Maybe [Text]
availabilityZones = Maybe [Text]
a} :: IncreaseReplicationFactor) 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 that will receive additional nodes.
increaseReplicationFactor_clusterName :: Lens.Lens' IncreaseReplicationFactor Prelude.Text
increaseReplicationFactor_clusterName :: Lens' IncreaseReplicationFactor Text
increaseReplicationFactor_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicationFactor' {Text
clusterName :: Text
$sel:clusterName:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Text
clusterName} -> Text
clusterName) (\s :: IncreaseReplicationFactor
s@IncreaseReplicationFactor' {} Text
a -> IncreaseReplicationFactor
s {$sel:clusterName:IncreaseReplicationFactor' :: Text
clusterName = Text
a} :: IncreaseReplicationFactor)

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

instance Core.AWSRequest IncreaseReplicationFactor where
  type
    AWSResponse IncreaseReplicationFactor =
      IncreaseReplicationFactorResponse
  request :: (Service -> Service)
-> IncreaseReplicationFactor -> Request IncreaseReplicationFactor
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 IncreaseReplicationFactor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse IncreaseReplicationFactor)))
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 -> IncreaseReplicationFactorResponse
IncreaseReplicationFactorResponse'
            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 IncreaseReplicationFactor where
  hashWithSalt :: Int -> IncreaseReplicationFactor -> Int
hashWithSalt Int
_salt IncreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Int
$sel:clusterName:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Text
$sel:availabilityZones:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> 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` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
newReplicationFactor'

instance Prelude.NFData IncreaseReplicationFactor where
  rnf :: IncreaseReplicationFactor -> ()
rnf IncreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Int
$sel:clusterName:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Text
$sel:availabilityZones:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> 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 Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
newReplicationFactor'

instance Data.ToHeaders IncreaseReplicationFactor where
  toHeaders :: IncreaseReplicationFactor -> 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.IncreaseReplicationFactor" ::
                          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 IncreaseReplicationFactor where
  toJSON :: IncreaseReplicationFactor -> Value
toJSON IncreaseReplicationFactor' {Int
Maybe [Text]
Text
newReplicationFactor' :: Int
clusterName :: Text
availabilityZones :: Maybe [Text]
$sel:newReplicationFactor':IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Int
$sel:clusterName:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> Text
$sel:availabilityZones:IncreaseReplicationFactor' :: IncreaseReplicationFactor -> 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,
            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 IncreaseReplicationFactor where
  toPath :: IncreaseReplicationFactor -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'IncreaseReplicationFactorResponse' 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', 'increaseReplicationFactorResponse_cluster' - A description of the DAX cluster. with its new replication factor.
--
-- 'httpStatus', 'increaseReplicationFactorResponse_httpStatus' - The response's http status code.
newIncreaseReplicationFactorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  IncreaseReplicationFactorResponse
newIncreaseReplicationFactorResponse :: Int -> IncreaseReplicationFactorResponse
newIncreaseReplicationFactorResponse Int
pHttpStatus_ =
  IncreaseReplicationFactorResponse'
    { $sel:cluster:IncreaseReplicationFactorResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:IncreaseReplicationFactorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the DAX cluster. with its new replication factor.
increaseReplicationFactorResponse_cluster :: Lens.Lens' IncreaseReplicationFactorResponse (Prelude.Maybe Cluster)
increaseReplicationFactorResponse_cluster :: Lens' IncreaseReplicationFactorResponse (Maybe Cluster)
increaseReplicationFactorResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IncreaseReplicationFactorResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:IncreaseReplicationFactorResponse' :: IncreaseReplicationFactorResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: IncreaseReplicationFactorResponse
s@IncreaseReplicationFactorResponse' {} Maybe Cluster
a -> IncreaseReplicationFactorResponse
s {$sel:cluster:IncreaseReplicationFactorResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: IncreaseReplicationFactorResponse)

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

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