{-# 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.EC2.Types.Image
-- 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.EC2.Types.Image where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.ArchitectureValues
import Amazonka.EC2.Types.BlockDeviceMapping
import Amazonka.EC2.Types.BootModeValues
import Amazonka.EC2.Types.DeviceType
import Amazonka.EC2.Types.HypervisorType
import Amazonka.EC2.Types.ImageState
import Amazonka.EC2.Types.ImageTypeValues
import Amazonka.EC2.Types.ImdsSupportValues
import Amazonka.EC2.Types.PlatformValues
import Amazonka.EC2.Types.ProductCode
import Amazonka.EC2.Types.StateReason
import Amazonka.EC2.Types.Tag
import Amazonka.EC2.Types.TpmSupportValues
import Amazonka.EC2.Types.VirtualizationType
import qualified Amazonka.Prelude as Prelude

-- | Describes an image.
--
-- /See:/ 'newImage' smart constructor.
data Image = Image'
  { -- | Any block device mapping entries.
    Image -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | The boot mode of the image. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
    -- in the /Amazon EC2 User Guide/.
    Image -> Maybe BootModeValues
bootMode :: Prelude.Maybe BootModeValues,
    -- | The date and time the image was created.
    Image -> Maybe Text
creationDate :: Prelude.Maybe Prelude.Text,
    -- | The date and time to deprecate the AMI, in UTC, in the following format:
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z. If you specified a value for seconds,
    -- Amazon EC2 rounds the seconds to the nearest minute.
    Image -> Maybe Text
deprecationTime :: Prelude.Maybe Prelude.Text,
    -- | The description of the AMI that was provided during image creation.
    Image -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether enhanced networking with ENA is enabled.
    Image -> Maybe Bool
enaSupport :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Web Services account alias (for example, @amazon@, @self@) or
    -- the Amazon Web Services account ID of the AMI owner.
    Image -> Maybe Text
imageOwnerAlias :: Prelude.Maybe Prelude.Text,
    -- | If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
    -- launched from this AMI will have @HttpTokens@ automatically set to
    -- @required@ so that, by default, the instance requires that IMDSv2 is
    -- used when requesting instance metadata. In addition,
    -- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
    -- in the /Amazon EC2 User Guide/.
    Image -> Maybe ImdsSupportValues
imdsSupport :: Prelude.Maybe ImdsSupportValues,
    -- | The kernel associated with the image, if any. Only applicable for
    -- machine images.
    Image -> Maybe Text
kernelId :: Prelude.Maybe Prelude.Text,
    -- | The name of the AMI that was provided during image creation.
    Image -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | This value is set to @windows@ for Windows AMIs; otherwise, it is blank.
    Image -> Maybe PlatformValues
platform :: Prelude.Maybe PlatformValues,
    -- | The platform details associated with the billing code of the AMI. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-billing-info.html Understand AMI billing information>
    -- in the /Amazon EC2 User Guide/.
    Image -> Maybe Text
platformDetails :: Prelude.Maybe Prelude.Text,
    -- | Any product codes associated with the AMI.
    Image -> Maybe [ProductCode]
productCodes :: Prelude.Maybe [ProductCode],
    -- | The RAM disk associated with the image, if any. Only applicable for
    -- machine images.
    Image -> Maybe Text
ramdiskId :: Prelude.Maybe Prelude.Text,
    -- | The device name of the root device volume (for example, @\/dev\/sda1@).
    Image -> Maybe Text
rootDeviceName :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether enhanced networking with the Intel 82599 Virtual
    -- Function interface is enabled.
    Image -> Maybe Text
sriovNetSupport :: Prelude.Maybe Prelude.Text,
    -- | The reason for the state change.
    Image -> Maybe StateReason
stateReason :: Prelude.Maybe StateReason,
    -- | Any tags assigned to the image.
    Image -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | If the image is configured for NitroTPM support, the value is @v2.0@.
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
    -- in the /Amazon EC2 User Guide/.
    Image -> Maybe TpmSupportValues
tpmSupport :: Prelude.Maybe TpmSupportValues,
    -- | The operation of the Amazon EC2 instance and the billing code that is
    -- associated with the AMI. @usageOperation@ corresponds to the
    -- <https://docs.aws.amazon.com/cur/latest/userguide/Lineitem-columns.html#Lineitem-details-O-Operation lineitem\/Operation>
    -- column on your Amazon Web Services Cost and Usage Report and in the
    -- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/price-changes.html Amazon Web Services Price List API>.
    -- You can view these fields on the __Instances__ or __AMIs__ pages in the
    -- Amazon EC2 console, or in the responses that are returned by the
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeImages.html DescribeImages>
    -- command in the Amazon EC2 API, or the
    -- <https://docs.aws.amazon.com/cli/latest/reference/ec2/describe-images.html describe-images>
    -- command in the CLI.
    Image -> Maybe Text
usageOperation :: Prelude.Maybe Prelude.Text,
    -- | The ID of the AMI.
    Image -> Text
imageId :: Prelude.Text,
    -- | The location of the AMI.
    Image -> Text
imageLocation :: Prelude.Text,
    -- | The current state of the AMI. If the state is @available@, the image is
    -- successfully registered and can be used to launch an instance.
    Image -> ImageState
state :: ImageState,
    -- | The ID of the Amazon Web Services account that owns the image.
    Image -> Text
ownerId :: Prelude.Text,
    -- | Indicates whether the image has public launch permissions. The value is
    -- @true@ if this image has public launch permissions or @false@ if it has
    -- only implicit and explicit launch permissions.
    Image -> Bool
public :: Prelude.Bool,
    -- | The architecture of the image.
    Image -> ArchitectureValues
architecture :: ArchitectureValues,
    -- | The type of image.
    Image -> ImageTypeValues
imageType :: ImageTypeValues,
    -- | The type of root device used by the AMI. The AMI can use an Amazon EBS
    -- volume or an instance store volume.
    Image -> DeviceType
rootDeviceType :: DeviceType,
    -- | The type of virtualization of the AMI.
    Image -> VirtualizationType
virtualizationType :: VirtualizationType,
    -- | The hypervisor type of the image.
    Image -> HypervisorType
hypervisor :: HypervisorType
  }
  deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Prelude.Eq, ReadPrec [Image]
ReadPrec Image
Int -> ReadS Image
ReadS [Image]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Prelude.Read, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Prelude.Show, forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Prelude.Generic)

-- |
-- Create a value of 'Image' 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:
--
-- 'blockDeviceMappings', 'image_blockDeviceMappings' - Any block device mapping entries.
--
-- 'bootMode', 'image_bootMode' - The boot mode of the image. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
-- in the /Amazon EC2 User Guide/.
--
-- 'creationDate', 'image_creationDate' - The date and time the image was created.
--
-- 'deprecationTime', 'image_deprecationTime' - The date and time to deprecate the AMI, in UTC, in the following format:
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z. If you specified a value for seconds,
-- Amazon EC2 rounds the seconds to the nearest minute.
--
-- 'description', 'image_description' - The description of the AMI that was provided during image creation.
--
-- 'enaSupport', 'image_enaSupport' - Specifies whether enhanced networking with ENA is enabled.
--
-- 'imageOwnerAlias', 'image_imageOwnerAlias' - The Amazon Web Services account alias (for example, @amazon@, @self@) or
-- the Amazon Web Services account ID of the AMI owner.
--
-- 'imdsSupport', 'image_imdsSupport' - If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
-- launched from this AMI will have @HttpTokens@ automatically set to
-- @required@ so that, by default, the instance requires that IMDSv2 is
-- used when requesting instance metadata. In addition,
-- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
-- in the /Amazon EC2 User Guide/.
--
-- 'kernelId', 'image_kernelId' - The kernel associated with the image, if any. Only applicable for
-- machine images.
--
-- 'name', 'image_name' - The name of the AMI that was provided during image creation.
--
-- 'platform', 'image_platform' - This value is set to @windows@ for Windows AMIs; otherwise, it is blank.
--
-- 'platformDetails', 'image_platformDetails' - The platform details associated with the billing code of the AMI. For
-- more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-billing-info.html Understand AMI billing information>
-- in the /Amazon EC2 User Guide/.
--
-- 'productCodes', 'image_productCodes' - Any product codes associated with the AMI.
--
-- 'ramdiskId', 'image_ramdiskId' - The RAM disk associated with the image, if any. Only applicable for
-- machine images.
--
-- 'rootDeviceName', 'image_rootDeviceName' - The device name of the root device volume (for example, @\/dev\/sda1@).
--
-- 'sriovNetSupport', 'image_sriovNetSupport' - Specifies whether enhanced networking with the Intel 82599 Virtual
-- Function interface is enabled.
--
-- 'stateReason', 'image_stateReason' - The reason for the state change.
--
-- 'tags', 'image_tags' - Any tags assigned to the image.
--
-- 'tpmSupport', 'image_tpmSupport' - If the image is configured for NitroTPM support, the value is @v2.0@.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
-- in the /Amazon EC2 User Guide/.
--
-- 'usageOperation', 'image_usageOperation' - The operation of the Amazon EC2 instance and the billing code that is
-- associated with the AMI. @usageOperation@ corresponds to the
-- <https://docs.aws.amazon.com/cur/latest/userguide/Lineitem-columns.html#Lineitem-details-O-Operation lineitem\/Operation>
-- column on your Amazon Web Services Cost and Usage Report and in the
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/price-changes.html Amazon Web Services Price List API>.
-- You can view these fields on the __Instances__ or __AMIs__ pages in the
-- Amazon EC2 console, or in the responses that are returned by the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeImages.html DescribeImages>
-- command in the Amazon EC2 API, or the
-- <https://docs.aws.amazon.com/cli/latest/reference/ec2/describe-images.html describe-images>
-- command in the CLI.
--
-- 'imageId', 'image_imageId' - The ID of the AMI.
--
-- 'imageLocation', 'image_imageLocation' - The location of the AMI.
--
-- 'state', 'image_state' - The current state of the AMI. If the state is @available@, the image is
-- successfully registered and can be used to launch an instance.
--
-- 'ownerId', 'image_ownerId' - The ID of the Amazon Web Services account that owns the image.
--
-- 'public', 'image_public' - Indicates whether the image has public launch permissions. The value is
-- @true@ if this image has public launch permissions or @false@ if it has
-- only implicit and explicit launch permissions.
--
-- 'architecture', 'image_architecture' - The architecture of the image.
--
-- 'imageType', 'image_imageType' - The type of image.
--
-- 'rootDeviceType', 'image_rootDeviceType' - The type of root device used by the AMI. The AMI can use an Amazon EBS
-- volume or an instance store volume.
--
-- 'virtualizationType', 'image_virtualizationType' - The type of virtualization of the AMI.
--
-- 'hypervisor', 'image_hypervisor' - The hypervisor type of the image.
newImage ::
  -- | 'imageId'
  Prelude.Text ->
  -- | 'imageLocation'
  Prelude.Text ->
  -- | 'state'
  ImageState ->
  -- | 'ownerId'
  Prelude.Text ->
  -- | 'public'
  Prelude.Bool ->
  -- | 'architecture'
  ArchitectureValues ->
  -- | 'imageType'
  ImageTypeValues ->
  -- | 'rootDeviceType'
  DeviceType ->
  -- | 'virtualizationType'
  VirtualizationType ->
  -- | 'hypervisor'
  HypervisorType ->
  Image
newImage :: Text
-> Text
-> ImageState
-> Text
-> Bool
-> ArchitectureValues
-> ImageTypeValues
-> DeviceType
-> VirtualizationType
-> HypervisorType
-> Image
newImage
  Text
pImageId_
  Text
pImageLocation_
  ImageState
pState_
  Text
pOwnerId_
  Bool
pPublic_
  ArchitectureValues
pArchitecture_
  ImageTypeValues
pImageType_
  DeviceType
pRootDeviceType_
  VirtualizationType
pVirtualizationType_
  HypervisorType
pHypervisor_ =
    Image'
      { $sel:blockDeviceMappings:Image' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
        $sel:bootMode:Image' :: Maybe BootModeValues
bootMode = forall a. Maybe a
Prelude.Nothing,
        $sel:creationDate:Image' :: Maybe Text
creationDate = forall a. Maybe a
Prelude.Nothing,
        $sel:deprecationTime:Image' :: Maybe Text
deprecationTime = forall a. Maybe a
Prelude.Nothing,
        $sel:description:Image' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:enaSupport:Image' :: Maybe Bool
enaSupport = forall a. Maybe a
Prelude.Nothing,
        $sel:imageOwnerAlias:Image' :: Maybe Text
imageOwnerAlias = forall a. Maybe a
Prelude.Nothing,
        $sel:imdsSupport:Image' :: Maybe ImdsSupportValues
imdsSupport = forall a. Maybe a
Prelude.Nothing,
        $sel:kernelId:Image' :: Maybe Text
kernelId = forall a. Maybe a
Prelude.Nothing,
        $sel:name:Image' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:platform:Image' :: Maybe PlatformValues
platform = forall a. Maybe a
Prelude.Nothing,
        $sel:platformDetails:Image' :: Maybe Text
platformDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:productCodes:Image' :: Maybe [ProductCode]
productCodes = forall a. Maybe a
Prelude.Nothing,
        $sel:ramdiskId:Image' :: Maybe Text
ramdiskId = forall a. Maybe a
Prelude.Nothing,
        $sel:rootDeviceName:Image' :: Maybe Text
rootDeviceName = forall a. Maybe a
Prelude.Nothing,
        $sel:sriovNetSupport:Image' :: Maybe Text
sriovNetSupport = forall a. Maybe a
Prelude.Nothing,
        $sel:stateReason:Image' :: Maybe StateReason
stateReason = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:Image' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:tpmSupport:Image' :: Maybe TpmSupportValues
tpmSupport = forall a. Maybe a
Prelude.Nothing,
        $sel:usageOperation:Image' :: Maybe Text
usageOperation = forall a. Maybe a
Prelude.Nothing,
        $sel:imageId:Image' :: Text
imageId = Text
pImageId_,
        $sel:imageLocation:Image' :: Text
imageLocation = Text
pImageLocation_,
        $sel:state:Image' :: ImageState
state = ImageState
pState_,
        $sel:ownerId:Image' :: Text
ownerId = Text
pOwnerId_,
        $sel:public:Image' :: Bool
public = Bool
pPublic_,
        $sel:architecture:Image' :: ArchitectureValues
architecture = ArchitectureValues
pArchitecture_,
        $sel:imageType:Image' :: ImageTypeValues
imageType = ImageTypeValues
pImageType_,
        $sel:rootDeviceType:Image' :: DeviceType
rootDeviceType = DeviceType
pRootDeviceType_,
        $sel:virtualizationType:Image' :: VirtualizationType
virtualizationType = VirtualizationType
pVirtualizationType_,
        $sel:hypervisor:Image' :: HypervisorType
hypervisor = HypervisorType
pHypervisor_
      }

-- | Any block device mapping entries.
image_blockDeviceMappings :: Lens.Lens' Image (Prelude.Maybe [BlockDeviceMapping])
image_blockDeviceMappings :: Lens' Image (Maybe [BlockDeviceMapping])
image_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:Image' :: Image -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: Image
s@Image' {} Maybe [BlockDeviceMapping]
a -> Image
s {$sel:blockDeviceMappings:Image' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: Image) 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 boot mode of the image. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
-- in the /Amazon EC2 User Guide/.
image_bootMode :: Lens.Lens' Image (Prelude.Maybe BootModeValues)
image_bootMode :: Lens' Image (Maybe BootModeValues)
image_bootMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe BootModeValues
bootMode :: Maybe BootModeValues
$sel:bootMode:Image' :: Image -> Maybe BootModeValues
bootMode} -> Maybe BootModeValues
bootMode) (\s :: Image
s@Image' {} Maybe BootModeValues
a -> Image
s {$sel:bootMode:Image' :: Maybe BootModeValues
bootMode = Maybe BootModeValues
a} :: Image)

-- | The date and time the image was created.
image_creationDate :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_creationDate :: Lens' Image (Maybe Text)
image_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
creationDate :: Maybe Text
$sel:creationDate:Image' :: Image -> Maybe Text
creationDate} -> Maybe Text
creationDate) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:creationDate:Image' :: Maybe Text
creationDate = Maybe Text
a} :: Image)

-- | The date and time to deprecate the AMI, in UTC, in the following format:
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z. If you specified a value for seconds,
-- Amazon EC2 rounds the seconds to the nearest minute.
image_deprecationTime :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_deprecationTime :: Lens' Image (Maybe Text)
image_deprecationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
deprecationTime :: Maybe Text
$sel:deprecationTime:Image' :: Image -> Maybe Text
deprecationTime} -> Maybe Text
deprecationTime) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:deprecationTime:Image' :: Maybe Text
deprecationTime = Maybe Text
a} :: Image)

-- | The description of the AMI that was provided during image creation.
image_description :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_description :: Lens' Image (Maybe Text)
image_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
description :: Maybe Text
$sel:description:Image' :: Image -> Maybe Text
description} -> Maybe Text
description) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:description:Image' :: Maybe Text
description = Maybe Text
a} :: Image)

-- | Specifies whether enhanced networking with ENA is enabled.
image_enaSupport :: Lens.Lens' Image (Prelude.Maybe Prelude.Bool)
image_enaSupport :: Lens' Image (Maybe Bool)
image_enaSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Bool
enaSupport :: Maybe Bool
$sel:enaSupport:Image' :: Image -> Maybe Bool
enaSupport} -> Maybe Bool
enaSupport) (\s :: Image
s@Image' {} Maybe Bool
a -> Image
s {$sel:enaSupport:Image' :: Maybe Bool
enaSupport = Maybe Bool
a} :: Image)

-- | The Amazon Web Services account alias (for example, @amazon@, @self@) or
-- the Amazon Web Services account ID of the AMI owner.
image_imageOwnerAlias :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_imageOwnerAlias :: Lens' Image (Maybe Text)
image_imageOwnerAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
imageOwnerAlias :: Maybe Text
$sel:imageOwnerAlias:Image' :: Image -> Maybe Text
imageOwnerAlias} -> Maybe Text
imageOwnerAlias) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:imageOwnerAlias:Image' :: Maybe Text
imageOwnerAlias = Maybe Text
a} :: Image)

-- | If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
-- launched from this AMI will have @HttpTokens@ automatically set to
-- @required@ so that, by default, the instance requires that IMDSv2 is
-- used when requesting instance metadata. In addition,
-- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
-- in the /Amazon EC2 User Guide/.
image_imdsSupport :: Lens.Lens' Image (Prelude.Maybe ImdsSupportValues)
image_imdsSupport :: Lens' Image (Maybe ImdsSupportValues)
image_imdsSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe ImdsSupportValues
imdsSupport :: Maybe ImdsSupportValues
$sel:imdsSupport:Image' :: Image -> Maybe ImdsSupportValues
imdsSupport} -> Maybe ImdsSupportValues
imdsSupport) (\s :: Image
s@Image' {} Maybe ImdsSupportValues
a -> Image
s {$sel:imdsSupport:Image' :: Maybe ImdsSupportValues
imdsSupport = Maybe ImdsSupportValues
a} :: Image)

-- | The kernel associated with the image, if any. Only applicable for
-- machine images.
image_kernelId :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_kernelId :: Lens' Image (Maybe Text)
image_kernelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
kernelId :: Maybe Text
$sel:kernelId:Image' :: Image -> Maybe Text
kernelId} -> Maybe Text
kernelId) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:kernelId:Image' :: Maybe Text
kernelId = Maybe Text
a} :: Image)

-- | The name of the AMI that was provided during image creation.
image_name :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_name :: Lens' Image (Maybe Text)
image_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
name :: Maybe Text
$sel:name:Image' :: Image -> Maybe Text
name} -> Maybe Text
name) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:name:Image' :: Maybe Text
name = Maybe Text
a} :: Image)

-- | This value is set to @windows@ for Windows AMIs; otherwise, it is blank.
image_platform :: Lens.Lens' Image (Prelude.Maybe PlatformValues)
image_platform :: Lens' Image (Maybe PlatformValues)
image_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe PlatformValues
platform :: Maybe PlatformValues
$sel:platform:Image' :: Image -> Maybe PlatformValues
platform} -> Maybe PlatformValues
platform) (\s :: Image
s@Image' {} Maybe PlatformValues
a -> Image
s {$sel:platform:Image' :: Maybe PlatformValues
platform = Maybe PlatformValues
a} :: Image)

-- | The platform details associated with the billing code of the AMI. For
-- more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-billing-info.html Understand AMI billing information>
-- in the /Amazon EC2 User Guide/.
image_platformDetails :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_platformDetails :: Lens' Image (Maybe Text)
image_platformDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
platformDetails :: Maybe Text
$sel:platformDetails:Image' :: Image -> Maybe Text
platformDetails} -> Maybe Text
platformDetails) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:platformDetails:Image' :: Maybe Text
platformDetails = Maybe Text
a} :: Image)

-- | Any product codes associated with the AMI.
image_productCodes :: Lens.Lens' Image (Prelude.Maybe [ProductCode])
image_productCodes :: Lens' Image (Maybe [ProductCode])
image_productCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe [ProductCode]
productCodes :: Maybe [ProductCode]
$sel:productCodes:Image' :: Image -> Maybe [ProductCode]
productCodes} -> Maybe [ProductCode]
productCodes) (\s :: Image
s@Image' {} Maybe [ProductCode]
a -> Image
s {$sel:productCodes:Image' :: Maybe [ProductCode]
productCodes = Maybe [ProductCode]
a} :: Image) 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 RAM disk associated with the image, if any. Only applicable for
-- machine images.
image_ramdiskId :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_ramdiskId :: Lens' Image (Maybe Text)
image_ramdiskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
ramdiskId :: Maybe Text
$sel:ramdiskId:Image' :: Image -> Maybe Text
ramdiskId} -> Maybe Text
ramdiskId) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:ramdiskId:Image' :: Maybe Text
ramdiskId = Maybe Text
a} :: Image)

-- | The device name of the root device volume (for example, @\/dev\/sda1@).
image_rootDeviceName :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_rootDeviceName :: Lens' Image (Maybe Text)
image_rootDeviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
rootDeviceName :: Maybe Text
$sel:rootDeviceName:Image' :: Image -> Maybe Text
rootDeviceName} -> Maybe Text
rootDeviceName) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:rootDeviceName:Image' :: Maybe Text
rootDeviceName = Maybe Text
a} :: Image)

-- | Specifies whether enhanced networking with the Intel 82599 Virtual
-- Function interface is enabled.
image_sriovNetSupport :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_sriovNetSupport :: Lens' Image (Maybe Text)
image_sriovNetSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
sriovNetSupport :: Maybe Text
$sel:sriovNetSupport:Image' :: Image -> Maybe Text
sriovNetSupport} -> Maybe Text
sriovNetSupport) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:sriovNetSupport:Image' :: Maybe Text
sriovNetSupport = Maybe Text
a} :: Image)

-- | The reason for the state change.
image_stateReason :: Lens.Lens' Image (Prelude.Maybe StateReason)
image_stateReason :: Lens' Image (Maybe StateReason)
image_stateReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe StateReason
stateReason :: Maybe StateReason
$sel:stateReason:Image' :: Image -> Maybe StateReason
stateReason} -> Maybe StateReason
stateReason) (\s :: Image
s@Image' {} Maybe StateReason
a -> Image
s {$sel:stateReason:Image' :: Maybe StateReason
stateReason = Maybe StateReason
a} :: Image)

-- | Any tags assigned to the image.
image_tags :: Lens.Lens' Image (Prelude.Maybe [Tag])
image_tags :: Lens' Image (Maybe [Tag])
image_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Image' :: Image -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Image
s@Image' {} Maybe [Tag]
a -> Image
s {$sel:tags:Image' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Image) 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

-- | If the image is configured for NitroTPM support, the value is @v2.0@.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
-- in the /Amazon EC2 User Guide/.
image_tpmSupport :: Lens.Lens' Image (Prelude.Maybe TpmSupportValues)
image_tpmSupport :: Lens' Image (Maybe TpmSupportValues)
image_tpmSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe TpmSupportValues
tpmSupport :: Maybe TpmSupportValues
$sel:tpmSupport:Image' :: Image -> Maybe TpmSupportValues
tpmSupport} -> Maybe TpmSupportValues
tpmSupport) (\s :: Image
s@Image' {} Maybe TpmSupportValues
a -> Image
s {$sel:tpmSupport:Image' :: Maybe TpmSupportValues
tpmSupport = Maybe TpmSupportValues
a} :: Image)

-- | The operation of the Amazon EC2 instance and the billing code that is
-- associated with the AMI. @usageOperation@ corresponds to the
-- <https://docs.aws.amazon.com/cur/latest/userguide/Lineitem-columns.html#Lineitem-details-O-Operation lineitem\/Operation>
-- column on your Amazon Web Services Cost and Usage Report and in the
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/price-changes.html Amazon Web Services Price List API>.
-- You can view these fields on the __Instances__ or __AMIs__ pages in the
-- Amazon EC2 console, or in the responses that are returned by the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeImages.html DescribeImages>
-- command in the Amazon EC2 API, or the
-- <https://docs.aws.amazon.com/cli/latest/reference/ec2/describe-images.html describe-images>
-- command in the CLI.
image_usageOperation :: Lens.Lens' Image (Prelude.Maybe Prelude.Text)
image_usageOperation :: Lens' Image (Maybe Text)
image_usageOperation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Maybe Text
usageOperation :: Maybe Text
$sel:usageOperation:Image' :: Image -> Maybe Text
usageOperation} -> Maybe Text
usageOperation) (\s :: Image
s@Image' {} Maybe Text
a -> Image
s {$sel:usageOperation:Image' :: Maybe Text
usageOperation = Maybe Text
a} :: Image)

-- | The ID of the AMI.
image_imageId :: Lens.Lens' Image Prelude.Text
image_imageId :: Lens' Image Text
image_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Text
imageId :: Text
$sel:imageId:Image' :: Image -> Text
imageId} -> Text
imageId) (\s :: Image
s@Image' {} Text
a -> Image
s {$sel:imageId:Image' :: Text
imageId = Text
a} :: Image)

-- | The location of the AMI.
image_imageLocation :: Lens.Lens' Image Prelude.Text
image_imageLocation :: Lens' Image Text
image_imageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Text
imageLocation :: Text
$sel:imageLocation:Image' :: Image -> Text
imageLocation} -> Text
imageLocation) (\s :: Image
s@Image' {} Text
a -> Image
s {$sel:imageLocation:Image' :: Text
imageLocation = Text
a} :: Image)

-- | The current state of the AMI. If the state is @available@, the image is
-- successfully registered and can be used to launch an instance.
image_state :: Lens.Lens' Image ImageState
image_state :: Lens' Image ImageState
image_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {ImageState
state :: ImageState
$sel:state:Image' :: Image -> ImageState
state} -> ImageState
state) (\s :: Image
s@Image' {} ImageState
a -> Image
s {$sel:state:Image' :: ImageState
state = ImageState
a} :: Image)

-- | The ID of the Amazon Web Services account that owns the image.
image_ownerId :: Lens.Lens' Image Prelude.Text
image_ownerId :: Lens' Image Text
image_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Text
ownerId :: Text
$sel:ownerId:Image' :: Image -> Text
ownerId} -> Text
ownerId) (\s :: Image
s@Image' {} Text
a -> Image
s {$sel:ownerId:Image' :: Text
ownerId = Text
a} :: Image)

-- | Indicates whether the image has public launch permissions. The value is
-- @true@ if this image has public launch permissions or @false@ if it has
-- only implicit and explicit launch permissions.
image_public :: Lens.Lens' Image Prelude.Bool
image_public :: Lens' Image Bool
image_public = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {Bool
public :: Bool
$sel:public:Image' :: Image -> Bool
public} -> Bool
public) (\s :: Image
s@Image' {} Bool
a -> Image
s {$sel:public:Image' :: Bool
public = Bool
a} :: Image)

-- | The architecture of the image.
image_architecture :: Lens.Lens' Image ArchitectureValues
image_architecture :: Lens' Image ArchitectureValues
image_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {ArchitectureValues
architecture :: ArchitectureValues
$sel:architecture:Image' :: Image -> ArchitectureValues
architecture} -> ArchitectureValues
architecture) (\s :: Image
s@Image' {} ArchitectureValues
a -> Image
s {$sel:architecture:Image' :: ArchitectureValues
architecture = ArchitectureValues
a} :: Image)

-- | The type of image.
image_imageType :: Lens.Lens' Image ImageTypeValues
image_imageType :: Lens' Image ImageTypeValues
image_imageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {ImageTypeValues
imageType :: ImageTypeValues
$sel:imageType:Image' :: Image -> ImageTypeValues
imageType} -> ImageTypeValues
imageType) (\s :: Image
s@Image' {} ImageTypeValues
a -> Image
s {$sel:imageType:Image' :: ImageTypeValues
imageType = ImageTypeValues
a} :: Image)

-- | The type of root device used by the AMI. The AMI can use an Amazon EBS
-- volume or an instance store volume.
image_rootDeviceType :: Lens.Lens' Image DeviceType
image_rootDeviceType :: Lens' Image DeviceType
image_rootDeviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {DeviceType
rootDeviceType :: DeviceType
$sel:rootDeviceType:Image' :: Image -> DeviceType
rootDeviceType} -> DeviceType
rootDeviceType) (\s :: Image
s@Image' {} DeviceType
a -> Image
s {$sel:rootDeviceType:Image' :: DeviceType
rootDeviceType = DeviceType
a} :: Image)

-- | The type of virtualization of the AMI.
image_virtualizationType :: Lens.Lens' Image VirtualizationType
image_virtualizationType :: Lens' Image VirtualizationType
image_virtualizationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {VirtualizationType
virtualizationType :: VirtualizationType
$sel:virtualizationType:Image' :: Image -> VirtualizationType
virtualizationType} -> VirtualizationType
virtualizationType) (\s :: Image
s@Image' {} VirtualizationType
a -> Image
s {$sel:virtualizationType:Image' :: VirtualizationType
virtualizationType = VirtualizationType
a} :: Image)

-- | The hypervisor type of the image.
image_hypervisor :: Lens.Lens' Image HypervisorType
image_hypervisor :: Lens' Image HypervisorType
image_hypervisor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Image' {HypervisorType
hypervisor :: HypervisorType
$sel:hypervisor:Image' :: Image -> HypervisorType
hypervisor} -> HypervisorType
hypervisor) (\s :: Image
s@Image' {} HypervisorType
a -> Image
s {$sel:hypervisor:Image' :: HypervisorType
hypervisor = HypervisorType
a} :: Image)

instance Data.FromXML Image where
  parseXML :: [Node] -> Either String Image
parseXML [Node]
x =
    Maybe [BlockDeviceMapping]
-> Maybe BootModeValues
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe ImdsSupportValues
-> Maybe Text
-> Maybe Text
-> Maybe PlatformValues
-> Maybe Text
-> Maybe [ProductCode]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe StateReason
-> Maybe [Tag]
-> Maybe TpmSupportValues
-> Maybe Text
-> Text
-> Text
-> ImageState
-> Text
-> Bool
-> ArchitectureValues
-> ImageTypeValues
-> DeviceType
-> VirtualizationType
-> HypervisorType
-> Image
Image'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"blockDeviceMapping"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"bootMode")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"creationDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"deprecationTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"description")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"enaSupport")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"imageOwnerAlias")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"imdsSupport")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"kernelId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"platform")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"platformDetails")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"productCodes"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ramdiskId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"rootDeviceName")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"sriovNetSupport")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"stateReason")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tagSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tpmSupport")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"usageOperation")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"imageId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"imageLocation")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"imageState")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"imageOwnerId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"isPublic")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"architecture")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"imageType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"rootDeviceType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"virtualizationType")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"hypervisor")

instance Prelude.Hashable Image where
  hashWithSalt :: Int -> Image -> Int
hashWithSalt Int
_salt Image' {Bool
Maybe Bool
Maybe [ProductCode]
Maybe [Tag]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe BootModeValues
Maybe ImdsSupportValues
Maybe PlatformValues
Maybe StateReason
Maybe TpmSupportValues
Text
ArchitectureValues
DeviceType
HypervisorType
ImageState
ImageTypeValues
VirtualizationType
hypervisor :: HypervisorType
virtualizationType :: VirtualizationType
rootDeviceType :: DeviceType
imageType :: ImageTypeValues
architecture :: ArchitectureValues
public :: Bool
ownerId :: Text
state :: ImageState
imageLocation :: Text
imageId :: Text
usageOperation :: Maybe Text
tpmSupport :: Maybe TpmSupportValues
tags :: Maybe [Tag]
stateReason :: Maybe StateReason
sriovNetSupport :: Maybe Text
rootDeviceName :: Maybe Text
ramdiskId :: Maybe Text
productCodes :: Maybe [ProductCode]
platformDetails :: Maybe Text
platform :: Maybe PlatformValues
name :: Maybe Text
kernelId :: Maybe Text
imdsSupport :: Maybe ImdsSupportValues
imageOwnerAlias :: Maybe Text
enaSupport :: Maybe Bool
description :: Maybe Text
deprecationTime :: Maybe Text
creationDate :: Maybe Text
bootMode :: Maybe BootModeValues
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:hypervisor:Image' :: Image -> HypervisorType
$sel:virtualizationType:Image' :: Image -> VirtualizationType
$sel:rootDeviceType:Image' :: Image -> DeviceType
$sel:imageType:Image' :: Image -> ImageTypeValues
$sel:architecture:Image' :: Image -> ArchitectureValues
$sel:public:Image' :: Image -> Bool
$sel:ownerId:Image' :: Image -> Text
$sel:state:Image' :: Image -> ImageState
$sel:imageLocation:Image' :: Image -> Text
$sel:imageId:Image' :: Image -> Text
$sel:usageOperation:Image' :: Image -> Maybe Text
$sel:tpmSupport:Image' :: Image -> Maybe TpmSupportValues
$sel:tags:Image' :: Image -> Maybe [Tag]
$sel:stateReason:Image' :: Image -> Maybe StateReason
$sel:sriovNetSupport:Image' :: Image -> Maybe Text
$sel:rootDeviceName:Image' :: Image -> Maybe Text
$sel:ramdiskId:Image' :: Image -> Maybe Text
$sel:productCodes:Image' :: Image -> Maybe [ProductCode]
$sel:platformDetails:Image' :: Image -> Maybe Text
$sel:platform:Image' :: Image -> Maybe PlatformValues
$sel:name:Image' :: Image -> Maybe Text
$sel:kernelId:Image' :: Image -> Maybe Text
$sel:imdsSupport:Image' :: Image -> Maybe ImdsSupportValues
$sel:imageOwnerAlias:Image' :: Image -> Maybe Text
$sel:enaSupport:Image' :: Image -> Maybe Bool
$sel:description:Image' :: Image -> Maybe Text
$sel:deprecationTime:Image' :: Image -> Maybe Text
$sel:creationDate:Image' :: Image -> Maybe Text
$sel:bootMode:Image' :: Image -> Maybe BootModeValues
$sel:blockDeviceMappings:Image' :: Image -> Maybe [BlockDeviceMapping]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [BlockDeviceMapping]
blockDeviceMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BootModeValues
bootMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deprecationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enaSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageOwnerAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImdsSupportValues
imdsSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kernelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PlatformValues
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProductCode]
productCodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ramdiskId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
rootDeviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sriovNetSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StateReason
stateReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TpmSupportValues
tpmSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
usageOperation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ImageState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ownerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
public
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ArchitectureValues
architecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ImageTypeValues
imageType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeviceType
rootDeviceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VirtualizationType
virtualizationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HypervisorType
hypervisor

instance Prelude.NFData Image where
  rnf :: Image -> ()
rnf Image' {Bool
Maybe Bool
Maybe [ProductCode]
Maybe [Tag]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe BootModeValues
Maybe ImdsSupportValues
Maybe PlatformValues
Maybe StateReason
Maybe TpmSupportValues
Text
ArchitectureValues
DeviceType
HypervisorType
ImageState
ImageTypeValues
VirtualizationType
hypervisor :: HypervisorType
virtualizationType :: VirtualizationType
rootDeviceType :: DeviceType
imageType :: ImageTypeValues
architecture :: ArchitectureValues
public :: Bool
ownerId :: Text
state :: ImageState
imageLocation :: Text
imageId :: Text
usageOperation :: Maybe Text
tpmSupport :: Maybe TpmSupportValues
tags :: Maybe [Tag]
stateReason :: Maybe StateReason
sriovNetSupport :: Maybe Text
rootDeviceName :: Maybe Text
ramdiskId :: Maybe Text
productCodes :: Maybe [ProductCode]
platformDetails :: Maybe Text
platform :: Maybe PlatformValues
name :: Maybe Text
kernelId :: Maybe Text
imdsSupport :: Maybe ImdsSupportValues
imageOwnerAlias :: Maybe Text
enaSupport :: Maybe Bool
description :: Maybe Text
deprecationTime :: Maybe Text
creationDate :: Maybe Text
bootMode :: Maybe BootModeValues
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:hypervisor:Image' :: Image -> HypervisorType
$sel:virtualizationType:Image' :: Image -> VirtualizationType
$sel:rootDeviceType:Image' :: Image -> DeviceType
$sel:imageType:Image' :: Image -> ImageTypeValues
$sel:architecture:Image' :: Image -> ArchitectureValues
$sel:public:Image' :: Image -> Bool
$sel:ownerId:Image' :: Image -> Text
$sel:state:Image' :: Image -> ImageState
$sel:imageLocation:Image' :: Image -> Text
$sel:imageId:Image' :: Image -> Text
$sel:usageOperation:Image' :: Image -> Maybe Text
$sel:tpmSupport:Image' :: Image -> Maybe TpmSupportValues
$sel:tags:Image' :: Image -> Maybe [Tag]
$sel:stateReason:Image' :: Image -> Maybe StateReason
$sel:sriovNetSupport:Image' :: Image -> Maybe Text
$sel:rootDeviceName:Image' :: Image -> Maybe Text
$sel:ramdiskId:Image' :: Image -> Maybe Text
$sel:productCodes:Image' :: Image -> Maybe [ProductCode]
$sel:platformDetails:Image' :: Image -> Maybe Text
$sel:platform:Image' :: Image -> Maybe PlatformValues
$sel:name:Image' :: Image -> Maybe Text
$sel:kernelId:Image' :: Image -> Maybe Text
$sel:imdsSupport:Image' :: Image -> Maybe ImdsSupportValues
$sel:imageOwnerAlias:Image' :: Image -> Maybe Text
$sel:enaSupport:Image' :: Image -> Maybe Bool
$sel:description:Image' :: Image -> Maybe Text
$sel:deprecationTime:Image' :: Image -> Maybe Text
$sel:creationDate:Image' :: Image -> Maybe Text
$sel:bootMode:Image' :: Image -> Maybe BootModeValues
$sel:blockDeviceMappings:Image' :: Image -> Maybe [BlockDeviceMapping]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BlockDeviceMapping]
blockDeviceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BootModeValues
bootMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deprecationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enaSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageOwnerAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImdsSupportValues
imdsSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kernelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PlatformValues
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProductCode]
productCodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ramdiskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
rootDeviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sriovNetSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StateReason
stateReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TpmSupportValues
tpmSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
usageOperation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ImageState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
public
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        ArchitectureValues
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        ImageTypeValues
imageType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        DeviceType
rootDeviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        VirtualizationType
virtualizationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        HypervisorType
hypervisor