{-# 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.UpdateCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the settings for a DAX cluster. You can use this action to
-- change one or more cluster configuration parameters by specifying the
-- parameters and the new values.
module Amazonka.DAX.UpdateCluster
  ( -- * Creating a Request
    UpdateCluster (..),
    newUpdateCluster,

    -- * Request Lenses
    updateCluster_description,
    updateCluster_notificationTopicArn,
    updateCluster_notificationTopicStatus,
    updateCluster_parameterGroupName,
    updateCluster_preferredMaintenanceWindow,
    updateCluster_securityGroupIds,
    updateCluster_clusterName,

    -- * Destructuring the Response
    UpdateClusterResponse (..),
    newUpdateClusterResponse,

    -- * Response Lenses
    updateClusterResponse_cluster,
    updateClusterResponse_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:/ 'newUpdateCluster' smart constructor.
data UpdateCluster = UpdateCluster'
  { -- | A description of the changes being made to the cluster.
    UpdateCluster -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) that identifies the topic.
    UpdateCluster -> Maybe Text
notificationTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The current state of the topic. A value of “active” means that
    -- notifications will be sent to the topic. A value of “inactive” means
    -- that notifications will not be sent to the topic.
    UpdateCluster -> Maybe Text
notificationTopicStatus :: Prelude.Maybe Prelude.Text,
    -- | The name of a parameter group for this cluster.
    UpdateCluster -> Maybe Text
parameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | A range of time when maintenance of DAX cluster software will be
    -- performed. For example: @sun:01:00-sun:09:00@. Cluster maintenance
    -- normally takes less than 30 minutes, and is performed automatically
    -- within the maintenance window.
    UpdateCluster -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | A list of user-specified security group IDs to be assigned to each node
    -- in the DAX cluster. If this parameter is not specified, DAX assigns the
    -- default VPC security group to each node.
    UpdateCluster -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the DAX cluster to be modified.
    UpdateCluster -> Text
clusterName :: Prelude.Text
  }
  deriving (UpdateCluster -> UpdateCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCluster -> UpdateCluster -> Bool
$c/= :: UpdateCluster -> UpdateCluster -> Bool
== :: UpdateCluster -> UpdateCluster -> Bool
$c== :: UpdateCluster -> UpdateCluster -> Bool
Prelude.Eq, ReadPrec [UpdateCluster]
ReadPrec UpdateCluster
Int -> ReadS UpdateCluster
ReadS [UpdateCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCluster]
$creadListPrec :: ReadPrec [UpdateCluster]
readPrec :: ReadPrec UpdateCluster
$creadPrec :: ReadPrec UpdateCluster
readList :: ReadS [UpdateCluster]
$creadList :: ReadS [UpdateCluster]
readsPrec :: Int -> ReadS UpdateCluster
$creadsPrec :: Int -> ReadS UpdateCluster
Prelude.Read, Int -> UpdateCluster -> ShowS
[UpdateCluster] -> ShowS
UpdateCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCluster] -> ShowS
$cshowList :: [UpdateCluster] -> ShowS
show :: UpdateCluster -> String
$cshow :: UpdateCluster -> String
showsPrec :: Int -> UpdateCluster -> ShowS
$cshowsPrec :: Int -> UpdateCluster -> ShowS
Prelude.Show, forall x. Rep UpdateCluster x -> UpdateCluster
forall x. UpdateCluster -> Rep UpdateCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCluster x -> UpdateCluster
$cfrom :: forall x. UpdateCluster -> Rep UpdateCluster x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCluster' 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:
--
-- 'description', 'updateCluster_description' - A description of the changes being made to the cluster.
--
-- 'notificationTopicArn', 'updateCluster_notificationTopicArn' - The Amazon Resource Name (ARN) that identifies the topic.
--
-- 'notificationTopicStatus', 'updateCluster_notificationTopicStatus' - The current state of the topic. A value of “active” means that
-- notifications will be sent to the topic. A value of “inactive” means
-- that notifications will not be sent to the topic.
--
-- 'parameterGroupName', 'updateCluster_parameterGroupName' - The name of a parameter group for this cluster.
--
-- 'preferredMaintenanceWindow', 'updateCluster_preferredMaintenanceWindow' - A range of time when maintenance of DAX cluster software will be
-- performed. For example: @sun:01:00-sun:09:00@. Cluster maintenance
-- normally takes less than 30 minutes, and is performed automatically
-- within the maintenance window.
--
-- 'securityGroupIds', 'updateCluster_securityGroupIds' - A list of user-specified security group IDs to be assigned to each node
-- in the DAX cluster. If this parameter is not specified, DAX assigns the
-- default VPC security group to each node.
--
-- 'clusterName', 'updateCluster_clusterName' - The name of the DAX cluster to be modified.
newUpdateCluster ::
  -- | 'clusterName'
  Prelude.Text ->
  UpdateCluster
newUpdateCluster :: Text -> UpdateCluster
newUpdateCluster Text
pClusterName_ =
  UpdateCluster'
    { $sel:description:UpdateCluster' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationTopicArn:UpdateCluster' :: Maybe Text
notificationTopicArn = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationTopicStatus:UpdateCluster' :: Maybe Text
notificationTopicStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterGroupName:UpdateCluster' :: Maybe Text
parameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:UpdateCluster' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupIds:UpdateCluster' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterName:UpdateCluster' :: Text
clusterName = Text
pClusterName_
    }

-- | A description of the changes being made to the cluster.
updateCluster_description :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_description :: Lens' UpdateCluster (Maybe Text)
updateCluster_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
description :: Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:description:UpdateCluster' :: Maybe Text
description = Maybe Text
a} :: UpdateCluster)

-- | The Amazon Resource Name (ARN) that identifies the topic.
updateCluster_notificationTopicArn :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_notificationTopicArn :: Lens' UpdateCluster (Maybe Text)
updateCluster_notificationTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
notificationTopicArn :: Maybe Text
$sel:notificationTopicArn:UpdateCluster' :: UpdateCluster -> Maybe Text
notificationTopicArn} -> Maybe Text
notificationTopicArn) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:notificationTopicArn:UpdateCluster' :: Maybe Text
notificationTopicArn = Maybe Text
a} :: UpdateCluster)

-- | The current state of the topic. A value of “active” means that
-- notifications will be sent to the topic. A value of “inactive” means
-- that notifications will not be sent to the topic.
updateCluster_notificationTopicStatus :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_notificationTopicStatus :: Lens' UpdateCluster (Maybe Text)
updateCluster_notificationTopicStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
notificationTopicStatus :: Maybe Text
$sel:notificationTopicStatus:UpdateCluster' :: UpdateCluster -> Maybe Text
notificationTopicStatus} -> Maybe Text
notificationTopicStatus) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:notificationTopicStatus:UpdateCluster' :: Maybe Text
notificationTopicStatus = Maybe Text
a} :: UpdateCluster)

-- | The name of a parameter group for this cluster.
updateCluster_parameterGroupName :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_parameterGroupName :: Lens' UpdateCluster (Maybe Text)
updateCluster_parameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
parameterGroupName :: Maybe Text
$sel:parameterGroupName:UpdateCluster' :: UpdateCluster -> Maybe Text
parameterGroupName} -> Maybe Text
parameterGroupName) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:parameterGroupName:UpdateCluster' :: Maybe Text
parameterGroupName = Maybe Text
a} :: UpdateCluster)

-- | A range of time when maintenance of DAX cluster software will be
-- performed. For example: @sun:01:00-sun:09:00@. Cluster maintenance
-- normally takes less than 30 minutes, and is performed automatically
-- within the maintenance window.
updateCluster_preferredMaintenanceWindow :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_preferredMaintenanceWindow :: Lens' UpdateCluster (Maybe Text)
updateCluster_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:UpdateCluster' :: UpdateCluster -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:preferredMaintenanceWindow:UpdateCluster' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: UpdateCluster)

-- | A list of user-specified security group IDs to be assigned to each node
-- in the DAX cluster. If this parameter is not specified, DAX assigns the
-- default VPC security group to each node.
updateCluster_securityGroupIds :: Lens.Lens' UpdateCluster (Prelude.Maybe [Prelude.Text])
updateCluster_securityGroupIds :: Lens' UpdateCluster (Maybe [Text])
updateCluster_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:UpdateCluster' :: UpdateCluster -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe [Text]
a -> UpdateCluster
s {$sel:securityGroupIds:UpdateCluster' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: UpdateCluster) 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 to be modified.
updateCluster_clusterName :: Lens.Lens' UpdateCluster Prelude.Text
updateCluster_clusterName :: Lens' UpdateCluster Text
updateCluster_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Text
clusterName :: Text
$sel:clusterName:UpdateCluster' :: UpdateCluster -> Text
clusterName} -> Text
clusterName) (\s :: UpdateCluster
s@UpdateCluster' {} Text
a -> UpdateCluster
s {$sel:clusterName:UpdateCluster' :: Text
clusterName = Text
a} :: UpdateCluster)

instance Core.AWSRequest UpdateCluster where
  type
    AWSResponse UpdateCluster =
      UpdateClusterResponse
  request :: (Service -> Service) -> UpdateCluster -> Request UpdateCluster
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 UpdateCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateCluster)))
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 -> UpdateClusterResponse
UpdateClusterResponse'
            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 UpdateCluster where
  hashWithSalt :: Int -> UpdateCluster -> Int
hashWithSalt Int
_salt UpdateCluster' {Maybe [Text]
Maybe Text
Text
clusterName :: Text
securityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicStatus :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
$sel:clusterName:UpdateCluster' :: UpdateCluster -> Text
$sel:securityGroupIds:UpdateCluster' :: UpdateCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:parameterGroupName:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicStatus:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicArn:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationTopicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationTopicStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName

instance Prelude.NFData UpdateCluster where
  rnf :: UpdateCluster -> ()
rnf UpdateCluster' {Maybe [Text]
Maybe Text
Text
clusterName :: Text
securityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicStatus :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
$sel:clusterName:UpdateCluster' :: UpdateCluster -> Text
$sel:securityGroupIds:UpdateCluster' :: UpdateCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:parameterGroupName:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicStatus:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicArn:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notificationTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notificationTopicStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName

instance Data.ToHeaders UpdateCluster where
  toHeaders :: UpdateCluster -> 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.UpdateCluster" :: 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 UpdateCluster where
  toJSON :: UpdateCluster -> Value
toJSON UpdateCluster' {Maybe [Text]
Maybe Text
Text
clusterName :: Text
securityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicStatus :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
$sel:clusterName:UpdateCluster' :: UpdateCluster -> Text
$sel:securityGroupIds:UpdateCluster' :: UpdateCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:parameterGroupName:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicStatus:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:notificationTopicArn:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"NotificationTopicArn" 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
notificationTopicArn,
            (Key
"NotificationTopicStatus" 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
notificationTopicStatus,
            (Key
"ParameterGroupName" 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
parameterGroupName,
            (Key
"PreferredMaintenanceWindow" 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
preferredMaintenanceWindow,
            (Key
"SecurityGroupIds" 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]
securityGroupIds,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateClusterResponse' 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', 'updateClusterResponse_cluster' - A description of the DAX cluster, after it has been modified.
--
-- 'httpStatus', 'updateClusterResponse_httpStatus' - The response's http status code.
newUpdateClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateClusterResponse
newUpdateClusterResponse :: Int -> UpdateClusterResponse
newUpdateClusterResponse Int
pHttpStatus_ =
  UpdateClusterResponse'
    { $sel:cluster:UpdateClusterResponse' :: Maybe Cluster
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the DAX cluster, after it has been modified.
updateClusterResponse_cluster :: Lens.Lens' UpdateClusterResponse (Prelude.Maybe Cluster)
updateClusterResponse_cluster :: Lens' UpdateClusterResponse (Maybe Cluster)
updateClusterResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:UpdateClusterResponse' :: UpdateClusterResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: UpdateClusterResponse
s@UpdateClusterResponse' {} Maybe Cluster
a -> UpdateClusterResponse
s {$sel:cluster:UpdateClusterResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: UpdateClusterResponse)

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

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