{-# 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.Kafka.UpdateClusterConfiguration
-- 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 the cluster with the configuration that is specified in the
-- request body.
module Amazonka.Kafka.UpdateClusterConfiguration
  ( -- * Creating a Request
    UpdateClusterConfiguration (..),
    newUpdateClusterConfiguration,

    -- * Request Lenses
    updateClusterConfiguration_clusterArn,
    updateClusterConfiguration_currentVersion,
    updateClusterConfiguration_configurationInfo,

    -- * Destructuring the Response
    UpdateClusterConfigurationResponse (..),
    newUpdateClusterConfigurationResponse,

    -- * Response Lenses
    updateClusterConfigurationResponse_clusterArn,
    updateClusterConfigurationResponse_clusterOperationArn,
    updateClusterConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateClusterConfiguration' smart constructor.
data UpdateClusterConfiguration = UpdateClusterConfiguration'
  { -- | The Amazon Resource Name (ARN) that uniquely identifies the cluster.
    UpdateClusterConfiguration -> Text
clusterArn :: Prelude.Text,
    -- | The version of the cluster that needs to be updated.
    UpdateClusterConfiguration -> Text
currentVersion :: Prelude.Text,
    -- | Represents the configuration that you want MSK to use for the brokers in
    -- a cluster.
    UpdateClusterConfiguration -> ConfigurationInfo
configurationInfo :: ConfigurationInfo
  }
  deriving (UpdateClusterConfiguration -> UpdateClusterConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClusterConfiguration -> UpdateClusterConfiguration -> Bool
$c/= :: UpdateClusterConfiguration -> UpdateClusterConfiguration -> Bool
== :: UpdateClusterConfiguration -> UpdateClusterConfiguration -> Bool
$c== :: UpdateClusterConfiguration -> UpdateClusterConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateClusterConfiguration]
ReadPrec UpdateClusterConfiguration
Int -> ReadS UpdateClusterConfiguration
ReadS [UpdateClusterConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClusterConfiguration]
$creadListPrec :: ReadPrec [UpdateClusterConfiguration]
readPrec :: ReadPrec UpdateClusterConfiguration
$creadPrec :: ReadPrec UpdateClusterConfiguration
readList :: ReadS [UpdateClusterConfiguration]
$creadList :: ReadS [UpdateClusterConfiguration]
readsPrec :: Int -> ReadS UpdateClusterConfiguration
$creadsPrec :: Int -> ReadS UpdateClusterConfiguration
Prelude.Read, Int -> UpdateClusterConfiguration -> ShowS
[UpdateClusterConfiguration] -> ShowS
UpdateClusterConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClusterConfiguration] -> ShowS
$cshowList :: [UpdateClusterConfiguration] -> ShowS
show :: UpdateClusterConfiguration -> String
$cshow :: UpdateClusterConfiguration -> String
showsPrec :: Int -> UpdateClusterConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateClusterConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateClusterConfiguration x -> UpdateClusterConfiguration
forall x.
UpdateClusterConfiguration -> Rep UpdateClusterConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateClusterConfiguration x -> UpdateClusterConfiguration
$cfrom :: forall x.
UpdateClusterConfiguration -> Rep UpdateClusterConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClusterConfiguration' 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:
--
-- 'clusterArn', 'updateClusterConfiguration_clusterArn' - The Amazon Resource Name (ARN) that uniquely identifies the cluster.
--
-- 'currentVersion', 'updateClusterConfiguration_currentVersion' - The version of the cluster that needs to be updated.
--
-- 'configurationInfo', 'updateClusterConfiguration_configurationInfo' - Represents the configuration that you want MSK to use for the brokers in
-- a cluster.
newUpdateClusterConfiguration ::
  -- | 'clusterArn'
  Prelude.Text ->
  -- | 'currentVersion'
  Prelude.Text ->
  -- | 'configurationInfo'
  ConfigurationInfo ->
  UpdateClusterConfiguration
newUpdateClusterConfiguration :: Text -> Text -> ConfigurationInfo -> UpdateClusterConfiguration
newUpdateClusterConfiguration
  Text
pClusterArn_
  Text
pCurrentVersion_
  ConfigurationInfo
pConfigurationInfo_ =
    UpdateClusterConfiguration'
      { $sel:clusterArn:UpdateClusterConfiguration' :: Text
clusterArn =
          Text
pClusterArn_,
        $sel:currentVersion:UpdateClusterConfiguration' :: Text
currentVersion = Text
pCurrentVersion_,
        $sel:configurationInfo:UpdateClusterConfiguration' :: ConfigurationInfo
configurationInfo = ConfigurationInfo
pConfigurationInfo_
      }

-- | The Amazon Resource Name (ARN) that uniquely identifies the cluster.
updateClusterConfiguration_clusterArn :: Lens.Lens' UpdateClusterConfiguration Prelude.Text
updateClusterConfiguration_clusterArn :: Lens' UpdateClusterConfiguration Text
updateClusterConfiguration_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfiguration' {Text
clusterArn :: Text
$sel:clusterArn:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
clusterArn} -> Text
clusterArn) (\s :: UpdateClusterConfiguration
s@UpdateClusterConfiguration' {} Text
a -> UpdateClusterConfiguration
s {$sel:clusterArn:UpdateClusterConfiguration' :: Text
clusterArn = Text
a} :: UpdateClusterConfiguration)

-- | The version of the cluster that needs to be updated.
updateClusterConfiguration_currentVersion :: Lens.Lens' UpdateClusterConfiguration Prelude.Text
updateClusterConfiguration_currentVersion :: Lens' UpdateClusterConfiguration Text
updateClusterConfiguration_currentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfiguration' {Text
currentVersion :: Text
$sel:currentVersion:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
currentVersion} -> Text
currentVersion) (\s :: UpdateClusterConfiguration
s@UpdateClusterConfiguration' {} Text
a -> UpdateClusterConfiguration
s {$sel:currentVersion:UpdateClusterConfiguration' :: Text
currentVersion = Text
a} :: UpdateClusterConfiguration)

-- | Represents the configuration that you want MSK to use for the brokers in
-- a cluster.
updateClusterConfiguration_configurationInfo :: Lens.Lens' UpdateClusterConfiguration ConfigurationInfo
updateClusterConfiguration_configurationInfo :: Lens' UpdateClusterConfiguration ConfigurationInfo
updateClusterConfiguration_configurationInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfiguration' {ConfigurationInfo
configurationInfo :: ConfigurationInfo
$sel:configurationInfo:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> ConfigurationInfo
configurationInfo} -> ConfigurationInfo
configurationInfo) (\s :: UpdateClusterConfiguration
s@UpdateClusterConfiguration' {} ConfigurationInfo
a -> UpdateClusterConfiguration
s {$sel:configurationInfo:UpdateClusterConfiguration' :: ConfigurationInfo
configurationInfo = ConfigurationInfo
a} :: UpdateClusterConfiguration)

instance Core.AWSRequest UpdateClusterConfiguration where
  type
    AWSResponse UpdateClusterConfiguration =
      UpdateClusterConfigurationResponse
  request :: (Service -> Service)
-> UpdateClusterConfiguration -> Request UpdateClusterConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateClusterConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateClusterConfiguration)))
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 Text
-> Maybe Text -> Int -> UpdateClusterConfigurationResponse
UpdateClusterConfigurationResponse'
            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
"clusterArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"clusterOperationArn")
            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 UpdateClusterConfiguration where
  hashWithSalt :: Int -> UpdateClusterConfiguration -> Int
hashWithSalt Int
_salt UpdateClusterConfiguration' {Text
ConfigurationInfo
configurationInfo :: ConfigurationInfo
currentVersion :: Text
clusterArn :: Text
$sel:configurationInfo:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> ConfigurationInfo
$sel:currentVersion:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
$sel:clusterArn:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
currentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConfigurationInfo
configurationInfo

instance Prelude.NFData UpdateClusterConfiguration where
  rnf :: UpdateClusterConfiguration -> ()
rnf UpdateClusterConfiguration' {Text
ConfigurationInfo
configurationInfo :: ConfigurationInfo
currentVersion :: Text
clusterArn :: Text
$sel:configurationInfo:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> ConfigurationInfo
$sel:currentVersion:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
$sel:clusterArn:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
currentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConfigurationInfo
configurationInfo

instance Data.ToHeaders UpdateClusterConfiguration where
  toHeaders :: UpdateClusterConfiguration -> 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 UpdateClusterConfiguration where
  toJSON :: UpdateClusterConfiguration -> Value
toJSON UpdateClusterConfiguration' {Text
ConfigurationInfo
configurationInfo :: ConfigurationInfo
currentVersion :: Text
clusterArn :: Text
$sel:configurationInfo:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> ConfigurationInfo
$sel:currentVersion:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
$sel:clusterArn:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"currentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
currentVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"configurationInfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConfigurationInfo
configurationInfo)
          ]
      )

instance Data.ToPath UpdateClusterConfiguration where
  toPath :: UpdateClusterConfiguration -> ByteString
toPath UpdateClusterConfiguration' {Text
ConfigurationInfo
configurationInfo :: ConfigurationInfo
currentVersion :: Text
clusterArn :: Text
$sel:configurationInfo:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> ConfigurationInfo
$sel:currentVersion:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
$sel:clusterArn:UpdateClusterConfiguration' :: UpdateClusterConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterArn,
        ByteString
"/configuration"
      ]

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

-- | /See:/ 'newUpdateClusterConfigurationResponse' smart constructor.
data UpdateClusterConfigurationResponse = UpdateClusterConfigurationResponse'
  { -- | The Amazon Resource Name (ARN) of the cluster.
    UpdateClusterConfigurationResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the cluster operation.
    UpdateClusterConfigurationResponse -> Maybe Text
clusterOperationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateClusterConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateClusterConfigurationResponse
-> UpdateClusterConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClusterConfigurationResponse
-> UpdateClusterConfigurationResponse -> Bool
$c/= :: UpdateClusterConfigurationResponse
-> UpdateClusterConfigurationResponse -> Bool
== :: UpdateClusterConfigurationResponse
-> UpdateClusterConfigurationResponse -> Bool
$c== :: UpdateClusterConfigurationResponse
-> UpdateClusterConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateClusterConfigurationResponse]
ReadPrec UpdateClusterConfigurationResponse
Int -> ReadS UpdateClusterConfigurationResponse
ReadS [UpdateClusterConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClusterConfigurationResponse]
$creadListPrec :: ReadPrec [UpdateClusterConfigurationResponse]
readPrec :: ReadPrec UpdateClusterConfigurationResponse
$creadPrec :: ReadPrec UpdateClusterConfigurationResponse
readList :: ReadS [UpdateClusterConfigurationResponse]
$creadList :: ReadS [UpdateClusterConfigurationResponse]
readsPrec :: Int -> ReadS UpdateClusterConfigurationResponse
$creadsPrec :: Int -> ReadS UpdateClusterConfigurationResponse
Prelude.Read, Int -> UpdateClusterConfigurationResponse -> ShowS
[UpdateClusterConfigurationResponse] -> ShowS
UpdateClusterConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClusterConfigurationResponse] -> ShowS
$cshowList :: [UpdateClusterConfigurationResponse] -> ShowS
show :: UpdateClusterConfigurationResponse -> String
$cshow :: UpdateClusterConfigurationResponse -> String
showsPrec :: Int -> UpdateClusterConfigurationResponse -> ShowS
$cshowsPrec :: Int -> UpdateClusterConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateClusterConfigurationResponse x
-> UpdateClusterConfigurationResponse
forall x.
UpdateClusterConfigurationResponse
-> Rep UpdateClusterConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateClusterConfigurationResponse x
-> UpdateClusterConfigurationResponse
$cfrom :: forall x.
UpdateClusterConfigurationResponse
-> Rep UpdateClusterConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClusterConfigurationResponse' 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:
--
-- 'clusterArn', 'updateClusterConfigurationResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'clusterOperationArn', 'updateClusterConfigurationResponse_clusterOperationArn' - The Amazon Resource Name (ARN) of the cluster operation.
--
-- 'httpStatus', 'updateClusterConfigurationResponse_httpStatus' - The response's http status code.
newUpdateClusterConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateClusterConfigurationResponse
newUpdateClusterConfigurationResponse :: Int -> UpdateClusterConfigurationResponse
newUpdateClusterConfigurationResponse Int
pHttpStatus_ =
  UpdateClusterConfigurationResponse'
    { $sel:clusterArn:UpdateClusterConfigurationResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterOperationArn:UpdateClusterConfigurationResponse' :: Maybe Text
clusterOperationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateClusterConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the cluster.
updateClusterConfigurationResponse_clusterArn :: Lens.Lens' UpdateClusterConfigurationResponse (Prelude.Maybe Prelude.Text)
updateClusterConfigurationResponse_clusterArn :: Lens' UpdateClusterConfigurationResponse (Maybe Text)
updateClusterConfigurationResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfigurationResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:UpdateClusterConfigurationResponse' :: UpdateClusterConfigurationResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: UpdateClusterConfigurationResponse
s@UpdateClusterConfigurationResponse' {} Maybe Text
a -> UpdateClusterConfigurationResponse
s {$sel:clusterArn:UpdateClusterConfigurationResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: UpdateClusterConfigurationResponse)

-- | The Amazon Resource Name (ARN) of the cluster operation.
updateClusterConfigurationResponse_clusterOperationArn :: Lens.Lens' UpdateClusterConfigurationResponse (Prelude.Maybe Prelude.Text)
updateClusterConfigurationResponse_clusterOperationArn :: Lens' UpdateClusterConfigurationResponse (Maybe Text)
updateClusterConfigurationResponse_clusterOperationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClusterConfigurationResponse' {Maybe Text
clusterOperationArn :: Maybe Text
$sel:clusterOperationArn:UpdateClusterConfigurationResponse' :: UpdateClusterConfigurationResponse -> Maybe Text
clusterOperationArn} -> Maybe Text
clusterOperationArn) (\s :: UpdateClusterConfigurationResponse
s@UpdateClusterConfigurationResponse' {} Maybe Text
a -> UpdateClusterConfigurationResponse
s {$sel:clusterOperationArn:UpdateClusterConfigurationResponse' :: Maybe Text
clusterOperationArn = Maybe Text
a} :: UpdateClusterConfigurationResponse)

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

instance
  Prelude.NFData
    UpdateClusterConfigurationResponse
  where
  rnf :: UpdateClusterConfigurationResponse -> ()
rnf UpdateClusterConfigurationResponse' {Int
Maybe Text
httpStatus :: Int
clusterOperationArn :: Maybe Text
clusterArn :: Maybe Text
$sel:httpStatus:UpdateClusterConfigurationResponse' :: UpdateClusterConfigurationResponse -> Int
$sel:clusterOperationArn:UpdateClusterConfigurationResponse' :: UpdateClusterConfigurationResponse -> Maybe Text
$sel:clusterArn:UpdateClusterConfigurationResponse' :: UpdateClusterConfigurationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterOperationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus