{-# 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.UpdateNodegroupConfig
-- 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 managed node group configuration. Your node group
-- continues to function during the update. The response output includes an
-- update ID that you can use to track the status of your node group update
-- with the DescribeUpdate API operation. Currently you can update the
-- Kubernetes labels for a node group or the scaling configuration.
module Amazonka.EKS.UpdateNodegroupConfig
  ( -- * Creating a Request
    UpdateNodegroupConfig (..),
    newUpdateNodegroupConfig,

    -- * Request Lenses
    updateNodegroupConfig_clientRequestToken,
    updateNodegroupConfig_labels,
    updateNodegroupConfig_scalingConfig,
    updateNodegroupConfig_taints,
    updateNodegroupConfig_updateConfig,
    updateNodegroupConfig_clusterName,
    updateNodegroupConfig_nodegroupName,

    -- * Destructuring the Response
    UpdateNodegroupConfigResponse (..),
    newUpdateNodegroupConfigResponse,

    -- * Response Lenses
    updateNodegroupConfigResponse_update,
    updateNodegroupConfigResponse_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:/ 'newUpdateNodegroupConfig' smart constructor.
data UpdateNodegroupConfig = UpdateNodegroupConfig'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    UpdateNodegroupConfig -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The Kubernetes labels to be applied to the nodes in the node group after
    -- the update.
    UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
labels :: Prelude.Maybe UpdateLabelsPayload,
    -- | The scaling configuration details for the Auto Scaling group after the
    -- update.
    UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
scalingConfig :: Prelude.Maybe NodegroupScalingConfig,
    -- | The Kubernetes taints to be applied to the nodes in the node group after
    -- the update. For more information, see
    -- <https://docs.aws.amazon.com/eks/latest/userguide/node-taints-managed-node-groups.html Node taints on managed node groups>.
    UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
taints :: Prelude.Maybe UpdateTaintsPayload,
    -- | The node group update configuration.
    UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
updateConfig :: Prelude.Maybe NodegroupUpdateConfig,
    -- | The name of the Amazon EKS cluster that the managed node group resides
    -- in.
    UpdateNodegroupConfig -> Text
clusterName :: Prelude.Text,
    -- | The name of the managed node group to update.
    UpdateNodegroupConfig -> Text
nodegroupName :: Prelude.Text
  }
  deriving (UpdateNodegroupConfig -> UpdateNodegroupConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNodegroupConfig -> UpdateNodegroupConfig -> Bool
$c/= :: UpdateNodegroupConfig -> UpdateNodegroupConfig -> Bool
== :: UpdateNodegroupConfig -> UpdateNodegroupConfig -> Bool
$c== :: UpdateNodegroupConfig -> UpdateNodegroupConfig -> Bool
Prelude.Eq, ReadPrec [UpdateNodegroupConfig]
ReadPrec UpdateNodegroupConfig
Int -> ReadS UpdateNodegroupConfig
ReadS [UpdateNodegroupConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNodegroupConfig]
$creadListPrec :: ReadPrec [UpdateNodegroupConfig]
readPrec :: ReadPrec UpdateNodegroupConfig
$creadPrec :: ReadPrec UpdateNodegroupConfig
readList :: ReadS [UpdateNodegroupConfig]
$creadList :: ReadS [UpdateNodegroupConfig]
readsPrec :: Int -> ReadS UpdateNodegroupConfig
$creadsPrec :: Int -> ReadS UpdateNodegroupConfig
Prelude.Read, Int -> UpdateNodegroupConfig -> ShowS
[UpdateNodegroupConfig] -> ShowS
UpdateNodegroupConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNodegroupConfig] -> ShowS
$cshowList :: [UpdateNodegroupConfig] -> ShowS
show :: UpdateNodegroupConfig -> String
$cshow :: UpdateNodegroupConfig -> String
showsPrec :: Int -> UpdateNodegroupConfig -> ShowS
$cshowsPrec :: Int -> UpdateNodegroupConfig -> ShowS
Prelude.Show, forall x. Rep UpdateNodegroupConfig x -> UpdateNodegroupConfig
forall x. UpdateNodegroupConfig -> Rep UpdateNodegroupConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateNodegroupConfig x -> UpdateNodegroupConfig
$cfrom :: forall x. UpdateNodegroupConfig -> Rep UpdateNodegroupConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateNodegroupConfig' 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', 'updateNodegroupConfig_clientRequestToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'labels', 'updateNodegroupConfig_labels' - The Kubernetes labels to be applied to the nodes in the node group after
-- the update.
--
-- 'scalingConfig', 'updateNodegroupConfig_scalingConfig' - The scaling configuration details for the Auto Scaling group after the
-- update.
--
-- 'taints', 'updateNodegroupConfig_taints' - The Kubernetes taints to be applied to the nodes in the node group after
-- the update. For more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/node-taints-managed-node-groups.html Node taints on managed node groups>.
--
-- 'updateConfig', 'updateNodegroupConfig_updateConfig' - The node group update configuration.
--
-- 'clusterName', 'updateNodegroupConfig_clusterName' - The name of the Amazon EKS cluster that the managed node group resides
-- in.
--
-- 'nodegroupName', 'updateNodegroupConfig_nodegroupName' - The name of the managed node group to update.
newUpdateNodegroupConfig ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'nodegroupName'
  Prelude.Text ->
  UpdateNodegroupConfig
newUpdateNodegroupConfig :: Text -> Text -> UpdateNodegroupConfig
newUpdateNodegroupConfig
  Text
pClusterName_
  Text
pNodegroupName_ =
    UpdateNodegroupConfig'
      { $sel:clientRequestToken:UpdateNodegroupConfig' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:labels:UpdateNodegroupConfig' :: Maybe UpdateLabelsPayload
labels = forall a. Maybe a
Prelude.Nothing,
        $sel:scalingConfig:UpdateNodegroupConfig' :: Maybe NodegroupScalingConfig
scalingConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:taints:UpdateNodegroupConfig' :: Maybe UpdateTaintsPayload
taints = forall a. Maybe a
Prelude.Nothing,
        $sel:updateConfig:UpdateNodegroupConfig' :: Maybe NodegroupUpdateConfig
updateConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterName:UpdateNodegroupConfig' :: Text
clusterName = Text
pClusterName_,
        $sel:nodegroupName:UpdateNodegroupConfig' :: Text
nodegroupName = Text
pNodegroupName_
      }

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

-- | The Kubernetes labels to be applied to the nodes in the node group after
-- the update.
updateNodegroupConfig_labels :: Lens.Lens' UpdateNodegroupConfig (Prelude.Maybe UpdateLabelsPayload)
updateNodegroupConfig_labels :: Lens' UpdateNodegroupConfig (Maybe UpdateLabelsPayload)
updateNodegroupConfig_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Maybe UpdateLabelsPayload
labels :: Maybe UpdateLabelsPayload
$sel:labels:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
labels} -> Maybe UpdateLabelsPayload
labels) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Maybe UpdateLabelsPayload
a -> UpdateNodegroupConfig
s {$sel:labels:UpdateNodegroupConfig' :: Maybe UpdateLabelsPayload
labels = Maybe UpdateLabelsPayload
a} :: UpdateNodegroupConfig)

-- | The scaling configuration details for the Auto Scaling group after the
-- update.
updateNodegroupConfig_scalingConfig :: Lens.Lens' UpdateNodegroupConfig (Prelude.Maybe NodegroupScalingConfig)
updateNodegroupConfig_scalingConfig :: Lens' UpdateNodegroupConfig (Maybe NodegroupScalingConfig)
updateNodegroupConfig_scalingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Maybe NodegroupScalingConfig
scalingConfig :: Maybe NodegroupScalingConfig
$sel:scalingConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
scalingConfig} -> Maybe NodegroupScalingConfig
scalingConfig) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Maybe NodegroupScalingConfig
a -> UpdateNodegroupConfig
s {$sel:scalingConfig:UpdateNodegroupConfig' :: Maybe NodegroupScalingConfig
scalingConfig = Maybe NodegroupScalingConfig
a} :: UpdateNodegroupConfig)

-- | The Kubernetes taints to be applied to the nodes in the node group after
-- the update. For more information, see
-- <https://docs.aws.amazon.com/eks/latest/userguide/node-taints-managed-node-groups.html Node taints on managed node groups>.
updateNodegroupConfig_taints :: Lens.Lens' UpdateNodegroupConfig (Prelude.Maybe UpdateTaintsPayload)
updateNodegroupConfig_taints :: Lens' UpdateNodegroupConfig (Maybe UpdateTaintsPayload)
updateNodegroupConfig_taints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Maybe UpdateTaintsPayload
taints :: Maybe UpdateTaintsPayload
$sel:taints:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
taints} -> Maybe UpdateTaintsPayload
taints) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Maybe UpdateTaintsPayload
a -> UpdateNodegroupConfig
s {$sel:taints:UpdateNodegroupConfig' :: Maybe UpdateTaintsPayload
taints = Maybe UpdateTaintsPayload
a} :: UpdateNodegroupConfig)

-- | The node group update configuration.
updateNodegroupConfig_updateConfig :: Lens.Lens' UpdateNodegroupConfig (Prelude.Maybe NodegroupUpdateConfig)
updateNodegroupConfig_updateConfig :: Lens' UpdateNodegroupConfig (Maybe NodegroupUpdateConfig)
updateNodegroupConfig_updateConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Maybe NodegroupUpdateConfig
updateConfig :: Maybe NodegroupUpdateConfig
$sel:updateConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
updateConfig} -> Maybe NodegroupUpdateConfig
updateConfig) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Maybe NodegroupUpdateConfig
a -> UpdateNodegroupConfig
s {$sel:updateConfig:UpdateNodegroupConfig' :: Maybe NodegroupUpdateConfig
updateConfig = Maybe NodegroupUpdateConfig
a} :: UpdateNodegroupConfig)

-- | The name of the Amazon EKS cluster that the managed node group resides
-- in.
updateNodegroupConfig_clusterName :: Lens.Lens' UpdateNodegroupConfig Prelude.Text
updateNodegroupConfig_clusterName :: Lens' UpdateNodegroupConfig Text
updateNodegroupConfig_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Text
clusterName :: Text
$sel:clusterName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
clusterName} -> Text
clusterName) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Text
a -> UpdateNodegroupConfig
s {$sel:clusterName:UpdateNodegroupConfig' :: Text
clusterName = Text
a} :: UpdateNodegroupConfig)

-- | The name of the managed node group to update.
updateNodegroupConfig_nodegroupName :: Lens.Lens' UpdateNodegroupConfig Prelude.Text
updateNodegroupConfig_nodegroupName :: Lens' UpdateNodegroupConfig Text
updateNodegroupConfig_nodegroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNodegroupConfig' {Text
nodegroupName :: Text
$sel:nodegroupName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
nodegroupName} -> Text
nodegroupName) (\s :: UpdateNodegroupConfig
s@UpdateNodegroupConfig' {} Text
a -> UpdateNodegroupConfig
s {$sel:nodegroupName:UpdateNodegroupConfig' :: Text
nodegroupName = Text
a} :: UpdateNodegroupConfig)

instance Core.AWSRequest UpdateNodegroupConfig where
  type
    AWSResponse UpdateNodegroupConfig =
      UpdateNodegroupConfigResponse
  request :: (Service -> Service)
-> UpdateNodegroupConfig -> Request UpdateNodegroupConfig
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 UpdateNodegroupConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateNodegroupConfig)))
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 -> UpdateNodegroupConfigResponse
UpdateNodegroupConfigResponse'
            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 UpdateNodegroupConfig where
  hashWithSalt :: Int -> UpdateNodegroupConfig -> Int
hashWithSalt Int
_salt UpdateNodegroupConfig' {Maybe Text
Maybe NodegroupScalingConfig
Maybe NodegroupUpdateConfig
Maybe UpdateLabelsPayload
Maybe UpdateTaintsPayload
Text
nodegroupName :: Text
clusterName :: Text
updateConfig :: Maybe NodegroupUpdateConfig
taints :: Maybe UpdateTaintsPayload
scalingConfig :: Maybe NodegroupScalingConfig
labels :: Maybe UpdateLabelsPayload
clientRequestToken :: Maybe Text
$sel:nodegroupName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:clusterName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:updateConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
$sel:taints:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
$sel:scalingConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
$sel:labels:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
$sel:clientRequestToken:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> 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 UpdateLabelsPayload
labels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodegroupScalingConfig
scalingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateTaintsPayload
taints
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodegroupUpdateConfig
updateConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
nodegroupName

instance Prelude.NFData UpdateNodegroupConfig where
  rnf :: UpdateNodegroupConfig -> ()
rnf UpdateNodegroupConfig' {Maybe Text
Maybe NodegroupScalingConfig
Maybe NodegroupUpdateConfig
Maybe UpdateLabelsPayload
Maybe UpdateTaintsPayload
Text
nodegroupName :: Text
clusterName :: Text
updateConfig :: Maybe NodegroupUpdateConfig
taints :: Maybe UpdateTaintsPayload
scalingConfig :: Maybe NodegroupScalingConfig
labels :: Maybe UpdateLabelsPayload
clientRequestToken :: Maybe Text
$sel:nodegroupName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:clusterName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:updateConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
$sel:taints:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
$sel:scalingConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
$sel:labels:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
$sel:clientRequestToken:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> 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 UpdateLabelsPayload
labels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodegroupScalingConfig
scalingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateTaintsPayload
taints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodegroupUpdateConfig
updateConfig
      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 Text
nodegroupName

instance Data.ToHeaders UpdateNodegroupConfig where
  toHeaders :: UpdateNodegroupConfig -> 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 UpdateNodegroupConfig where
  toJSON :: UpdateNodegroupConfig -> Value
toJSON UpdateNodegroupConfig' {Maybe Text
Maybe NodegroupScalingConfig
Maybe NodegroupUpdateConfig
Maybe UpdateLabelsPayload
Maybe UpdateTaintsPayload
Text
nodegroupName :: Text
clusterName :: Text
updateConfig :: Maybe NodegroupUpdateConfig
taints :: Maybe UpdateTaintsPayload
scalingConfig :: Maybe NodegroupScalingConfig
labels :: Maybe UpdateLabelsPayload
clientRequestToken :: Maybe Text
$sel:nodegroupName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:clusterName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:updateConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
$sel:taints:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
$sel:scalingConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
$sel:labels:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
$sel:clientRequestToken:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> 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
"labels" 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 UpdateLabelsPayload
labels,
            (Key
"scalingConfig" 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 NodegroupScalingConfig
scalingConfig,
            (Key
"taints" 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 UpdateTaintsPayload
taints,
            (Key
"updateConfig" 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 NodegroupUpdateConfig
updateConfig
          ]
      )

instance Data.ToPath UpdateNodegroupConfig where
  toPath :: UpdateNodegroupConfig -> ByteString
toPath UpdateNodegroupConfig' {Maybe Text
Maybe NodegroupScalingConfig
Maybe NodegroupUpdateConfig
Maybe UpdateLabelsPayload
Maybe UpdateTaintsPayload
Text
nodegroupName :: Text
clusterName :: Text
updateConfig :: Maybe NodegroupUpdateConfig
taints :: Maybe UpdateTaintsPayload
scalingConfig :: Maybe NodegroupScalingConfig
labels :: Maybe UpdateLabelsPayload
clientRequestToken :: Maybe Text
$sel:nodegroupName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:clusterName:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Text
$sel:updateConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupUpdateConfig
$sel:taints:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateTaintsPayload
$sel:scalingConfig:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe NodegroupScalingConfig
$sel:labels:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe UpdateLabelsPayload
$sel:clientRequestToken:UpdateNodegroupConfig' :: UpdateNodegroupConfig -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterName,
        ByteString
"/node-groups/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
nodegroupName,
        ByteString
"/update-config"
      ]

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

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

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

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

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

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