{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.ComputeEnvironmentDetail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Batch.Types.ComputeEnvironmentDetail where

import Amazonka.Batch.Types.CEState
import Amazonka.Batch.Types.CEStatus
import Amazonka.Batch.Types.CEType
import Amazonka.Batch.Types.ComputeResource
import Amazonka.Batch.Types.EksConfiguration
import Amazonka.Batch.Types.OrchestrationType
import Amazonka.Batch.Types.UpdatePolicy
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

-- | An object that represents an Batch compute environment.
--
-- /See:/ 'newComputeEnvironmentDetail' smart constructor.
data ComputeEnvironmentDetail = ComputeEnvironmentDetail'
  { -- | The compute resources defined for the compute environment. For more
    -- information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
    -- in the /Batch User Guide/.
    ComputeEnvironmentDetail -> Maybe ComputeResource
computeResources :: Prelude.Maybe ComputeResource,
    -- | The orchestration type of the compute environment. The valid values are
    -- @ECS@ (default) or @EKS@.
    ComputeEnvironmentDetail -> Maybe OrchestrationType
containerOrchestrationType :: Prelude.Maybe OrchestrationType,
    -- | The Amazon Resource Name (ARN) of the underlying Amazon ECS cluster that
    -- the compute environment uses.
    ComputeEnvironmentDetail -> Maybe Text
ecsClusterArn :: Prelude.Maybe Prelude.Text,
    -- | The configuration for the Amazon EKS cluster that supports the Batch
    -- compute environment. Only specify this parameter if the
    -- @containerOrchestrationType@ is @EKS@.
    ComputeEnvironmentDetail -> Maybe EksConfiguration
eksConfiguration :: Prelude.Maybe EksConfiguration,
    -- | The service role that\'s associated with the compute environment that
    -- allows Batch to make calls to Amazon Web Services API operations 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/.
    ComputeEnvironmentDetail -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | The state of the compute environment. The valid values are @ENABLED@ or
    -- @DISABLED@.
    --
    -- 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.
    ComputeEnvironmentDetail -> Maybe CEState
state :: Prelude.Maybe CEState,
    -- | The current status of the compute environment (for example, @CREATING@
    -- or @VALID@).
    ComputeEnvironmentDetail -> Maybe CEStatus
status :: Prelude.Maybe CEStatus,
    -- | A short, human-readable string to provide additional details for the
    -- current status of the compute environment.
    ComputeEnvironmentDetail -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The tags applied to the compute environment.
    ComputeEnvironmentDetail -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The type of the compute environment: @MANAGED@ or @UNMANAGED@. For more
    -- information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
    -- in the /Batch User Guide/.
    ComputeEnvironmentDetail -> Maybe CEType
type' :: Prelude.Maybe CEType,
    -- | The maximum number of VCPUs expected to be used for an unmanaged compute
    -- environment.
    ComputeEnvironmentDetail -> Maybe Int
unmanagedvCpus :: Prelude.Maybe Prelude.Int,
    -- | Specifies the 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/.
    ComputeEnvironmentDetail -> Maybe UpdatePolicy
updatePolicy :: Prelude.Maybe UpdatePolicy,
    -- | Unique identifier for the compute environment.
    ComputeEnvironmentDetail -> Maybe Text
uuid :: 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 (_).
    ComputeEnvironmentDetail -> Text
computeEnvironmentName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the compute environment.
    ComputeEnvironmentDetail -> Text
computeEnvironmentArn :: Prelude.Text
  }
  deriving (ComputeEnvironmentDetail -> ComputeEnvironmentDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputeEnvironmentDetail -> ComputeEnvironmentDetail -> Bool
$c/= :: ComputeEnvironmentDetail -> ComputeEnvironmentDetail -> Bool
== :: ComputeEnvironmentDetail -> ComputeEnvironmentDetail -> Bool
$c== :: ComputeEnvironmentDetail -> ComputeEnvironmentDetail -> Bool
Prelude.Eq, ReadPrec [ComputeEnvironmentDetail]
ReadPrec ComputeEnvironmentDetail
Int -> ReadS ComputeEnvironmentDetail
ReadS [ComputeEnvironmentDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComputeEnvironmentDetail]
$creadListPrec :: ReadPrec [ComputeEnvironmentDetail]
readPrec :: ReadPrec ComputeEnvironmentDetail
$creadPrec :: ReadPrec ComputeEnvironmentDetail
readList :: ReadS [ComputeEnvironmentDetail]
$creadList :: ReadS [ComputeEnvironmentDetail]
readsPrec :: Int -> ReadS ComputeEnvironmentDetail
$creadsPrec :: Int -> ReadS ComputeEnvironmentDetail
Prelude.Read, Int -> ComputeEnvironmentDetail -> ShowS
[ComputeEnvironmentDetail] -> ShowS
ComputeEnvironmentDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputeEnvironmentDetail] -> ShowS
$cshowList :: [ComputeEnvironmentDetail] -> ShowS
show :: ComputeEnvironmentDetail -> String
$cshow :: ComputeEnvironmentDetail -> String
showsPrec :: Int -> ComputeEnvironmentDetail -> ShowS
$cshowsPrec :: Int -> ComputeEnvironmentDetail -> ShowS
Prelude.Show, forall x.
Rep ComputeEnvironmentDetail x -> ComputeEnvironmentDetail
forall x.
ComputeEnvironmentDetail -> Rep ComputeEnvironmentDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ComputeEnvironmentDetail x -> ComputeEnvironmentDetail
$cfrom :: forall x.
ComputeEnvironmentDetail -> Rep ComputeEnvironmentDetail x
Prelude.Generic)

-- |
-- Create a value of 'ComputeEnvironmentDetail' 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', 'computeEnvironmentDetail_computeResources' - The compute resources defined for the compute environment. For more
-- information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
-- in the /Batch User Guide/.
--
-- 'containerOrchestrationType', 'computeEnvironmentDetail_containerOrchestrationType' - The orchestration type of the compute environment. The valid values are
-- @ECS@ (default) or @EKS@.
--
-- 'ecsClusterArn', 'computeEnvironmentDetail_ecsClusterArn' - The Amazon Resource Name (ARN) of the underlying Amazon ECS cluster that
-- the compute environment uses.
--
-- 'eksConfiguration', 'computeEnvironmentDetail_eksConfiguration' - The configuration for the Amazon EKS cluster that supports the Batch
-- compute environment. Only specify this parameter if the
-- @containerOrchestrationType@ is @EKS@.
--
-- 'serviceRole', 'computeEnvironmentDetail_serviceRole' - The service role that\'s associated with the compute environment that
-- allows Batch to make calls to Amazon Web Services API operations 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/.
--
-- 'state', 'computeEnvironmentDetail_state' - The state of the compute environment. The valid values are @ENABLED@ or
-- @DISABLED@.
--
-- 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.
--
-- 'status', 'computeEnvironmentDetail_status' - The current status of the compute environment (for example, @CREATING@
-- or @VALID@).
--
-- 'statusReason', 'computeEnvironmentDetail_statusReason' - A short, human-readable string to provide additional details for the
-- current status of the compute environment.
--
-- 'tags', 'computeEnvironmentDetail_tags' - The tags applied to the compute environment.
--
-- 'type'', 'computeEnvironmentDetail_type' - The type of the compute environment: @MANAGED@ or @UNMANAGED@. For more
-- information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
-- in the /Batch User Guide/.
--
-- 'unmanagedvCpus', 'computeEnvironmentDetail_unmanagedvCpus' - The maximum number of VCPUs expected to be used for an unmanaged compute
-- environment.
--
-- 'updatePolicy', 'computeEnvironmentDetail_updatePolicy' - Specifies the 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/.
--
-- 'uuid', 'computeEnvironmentDetail_uuid' - Unique identifier for the compute environment.
--
-- 'computeEnvironmentName', 'computeEnvironmentDetail_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 (_).
--
-- 'computeEnvironmentArn', 'computeEnvironmentDetail_computeEnvironmentArn' - The Amazon Resource Name (ARN) of the compute environment.
newComputeEnvironmentDetail ::
  -- | 'computeEnvironmentName'
  Prelude.Text ->
  -- | 'computeEnvironmentArn'
  Prelude.Text ->
  ComputeEnvironmentDetail
newComputeEnvironmentDetail :: Text -> Text -> ComputeEnvironmentDetail
newComputeEnvironmentDetail
  Text
pComputeEnvironmentName_
  Text
pComputeEnvironmentArn_ =
    ComputeEnvironmentDetail'
      { $sel:computeResources:ComputeEnvironmentDetail' :: Maybe ComputeResource
computeResources =
          forall a. Maybe a
Prelude.Nothing,
        $sel:containerOrchestrationType:ComputeEnvironmentDetail' :: Maybe OrchestrationType
containerOrchestrationType = forall a. Maybe a
Prelude.Nothing,
        $sel:ecsClusterArn:ComputeEnvironmentDetail' :: Maybe Text
ecsClusterArn = forall a. Maybe a
Prelude.Nothing,
        $sel:eksConfiguration:ComputeEnvironmentDetail' :: Maybe EksConfiguration
eksConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceRole:ComputeEnvironmentDetail' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
        $sel:state:ComputeEnvironmentDetail' :: Maybe CEState
state = forall a. Maybe a
Prelude.Nothing,
        $sel:status:ComputeEnvironmentDetail' :: Maybe CEStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:ComputeEnvironmentDetail' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:ComputeEnvironmentDetail' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:type':ComputeEnvironmentDetail' :: Maybe CEType
type' = forall a. Maybe a
Prelude.Nothing,
        $sel:unmanagedvCpus:ComputeEnvironmentDetail' :: Maybe Int
unmanagedvCpus = forall a. Maybe a
Prelude.Nothing,
        $sel:updatePolicy:ComputeEnvironmentDetail' :: Maybe UpdatePolicy
updatePolicy = forall a. Maybe a
Prelude.Nothing,
        $sel:uuid:ComputeEnvironmentDetail' :: Maybe Text
uuid = forall a. Maybe a
Prelude.Nothing,
        $sel:computeEnvironmentName:ComputeEnvironmentDetail' :: Text
computeEnvironmentName = Text
pComputeEnvironmentName_,
        $sel:computeEnvironmentArn:ComputeEnvironmentDetail' :: Text
computeEnvironmentArn = Text
pComputeEnvironmentArn_
      }

-- | The compute resources defined for the compute environment. For more
-- information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
-- in the /Batch User Guide/.
computeEnvironmentDetail_computeResources :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe ComputeResource)
computeEnvironmentDetail_computeResources :: Lens' ComputeEnvironmentDetail (Maybe ComputeResource)
computeEnvironmentDetail_computeResources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe ComputeResource
computeResources :: Maybe ComputeResource
$sel:computeResources:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe ComputeResource
computeResources} -> Maybe ComputeResource
computeResources) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe ComputeResource
a -> ComputeEnvironmentDetail
s {$sel:computeResources:ComputeEnvironmentDetail' :: Maybe ComputeResource
computeResources = Maybe ComputeResource
a} :: ComputeEnvironmentDetail)

-- | The orchestration type of the compute environment. The valid values are
-- @ECS@ (default) or @EKS@.
computeEnvironmentDetail_containerOrchestrationType :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe OrchestrationType)
computeEnvironmentDetail_containerOrchestrationType :: Lens' ComputeEnvironmentDetail (Maybe OrchestrationType)
computeEnvironmentDetail_containerOrchestrationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe OrchestrationType
containerOrchestrationType :: Maybe OrchestrationType
$sel:containerOrchestrationType:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe OrchestrationType
containerOrchestrationType} -> Maybe OrchestrationType
containerOrchestrationType) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe OrchestrationType
a -> ComputeEnvironmentDetail
s {$sel:containerOrchestrationType:ComputeEnvironmentDetail' :: Maybe OrchestrationType
containerOrchestrationType = Maybe OrchestrationType
a} :: ComputeEnvironmentDetail)

-- | The Amazon Resource Name (ARN) of the underlying Amazon ECS cluster that
-- the compute environment uses.
computeEnvironmentDetail_ecsClusterArn :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe Prelude.Text)
computeEnvironmentDetail_ecsClusterArn :: Lens' ComputeEnvironmentDetail (Maybe Text)
computeEnvironmentDetail_ecsClusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe Text
ecsClusterArn :: Maybe Text
$sel:ecsClusterArn:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
ecsClusterArn} -> Maybe Text
ecsClusterArn) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe Text
a -> ComputeEnvironmentDetail
s {$sel:ecsClusterArn:ComputeEnvironmentDetail' :: Maybe Text
ecsClusterArn = Maybe Text
a} :: ComputeEnvironmentDetail)

-- | The configuration for the Amazon EKS cluster that supports the Batch
-- compute environment. Only specify this parameter if the
-- @containerOrchestrationType@ is @EKS@.
computeEnvironmentDetail_eksConfiguration :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe EksConfiguration)
computeEnvironmentDetail_eksConfiguration :: Lens' ComputeEnvironmentDetail (Maybe EksConfiguration)
computeEnvironmentDetail_eksConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe EksConfiguration
eksConfiguration :: Maybe EksConfiguration
$sel:eksConfiguration:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe EksConfiguration
eksConfiguration} -> Maybe EksConfiguration
eksConfiguration) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe EksConfiguration
a -> ComputeEnvironmentDetail
s {$sel:eksConfiguration:ComputeEnvironmentDetail' :: Maybe EksConfiguration
eksConfiguration = Maybe EksConfiguration
a} :: ComputeEnvironmentDetail)

-- | The service role that\'s associated with the compute environment that
-- allows Batch to make calls to Amazon Web Services API operations 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/.
computeEnvironmentDetail_serviceRole :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe Prelude.Text)
computeEnvironmentDetail_serviceRole :: Lens' ComputeEnvironmentDetail (Maybe Text)
computeEnvironmentDetail_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe Text
a -> ComputeEnvironmentDetail
s {$sel:serviceRole:ComputeEnvironmentDetail' :: Maybe Text
serviceRole = Maybe Text
a} :: ComputeEnvironmentDetail)

-- | The state of the compute environment. The valid values are @ENABLED@ or
-- @DISABLED@.
--
-- 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.
computeEnvironmentDetail_state :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe CEState)
computeEnvironmentDetail_state :: Lens' ComputeEnvironmentDetail (Maybe CEState)
computeEnvironmentDetail_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe CEState
state :: Maybe CEState
$sel:state:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEState
state} -> Maybe CEState
state) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe CEState
a -> ComputeEnvironmentDetail
s {$sel:state:ComputeEnvironmentDetail' :: Maybe CEState
state = Maybe CEState
a} :: ComputeEnvironmentDetail)

-- | The current status of the compute environment (for example, @CREATING@
-- or @VALID@).
computeEnvironmentDetail_status :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe CEStatus)
computeEnvironmentDetail_status :: Lens' ComputeEnvironmentDetail (Maybe CEStatus)
computeEnvironmentDetail_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe CEStatus
status :: Maybe CEStatus
$sel:status:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEStatus
status} -> Maybe CEStatus
status) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe CEStatus
a -> ComputeEnvironmentDetail
s {$sel:status:ComputeEnvironmentDetail' :: Maybe CEStatus
status = Maybe CEStatus
a} :: ComputeEnvironmentDetail)

-- | A short, human-readable string to provide additional details for the
-- current status of the compute environment.
computeEnvironmentDetail_statusReason :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe Prelude.Text)
computeEnvironmentDetail_statusReason :: Lens' ComputeEnvironmentDetail (Maybe Text)
computeEnvironmentDetail_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe Text
a -> ComputeEnvironmentDetail
s {$sel:statusReason:ComputeEnvironmentDetail' :: Maybe Text
statusReason = Maybe Text
a} :: ComputeEnvironmentDetail)

-- | The tags applied to the compute environment.
computeEnvironmentDetail_tags :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
computeEnvironmentDetail_tags :: Lens' ComputeEnvironmentDetail (Maybe (HashMap Text Text))
computeEnvironmentDetail_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe (HashMap Text Text)
a -> ComputeEnvironmentDetail
s {$sel:tags:ComputeEnvironmentDetail' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ComputeEnvironmentDetail) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The type of the compute environment: @MANAGED@ or @UNMANAGED@. For more
-- information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/compute_environments.html Compute environments>
-- in the /Batch User Guide/.
computeEnvironmentDetail_type :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe CEType)
computeEnvironmentDetail_type :: Lens' ComputeEnvironmentDetail (Maybe CEType)
computeEnvironmentDetail_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe CEType
type' :: Maybe CEType
$sel:type':ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEType
type'} -> Maybe CEType
type') (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe CEType
a -> ComputeEnvironmentDetail
s {$sel:type':ComputeEnvironmentDetail' :: Maybe CEType
type' = Maybe CEType
a} :: ComputeEnvironmentDetail)

-- | The maximum number of VCPUs expected to be used for an unmanaged compute
-- environment.
computeEnvironmentDetail_unmanagedvCpus :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe Prelude.Int)
computeEnvironmentDetail_unmanagedvCpus :: Lens' ComputeEnvironmentDetail (Maybe Int)
computeEnvironmentDetail_unmanagedvCpus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe Int
unmanagedvCpus :: Maybe Int
$sel:unmanagedvCpus:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Int
unmanagedvCpus} -> Maybe Int
unmanagedvCpus) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe Int
a -> ComputeEnvironmentDetail
s {$sel:unmanagedvCpus:ComputeEnvironmentDetail' :: Maybe Int
unmanagedvCpus = Maybe Int
a} :: ComputeEnvironmentDetail)

-- | Specifies the 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/.
computeEnvironmentDetail_updatePolicy :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe UpdatePolicy)
computeEnvironmentDetail_updatePolicy :: Lens' ComputeEnvironmentDetail (Maybe UpdatePolicy)
computeEnvironmentDetail_updatePolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe UpdatePolicy
updatePolicy :: Maybe UpdatePolicy
$sel:updatePolicy:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe UpdatePolicy
updatePolicy} -> Maybe UpdatePolicy
updatePolicy) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe UpdatePolicy
a -> ComputeEnvironmentDetail
s {$sel:updatePolicy:ComputeEnvironmentDetail' :: Maybe UpdatePolicy
updatePolicy = Maybe UpdatePolicy
a} :: ComputeEnvironmentDetail)

-- | Unique identifier for the compute environment.
computeEnvironmentDetail_uuid :: Lens.Lens' ComputeEnvironmentDetail (Prelude.Maybe Prelude.Text)
computeEnvironmentDetail_uuid :: Lens' ComputeEnvironmentDetail (Maybe Text)
computeEnvironmentDetail_uuid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Maybe Text
uuid :: Maybe Text
$sel:uuid:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
uuid} -> Maybe Text
uuid) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Maybe Text
a -> ComputeEnvironmentDetail
s {$sel:uuid:ComputeEnvironmentDetail' :: Maybe Text
uuid = Maybe Text
a} :: ComputeEnvironmentDetail)

-- | 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 (_).
computeEnvironmentDetail_computeEnvironmentName :: Lens.Lens' ComputeEnvironmentDetail Prelude.Text
computeEnvironmentDetail_computeEnvironmentName :: Lens' ComputeEnvironmentDetail Text
computeEnvironmentDetail_computeEnvironmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ComputeEnvironmentDetail' {Text
computeEnvironmentName :: Text
$sel:computeEnvironmentName:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Text
computeEnvironmentName} -> Text
computeEnvironmentName) (\s :: ComputeEnvironmentDetail
s@ComputeEnvironmentDetail' {} Text
a -> ComputeEnvironmentDetail
s {$sel:computeEnvironmentName:ComputeEnvironmentDetail' :: Text
computeEnvironmentName = Text
a} :: ComputeEnvironmentDetail)

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

instance Data.FromJSON ComputeEnvironmentDetail where
  parseJSON :: Value -> Parser ComputeEnvironmentDetail
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ComputeEnvironmentDetail"
      ( \Object
x ->
          Maybe ComputeResource
-> Maybe OrchestrationType
-> Maybe Text
-> Maybe EksConfiguration
-> Maybe Text
-> Maybe CEState
-> Maybe CEStatus
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe CEType
-> Maybe Int
-> Maybe UpdatePolicy
-> Maybe Text
-> Text
-> Text
-> ComputeEnvironmentDetail
ComputeEnvironmentDetail'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"computeResources")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"containerOrchestrationType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ecsClusterArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"eksConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"serviceRole")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"state")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"statusReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"unmanagedvCpus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"updatePolicy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"uuid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"computeEnvironmentName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"computeEnvironmentArn")
      )

instance Prelude.Hashable ComputeEnvironmentDetail where
  hashWithSalt :: Int -> ComputeEnvironmentDetail -> Int
hashWithSalt Int
_salt ComputeEnvironmentDetail' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe CEState
Maybe CEStatus
Maybe CEType
Maybe EksConfiguration
Maybe ComputeResource
Maybe OrchestrationType
Maybe UpdatePolicy
Text
computeEnvironmentArn :: Text
computeEnvironmentName :: Text
uuid :: Maybe Text
updatePolicy :: Maybe UpdatePolicy
unmanagedvCpus :: Maybe Int
type' :: Maybe CEType
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
status :: Maybe CEStatus
state :: Maybe CEState
serviceRole :: Maybe Text
eksConfiguration :: Maybe EksConfiguration
ecsClusterArn :: Maybe Text
containerOrchestrationType :: Maybe OrchestrationType
computeResources :: Maybe ComputeResource
$sel:computeEnvironmentArn:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Text
$sel:computeEnvironmentName:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Text
$sel:uuid:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:updatePolicy:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe UpdatePolicy
$sel:unmanagedvCpus:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Int
$sel:type':ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEType
$sel:tags:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe (HashMap Text Text)
$sel:statusReason:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:status:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEStatus
$sel:state:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEState
$sel:serviceRole:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:eksConfiguration:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe EksConfiguration
$sel:ecsClusterArn:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:containerOrchestrationType:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe OrchestrationType
$sel:computeResources:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe ComputeResource
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputeResource
computeResources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrchestrationType
containerOrchestrationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ecsClusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksConfiguration
eksConfiguration
      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 CEStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CEType
type'
      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` Maybe Text
uuid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
computeEnvironmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
computeEnvironmentArn

instance Prelude.NFData ComputeEnvironmentDetail where
  rnf :: ComputeEnvironmentDetail -> ()
rnf ComputeEnvironmentDetail' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe CEState
Maybe CEStatus
Maybe CEType
Maybe EksConfiguration
Maybe ComputeResource
Maybe OrchestrationType
Maybe UpdatePolicy
Text
computeEnvironmentArn :: Text
computeEnvironmentName :: Text
uuid :: Maybe Text
updatePolicy :: Maybe UpdatePolicy
unmanagedvCpus :: Maybe Int
type' :: Maybe CEType
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
status :: Maybe CEStatus
state :: Maybe CEState
serviceRole :: Maybe Text
eksConfiguration :: Maybe EksConfiguration
ecsClusterArn :: Maybe Text
containerOrchestrationType :: Maybe OrchestrationType
computeResources :: Maybe ComputeResource
$sel:computeEnvironmentArn:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Text
$sel:computeEnvironmentName:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Text
$sel:uuid:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:updatePolicy:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe UpdatePolicy
$sel:unmanagedvCpus:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Int
$sel:type':ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEType
$sel:tags:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe (HashMap Text Text)
$sel:statusReason:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:status:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEStatus
$sel:state:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe CEState
$sel:serviceRole:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:eksConfiguration:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe EksConfiguration
$sel:ecsClusterArn:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe Text
$sel:containerOrchestrationType:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe OrchestrationType
$sel:computeResources:ComputeEnvironmentDetail' :: ComputeEnvironmentDetail -> Maybe ComputeResource
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputeResource
computeResources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrchestrationType
containerOrchestrationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ecsClusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EksConfiguration
eksConfiguration
      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 CEStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CEType
type'
      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 Maybe Text
uuid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
computeEnvironmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
computeEnvironmentArn