{-# 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.EKS.UpdateClusterConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an Amazon EKS cluster configuration. Your cluster continues to
-- function during the update. The response output includes an update ID
-- that you can use to track the status of your cluster update with the
-- DescribeUpdate API operation.
--
-- You can use this API operation to enable or disable exporting the
-- Kubernetes control plane logs for your cluster to CloudWatch Logs. By
-- default, cluster control plane logs aren\'t exported to CloudWatch Logs.
-- For more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/control-plane-logs.html Amazon EKS Cluster Control Plane Logs>
-- in the //Amazon EKS User Guide// .
--
-- CloudWatch Logs ingestion, archive storage, and data scanning rates
-- apply to exported control plane logs. For more information, see
-- <http://aws.amazon.com/cloudwatch/pricing/ CloudWatch Pricing>.
--
-- You can also use this API operation to enable or disable public and
-- private access to your cluster\'s Kubernetes API server endpoint. By
-- default, public access is enabled, and private access is disabled. For
-- more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/cluster-endpoint.html Amazon EKS cluster endpoint access control>
-- in the //Amazon EKS User Guide// .
--
-- You can\'t update the subnets or security group IDs for an existing
-- cluster.
--
-- Cluster updates are asynchronous, and they should finish within a few
-- minutes. During an update, the cluster status moves to @UPDATING@ (this
-- status transition is eventually consistent). When the update is complete
-- (either @Failed@ or @Successful@), the cluster status moves to @Active@.
module Amazonka.EKS.UpdateClusterConfig
  ( -- * Creating a Request
    UpdateClusterConfig (..),
    newUpdateClusterConfig,

    -- * Request Lenses
    updateClusterConfig_clientRequestToken,
    updateClusterConfig_logging,
    updateClusterConfig_resourcesVpcConfig,
    updateClusterConfig_name,

    -- * Destructuring the Response
    UpdateClusterConfigResponse (..),
    newUpdateClusterConfigResponse,

    -- * Response Lenses
    updateClusterConfigResponse_update,
    updateClusterConfigResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateClusterConfig' smart constructor.
data UpdateClusterConfig = UpdateClusterConfig'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    UpdateClusterConfig -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Enable or disable exporting the Kubernetes control plane logs for your
    -- cluster to CloudWatch Logs. By default, cluster control plane logs
    -- aren\'t exported to CloudWatch Logs. For more information, see
    -- <https://docs.aws.amazon.com/eks/latest/userguide/control-plane-logs.html Amazon EKS cluster control plane logs>
    -- in the //Amazon EKS User Guide// .
    --
    -- CloudWatch Logs ingestion, archive storage, and data scanning rates
    -- apply to exported control plane logs. For more information, see
    -- <http://aws.amazon.com/cloudwatch/pricing/ CloudWatch Pricing>.
    UpdateClusterConfig -> Maybe Logging
logging :: Prelude.Maybe Logging,
    UpdateClusterConfig -> Maybe VpcConfigRequest
resourcesVpcConfig :: Prelude.Maybe VpcConfigRequest,
    -- | The name of the Amazon EKS cluster to update.
    UpdateClusterConfig -> Text
name :: Prelude.Text
  }
  deriving (UpdateClusterConfig -> UpdateClusterConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClusterConfig -> UpdateClusterConfig -> Bool
$c/= :: UpdateClusterConfig -> UpdateClusterConfig -> Bool
== :: UpdateClusterConfig -> UpdateClusterConfig -> Bool
$c== :: UpdateClusterConfig -> UpdateClusterConfig -> Bool
Prelude.Eq, ReadPrec [UpdateClusterConfig]
ReadPrec UpdateClusterConfig
Int -> ReadS UpdateClusterConfig
ReadS [UpdateClusterConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClusterConfig]
$creadListPrec :: ReadPrec [UpdateClusterConfig]
readPrec :: ReadPrec UpdateClusterConfig
$creadPrec :: ReadPrec UpdateClusterConfig
readList :: ReadS [UpdateClusterConfig]
$creadList :: ReadS [UpdateClusterConfig]
readsPrec :: Int -> ReadS UpdateClusterConfig
$creadsPrec :: Int -> ReadS UpdateClusterConfig
Prelude.Read, Int -> UpdateClusterConfig -> ShowS
[UpdateClusterConfig] -> ShowS
UpdateClusterConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClusterConfig] -> ShowS
$cshowList :: [UpdateClusterConfig] -> ShowS
show :: UpdateClusterConfig -> String
$cshow :: UpdateClusterConfig -> String
showsPrec :: Int -> UpdateClusterConfig -> ShowS
$cshowsPrec :: Int -> UpdateClusterConfig -> ShowS
Prelude.Show, forall x. Rep UpdateClusterConfig x -> UpdateClusterConfig
forall x. UpdateClusterConfig -> Rep UpdateClusterConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateClusterConfig x -> UpdateClusterConfig
$cfrom :: forall x. UpdateClusterConfig -> Rep UpdateClusterConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClusterConfig' 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:
--
-- 'clientRequestToken', 'updateClusterConfig_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'logging', 'updateClusterConfig_logging' - Enable or disable exporting the Kubernetes control plane logs for your
-- cluster to CloudWatch Logs. By default, cluster control plane logs
-- aren\'t exported to CloudWatch Logs. For more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/control-plane-logs.html Amazon EKS cluster control plane logs>
-- in the //Amazon EKS User Guide// .
--
-- CloudWatch Logs ingestion, archive storage, and data scanning rates
-- apply to exported control plane logs. For more information, see
-- <http://aws.amazon.com/cloudwatch/pricing/ CloudWatch Pricing>.
--
-- 'resourcesVpcConfig', 'updateClusterConfig_resourcesVpcConfig' - Undocumented member.
--
-- 'name', 'updateClusterConfig_name' - The name of the Amazon EKS cluster to update.
newUpdateClusterConfig ::
  -- | 'name'
  Prelude.Text ->
  UpdateClusterConfig
newUpdateClusterConfig :: Text -> UpdateClusterConfig
newUpdateClusterConfig Text
pName_ =
  UpdateClusterConfig'
    { $sel:clientRequestToken:UpdateClusterConfig' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:logging:UpdateClusterConfig' :: Maybe Logging
logging = forall a. Maybe a
Prelude.Nothing,
      $sel:resourcesVpcConfig:UpdateClusterConfig' :: Maybe VpcConfigRequest
resourcesVpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateClusterConfig' :: Text
name = Text
pName_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
updateClusterConfig_clientRequestToken :: Lens.Lens' UpdateClusterConfig (Prelude.Maybe Prelude.Text)
updateClusterConfig_clientRequestToken :: Lens' UpdateClusterConfig (Maybe Text)
updateClusterConfig_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfig' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: UpdateClusterConfig
s@UpdateClusterConfig' {} Maybe Text
a -> UpdateClusterConfig
s {$sel:clientRequestToken:UpdateClusterConfig' :: Maybe Text
clientRequestToken = Maybe Text
a} :: UpdateClusterConfig)

-- | Enable or disable exporting the Kubernetes control plane logs for your
-- cluster to CloudWatch Logs. By default, cluster control plane logs
-- aren\'t exported to CloudWatch Logs. For more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/control-plane-logs.html Amazon EKS cluster control plane logs>
-- in the //Amazon EKS User Guide// .
--
-- CloudWatch Logs ingestion, archive storage, and data scanning rates
-- apply to exported control plane logs. For more information, see
-- <http://aws.amazon.com/cloudwatch/pricing/ CloudWatch Pricing>.
updateClusterConfig_logging :: Lens.Lens' UpdateClusterConfig (Prelude.Maybe Logging)
updateClusterConfig_logging :: Lens' UpdateClusterConfig (Maybe Logging)
updateClusterConfig_logging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfig' {Maybe Logging
logging :: Maybe Logging
$sel:logging:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Logging
logging} -> Maybe Logging
logging) (\s :: UpdateClusterConfig
s@UpdateClusterConfig' {} Maybe Logging
a -> UpdateClusterConfig
s {$sel:logging:UpdateClusterConfig' :: Maybe Logging
logging = Maybe Logging
a} :: UpdateClusterConfig)

-- | Undocumented member.
updateClusterConfig_resourcesVpcConfig :: Lens.Lens' UpdateClusterConfig (Prelude.Maybe VpcConfigRequest)
updateClusterConfig_resourcesVpcConfig :: Lens' UpdateClusterConfig (Maybe VpcConfigRequest)
updateClusterConfig_resourcesVpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfig' {Maybe VpcConfigRequest
resourcesVpcConfig :: Maybe VpcConfigRequest
$sel:resourcesVpcConfig:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe VpcConfigRequest
resourcesVpcConfig} -> Maybe VpcConfigRequest
resourcesVpcConfig) (\s :: UpdateClusterConfig
s@UpdateClusterConfig' {} Maybe VpcConfigRequest
a -> UpdateClusterConfig
s {$sel:resourcesVpcConfig:UpdateClusterConfig' :: Maybe VpcConfigRequest
resourcesVpcConfig = Maybe VpcConfigRequest
a} :: UpdateClusterConfig)

-- | The name of the Amazon EKS cluster to update.
updateClusterConfig_name :: Lens.Lens' UpdateClusterConfig Prelude.Text
updateClusterConfig_name :: Lens' UpdateClusterConfig Text
updateClusterConfig_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfig' {Text
name :: Text
$sel:name:UpdateClusterConfig' :: UpdateClusterConfig -> Text
name} -> Text
name) (\s :: UpdateClusterConfig
s@UpdateClusterConfig' {} Text
a -> UpdateClusterConfig
s {$sel:name:UpdateClusterConfig' :: Text
name = Text
a} :: UpdateClusterConfig)

instance Core.AWSRequest UpdateClusterConfig where
  type
    AWSResponse UpdateClusterConfig =
      UpdateClusterConfigResponse
  request :: (Service -> Service)
-> UpdateClusterConfig -> Request UpdateClusterConfig
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 UpdateClusterConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateClusterConfig)))
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 Update -> Int -> UpdateClusterConfigResponse
UpdateClusterConfigResponse'
            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
"update")
            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 UpdateClusterConfig where
  hashWithSalt :: Int -> UpdateClusterConfig -> Int
hashWithSalt Int
_salt UpdateClusterConfig' {Maybe Text
Maybe Logging
Maybe VpcConfigRequest
Text
name :: Text
resourcesVpcConfig :: Maybe VpcConfigRequest
logging :: Maybe Logging
clientRequestToken :: Maybe Text
$sel:name:UpdateClusterConfig' :: UpdateClusterConfig -> Text
$sel:resourcesVpcConfig:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe VpcConfigRequest
$sel:logging:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Logging
$sel:clientRequestToken:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Logging
logging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfigRequest
resourcesVpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateClusterConfig where
  rnf :: UpdateClusterConfig -> ()
rnf UpdateClusterConfig' {Maybe Text
Maybe Logging
Maybe VpcConfigRequest
Text
name :: Text
resourcesVpcConfig :: Maybe VpcConfigRequest
logging :: Maybe Logging
clientRequestToken :: Maybe Text
$sel:name:UpdateClusterConfig' :: UpdateClusterConfig -> Text
$sel:resourcesVpcConfig:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe VpcConfigRequest
$sel:logging:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Logging
$sel:clientRequestToken:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Logging
logging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfigRequest
resourcesVpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON UpdateClusterConfig where
  toJSON :: UpdateClusterConfig -> Value
toJSON UpdateClusterConfig' {Maybe Text
Maybe Logging
Maybe VpcConfigRequest
Text
name :: Text
resourcesVpcConfig :: Maybe VpcConfigRequest
logging :: Maybe Logging
clientRequestToken :: Maybe Text
$sel:name:UpdateClusterConfig' :: UpdateClusterConfig -> Text
$sel:resourcesVpcConfig:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe VpcConfigRequest
$sel:logging:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Logging
$sel:clientRequestToken:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientRequestToken" 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
clientRequestToken,
            (Key
"logging" 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 Logging
logging,
            (Key
"resourcesVpcConfig" 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 VpcConfigRequest
resourcesVpcConfig
          ]
      )

instance Data.ToPath UpdateClusterConfig where
  toPath :: UpdateClusterConfig -> ByteString
toPath UpdateClusterConfig' {Maybe Text
Maybe Logging
Maybe VpcConfigRequest
Text
name :: Text
resourcesVpcConfig :: Maybe VpcConfigRequest
logging :: Maybe Logging
clientRequestToken :: Maybe Text
$sel:name:UpdateClusterConfig' :: UpdateClusterConfig -> Text
$sel:resourcesVpcConfig:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe VpcConfigRequest
$sel:logging:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Logging
$sel:clientRequestToken:UpdateClusterConfig' :: UpdateClusterConfig -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/clusters/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name, ByteString
"/update-config"]

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

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

-- |
-- Create a value of 'UpdateClusterConfigResponse' 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:
--
-- 'update', 'updateClusterConfigResponse_update' - Undocumented member.
--
-- 'httpStatus', 'updateClusterConfigResponse_httpStatus' - The response's http status code.
newUpdateClusterConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateClusterConfigResponse
newUpdateClusterConfigResponse :: Int -> UpdateClusterConfigResponse
newUpdateClusterConfigResponse Int
pHttpStatus_ =
  UpdateClusterConfigResponse'
    { $sel:update:UpdateClusterConfigResponse' :: Maybe Update
update =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateClusterConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateClusterConfigResponse_update :: Lens.Lens' UpdateClusterConfigResponse (Prelude.Maybe Update)
updateClusterConfigResponse_update :: Lens' UpdateClusterConfigResponse (Maybe Update)
updateClusterConfigResponse_update = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfigResponse' {Maybe Update
update :: Maybe Update
$sel:update:UpdateClusterConfigResponse' :: UpdateClusterConfigResponse -> Maybe Update
update} -> Maybe Update
update) (\s :: UpdateClusterConfigResponse
s@UpdateClusterConfigResponse' {} Maybe Update
a -> UpdateClusterConfigResponse
s {$sel:update:UpdateClusterConfigResponse' :: Maybe Update
update = Maybe Update
a} :: UpdateClusterConfigResponse)

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

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