{-# 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.Ec2Configuration
-- 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.Ec2Configuration where

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

-- | Provides information used to select Amazon Machine Images (AMIs) for
-- instances in the compute environment. If @Ec2Configuration@ isn\'t
-- specified, the default is @ECS_AL2@
-- (<https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon Linux 2>).
--
-- This object isn\'t applicable to jobs that are running on Fargate
-- resources.
--
-- /See:/ 'newEc2Configuration' smart constructor.
data Ec2Configuration = Ec2Configuration'
  { -- | The AMI ID used for instances launched in the compute environment that
    -- match the image type. This setting overrides the @imageId@ set in the
    -- @computeResource@ object.
    --
    -- The AMI that you choose for a compute environment must match the
    -- architecture of the instance types that you intend to use for that
    -- compute environment. For example, if your compute environment uses A1
    -- instance types, the compute resource AMI that you choose must support
    -- ARM instances. Amazon ECS vends both x86 and ARM versions of the Amazon
    -- ECS-optimized Amazon Linux 2 AMI. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#ecs-optimized-ami-linux-variants.html Amazon ECS-optimized Amazon Linux 2 AMI>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    Ec2Configuration -> Maybe Text
imageIdOverride :: Prelude.Maybe Prelude.Text,
    -- | The Kubernetes version for the compute environment. If you don\'t
    -- specify a value, the latest version that Batch supports is used.
    Ec2Configuration -> Maybe Text
imageKubernetesVersion :: Prelude.Maybe Prelude.Text,
    -- | The image type to match with the instance type to select an AMI. The
    -- supported values are different for @ECS@ and @EKS@ resources.
    --
    -- [ECS]
    --     If the @imageIdOverride@ parameter isn\'t specified, then a recent
    --     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon ECS-optimized Amazon Linux 2 AMI>
    --     (@ECS_AL2@) is used. If a new image type is specified in an update,
    --     but neither an @imageId@ nor a @imageIdOverride@ parameter is
    --     specified, then the latest Amazon ECS optimized AMI for that image
    --     type that\'s supported by Batch is used.
    --
    --     [ECS_AL2]
    --         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon Linux 2>:
    --         Default for all non-GPU instance families.
    --
    --     [ECS_AL2_NVIDIA]
    --         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#gpuami Amazon Linux 2 (GPU)>:
    --         Default for all GPU instance families (for example @P4@ and
    --         @G4@) and can be used for all non Amazon Web Services
    --         Graviton-based instance types.
    --
    --     [ECS_AL1]
    --         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#alami Amazon Linux>.
    --         Amazon Linux has reached the end-of-life of standard support.
    --         For more information, see
    --         <http://aws.amazon.com/amazon-linux-ami/ Amazon Linux AMI>.
    --
    -- [EKS]
    --     If the @imageIdOverride@ parameter isn\'t specified, then a recent
    --     <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon EKS-optimized Amazon Linux AMI>
    --     (@EKS_AL2@) is used. If a new image type is specified in an update,
    --     but neither an @imageId@ nor a @imageIdOverride@ parameter is
    --     specified, then the latest Amazon EKS optimized AMI for that image
    --     type that Batch supports is used.
    --
    --     [EKS_AL2]
    --         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2>:
    --         Default for all non-GPU instance families.
    --
    --     [EKS_AL2_NVIDIA]
    --         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2 (accelerated)>:
    --         Default for all GPU instance families (for example, @P4@ and
    --         @G4@) and can be used for all non Amazon Web Services
    --         Graviton-based instance types.
    Ec2Configuration -> Text
imageType :: Prelude.Text
  }
  deriving (Ec2Configuration -> Ec2Configuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ec2Configuration -> Ec2Configuration -> Bool
$c/= :: Ec2Configuration -> Ec2Configuration -> Bool
== :: Ec2Configuration -> Ec2Configuration -> Bool
$c== :: Ec2Configuration -> Ec2Configuration -> Bool
Prelude.Eq, ReadPrec [Ec2Configuration]
ReadPrec Ec2Configuration
Int -> ReadS Ec2Configuration
ReadS [Ec2Configuration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ec2Configuration]
$creadListPrec :: ReadPrec [Ec2Configuration]
readPrec :: ReadPrec Ec2Configuration
$creadPrec :: ReadPrec Ec2Configuration
readList :: ReadS [Ec2Configuration]
$creadList :: ReadS [Ec2Configuration]
readsPrec :: Int -> ReadS Ec2Configuration
$creadsPrec :: Int -> ReadS Ec2Configuration
Prelude.Read, Int -> Ec2Configuration -> ShowS
[Ec2Configuration] -> ShowS
Ec2Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ec2Configuration] -> ShowS
$cshowList :: [Ec2Configuration] -> ShowS
show :: Ec2Configuration -> String
$cshow :: Ec2Configuration -> String
showsPrec :: Int -> Ec2Configuration -> ShowS
$cshowsPrec :: Int -> Ec2Configuration -> ShowS
Prelude.Show, forall x. Rep Ec2Configuration x -> Ec2Configuration
forall x. Ec2Configuration -> Rep Ec2Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ec2Configuration x -> Ec2Configuration
$cfrom :: forall x. Ec2Configuration -> Rep Ec2Configuration x
Prelude.Generic)

-- |
-- Create a value of 'Ec2Configuration' 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:
--
-- 'imageIdOverride', 'ec2Configuration_imageIdOverride' - The AMI ID used for instances launched in the compute environment that
-- match the image type. This setting overrides the @imageId@ set in the
-- @computeResource@ object.
--
-- The AMI that you choose for a compute environment must match the
-- architecture of the instance types that you intend to use for that
-- compute environment. For example, if your compute environment uses A1
-- instance types, the compute resource AMI that you choose must support
-- ARM instances. Amazon ECS vends both x86 and ARM versions of the Amazon
-- ECS-optimized Amazon Linux 2 AMI. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#ecs-optimized-ami-linux-variants.html Amazon ECS-optimized Amazon Linux 2 AMI>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'imageKubernetesVersion', 'ec2Configuration_imageKubernetesVersion' - The Kubernetes version for the compute environment. If you don\'t
-- specify a value, the latest version that Batch supports is used.
--
-- 'imageType', 'ec2Configuration_imageType' - The image type to match with the instance type to select an AMI. The
-- supported values are different for @ECS@ and @EKS@ resources.
--
-- [ECS]
--     If the @imageIdOverride@ parameter isn\'t specified, then a recent
--     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon ECS-optimized Amazon Linux 2 AMI>
--     (@ECS_AL2@) is used. If a new image type is specified in an update,
--     but neither an @imageId@ nor a @imageIdOverride@ parameter is
--     specified, then the latest Amazon ECS optimized AMI for that image
--     type that\'s supported by Batch is used.
--
--     [ECS_AL2]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon Linux 2>:
--         Default for all non-GPU instance families.
--
--     [ECS_AL2_NVIDIA]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#gpuami Amazon Linux 2 (GPU)>:
--         Default for all GPU instance families (for example @P4@ and
--         @G4@) and can be used for all non Amazon Web Services
--         Graviton-based instance types.
--
--     [ECS_AL1]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#alami Amazon Linux>.
--         Amazon Linux has reached the end-of-life of standard support.
--         For more information, see
--         <http://aws.amazon.com/amazon-linux-ami/ Amazon Linux AMI>.
--
-- [EKS]
--     If the @imageIdOverride@ parameter isn\'t specified, then a recent
--     <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon EKS-optimized Amazon Linux AMI>
--     (@EKS_AL2@) is used. If a new image type is specified in an update,
--     but neither an @imageId@ nor a @imageIdOverride@ parameter is
--     specified, then the latest Amazon EKS optimized AMI for that image
--     type that Batch supports is used.
--
--     [EKS_AL2]
--         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2>:
--         Default for all non-GPU instance families.
--
--     [EKS_AL2_NVIDIA]
--         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2 (accelerated)>:
--         Default for all GPU instance families (for example, @P4@ and
--         @G4@) and can be used for all non Amazon Web Services
--         Graviton-based instance types.
newEc2Configuration ::
  -- | 'imageType'
  Prelude.Text ->
  Ec2Configuration
newEc2Configuration :: Text -> Ec2Configuration
newEc2Configuration Text
pImageType_ =
  Ec2Configuration'
    { $sel:imageIdOverride:Ec2Configuration' :: Maybe Text
imageIdOverride =
        forall a. Maybe a
Prelude.Nothing,
      $sel:imageKubernetesVersion:Ec2Configuration' :: Maybe Text
imageKubernetesVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:imageType:Ec2Configuration' :: Text
imageType = Text
pImageType_
    }

-- | The AMI ID used for instances launched in the compute environment that
-- match the image type. This setting overrides the @imageId@ set in the
-- @computeResource@ object.
--
-- The AMI that you choose for a compute environment must match the
-- architecture of the instance types that you intend to use for that
-- compute environment. For example, if your compute environment uses A1
-- instance types, the compute resource AMI that you choose must support
-- ARM instances. Amazon ECS vends both x86 and ARM versions of the Amazon
-- ECS-optimized Amazon Linux 2 AMI. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#ecs-optimized-ami-linux-variants.html Amazon ECS-optimized Amazon Linux 2 AMI>
-- in the /Amazon Elastic Container Service Developer Guide/.
ec2Configuration_imageIdOverride :: Lens.Lens' Ec2Configuration (Prelude.Maybe Prelude.Text)
ec2Configuration_imageIdOverride :: Lens' Ec2Configuration (Maybe Text)
ec2Configuration_imageIdOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2Configuration' {Maybe Text
imageIdOverride :: Maybe Text
$sel:imageIdOverride:Ec2Configuration' :: Ec2Configuration -> Maybe Text
imageIdOverride} -> Maybe Text
imageIdOverride) (\s :: Ec2Configuration
s@Ec2Configuration' {} Maybe Text
a -> Ec2Configuration
s {$sel:imageIdOverride:Ec2Configuration' :: Maybe Text
imageIdOverride = Maybe Text
a} :: Ec2Configuration)

-- | The Kubernetes version for the compute environment. If you don\'t
-- specify a value, the latest version that Batch supports is used.
ec2Configuration_imageKubernetesVersion :: Lens.Lens' Ec2Configuration (Prelude.Maybe Prelude.Text)
ec2Configuration_imageKubernetesVersion :: Lens' Ec2Configuration (Maybe Text)
ec2Configuration_imageKubernetesVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2Configuration' {Maybe Text
imageKubernetesVersion :: Maybe Text
$sel:imageKubernetesVersion:Ec2Configuration' :: Ec2Configuration -> Maybe Text
imageKubernetesVersion} -> Maybe Text
imageKubernetesVersion) (\s :: Ec2Configuration
s@Ec2Configuration' {} Maybe Text
a -> Ec2Configuration
s {$sel:imageKubernetesVersion:Ec2Configuration' :: Maybe Text
imageKubernetesVersion = Maybe Text
a} :: Ec2Configuration)

-- | The image type to match with the instance type to select an AMI. The
-- supported values are different for @ECS@ and @EKS@ resources.
--
-- [ECS]
--     If the @imageIdOverride@ parameter isn\'t specified, then a recent
--     <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon ECS-optimized Amazon Linux 2 AMI>
--     (@ECS_AL2@) is used. If a new image type is specified in an update,
--     but neither an @imageId@ nor a @imageIdOverride@ parameter is
--     specified, then the latest Amazon ECS optimized AMI for that image
--     type that\'s supported by Batch is used.
--
--     [ECS_AL2]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#al2ami Amazon Linux 2>:
--         Default for all non-GPU instance families.
--
--     [ECS_AL2_NVIDIA]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#gpuami Amazon Linux 2 (GPU)>:
--         Default for all GPU instance families (for example @P4@ and
--         @G4@) and can be used for all non Amazon Web Services
--         Graviton-based instance types.
--
--     [ECS_AL1]
--         <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-optimized_AMI.html#alami Amazon Linux>.
--         Amazon Linux has reached the end-of-life of standard support.
--         For more information, see
--         <http://aws.amazon.com/amazon-linux-ami/ Amazon Linux AMI>.
--
-- [EKS]
--     If the @imageIdOverride@ parameter isn\'t specified, then a recent
--     <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon EKS-optimized Amazon Linux AMI>
--     (@EKS_AL2@) is used. If a new image type is specified in an update,
--     but neither an @imageId@ nor a @imageIdOverride@ parameter is
--     specified, then the latest Amazon EKS optimized AMI for that image
--     type that Batch supports is used.
--
--     [EKS_AL2]
--         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2>:
--         Default for all non-GPU instance families.
--
--     [EKS_AL2_NVIDIA]
--         <https://docs.aws.amazon.com/eks/latest/userguide/eks-optimized-ami.html Amazon Linux 2 (accelerated)>:
--         Default for all GPU instance families (for example, @P4@ and
--         @G4@) and can be used for all non Amazon Web Services
--         Graviton-based instance types.
ec2Configuration_imageType :: Lens.Lens' Ec2Configuration Prelude.Text
ec2Configuration_imageType :: Lens' Ec2Configuration Text
ec2Configuration_imageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2Configuration' {Text
imageType :: Text
$sel:imageType:Ec2Configuration' :: Ec2Configuration -> Text
imageType} -> Text
imageType) (\s :: Ec2Configuration
s@Ec2Configuration' {} Text
a -> Ec2Configuration
s {$sel:imageType:Ec2Configuration' :: Text
imageType = Text
a} :: Ec2Configuration)

instance Data.FromJSON Ec2Configuration where
  parseJSON :: Value -> Parser Ec2Configuration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Ec2Configuration"
      ( \Object
x ->
          Maybe Text -> Maybe Text -> Text -> Ec2Configuration
Ec2Configuration'
            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
"imageIdOverride")
            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
"imageKubernetesVersion")
            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
"imageType")
      )

instance Prelude.Hashable Ec2Configuration where
  hashWithSalt :: Int -> Ec2Configuration -> Int
hashWithSalt Int
_salt Ec2Configuration' {Maybe Text
Text
imageType :: Text
imageKubernetesVersion :: Maybe Text
imageIdOverride :: Maybe Text
$sel:imageType:Ec2Configuration' :: Ec2Configuration -> Text
$sel:imageKubernetesVersion:Ec2Configuration' :: Ec2Configuration -> Maybe Text
$sel:imageIdOverride:Ec2Configuration' :: Ec2Configuration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageIdOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageKubernetesVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageType

instance Prelude.NFData Ec2Configuration where
  rnf :: Ec2Configuration -> ()
rnf Ec2Configuration' {Maybe Text
Text
imageType :: Text
imageKubernetesVersion :: Maybe Text
imageIdOverride :: Maybe Text
$sel:imageType:Ec2Configuration' :: Ec2Configuration -> Text
$sel:imageKubernetesVersion:Ec2Configuration' :: Ec2Configuration -> Maybe Text
$sel:imageIdOverride:Ec2Configuration' :: Ec2Configuration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageIdOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageKubernetesVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageType

instance Data.ToJSON Ec2Configuration where
  toJSON :: Ec2Configuration -> Value
toJSON Ec2Configuration' {Maybe Text
Text
imageType :: Text
imageKubernetesVersion :: Maybe Text
imageIdOverride :: Maybe Text
$sel:imageType:Ec2Configuration' :: Ec2Configuration -> Text
$sel:imageKubernetesVersion:Ec2Configuration' :: Ec2Configuration -> Maybe Text
$sel:imageIdOverride:Ec2Configuration' :: Ec2Configuration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"imageIdOverride" 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
imageIdOverride,
            (Key
"imageKubernetesVersion" 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
imageKubernetesVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"imageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
imageType)
          ]
      )