{-# 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.Batch.UpdateComputeEnvironment
-- 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 Batch compute environment.
module Amazonka.Batch.UpdateComputeEnvironment
  ( -- * Creating a Request
    UpdateComputeEnvironment (..),
    newUpdateComputeEnvironment,

    -- * Request Lenses
    updateComputeEnvironment_computeResources,
    updateComputeEnvironment_serviceRole,
    updateComputeEnvironment_state,
    updateComputeEnvironment_unmanagedvCpus,
    updateComputeEnvironment_updatePolicy,
    updateComputeEnvironment_computeEnvironment,

    -- * Destructuring the Response
    UpdateComputeEnvironmentResponse (..),
    newUpdateComputeEnvironmentResponse,

    -- * Response Lenses
    updateComputeEnvironmentResponse_computeEnvironmentArn,
    updateComputeEnvironmentResponse_computeEnvironmentName,
    updateComputeEnvironmentResponse_httpStatus,
  )
where

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

-- | Contains the parameters for @UpdateComputeEnvironment@.
--
-- /See:/ 'newUpdateComputeEnvironment' smart constructor.
data UpdateComputeEnvironment = UpdateComputeEnvironment'
  { -- | Details of the compute resources managed by the compute environment.
    -- Required for a managed compute environment. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute Environments>
    -- in the /Batch User Guide/.
    UpdateComputeEnvironment -> Maybe ComputeResourceUpdate
computeResources :: Prelude.Maybe ComputeResourceUpdate,
    -- | The full Amazon Resource Name (ARN) of the IAM role that allows Batch to
    -- make calls to other Amazon Web Services services on your behalf. For
    -- more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/service_IAM_role.html Batch service IAM role>
    -- in the /Batch User Guide/.
    --
    -- If the compute environment has a service-linked role, it can\'t be
    -- changed to use a regular IAM role. Likewise, if the compute environment
    -- has a regular IAM role, it can\'t be changed to use a service-linked
    -- role. To update the parameters for the compute environment that require
    -- an infrastructure update to change, the __AWSServiceRoleForBatch__
    -- service-linked role must be used. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
    -- in the /Batch User Guide/.
    --
    -- If your specified role has a path other than @\/@, then you must either
    -- specify the full role ARN (recommended) or prefix the role name with the
    -- path.
    --
    -- Depending on how you created your Batch service role, its ARN might
    -- contain the @service-role@ path prefix. When you only specify the name
    -- of the service role, Batch assumes that your ARN doesn\'t use the
    -- @service-role@ path prefix. Because of this, we recommend that you
    -- specify the full ARN of your service role when you create compute
    -- environments.
    UpdateComputeEnvironment -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | The state of the compute environment. Compute environments in the
    -- @ENABLED@ state can accept jobs from a queue and scale in or out
    -- automatically based on the workload demand of its associated queues.
    --
    -- If the state is @ENABLED@, then the Batch scheduler can attempt to place
    -- jobs from an associated job queue on the compute resources within the
    -- environment. If the compute environment is managed, then it can scale
    -- its instances out or in automatically, based on the job queue demand.
    --
    -- If the state is @DISABLED@, then the Batch scheduler doesn\'t attempt to
    -- place jobs within the environment. Jobs in a @STARTING@ or @RUNNING@
    -- state continue to progress normally. Managed compute environments in the
    -- @DISABLED@ state don\'t scale out. However, they scale in to @minvCpus@
    -- value after instances become idle.
    UpdateComputeEnvironment -> Maybe CEState
state :: Prelude.Maybe CEState,
    -- | The maximum number of vCPUs expected to be used for an unmanaged compute
    -- environment. Don\'t specify this parameter for a managed compute
    -- environment. This parameter is only used for fair share scheduling to
    -- reserve vCPU capacity for new share identifiers. If this parameter
    -- isn\'t provided for a fair share job queue, no vCPU capacity is
    -- reserved.
    UpdateComputeEnvironment -> Maybe Int
unmanagedvCpus :: Prelude.Maybe Prelude.Int,
    -- | Specifies the updated infrastructure update policy for the compute
    -- environment. For more information about infrastructure updates, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
    -- in the /Batch User Guide/.
    UpdateComputeEnvironment -> Maybe UpdatePolicy
updatePolicy :: Prelude.Maybe UpdatePolicy,
    -- | The name or full Amazon Resource Name (ARN) of the compute environment
    -- to update.
    UpdateComputeEnvironment -> Text
computeEnvironment :: Prelude.Text
  }
  deriving (UpdateComputeEnvironment -> UpdateComputeEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateComputeEnvironment -> UpdateComputeEnvironment -> Bool
$c/= :: UpdateComputeEnvironment -> UpdateComputeEnvironment -> Bool
== :: UpdateComputeEnvironment -> UpdateComputeEnvironment -> Bool
$c== :: UpdateComputeEnvironment -> UpdateComputeEnvironment -> Bool
Prelude.Eq, ReadPrec [UpdateComputeEnvironment]
ReadPrec UpdateComputeEnvironment
Int -> ReadS UpdateComputeEnvironment
ReadS [UpdateComputeEnvironment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateComputeEnvironment]
$creadListPrec :: ReadPrec [UpdateComputeEnvironment]
readPrec :: ReadPrec UpdateComputeEnvironment
$creadPrec :: ReadPrec UpdateComputeEnvironment
readList :: ReadS [UpdateComputeEnvironment]
$creadList :: ReadS [UpdateComputeEnvironment]
readsPrec :: Int -> ReadS UpdateComputeEnvironment
$creadsPrec :: Int -> ReadS UpdateComputeEnvironment
Prelude.Read, Int -> UpdateComputeEnvironment -> ShowS
[UpdateComputeEnvironment] -> ShowS
UpdateComputeEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateComputeEnvironment] -> ShowS
$cshowList :: [UpdateComputeEnvironment] -> ShowS
show :: UpdateComputeEnvironment -> String
$cshow :: UpdateComputeEnvironment -> String
showsPrec :: Int -> UpdateComputeEnvironment -> ShowS
$cshowsPrec :: Int -> UpdateComputeEnvironment -> ShowS
Prelude.Show, forall x.
Rep UpdateComputeEnvironment x -> UpdateComputeEnvironment
forall x.
UpdateComputeEnvironment -> Rep UpdateComputeEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateComputeEnvironment x -> UpdateComputeEnvironment
$cfrom :: forall x.
UpdateComputeEnvironment -> Rep UpdateComputeEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'UpdateComputeEnvironment' 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:
--
-- 'computeResources', 'updateComputeEnvironment_computeResources' - Details of the compute resources managed by the compute environment.
-- Required for a managed compute environment. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute Environments>
-- in the /Batch User Guide/.
--
-- 'serviceRole', 'updateComputeEnvironment_serviceRole' - The full Amazon Resource Name (ARN) of the IAM role that allows Batch to
-- make calls to other Amazon Web Services services on your behalf. For
-- more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/service_IAM_role.html Batch service IAM role>
-- in the /Batch User Guide/.
--
-- If the compute environment has a service-linked role, it can\'t be
-- changed to use a regular IAM role. Likewise, if the compute environment
-- has a regular IAM role, it can\'t be changed to use a service-linked
-- role. To update the parameters for the compute environment that require
-- an infrastructure update to change, the __AWSServiceRoleForBatch__
-- service-linked role must be used. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
-- in the /Batch User Guide/.
--
-- If your specified role has a path other than @\/@, then you must either
-- specify the full role ARN (recommended) or prefix the role name with the
-- path.
--
-- Depending on how you created your Batch service role, its ARN might
-- contain the @service-role@ path prefix. When you only specify the name
-- of the service role, Batch assumes that your ARN doesn\'t use the
-- @service-role@ path prefix. Because of this, we recommend that you
-- specify the full ARN of your service role when you create compute
-- environments.
--
-- 'state', 'updateComputeEnvironment_state' - The state of the compute environment. Compute environments in the
-- @ENABLED@ state can accept jobs from a queue and scale in or out
-- automatically based on the workload demand of its associated queues.
--
-- If the state is @ENABLED@, then the Batch scheduler can attempt to place
-- jobs from an associated job queue on the compute resources within the
-- environment. If the compute environment is managed, then it can scale
-- its instances out or in automatically, based on the job queue demand.
--
-- If the state is @DISABLED@, then the Batch scheduler doesn\'t attempt to
-- place jobs within the environment. Jobs in a @STARTING@ or @RUNNING@
-- state continue to progress normally. Managed compute environments in the
-- @DISABLED@ state don\'t scale out. However, they scale in to @minvCpus@
-- value after instances become idle.
--
-- 'unmanagedvCpus', 'updateComputeEnvironment_unmanagedvCpus' - The maximum number of vCPUs expected to be used for an unmanaged compute
-- environment. Don\'t specify this parameter for a managed compute
-- environment. This parameter is only used for fair share scheduling to
-- reserve vCPU capacity for new share identifiers. If this parameter
-- isn\'t provided for a fair share job queue, no vCPU capacity is
-- reserved.
--
-- 'updatePolicy', 'updateComputeEnvironment_updatePolicy' - Specifies the updated infrastructure update policy for the compute
-- environment. For more information about infrastructure updates, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
-- in the /Batch User Guide/.
--
-- 'computeEnvironment', 'updateComputeEnvironment_computeEnvironment' - The name or full Amazon Resource Name (ARN) of the compute environment
-- to update.
newUpdateComputeEnvironment ::
  -- | 'computeEnvironment'
  Prelude.Text ->
  UpdateComputeEnvironment
newUpdateComputeEnvironment :: Text -> UpdateComputeEnvironment
newUpdateComputeEnvironment Text
pComputeEnvironment_ =
  UpdateComputeEnvironment'
    { $sel:computeResources:UpdateComputeEnvironment' :: Maybe ComputeResourceUpdate
computeResources =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRole:UpdateComputeEnvironment' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateComputeEnvironment' :: Maybe CEState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:unmanagedvCpus:UpdateComputeEnvironment' :: Maybe Int
unmanagedvCpus = forall a. Maybe a
Prelude.Nothing,
      $sel:updatePolicy:UpdateComputeEnvironment' :: Maybe UpdatePolicy
updatePolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:computeEnvironment:UpdateComputeEnvironment' :: Text
computeEnvironment = Text
pComputeEnvironment_
    }

-- | Details of the compute resources managed by the compute environment.
-- Required for a managed compute environment. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute Environments>
-- in the /Batch User Guide/.
updateComputeEnvironment_computeResources :: Lens.Lens' UpdateComputeEnvironment (Prelude.Maybe ComputeResourceUpdate)
updateComputeEnvironment_computeResources :: Lens' UpdateComputeEnvironment (Maybe ComputeResourceUpdate)
updateComputeEnvironment_computeResources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Maybe ComputeResourceUpdate
computeResources :: Maybe ComputeResourceUpdate
$sel:computeResources:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe ComputeResourceUpdate
computeResources} -> Maybe ComputeResourceUpdate
computeResources) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Maybe ComputeResourceUpdate
a -> UpdateComputeEnvironment
s {$sel:computeResources:UpdateComputeEnvironment' :: Maybe ComputeResourceUpdate
computeResources = Maybe ComputeResourceUpdate
a} :: UpdateComputeEnvironment)

-- | The full Amazon Resource Name (ARN) of the IAM role that allows Batch to
-- make calls to other Amazon Web Services services on your behalf. For
-- more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/service_IAM_role.html Batch service IAM role>
-- in the /Batch User Guide/.
--
-- If the compute environment has a service-linked role, it can\'t be
-- changed to use a regular IAM role. Likewise, if the compute environment
-- has a regular IAM role, it can\'t be changed to use a service-linked
-- role. To update the parameters for the compute environment that require
-- an infrastructure update to change, the __AWSServiceRoleForBatch__
-- service-linked role must be used. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
-- in the /Batch User Guide/.
--
-- If your specified role has a path other than @\/@, then you must either
-- specify the full role ARN (recommended) or prefix the role name with the
-- path.
--
-- Depending on how you created your Batch service role, its ARN might
-- contain the @service-role@ path prefix. When you only specify the name
-- of the service role, Batch assumes that your ARN doesn\'t use the
-- @service-role@ path prefix. Because of this, we recommend that you
-- specify the full ARN of your service role when you create compute
-- environments.
updateComputeEnvironment_serviceRole :: Lens.Lens' UpdateComputeEnvironment (Prelude.Maybe Prelude.Text)
updateComputeEnvironment_serviceRole :: Lens' UpdateComputeEnvironment (Maybe Text)
updateComputeEnvironment_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Maybe Text
a -> UpdateComputeEnvironment
s {$sel:serviceRole:UpdateComputeEnvironment' :: Maybe Text
serviceRole = Maybe Text
a} :: UpdateComputeEnvironment)

-- | The state of the compute environment. Compute environments in the
-- @ENABLED@ state can accept jobs from a queue and scale in or out
-- automatically based on the workload demand of its associated queues.
--
-- If the state is @ENABLED@, then the Batch scheduler can attempt to place
-- jobs from an associated job queue on the compute resources within the
-- environment. If the compute environment is managed, then it can scale
-- its instances out or in automatically, based on the job queue demand.
--
-- If the state is @DISABLED@, then the Batch scheduler doesn\'t attempt to
-- place jobs within the environment. Jobs in a @STARTING@ or @RUNNING@
-- state continue to progress normally. Managed compute environments in the
-- @DISABLED@ state don\'t scale out. However, they scale in to @minvCpus@
-- value after instances become idle.
updateComputeEnvironment_state :: Lens.Lens' UpdateComputeEnvironment (Prelude.Maybe CEState)
updateComputeEnvironment_state :: Lens' UpdateComputeEnvironment (Maybe CEState)
updateComputeEnvironment_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Maybe CEState
state :: Maybe CEState
$sel:state:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe CEState
state} -> Maybe CEState
state) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Maybe CEState
a -> UpdateComputeEnvironment
s {$sel:state:UpdateComputeEnvironment' :: Maybe CEState
state = Maybe CEState
a} :: UpdateComputeEnvironment)

-- | The maximum number of vCPUs expected to be used for an unmanaged compute
-- environment. Don\'t specify this parameter for a managed compute
-- environment. This parameter is only used for fair share scheduling to
-- reserve vCPU capacity for new share identifiers. If this parameter
-- isn\'t provided for a fair share job queue, no vCPU capacity is
-- reserved.
updateComputeEnvironment_unmanagedvCpus :: Lens.Lens' UpdateComputeEnvironment (Prelude.Maybe Prelude.Int)
updateComputeEnvironment_unmanagedvCpus :: Lens' UpdateComputeEnvironment (Maybe Int)
updateComputeEnvironment_unmanagedvCpus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Maybe Int
unmanagedvCpus :: Maybe Int
$sel:unmanagedvCpus:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Int
unmanagedvCpus} -> Maybe Int
unmanagedvCpus) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Maybe Int
a -> UpdateComputeEnvironment
s {$sel:unmanagedvCpus:UpdateComputeEnvironment' :: Maybe Int
unmanagedvCpus = Maybe Int
a} :: UpdateComputeEnvironment)

-- | Specifies the updated infrastructure update policy for the compute
-- environment. For more information about infrastructure updates, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/updating-compute-environments.html Updating compute environments>
-- in the /Batch User Guide/.
updateComputeEnvironment_updatePolicy :: Lens.Lens' UpdateComputeEnvironment (Prelude.Maybe UpdatePolicy)
updateComputeEnvironment_updatePolicy :: Lens' UpdateComputeEnvironment (Maybe UpdatePolicy)
updateComputeEnvironment_updatePolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Maybe UpdatePolicy
updatePolicy :: Maybe UpdatePolicy
$sel:updatePolicy:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe UpdatePolicy
updatePolicy} -> Maybe UpdatePolicy
updatePolicy) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Maybe UpdatePolicy
a -> UpdateComputeEnvironment
s {$sel:updatePolicy:UpdateComputeEnvironment' :: Maybe UpdatePolicy
updatePolicy = Maybe UpdatePolicy
a} :: UpdateComputeEnvironment)

-- | The name or full Amazon Resource Name (ARN) of the compute environment
-- to update.
updateComputeEnvironment_computeEnvironment :: Lens.Lens' UpdateComputeEnvironment Prelude.Text
updateComputeEnvironment_computeEnvironment :: Lens' UpdateComputeEnvironment Text
updateComputeEnvironment_computeEnvironment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironment' {Text
computeEnvironment :: Text
$sel:computeEnvironment:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Text
computeEnvironment} -> Text
computeEnvironment) (\s :: UpdateComputeEnvironment
s@UpdateComputeEnvironment' {} Text
a -> UpdateComputeEnvironment
s {$sel:computeEnvironment:UpdateComputeEnvironment' :: Text
computeEnvironment = Text
a} :: UpdateComputeEnvironment)

instance Core.AWSRequest UpdateComputeEnvironment where
  type
    AWSResponse UpdateComputeEnvironment =
      UpdateComputeEnvironmentResponse
  request :: (Service -> Service)
-> UpdateComputeEnvironment -> Request UpdateComputeEnvironment
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 UpdateComputeEnvironment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateComputeEnvironment)))
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 -> UpdateComputeEnvironmentResponse
UpdateComputeEnvironmentResponse'
            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
"computeEnvironmentArn")
            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
"computeEnvironmentName")
            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 UpdateComputeEnvironment where
  hashWithSalt :: Int -> UpdateComputeEnvironment -> Int
hashWithSalt Int
_salt UpdateComputeEnvironment' {Maybe Int
Maybe Text
Maybe CEState
Maybe ComputeResourceUpdate
Maybe UpdatePolicy
Text
computeEnvironment :: Text
updatePolicy :: Maybe UpdatePolicy
unmanagedvCpus :: Maybe Int
state :: Maybe CEState
serviceRole :: Maybe Text
computeResources :: Maybe ComputeResourceUpdate
$sel:computeEnvironment:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Text
$sel:updatePolicy:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe UpdatePolicy
$sel:unmanagedvCpus:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Int
$sel:state:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe CEState
$sel:serviceRole:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Text
$sel:computeResources:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe ComputeResourceUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputeResourceUpdate
computeResources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CEState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
unmanagedvCpus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdatePolicy
updatePolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
computeEnvironment

instance Prelude.NFData UpdateComputeEnvironment where
  rnf :: UpdateComputeEnvironment -> ()
rnf UpdateComputeEnvironment' {Maybe Int
Maybe Text
Maybe CEState
Maybe ComputeResourceUpdate
Maybe UpdatePolicy
Text
computeEnvironment :: Text
updatePolicy :: Maybe UpdatePolicy
unmanagedvCpus :: Maybe Int
state :: Maybe CEState
serviceRole :: Maybe Text
computeResources :: Maybe ComputeResourceUpdate
$sel:computeEnvironment:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Text
$sel:updatePolicy:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe UpdatePolicy
$sel:unmanagedvCpus:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Int
$sel:state:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe CEState
$sel:serviceRole:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Text
$sel:computeResources:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe ComputeResourceUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputeResourceUpdate
computeResources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CEState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
unmanagedvCpus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdatePolicy
updatePolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
computeEnvironment

instance Data.ToHeaders UpdateComputeEnvironment where
  toHeaders :: UpdateComputeEnvironment -> 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 UpdateComputeEnvironment where
  toJSON :: UpdateComputeEnvironment -> Value
toJSON UpdateComputeEnvironment' {Maybe Int
Maybe Text
Maybe CEState
Maybe ComputeResourceUpdate
Maybe UpdatePolicy
Text
computeEnvironment :: Text
updatePolicy :: Maybe UpdatePolicy
unmanagedvCpus :: Maybe Int
state :: Maybe CEState
serviceRole :: Maybe Text
computeResources :: Maybe ComputeResourceUpdate
$sel:computeEnvironment:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Text
$sel:updatePolicy:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe UpdatePolicy
$sel:unmanagedvCpus:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Int
$sel:state:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe CEState
$sel:serviceRole:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe Text
$sel:computeResources:UpdateComputeEnvironment' :: UpdateComputeEnvironment -> Maybe ComputeResourceUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"computeResources" 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 ComputeResourceUpdate
computeResources,
            (Key
"serviceRole" 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
serviceRole,
            (Key
"state" 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 CEState
state,
            (Key
"unmanagedvCpus" 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 Int
unmanagedvCpus,
            (Key
"updatePolicy" 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 UpdatePolicy
updatePolicy,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"computeEnvironment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
computeEnvironment)
          ]
      )

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

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

-- | /See:/ 'newUpdateComputeEnvironmentResponse' smart constructor.
data UpdateComputeEnvironmentResponse = UpdateComputeEnvironmentResponse'
  { -- | The Amazon Resource Name (ARN) of the compute environment.
    UpdateComputeEnvironmentResponse -> Maybe Text
computeEnvironmentArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the compute environment. It can be up to 128 characters
    -- long. It can contain uppercase and lowercase letters, numbers, hyphens
    -- (-), and underscores (_).
    UpdateComputeEnvironmentResponse -> Maybe Text
computeEnvironmentName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateComputeEnvironmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateComputeEnvironmentResponse
-> UpdateComputeEnvironmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateComputeEnvironmentResponse
-> UpdateComputeEnvironmentResponse -> Bool
$c/= :: UpdateComputeEnvironmentResponse
-> UpdateComputeEnvironmentResponse -> Bool
== :: UpdateComputeEnvironmentResponse
-> UpdateComputeEnvironmentResponse -> Bool
$c== :: UpdateComputeEnvironmentResponse
-> UpdateComputeEnvironmentResponse -> Bool
Prelude.Eq, ReadPrec [UpdateComputeEnvironmentResponse]
ReadPrec UpdateComputeEnvironmentResponse
Int -> ReadS UpdateComputeEnvironmentResponse
ReadS [UpdateComputeEnvironmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateComputeEnvironmentResponse]
$creadListPrec :: ReadPrec [UpdateComputeEnvironmentResponse]
readPrec :: ReadPrec UpdateComputeEnvironmentResponse
$creadPrec :: ReadPrec UpdateComputeEnvironmentResponse
readList :: ReadS [UpdateComputeEnvironmentResponse]
$creadList :: ReadS [UpdateComputeEnvironmentResponse]
readsPrec :: Int -> ReadS UpdateComputeEnvironmentResponse
$creadsPrec :: Int -> ReadS UpdateComputeEnvironmentResponse
Prelude.Read, Int -> UpdateComputeEnvironmentResponse -> ShowS
[UpdateComputeEnvironmentResponse] -> ShowS
UpdateComputeEnvironmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateComputeEnvironmentResponse] -> ShowS
$cshowList :: [UpdateComputeEnvironmentResponse] -> ShowS
show :: UpdateComputeEnvironmentResponse -> String
$cshow :: UpdateComputeEnvironmentResponse -> String
showsPrec :: Int -> UpdateComputeEnvironmentResponse -> ShowS
$cshowsPrec :: Int -> UpdateComputeEnvironmentResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateComputeEnvironmentResponse x
-> UpdateComputeEnvironmentResponse
forall x.
UpdateComputeEnvironmentResponse
-> Rep UpdateComputeEnvironmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateComputeEnvironmentResponse x
-> UpdateComputeEnvironmentResponse
$cfrom :: forall x.
UpdateComputeEnvironmentResponse
-> Rep UpdateComputeEnvironmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateComputeEnvironmentResponse' 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:
--
-- 'computeEnvironmentArn', 'updateComputeEnvironmentResponse_computeEnvironmentArn' - The Amazon Resource Name (ARN) of the compute environment.
--
-- 'computeEnvironmentName', 'updateComputeEnvironmentResponse_computeEnvironmentName' - The name of the compute environment. It can be up to 128 characters
-- long. It can contain uppercase and lowercase letters, numbers, hyphens
-- (-), and underscores (_).
--
-- 'httpStatus', 'updateComputeEnvironmentResponse_httpStatus' - The response's http status code.
newUpdateComputeEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateComputeEnvironmentResponse
newUpdateComputeEnvironmentResponse :: Int -> UpdateComputeEnvironmentResponse
newUpdateComputeEnvironmentResponse Int
pHttpStatus_ =
  UpdateComputeEnvironmentResponse'
    { $sel:computeEnvironmentArn:UpdateComputeEnvironmentResponse' :: Maybe Text
computeEnvironmentArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:computeEnvironmentName:UpdateComputeEnvironmentResponse' :: Maybe Text
computeEnvironmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateComputeEnvironmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the compute environment.
updateComputeEnvironmentResponse_computeEnvironmentArn :: Lens.Lens' UpdateComputeEnvironmentResponse (Prelude.Maybe Prelude.Text)
updateComputeEnvironmentResponse_computeEnvironmentArn :: Lens' UpdateComputeEnvironmentResponse (Maybe Text)
updateComputeEnvironmentResponse_computeEnvironmentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironmentResponse' {Maybe Text
computeEnvironmentArn :: Maybe Text
$sel:computeEnvironmentArn:UpdateComputeEnvironmentResponse' :: UpdateComputeEnvironmentResponse -> Maybe Text
computeEnvironmentArn} -> Maybe Text
computeEnvironmentArn) (\s :: UpdateComputeEnvironmentResponse
s@UpdateComputeEnvironmentResponse' {} Maybe Text
a -> UpdateComputeEnvironmentResponse
s {$sel:computeEnvironmentArn:UpdateComputeEnvironmentResponse' :: Maybe Text
computeEnvironmentArn = Maybe Text
a} :: UpdateComputeEnvironmentResponse)

-- | The name of the compute environment. It can be up to 128 characters
-- long. It can contain uppercase and lowercase letters, numbers, hyphens
-- (-), and underscores (_).
updateComputeEnvironmentResponse_computeEnvironmentName :: Lens.Lens' UpdateComputeEnvironmentResponse (Prelude.Maybe Prelude.Text)
updateComputeEnvironmentResponse_computeEnvironmentName :: Lens' UpdateComputeEnvironmentResponse (Maybe Text)
updateComputeEnvironmentResponse_computeEnvironmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateComputeEnvironmentResponse' {Maybe Text
computeEnvironmentName :: Maybe Text
$sel:computeEnvironmentName:UpdateComputeEnvironmentResponse' :: UpdateComputeEnvironmentResponse -> Maybe Text
computeEnvironmentName} -> Maybe Text
computeEnvironmentName) (\s :: UpdateComputeEnvironmentResponse
s@UpdateComputeEnvironmentResponse' {} Maybe Text
a -> UpdateComputeEnvironmentResponse
s {$sel:computeEnvironmentName:UpdateComputeEnvironmentResponse' :: Maybe Text
computeEnvironmentName = Maybe Text
a} :: UpdateComputeEnvironmentResponse)

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

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