{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EC2.RegisterImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an AMI. When you\'re creating an AMI, this is the final step
-- you must complete before you can launch an instance from the AMI. For
-- more information about creating AMIs, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/creating-an-ami.html Create your own AMI>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- For Amazon EBS-backed instances, CreateImage creates and registers the
-- AMI in a single request, so you don\'t have to register the AMI
-- yourself. We recommend that you always use CreateImage unless you have a
-- specific reason to use RegisterImage.
--
-- If needed, you can deregister an AMI at any time. Any modifications you
-- make to an AMI backed by an instance store volume invalidates its
-- registration. If you make changes to an image, deregister the previous
-- image and register the new image.
--
-- __Register a snapshot of a root device volume__
--
-- You can use @RegisterImage@ to create an Amazon EBS-backed Linux AMI
-- from a snapshot of a root device volume. You specify the snapshot using
-- a block device mapping. You can\'t set the encryption state of the
-- volume using the block device mapping. If the snapshot is encrypted, or
-- encryption by default is enabled, the root volume of an instance
-- launched from the AMI is encrypted.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/creating-an-ami-ebs.html#creating-launching-ami-from-snapshot Create a Linux AMI from a snapshot>
-- and
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/AMIEncryption.html Use encryption with Amazon EBS-backed AMIs>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- __Amazon Web Services Marketplace product codes__
--
-- If any snapshots have Amazon Web Services Marketplace product codes,
-- they are copied to the new AMI.
--
-- Windows and some Linux distributions, such as Red Hat Enterprise Linux
-- (RHEL) and SUSE Linux Enterprise Server (SLES), use the Amazon EC2
-- billing product code associated with an AMI to verify the subscription
-- status for package updates. To create a new AMI for operating systems
-- that require a billing product code, instead of registering the AMI, do
-- the following to preserve the billing product code association:
--
-- 1.  Launch an instance from an existing AMI with that billing product
--     code.
--
-- 2.  Customize the instance.
--
-- 3.  Create an AMI from the instance using CreateImage.
--
-- If you purchase a Reserved Instance to apply to an On-Demand Instance
-- that was launched from an AMI with a billing product code, make sure
-- that the Reserved Instance has the matching billing product code. If you
-- purchase a Reserved Instance without the matching billing product code,
-- the Reserved Instance will not be applied to the On-Demand Instance. For
-- information about how to obtain the platform details and billing
-- information of an AMI, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-billing-info.html Understand AMI billing information>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.RegisterImage
  ( -- * Creating a Request
    RegisterImage (..),
    newRegisterImage,

    -- * Request Lenses
    registerImage_architecture,
    registerImage_billingProducts,
    registerImage_blockDeviceMappings,
    registerImage_bootMode,
    registerImage_description,
    registerImage_dryRun,
    registerImage_enaSupport,
    registerImage_imageLocation,
    registerImage_imdsSupport,
    registerImage_kernelId,
    registerImage_ramdiskId,
    registerImage_rootDeviceName,
    registerImage_sriovNetSupport,
    registerImage_tpmSupport,
    registerImage_uefiData,
    registerImage_virtualizationType,
    registerImage_name,

    -- * Destructuring the Response
    RegisterImageResponse (..),
    newRegisterImageResponse,

    -- * Response Lenses
    registerImageResponse_imageId,
    registerImageResponse_httpStatus,
  )
where

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

-- | Contains the parameters for RegisterImage.
--
-- /See:/ 'newRegisterImage' smart constructor.
data RegisterImage = RegisterImage'
  { -- | The architecture of the AMI.
    --
    -- Default: For Amazon EBS-backed AMIs, @i386@. For instance store-backed
    -- AMIs, the architecture specified in the manifest file.
    RegisterImage -> Maybe ArchitectureValues
architecture :: Prelude.Maybe ArchitectureValues,
    -- | The billing product codes. Your account must be authorized to specify
    -- billing product codes.
    --
    -- If your account is not authorized to specify billing product codes, you
    -- can publish AMIs that include billable software and list them on the
    -- Amazon Web Services Marketplace. You must first register as a seller on
    -- the Amazon Web Services Marketplace. For more information, see
    -- <https://docs.aws.amazon.com/marketplace/latest/userguide/user-guide-for-sellers.html Getting started as a seller>
    -- and
    -- <https://docs.aws.amazon.com/marketplace/latest/userguide/ami-products.html AMI-based products>
    -- in the /Amazon Web Services Marketplace Seller Guide/.
    RegisterImage -> Maybe [Text]
billingProducts :: Prelude.Maybe [Prelude.Text],
    -- | The block device mapping entries.
    --
    -- If you specify an Amazon EBS volume using the ID of an Amazon EBS
    -- snapshot, you can\'t specify the encryption state of the volume.
    --
    -- If you create an AMI on an Outpost, then all backing snapshots must be
    -- on the same Outpost or in the Region of that Outpost. AMIs on an Outpost
    -- that include local snapshots can be used to launch instances on the same
    -- Outpost only. For more information,
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#ami Amazon EBS local snapshots on Outposts>
    -- in the /Amazon EC2 User Guide/.
    RegisterImage -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | The boot mode of the AMI. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
    -- in the /Amazon EC2 User Guide/.
    RegisterImage -> Maybe BootModeValues
bootMode :: Prelude.Maybe BootModeValues,
    -- | A description for your AMI.
    RegisterImage -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    RegisterImage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Set to @true@ to enable enhanced networking with ENA for the AMI and any
    -- instances that you launch from the AMI.
    --
    -- This option is supported only for HVM AMIs. Specifying this option with
    -- a PV AMI can make instances launched from the AMI unreachable.
    RegisterImage -> Maybe Bool
enaSupport :: Prelude.Maybe Prelude.Bool,
    -- | The full path to your AMI manifest in Amazon S3 storage. The specified
    -- bucket must have the @aws-exec-read@ canned access control list (ACL) to
    -- ensure that it can be accessed by Amazon EC2. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl Canned ACLs>
    -- in the /Amazon S3 Service Developer Guide/.
    RegisterImage -> Maybe Text
imageLocation :: Prelude.Maybe Prelude.Text,
    -- | Set to @v2.0@ to indicate 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/.
    --
    -- If you set the value to @v2.0@, make sure that your AMI software can
    -- support IMDSv2.
    RegisterImage -> Maybe ImdsSupportValues
imdsSupport :: Prelude.Maybe ImdsSupportValues,
    -- | The ID of the kernel.
    RegisterImage -> Maybe Text
kernelId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the RAM disk.
    RegisterImage -> Maybe Text
ramdiskId :: Prelude.Maybe Prelude.Text,
    -- | The device name of the root device volume (for example, @\/dev\/sda1@).
    RegisterImage -> Maybe Text
rootDeviceName :: Prelude.Maybe Prelude.Text,
    -- | Set to @simple@ to enable enhanced networking with the Intel 82599
    -- Virtual Function interface for the AMI and any instances that you launch
    -- from the AMI.
    --
    -- There is no way to disable @sriovNetSupport@ at this time.
    --
    -- This option is supported only for HVM AMIs. Specifying this option with
    -- a PV AMI can make instances launched from the AMI unreachable.
    RegisterImage -> Maybe Text
sriovNetSupport :: Prelude.Maybe Prelude.Text,
    -- | Set to @v2.0@ to enable Trusted Platform Module (TPM) support. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
    -- in the /Amazon EC2 User Guide/.
    RegisterImage -> Maybe TpmSupportValues
tpmSupport :: Prelude.Maybe TpmSupportValues,
    -- | Base64 representation of the non-volatile UEFI variable store. To
    -- retrieve the UEFI data, use the
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
    -- command. You can inspect and modify the UEFI data by using the
    -- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
    -- GitHub. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
    -- in the /Amazon EC2 User Guide/.
    RegisterImage -> Maybe Text
uefiData :: Prelude.Maybe Prelude.Text,
    -- | The type of virtualization (@hvm@ | @paravirtual@).
    --
    -- Default: @paravirtual@
    RegisterImage -> Maybe Text
virtualizationType :: Prelude.Maybe Prelude.Text,
    -- | A name for your AMI.
    --
    -- Constraints: 3-128 alphanumeric characters, parentheses (()), square
    -- brackets ([]), spaces ( ), periods (.), slashes (\/), dashes (-), single
    -- quotes (\'), at-signs (\@), or underscores(_)
    RegisterImage -> Text
name :: Prelude.Text
  }
  deriving (RegisterImage -> RegisterImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterImage -> RegisterImage -> Bool
$c/= :: RegisterImage -> RegisterImage -> Bool
== :: RegisterImage -> RegisterImage -> Bool
$c== :: RegisterImage -> RegisterImage -> Bool
Prelude.Eq, ReadPrec [RegisterImage]
ReadPrec RegisterImage
Int -> ReadS RegisterImage
ReadS [RegisterImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterImage]
$creadListPrec :: ReadPrec [RegisterImage]
readPrec :: ReadPrec RegisterImage
$creadPrec :: ReadPrec RegisterImage
readList :: ReadS [RegisterImage]
$creadList :: ReadS [RegisterImage]
readsPrec :: Int -> ReadS RegisterImage
$creadsPrec :: Int -> ReadS RegisterImage
Prelude.Read, Int -> RegisterImage -> ShowS
[RegisterImage] -> ShowS
RegisterImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterImage] -> ShowS
$cshowList :: [RegisterImage] -> ShowS
show :: RegisterImage -> String
$cshow :: RegisterImage -> String
showsPrec :: Int -> RegisterImage -> ShowS
$cshowsPrec :: Int -> RegisterImage -> ShowS
Prelude.Show, forall x. Rep RegisterImage x -> RegisterImage
forall x. RegisterImage -> Rep RegisterImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterImage x -> RegisterImage
$cfrom :: forall x. RegisterImage -> Rep RegisterImage x
Prelude.Generic)

-- |
-- Create a value of 'RegisterImage' 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:
--
-- 'architecture', 'registerImage_architecture' - The architecture of the AMI.
--
-- Default: For Amazon EBS-backed AMIs, @i386@. For instance store-backed
-- AMIs, the architecture specified in the manifest file.
--
-- 'billingProducts', 'registerImage_billingProducts' - The billing product codes. Your account must be authorized to specify
-- billing product codes.
--
-- If your account is not authorized to specify billing product codes, you
-- can publish AMIs that include billable software and list them on the
-- Amazon Web Services Marketplace. You must first register as a seller on
-- the Amazon Web Services Marketplace. For more information, see
-- <https://docs.aws.amazon.com/marketplace/latest/userguide/user-guide-for-sellers.html Getting started as a seller>
-- and
-- <https://docs.aws.amazon.com/marketplace/latest/userguide/ami-products.html AMI-based products>
-- in the /Amazon Web Services Marketplace Seller Guide/.
--
-- 'blockDeviceMappings', 'registerImage_blockDeviceMappings' - The block device mapping entries.
--
-- If you specify an Amazon EBS volume using the ID of an Amazon EBS
-- snapshot, you can\'t specify the encryption state of the volume.
--
-- If you create an AMI on an Outpost, then all backing snapshots must be
-- on the same Outpost or in the Region of that Outpost. AMIs on an Outpost
-- that include local snapshots can be used to launch instances on the same
-- Outpost only. For more information,
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#ami Amazon EBS local snapshots on Outposts>
-- in the /Amazon EC2 User Guide/.
--
-- 'bootMode', 'registerImage_bootMode' - The boot mode of the AMI. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
-- in the /Amazon EC2 User Guide/.
--
-- 'description', 'registerImage_description' - A description for your AMI.
--
-- 'dryRun', 'registerImage_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'enaSupport', 'registerImage_enaSupport' - Set to @true@ to enable enhanced networking with ENA for the AMI and any
-- instances that you launch from the AMI.
--
-- This option is supported only for HVM AMIs. Specifying this option with
-- a PV AMI can make instances launched from the AMI unreachable.
--
-- 'imageLocation', 'registerImage_imageLocation' - The full path to your AMI manifest in Amazon S3 storage. The specified
-- bucket must have the @aws-exec-read@ canned access control list (ACL) to
-- ensure that it can be accessed by Amazon EC2. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl Canned ACLs>
-- in the /Amazon S3 Service Developer Guide/.
--
-- 'imdsSupport', 'registerImage_imdsSupport' - Set to @v2.0@ to indicate 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/.
--
-- If you set the value to @v2.0@, make sure that your AMI software can
-- support IMDSv2.
--
-- 'kernelId', 'registerImage_kernelId' - The ID of the kernel.
--
-- 'ramdiskId', 'registerImage_ramdiskId' - The ID of the RAM disk.
--
-- 'rootDeviceName', 'registerImage_rootDeviceName' - The device name of the root device volume (for example, @\/dev\/sda1@).
--
-- 'sriovNetSupport', 'registerImage_sriovNetSupport' - Set to @simple@ to enable enhanced networking with the Intel 82599
-- Virtual Function interface for the AMI and any instances that you launch
-- from the AMI.
--
-- There is no way to disable @sriovNetSupport@ at this time.
--
-- This option is supported only for HVM AMIs. Specifying this option with
-- a PV AMI can make instances launched from the AMI unreachable.
--
-- 'tpmSupport', 'registerImage_tpmSupport' - Set to @v2.0@ to enable Trusted Platform Module (TPM) support. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
-- in the /Amazon EC2 User Guide/.
--
-- 'uefiData', 'registerImage_uefiData' - Base64 representation of the non-volatile UEFI variable store. To
-- retrieve the UEFI data, use the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
-- command. You can inspect and modify the UEFI data by using the
-- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
-- GitHub. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
-- in the /Amazon EC2 User Guide/.
--
-- 'virtualizationType', 'registerImage_virtualizationType' - The type of virtualization (@hvm@ | @paravirtual@).
--
-- Default: @paravirtual@
--
-- 'name', 'registerImage_name' - A name for your AMI.
--
-- Constraints: 3-128 alphanumeric characters, parentheses (()), square
-- brackets ([]), spaces ( ), periods (.), slashes (\/), dashes (-), single
-- quotes (\'), at-signs (\@), or underscores(_)
newRegisterImage ::
  -- | 'name'
  Prelude.Text ->
  RegisterImage
newRegisterImage :: Text -> RegisterImage
newRegisterImage Text
pName_ =
  RegisterImage'
    { $sel:architecture:RegisterImage' :: Maybe ArchitectureValues
architecture = forall a. Maybe a
Prelude.Nothing,
      $sel:billingProducts:RegisterImage' :: Maybe [Text]
billingProducts = forall a. Maybe a
Prelude.Nothing,
      $sel:blockDeviceMappings:RegisterImage' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:bootMode:RegisterImage' :: Maybe BootModeValues
bootMode = forall a. Maybe a
Prelude.Nothing,
      $sel:description:RegisterImage' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:RegisterImage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:enaSupport:RegisterImage' :: Maybe Bool
enaSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:imageLocation:RegisterImage' :: Maybe Text
imageLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:imdsSupport:RegisterImage' :: Maybe ImdsSupportValues
imdsSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:kernelId:RegisterImage' :: Maybe Text
kernelId = forall a. Maybe a
Prelude.Nothing,
      $sel:ramdiskId:RegisterImage' :: Maybe Text
ramdiskId = forall a. Maybe a
Prelude.Nothing,
      $sel:rootDeviceName:RegisterImage' :: Maybe Text
rootDeviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:sriovNetSupport:RegisterImage' :: Maybe Text
sriovNetSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:tpmSupport:RegisterImage' :: Maybe TpmSupportValues
tpmSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:uefiData:RegisterImage' :: Maybe Text
uefiData = forall a. Maybe a
Prelude.Nothing,
      $sel:virtualizationType:RegisterImage' :: Maybe Text
virtualizationType = forall a. Maybe a
Prelude.Nothing,
      $sel:name:RegisterImage' :: Text
name = Text
pName_
    }

-- | The architecture of the AMI.
--
-- Default: For Amazon EBS-backed AMIs, @i386@. For instance store-backed
-- AMIs, the architecture specified in the manifest file.
registerImage_architecture :: Lens.Lens' RegisterImage (Prelude.Maybe ArchitectureValues)
registerImage_architecture :: Lens' RegisterImage (Maybe ArchitectureValues)
registerImage_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe ArchitectureValues
architecture :: Maybe ArchitectureValues
$sel:architecture:RegisterImage' :: RegisterImage -> Maybe ArchitectureValues
architecture} -> Maybe ArchitectureValues
architecture) (\s :: RegisterImage
s@RegisterImage' {} Maybe ArchitectureValues
a -> RegisterImage
s {$sel:architecture:RegisterImage' :: Maybe ArchitectureValues
architecture = Maybe ArchitectureValues
a} :: RegisterImage)

-- | The billing product codes. Your account must be authorized to specify
-- billing product codes.
--
-- If your account is not authorized to specify billing product codes, you
-- can publish AMIs that include billable software and list them on the
-- Amazon Web Services Marketplace. You must first register as a seller on
-- the Amazon Web Services Marketplace. For more information, see
-- <https://docs.aws.amazon.com/marketplace/latest/userguide/user-guide-for-sellers.html Getting started as a seller>
-- and
-- <https://docs.aws.amazon.com/marketplace/latest/userguide/ami-products.html AMI-based products>
-- in the /Amazon Web Services Marketplace Seller Guide/.
registerImage_billingProducts :: Lens.Lens' RegisterImage (Prelude.Maybe [Prelude.Text])
registerImage_billingProducts :: Lens' RegisterImage (Maybe [Text])
registerImage_billingProducts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe [Text]
billingProducts :: Maybe [Text]
$sel:billingProducts:RegisterImage' :: RegisterImage -> Maybe [Text]
billingProducts} -> Maybe [Text]
billingProducts) (\s :: RegisterImage
s@RegisterImage' {} Maybe [Text]
a -> RegisterImage
s {$sel:billingProducts:RegisterImage' :: Maybe [Text]
billingProducts = Maybe [Text]
a} :: RegisterImage) 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 block device mapping entries.
--
-- If you specify an Amazon EBS volume using the ID of an Amazon EBS
-- snapshot, you can\'t specify the encryption state of the volume.
--
-- If you create an AMI on an Outpost, then all backing snapshots must be
-- on the same Outpost or in the Region of that Outpost. AMIs on an Outpost
-- that include local snapshots can be used to launch instances on the same
-- Outpost only. For more information,
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshots-outposts.html#ami Amazon EBS local snapshots on Outposts>
-- in the /Amazon EC2 User Guide/.
registerImage_blockDeviceMappings :: Lens.Lens' RegisterImage (Prelude.Maybe [BlockDeviceMapping])
registerImage_blockDeviceMappings :: Lens' RegisterImage (Maybe [BlockDeviceMapping])
registerImage_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:RegisterImage' :: RegisterImage -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: RegisterImage
s@RegisterImage' {} Maybe [BlockDeviceMapping]
a -> RegisterImage
s {$sel:blockDeviceMappings:RegisterImage' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: RegisterImage) 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 AMI. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-boot.html Boot modes>
-- in the /Amazon EC2 User Guide/.
registerImage_bootMode :: Lens.Lens' RegisterImage (Prelude.Maybe BootModeValues)
registerImage_bootMode :: Lens' RegisterImage (Maybe BootModeValues)
registerImage_bootMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe BootModeValues
bootMode :: Maybe BootModeValues
$sel:bootMode:RegisterImage' :: RegisterImage -> Maybe BootModeValues
bootMode} -> Maybe BootModeValues
bootMode) (\s :: RegisterImage
s@RegisterImage' {} Maybe BootModeValues
a -> RegisterImage
s {$sel:bootMode:RegisterImage' :: Maybe BootModeValues
bootMode = Maybe BootModeValues
a} :: RegisterImage)

-- | A description for your AMI.
registerImage_description :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_description :: Lens' RegisterImage (Maybe Text)
registerImage_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
description :: Maybe Text
$sel:description:RegisterImage' :: RegisterImage -> Maybe Text
description} -> Maybe Text
description) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:description:RegisterImage' :: Maybe Text
description = Maybe Text
a} :: RegisterImage)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
registerImage_dryRun :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Bool)
registerImage_dryRun :: Lens' RegisterImage (Maybe Bool)
registerImage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:RegisterImage' :: RegisterImage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: RegisterImage
s@RegisterImage' {} Maybe Bool
a -> RegisterImage
s {$sel:dryRun:RegisterImage' :: Maybe Bool
dryRun = Maybe Bool
a} :: RegisterImage)

-- | Set to @true@ to enable enhanced networking with ENA for the AMI and any
-- instances that you launch from the AMI.
--
-- This option is supported only for HVM AMIs. Specifying this option with
-- a PV AMI can make instances launched from the AMI unreachable.
registerImage_enaSupport :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Bool)
registerImage_enaSupport :: Lens' RegisterImage (Maybe Bool)
registerImage_enaSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Bool
enaSupport :: Maybe Bool
$sel:enaSupport:RegisterImage' :: RegisterImage -> Maybe Bool
enaSupport} -> Maybe Bool
enaSupport) (\s :: RegisterImage
s@RegisterImage' {} Maybe Bool
a -> RegisterImage
s {$sel:enaSupport:RegisterImage' :: Maybe Bool
enaSupport = Maybe Bool
a} :: RegisterImage)

-- | The full path to your AMI manifest in Amazon S3 storage. The specified
-- bucket must have the @aws-exec-read@ canned access control list (ACL) to
-- ensure that it can be accessed by Amazon EC2. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl Canned ACLs>
-- in the /Amazon S3 Service Developer Guide/.
registerImage_imageLocation :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_imageLocation :: Lens' RegisterImage (Maybe Text)
registerImage_imageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
imageLocation :: Maybe Text
$sel:imageLocation:RegisterImage' :: RegisterImage -> Maybe Text
imageLocation} -> Maybe Text
imageLocation) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:imageLocation:RegisterImage' :: Maybe Text
imageLocation = Maybe Text
a} :: RegisterImage)

-- | Set to @v2.0@ to indicate 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/.
--
-- If you set the value to @v2.0@, make sure that your AMI software can
-- support IMDSv2.
registerImage_imdsSupport :: Lens.Lens' RegisterImage (Prelude.Maybe ImdsSupportValues)
registerImage_imdsSupport :: Lens' RegisterImage (Maybe ImdsSupportValues)
registerImage_imdsSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe ImdsSupportValues
imdsSupport :: Maybe ImdsSupportValues
$sel:imdsSupport:RegisterImage' :: RegisterImage -> Maybe ImdsSupportValues
imdsSupport} -> Maybe ImdsSupportValues
imdsSupport) (\s :: RegisterImage
s@RegisterImage' {} Maybe ImdsSupportValues
a -> RegisterImage
s {$sel:imdsSupport:RegisterImage' :: Maybe ImdsSupportValues
imdsSupport = Maybe ImdsSupportValues
a} :: RegisterImage)

-- | The ID of the kernel.
registerImage_kernelId :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_kernelId :: Lens' RegisterImage (Maybe Text)
registerImage_kernelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
kernelId :: Maybe Text
$sel:kernelId:RegisterImage' :: RegisterImage -> Maybe Text
kernelId} -> Maybe Text
kernelId) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:kernelId:RegisterImage' :: Maybe Text
kernelId = Maybe Text
a} :: RegisterImage)

-- | The ID of the RAM disk.
registerImage_ramdiskId :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_ramdiskId :: Lens' RegisterImage (Maybe Text)
registerImage_ramdiskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
ramdiskId :: Maybe Text
$sel:ramdiskId:RegisterImage' :: RegisterImage -> Maybe Text
ramdiskId} -> Maybe Text
ramdiskId) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:ramdiskId:RegisterImage' :: Maybe Text
ramdiskId = Maybe Text
a} :: RegisterImage)

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

-- | Set to @simple@ to enable enhanced networking with the Intel 82599
-- Virtual Function interface for the AMI and any instances that you launch
-- from the AMI.
--
-- There is no way to disable @sriovNetSupport@ at this time.
--
-- This option is supported only for HVM AMIs. Specifying this option with
-- a PV AMI can make instances launched from the AMI unreachable.
registerImage_sriovNetSupport :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_sriovNetSupport :: Lens' RegisterImage (Maybe Text)
registerImage_sriovNetSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
sriovNetSupport :: Maybe Text
$sel:sriovNetSupport:RegisterImage' :: RegisterImage -> Maybe Text
sriovNetSupport} -> Maybe Text
sriovNetSupport) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:sriovNetSupport:RegisterImage' :: Maybe Text
sriovNetSupport = Maybe Text
a} :: RegisterImage)

-- | Set to @v2.0@ to enable Trusted Platform Module (TPM) support. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/nitrotpm.html NitroTPM>
-- in the /Amazon EC2 User Guide/.
registerImage_tpmSupport :: Lens.Lens' RegisterImage (Prelude.Maybe TpmSupportValues)
registerImage_tpmSupport :: Lens' RegisterImage (Maybe TpmSupportValues)
registerImage_tpmSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe TpmSupportValues
tpmSupport :: Maybe TpmSupportValues
$sel:tpmSupport:RegisterImage' :: RegisterImage -> Maybe TpmSupportValues
tpmSupport} -> Maybe TpmSupportValues
tpmSupport) (\s :: RegisterImage
s@RegisterImage' {} Maybe TpmSupportValues
a -> RegisterImage
s {$sel:tpmSupport:RegisterImage' :: Maybe TpmSupportValues
tpmSupport = Maybe TpmSupportValues
a} :: RegisterImage)

-- | Base64 representation of the non-volatile UEFI variable store. To
-- retrieve the UEFI data, use the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
-- command. You can inspect and modify the UEFI data by using the
-- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
-- GitHub. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
-- in the /Amazon EC2 User Guide/.
registerImage_uefiData :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_uefiData :: Lens' RegisterImage (Maybe Text)
registerImage_uefiData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
uefiData :: Maybe Text
$sel:uefiData:RegisterImage' :: RegisterImage -> Maybe Text
uefiData} -> Maybe Text
uefiData) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:uefiData:RegisterImage' :: Maybe Text
uefiData = Maybe Text
a} :: RegisterImage)

-- | The type of virtualization (@hvm@ | @paravirtual@).
--
-- Default: @paravirtual@
registerImage_virtualizationType :: Lens.Lens' RegisterImage (Prelude.Maybe Prelude.Text)
registerImage_virtualizationType :: Lens' RegisterImage (Maybe Text)
registerImage_virtualizationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Maybe Text
virtualizationType :: Maybe Text
$sel:virtualizationType:RegisterImage' :: RegisterImage -> Maybe Text
virtualizationType} -> Maybe Text
virtualizationType) (\s :: RegisterImage
s@RegisterImage' {} Maybe Text
a -> RegisterImage
s {$sel:virtualizationType:RegisterImage' :: Maybe Text
virtualizationType = Maybe Text
a} :: RegisterImage)

-- | A name for your AMI.
--
-- Constraints: 3-128 alphanumeric characters, parentheses (()), square
-- brackets ([]), spaces ( ), periods (.), slashes (\/), dashes (-), single
-- quotes (\'), at-signs (\@), or underscores(_)
registerImage_name :: Lens.Lens' RegisterImage Prelude.Text
registerImage_name :: Lens' RegisterImage Text
registerImage_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterImage' {Text
name :: Text
$sel:name:RegisterImage' :: RegisterImage -> Text
name} -> Text
name) (\s :: RegisterImage
s@RegisterImage' {} Text
a -> RegisterImage
s {$sel:name:RegisterImage' :: Text
name = Text
a} :: RegisterImage)

instance Core.AWSRequest RegisterImage where
  type
    AWSResponse RegisterImage =
      RegisterImageResponse
  request :: (Service -> Service) -> RegisterImage -> Request RegisterImage
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RegisterImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterImage)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> RegisterImageResponse
RegisterImageResponse'
            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
"imageId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable RegisterImage where
  hashWithSalt :: Int -> RegisterImage -> Int
hashWithSalt Int
_salt RegisterImage' {Maybe Bool
Maybe [Text]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe ArchitectureValues
Maybe BootModeValues
Maybe ImdsSupportValues
Maybe TpmSupportValues
Text
name :: Text
virtualizationType :: Maybe Text
uefiData :: Maybe Text
tpmSupport :: Maybe TpmSupportValues
sriovNetSupport :: Maybe Text
rootDeviceName :: Maybe Text
ramdiskId :: Maybe Text
kernelId :: Maybe Text
imdsSupport :: Maybe ImdsSupportValues
imageLocation :: Maybe Text
enaSupport :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
bootMode :: Maybe BootModeValues
blockDeviceMappings :: Maybe [BlockDeviceMapping]
billingProducts :: Maybe [Text]
architecture :: Maybe ArchitectureValues
$sel:name:RegisterImage' :: RegisterImage -> Text
$sel:virtualizationType:RegisterImage' :: RegisterImage -> Maybe Text
$sel:uefiData:RegisterImage' :: RegisterImage -> Maybe Text
$sel:tpmSupport:RegisterImage' :: RegisterImage -> Maybe TpmSupportValues
$sel:sriovNetSupport:RegisterImage' :: RegisterImage -> Maybe Text
$sel:rootDeviceName:RegisterImage' :: RegisterImage -> Maybe Text
$sel:ramdiskId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:kernelId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:imdsSupport:RegisterImage' :: RegisterImage -> Maybe ImdsSupportValues
$sel:imageLocation:RegisterImage' :: RegisterImage -> Maybe Text
$sel:enaSupport:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:dryRun:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:description:RegisterImage' :: RegisterImage -> Maybe Text
$sel:bootMode:RegisterImage' :: RegisterImage -> Maybe BootModeValues
$sel:blockDeviceMappings:RegisterImage' :: RegisterImage -> Maybe [BlockDeviceMapping]
$sel:billingProducts:RegisterImage' :: RegisterImage -> Maybe [Text]
$sel:architecture:RegisterImage' :: RegisterImage -> Maybe ArchitectureValues
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ArchitectureValues
architecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
billingProducts
      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
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enaSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageLocation
      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
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 TpmSupportValues
tpmSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
uefiData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
virtualizationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData RegisterImage where
  rnf :: RegisterImage -> ()
rnf RegisterImage' {Maybe Bool
Maybe [Text]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe ArchitectureValues
Maybe BootModeValues
Maybe ImdsSupportValues
Maybe TpmSupportValues
Text
name :: Text
virtualizationType :: Maybe Text
uefiData :: Maybe Text
tpmSupport :: Maybe TpmSupportValues
sriovNetSupport :: Maybe Text
rootDeviceName :: Maybe Text
ramdiskId :: Maybe Text
kernelId :: Maybe Text
imdsSupport :: Maybe ImdsSupportValues
imageLocation :: Maybe Text
enaSupport :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
bootMode :: Maybe BootModeValues
blockDeviceMappings :: Maybe [BlockDeviceMapping]
billingProducts :: Maybe [Text]
architecture :: Maybe ArchitectureValues
$sel:name:RegisterImage' :: RegisterImage -> Text
$sel:virtualizationType:RegisterImage' :: RegisterImage -> Maybe Text
$sel:uefiData:RegisterImage' :: RegisterImage -> Maybe Text
$sel:tpmSupport:RegisterImage' :: RegisterImage -> Maybe TpmSupportValues
$sel:sriovNetSupport:RegisterImage' :: RegisterImage -> Maybe Text
$sel:rootDeviceName:RegisterImage' :: RegisterImage -> Maybe Text
$sel:ramdiskId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:kernelId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:imdsSupport:RegisterImage' :: RegisterImage -> Maybe ImdsSupportValues
$sel:imageLocation:RegisterImage' :: RegisterImage -> Maybe Text
$sel:enaSupport:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:dryRun:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:description:RegisterImage' :: RegisterImage -> Maybe Text
$sel:bootMode:RegisterImage' :: RegisterImage -> Maybe BootModeValues
$sel:blockDeviceMappings:RegisterImage' :: RegisterImage -> Maybe [BlockDeviceMapping]
$sel:billingProducts:RegisterImage' :: RegisterImage -> Maybe [Text]
$sel:architecture:RegisterImage' :: RegisterImage -> Maybe ArchitectureValues
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ArchitectureValues
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
billingProducts
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      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
imageLocation
      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
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 TpmSupportValues
tpmSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uefiData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
virtualizationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders RegisterImage where
  toHeaders :: RegisterImage -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery RegisterImage where
  toQuery :: RegisterImage -> QueryString
toQuery RegisterImage' {Maybe Bool
Maybe [Text]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe ArchitectureValues
Maybe BootModeValues
Maybe ImdsSupportValues
Maybe TpmSupportValues
Text
name :: Text
virtualizationType :: Maybe Text
uefiData :: Maybe Text
tpmSupport :: Maybe TpmSupportValues
sriovNetSupport :: Maybe Text
rootDeviceName :: Maybe Text
ramdiskId :: Maybe Text
kernelId :: Maybe Text
imdsSupport :: Maybe ImdsSupportValues
imageLocation :: Maybe Text
enaSupport :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
bootMode :: Maybe BootModeValues
blockDeviceMappings :: Maybe [BlockDeviceMapping]
billingProducts :: Maybe [Text]
architecture :: Maybe ArchitectureValues
$sel:name:RegisterImage' :: RegisterImage -> Text
$sel:virtualizationType:RegisterImage' :: RegisterImage -> Maybe Text
$sel:uefiData:RegisterImage' :: RegisterImage -> Maybe Text
$sel:tpmSupport:RegisterImage' :: RegisterImage -> Maybe TpmSupportValues
$sel:sriovNetSupport:RegisterImage' :: RegisterImage -> Maybe Text
$sel:rootDeviceName:RegisterImage' :: RegisterImage -> Maybe Text
$sel:ramdiskId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:kernelId:RegisterImage' :: RegisterImage -> Maybe Text
$sel:imdsSupport:RegisterImage' :: RegisterImage -> Maybe ImdsSupportValues
$sel:imageLocation:RegisterImage' :: RegisterImage -> Maybe Text
$sel:enaSupport:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:dryRun:RegisterImage' :: RegisterImage -> Maybe Bool
$sel:description:RegisterImage' :: RegisterImage -> Maybe Text
$sel:bootMode:RegisterImage' :: RegisterImage -> Maybe BootModeValues
$sel:blockDeviceMappings:RegisterImage' :: RegisterImage -> Maybe [BlockDeviceMapping]
$sel:billingProducts:RegisterImage' :: RegisterImage -> Maybe [Text]
$sel:architecture:RegisterImage' :: RegisterImage -> Maybe ArchitectureValues
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RegisterImage" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Architecture" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ArchitectureValues
architecture,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"BillingProduct"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
billingProducts
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"BlockDeviceMapping"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BlockDeviceMapping]
blockDeviceMappings
          ),
        ByteString
"BootMode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BootModeValues
bootMode,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"EnaSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enaSupport,
        ByteString
"ImageLocation" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
imageLocation,
        ByteString
"ImdsSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ImdsSupportValues
imdsSupport,
        ByteString
"KernelId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kernelId,
        ByteString
"RamdiskId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ramdiskId,
        ByteString
"RootDeviceName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
rootDeviceName,
        ByteString
"SriovNetSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sriovNetSupport,
        ByteString
"TpmSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TpmSupportValues
tpmSupport,
        ByteString
"UefiData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
uefiData,
        ByteString
"VirtualizationType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
virtualizationType,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name
      ]

-- | Contains the output of RegisterImage.
--
-- /See:/ 'newRegisterImageResponse' smart constructor.
data RegisterImageResponse = RegisterImageResponse'
  { -- | The ID of the newly registered AMI.
    RegisterImageResponse -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterImageResponse -> RegisterImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterImageResponse -> RegisterImageResponse -> Bool
$c/= :: RegisterImageResponse -> RegisterImageResponse -> Bool
== :: RegisterImageResponse -> RegisterImageResponse -> Bool
$c== :: RegisterImageResponse -> RegisterImageResponse -> Bool
Prelude.Eq, ReadPrec [RegisterImageResponse]
ReadPrec RegisterImageResponse
Int -> ReadS RegisterImageResponse
ReadS [RegisterImageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterImageResponse]
$creadListPrec :: ReadPrec [RegisterImageResponse]
readPrec :: ReadPrec RegisterImageResponse
$creadPrec :: ReadPrec RegisterImageResponse
readList :: ReadS [RegisterImageResponse]
$creadList :: ReadS [RegisterImageResponse]
readsPrec :: Int -> ReadS RegisterImageResponse
$creadsPrec :: Int -> ReadS RegisterImageResponse
Prelude.Read, Int -> RegisterImageResponse -> ShowS
[RegisterImageResponse] -> ShowS
RegisterImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterImageResponse] -> ShowS
$cshowList :: [RegisterImageResponse] -> ShowS
show :: RegisterImageResponse -> String
$cshow :: RegisterImageResponse -> String
showsPrec :: Int -> RegisterImageResponse -> ShowS
$cshowsPrec :: Int -> RegisterImageResponse -> ShowS
Prelude.Show, forall x. Rep RegisterImageResponse x -> RegisterImageResponse
forall x. RegisterImageResponse -> Rep RegisterImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterImageResponse x -> RegisterImageResponse
$cfrom :: forall x. RegisterImageResponse -> Rep RegisterImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterImageResponse' 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:
--
-- 'imageId', 'registerImageResponse_imageId' - The ID of the newly registered AMI.
--
-- 'httpStatus', 'registerImageResponse_httpStatus' - The response's http status code.
newRegisterImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterImageResponse
newRegisterImageResponse :: Int -> RegisterImageResponse
newRegisterImageResponse Int
pHttpStatus_ =
  RegisterImageResponse'
    { $sel:imageId:RegisterImageResponse' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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