{-# 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.ECS.PutClusterCapacityProviders
-- 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 available capacity providers and the default capacity
-- provider strategy for a cluster.
--
-- You must specify both the available capacity providers and a default
-- capacity provider strategy for the cluster. If the specified cluster has
-- existing capacity providers associated with it, you must specify all
-- existing capacity providers in addition to any new ones you want to add.
-- Any existing capacity providers that are associated with a cluster that
-- are omitted from a PutClusterCapacityProviders API call will be
-- disassociated with the cluster. You can only disassociate an existing
-- capacity provider from a cluster if it\'s not being used by any existing
-- tasks.
--
-- When creating a service or running a task on a cluster, if no capacity
-- provider or launch type is specified, then the cluster\'s default
-- capacity provider strategy is used. We recommend that you define a
-- default capacity provider strategy for your cluster. However, you must
-- specify an empty array (@[]@) to bypass defining a default strategy.
module Amazonka.ECS.PutClusterCapacityProviders
  ( -- * Creating a Request
    PutClusterCapacityProviders (..),
    newPutClusterCapacityProviders,

    -- * Request Lenses
    putClusterCapacityProviders_cluster,
    putClusterCapacityProviders_capacityProviders,
    putClusterCapacityProviders_defaultCapacityProviderStrategy,

    -- * Destructuring the Response
    PutClusterCapacityProvidersResponse (..),
    newPutClusterCapacityProvidersResponse,

    -- * Response Lenses
    putClusterCapacityProvidersResponse_cluster,
    putClusterCapacityProvidersResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutClusterCapacityProviders' smart constructor.
data PutClusterCapacityProviders = PutClusterCapacityProviders'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster to
    -- modify the capacity provider settings for. If you don\'t specify a
    -- cluster, the default cluster is assumed.
    PutClusterCapacityProviders -> Text
cluster :: Prelude.Text,
    -- | The name of one or more capacity providers to associate with the
    -- cluster.
    --
    -- If specifying a capacity provider that uses an Auto Scaling group, the
    -- capacity provider must already be created. New capacity providers can be
    -- created with the CreateCapacityProvider API operation.
    --
    -- To use a Fargate capacity provider, specify either the @FARGATE@ or
    -- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
    -- available to all accounts and only need to be associated with a cluster
    -- to be used.
    PutClusterCapacityProviders -> [Text]
capacityProviders :: [Prelude.Text],
    -- | The capacity provider strategy to use by default for the cluster.
    --
    -- When creating a service or running a task on a cluster, if no capacity
    -- provider or launch type is specified then the default capacity provider
    -- strategy for the cluster is used.
    --
    -- A capacity provider strategy consists of one or more capacity providers
    -- along with the @base@ and @weight@ to assign to them. A capacity
    -- provider must be associated with the cluster to be used in a capacity
    -- provider strategy. The PutClusterCapacityProviders API is used to
    -- associate a capacity provider with a cluster. Only capacity providers
    -- with an @ACTIVE@ or @UPDATING@ status can be used.
    --
    -- If specifying a capacity provider that uses an Auto Scaling group, the
    -- capacity provider must already be created. New capacity providers can be
    -- created with the CreateCapacityProvider API operation.
    --
    -- To use a Fargate capacity provider, specify either the @FARGATE@ or
    -- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
    -- available to all accounts and only need to be associated with a cluster
    -- to be used.
    PutClusterCapacityProviders -> [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy :: [CapacityProviderStrategyItem]
  }
  deriving (PutClusterCapacityProviders -> PutClusterCapacityProviders -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutClusterCapacityProviders -> PutClusterCapacityProviders -> Bool
$c/= :: PutClusterCapacityProviders -> PutClusterCapacityProviders -> Bool
== :: PutClusterCapacityProviders -> PutClusterCapacityProviders -> Bool
$c== :: PutClusterCapacityProviders -> PutClusterCapacityProviders -> Bool
Prelude.Eq, ReadPrec [PutClusterCapacityProviders]
ReadPrec PutClusterCapacityProviders
Int -> ReadS PutClusterCapacityProviders
ReadS [PutClusterCapacityProviders]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutClusterCapacityProviders]
$creadListPrec :: ReadPrec [PutClusterCapacityProviders]
readPrec :: ReadPrec PutClusterCapacityProviders
$creadPrec :: ReadPrec PutClusterCapacityProviders
readList :: ReadS [PutClusterCapacityProviders]
$creadList :: ReadS [PutClusterCapacityProviders]
readsPrec :: Int -> ReadS PutClusterCapacityProviders
$creadsPrec :: Int -> ReadS PutClusterCapacityProviders
Prelude.Read, Int -> PutClusterCapacityProviders -> ShowS
[PutClusterCapacityProviders] -> ShowS
PutClusterCapacityProviders -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutClusterCapacityProviders] -> ShowS
$cshowList :: [PutClusterCapacityProviders] -> ShowS
show :: PutClusterCapacityProviders -> String
$cshow :: PutClusterCapacityProviders -> String
showsPrec :: Int -> PutClusterCapacityProviders -> ShowS
$cshowsPrec :: Int -> PutClusterCapacityProviders -> ShowS
Prelude.Show, forall x.
Rep PutClusterCapacityProviders x -> PutClusterCapacityProviders
forall x.
PutClusterCapacityProviders -> Rep PutClusterCapacityProviders x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutClusterCapacityProviders x -> PutClusterCapacityProviders
$cfrom :: forall x.
PutClusterCapacityProviders -> Rep PutClusterCapacityProviders x
Prelude.Generic)

-- |
-- Create a value of 'PutClusterCapacityProviders' 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', 'putClusterCapacityProviders_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster to
-- modify the capacity provider settings for. If you don\'t specify a
-- cluster, the default cluster is assumed.
--
-- 'capacityProviders', 'putClusterCapacityProviders_capacityProviders' - The name of one or more capacity providers to associate with the
-- cluster.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must already be created. New capacity providers can be
-- created with the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
--
-- 'defaultCapacityProviderStrategy', 'putClusterCapacityProviders_defaultCapacityProviderStrategy' - The capacity provider strategy to use by default for the cluster.
--
-- When creating a service or running a task on a cluster, if no capacity
-- provider or launch type is specified then the default capacity provider
-- strategy for the cluster is used.
--
-- A capacity provider strategy consists of one or more capacity providers
-- along with the @base@ and @weight@ to assign to them. A capacity
-- provider must be associated with the cluster to be used in a capacity
-- provider strategy. The PutClusterCapacityProviders API is used to
-- associate a capacity provider with a cluster. Only capacity providers
-- with an @ACTIVE@ or @UPDATING@ status can be used.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must already be created. New capacity providers can be
-- created with the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
newPutClusterCapacityProviders ::
  -- | 'cluster'
  Prelude.Text ->
  PutClusterCapacityProviders
newPutClusterCapacityProviders :: Text -> PutClusterCapacityProviders
newPutClusterCapacityProviders Text
pCluster_ =
  PutClusterCapacityProviders'
    { $sel:cluster:PutClusterCapacityProviders' :: Text
cluster = Text
pCluster_,
      $sel:capacityProviders:PutClusterCapacityProviders' :: [Text]
capacityProviders = forall a. Monoid a => a
Prelude.mempty,
      $sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The short name or full Amazon Resource Name (ARN) of the cluster to
-- modify the capacity provider settings for. If you don\'t specify a
-- cluster, the default cluster is assumed.
putClusterCapacityProviders_cluster :: Lens.Lens' PutClusterCapacityProviders Prelude.Text
putClusterCapacityProviders_cluster :: Lens' PutClusterCapacityProviders Text
putClusterCapacityProviders_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutClusterCapacityProviders' {Text
cluster :: Text
$sel:cluster:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> Text
cluster} -> Text
cluster) (\s :: PutClusterCapacityProviders
s@PutClusterCapacityProviders' {} Text
a -> PutClusterCapacityProviders
s {$sel:cluster:PutClusterCapacityProviders' :: Text
cluster = Text
a} :: PutClusterCapacityProviders)

-- | The name of one or more capacity providers to associate with the
-- cluster.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must already be created. New capacity providers can be
-- created with the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
putClusterCapacityProviders_capacityProviders :: Lens.Lens' PutClusterCapacityProviders [Prelude.Text]
putClusterCapacityProviders_capacityProviders :: Lens' PutClusterCapacityProviders [Text]
putClusterCapacityProviders_capacityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutClusterCapacityProviders' {[Text]
capacityProviders :: [Text]
$sel:capacityProviders:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [Text]
capacityProviders} -> [Text]
capacityProviders) (\s :: PutClusterCapacityProviders
s@PutClusterCapacityProviders' {} [Text]
a -> PutClusterCapacityProviders
s {$sel:capacityProviders:PutClusterCapacityProviders' :: [Text]
capacityProviders = [Text]
a} :: PutClusterCapacityProviders) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The capacity provider strategy to use by default for the cluster.
--
-- When creating a service or running a task on a cluster, if no capacity
-- provider or launch type is specified then the default capacity provider
-- strategy for the cluster is used.
--
-- A capacity provider strategy consists of one or more capacity providers
-- along with the @base@ and @weight@ to assign to them. A capacity
-- provider must be associated with the cluster to be used in a capacity
-- provider strategy. The PutClusterCapacityProviders API is used to
-- associate a capacity provider with a cluster. Only capacity providers
-- with an @ACTIVE@ or @UPDATING@ status can be used.
--
-- If specifying a capacity provider that uses an Auto Scaling group, the
-- capacity provider must already be created. New capacity providers can be
-- created with the CreateCapacityProvider API operation.
--
-- To use a Fargate capacity provider, specify either the @FARGATE@ or
-- @FARGATE_SPOT@ capacity providers. The Fargate capacity providers are
-- available to all accounts and only need to be associated with a cluster
-- to be used.
putClusterCapacityProviders_defaultCapacityProviderStrategy :: Lens.Lens' PutClusterCapacityProviders [CapacityProviderStrategyItem]
putClusterCapacityProviders_defaultCapacityProviderStrategy :: Lens' PutClusterCapacityProviders [CapacityProviderStrategyItem]
putClusterCapacityProviders_defaultCapacityProviderStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutClusterCapacityProviders' {[CapacityProviderStrategyItem]
defaultCapacityProviderStrategy :: [CapacityProviderStrategyItem]
$sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy} -> [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy) (\s :: PutClusterCapacityProviders
s@PutClusterCapacityProviders' {} [CapacityProviderStrategyItem]
a -> PutClusterCapacityProviders
s {$sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy = [CapacityProviderStrategyItem]
a} :: PutClusterCapacityProviders) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest PutClusterCapacityProviders where
  type
    AWSResponse PutClusterCapacityProviders =
      PutClusterCapacityProvidersResponse
  request :: (Service -> Service)
-> PutClusterCapacityProviders
-> Request PutClusterCapacityProviders
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 PutClusterCapacityProviders
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutClusterCapacityProviders)))
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 -> PutClusterCapacityProvidersResponse
PutClusterCapacityProvidersResponse'
            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 PutClusterCapacityProviders where
  hashWithSalt :: Int -> PutClusterCapacityProviders -> Int
hashWithSalt Int
_salt PutClusterCapacityProviders' {[Text]
[CapacityProviderStrategyItem]
Text
defaultCapacityProviderStrategy :: [CapacityProviderStrategyItem]
capacityProviders :: [Text]
cluster :: Text
$sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [CapacityProviderStrategyItem]
$sel:capacityProviders:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [Text]
$sel:cluster:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
capacityProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy

instance Prelude.NFData PutClusterCapacityProviders where
  rnf :: PutClusterCapacityProviders -> ()
rnf PutClusterCapacityProviders' {[Text]
[CapacityProviderStrategyItem]
Text
defaultCapacityProviderStrategy :: [CapacityProviderStrategyItem]
capacityProviders :: [Text]
cluster :: Text
$sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [CapacityProviderStrategyItem]
$sel:capacityProviders:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [Text]
$sel:cluster:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
capacityProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy

instance Data.ToHeaders PutClusterCapacityProviders where
  toHeaders :: PutClusterCapacityProviders -> 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
"AmazonEC2ContainerServiceV20141113.PutClusterCapacityProviders" ::
                          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 PutClusterCapacityProviders where
  toJSON :: PutClusterCapacityProviders -> Value
toJSON PutClusterCapacityProviders' {[Text]
[CapacityProviderStrategyItem]
Text
defaultCapacityProviderStrategy :: [CapacityProviderStrategyItem]
capacityProviders :: [Text]
cluster :: Text
$sel:defaultCapacityProviderStrategy:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [CapacityProviderStrategyItem]
$sel:capacityProviders:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> [Text]
$sel:cluster:PutClusterCapacityProviders' :: PutClusterCapacityProviders -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"cluster" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
cluster),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"capacityProviders" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
capacityProviders),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"defaultCapacityProviderStrategy"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [CapacityProviderStrategyItem]
defaultCapacityProviderStrategy
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'PutClusterCapacityProvidersResponse' 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', 'putClusterCapacityProvidersResponse_cluster' - Details about the cluster.
--
-- 'httpStatus', 'putClusterCapacityProvidersResponse_httpStatus' - The response's http status code.
newPutClusterCapacityProvidersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutClusterCapacityProvidersResponse
newPutClusterCapacityProvidersResponse :: Int -> PutClusterCapacityProvidersResponse
newPutClusterCapacityProvidersResponse Int
pHttpStatus_ =
  PutClusterCapacityProvidersResponse'
    { $sel:cluster:PutClusterCapacityProvidersResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutClusterCapacityProvidersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details about the cluster.
putClusterCapacityProvidersResponse_cluster :: Lens.Lens' PutClusterCapacityProvidersResponse (Prelude.Maybe Cluster)
putClusterCapacityProvidersResponse_cluster :: Lens' PutClusterCapacityProvidersResponse (Maybe Cluster)
putClusterCapacityProvidersResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutClusterCapacityProvidersResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:PutClusterCapacityProvidersResponse' :: PutClusterCapacityProvidersResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: PutClusterCapacityProvidersResponse
s@PutClusterCapacityProvidersResponse' {} Maybe Cluster
a -> PutClusterCapacityProvidersResponse
s {$sel:cluster:PutClusterCapacityProvidersResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: PutClusterCapacityProvidersResponse)

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

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