{-# 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.CreateImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Amazon EBS-backed AMI from an Amazon EBS-backed instance that
-- is either running or stopped.
--
-- By default, when Amazon EC2 creates the new AMI, it reboots the instance
-- so that it can take snapshots of the attached volumes while data is at
-- rest, in order to ensure a consistent state. You can set the @NoReboot@
-- parameter to @true@ in the API request, or use the @--no-reboot@ option
-- in the CLI to prevent Amazon EC2 from shutting down and rebooting the
-- instance.
--
-- If you choose to bypass the shutdown and reboot process by setting the
-- @NoReboot@ parameter to @true@ in the API request, or by using the
-- @--no-reboot@ option in the CLI, we can\'t guarantee the file system
-- integrity of the created image.
--
-- If you customized your instance with instance store volumes or Amazon
-- EBS volumes in addition to the root device volume, the new AMI contains
-- block device mapping information for those volumes. When you launch an
-- instance from this new AMI, the instance automatically launches with
-- those additional volumes.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/creating-an-ami-ebs.html Create an Amazon EBS-backed Linux AMI>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateImage
  ( -- * Creating a Request
    CreateImage (..),
    newCreateImage,

    -- * Request Lenses
    createImage_blockDeviceMappings,
    createImage_description,
    createImage_dryRun,
    createImage_noReboot,
    createImage_tagSpecifications,
    createImage_instanceId,
    createImage_name,

    -- * Destructuring the Response
    CreateImageResponse (..),
    newCreateImageResponse,

    -- * Response Lenses
    createImageResponse_imageId,
    createImageResponse_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

-- | /See:/ 'newCreateImage' smart constructor.
data CreateImage = CreateImage'
  { -- | The block device mappings. This parameter cannot be used to modify the
    -- encryption status of existing volumes or snapshots. To create an AMI
    -- with encrypted snapshots, use the CopyImage action.
    CreateImage -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | A description for the new image.
    CreateImage -> 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@.
    CreateImage -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | By default, when Amazon EC2 creates the new AMI, it reboots the instance
    -- so that it can take snapshots of the attached volumes while data is at
    -- rest, in order to ensure a consistent state. You can set the @NoReboot@
    -- parameter to @true@ in the API request, or use the @--no-reboot@ option
    -- in the CLI to prevent Amazon EC2 from shutting down and rebooting the
    -- instance.
    --
    -- If you choose to bypass the shutdown and reboot process by setting the
    -- @NoReboot@ parameter to @true@ in the API request, or by using the
    -- @--no-reboot@ option in the CLI, we can\'t guarantee the file system
    -- integrity of the created image.
    --
    -- Default: @false@ (follow standard reboot process)
    CreateImage -> Maybe Bool
noReboot :: Prelude.Maybe Prelude.Bool,
    -- | The tags to apply to the AMI and snapshots on creation. You can tag the
    -- AMI, the snapshots, or both.
    --
    -- -   To tag the AMI, the value for @ResourceType@ must be @image@.
    --
    -- -   To tag the snapshots that are created of the root volume and of
    --     other Amazon EBS volumes that are attached to the instance, the
    --     value for @ResourceType@ must be @snapshot@. The same tag is applied
    --     to all of the snapshots that are created.
    --
    -- If you specify other values for @ResourceType@, the request fails.
    --
    -- To tag an AMI or snapshot after it has been created, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
    CreateImage -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the instance.
    CreateImage -> Text
instanceId :: Prelude.Text,
    -- | A name for the new image.
    --
    -- Constraints: 3-128 alphanumeric characters, parentheses (()), square
    -- brackets ([]), spaces ( ), periods (.), slashes (\/), dashes (-), single
    -- quotes (\'), at-signs (\@), or underscores(_)
    CreateImage -> Text
name :: Prelude.Text
  }
  deriving (CreateImage -> CreateImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateImage -> CreateImage -> Bool
$c/= :: CreateImage -> CreateImage -> Bool
== :: CreateImage -> CreateImage -> Bool
$c== :: CreateImage -> CreateImage -> Bool
Prelude.Eq, ReadPrec [CreateImage]
ReadPrec CreateImage
Int -> ReadS CreateImage
ReadS [CreateImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateImage]
$creadListPrec :: ReadPrec [CreateImage]
readPrec :: ReadPrec CreateImage
$creadPrec :: ReadPrec CreateImage
readList :: ReadS [CreateImage]
$creadList :: ReadS [CreateImage]
readsPrec :: Int -> ReadS CreateImage
$creadsPrec :: Int -> ReadS CreateImage
Prelude.Read, Int -> CreateImage -> ShowS
[CreateImage] -> ShowS
CreateImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateImage] -> ShowS
$cshowList :: [CreateImage] -> ShowS
show :: CreateImage -> String
$cshow :: CreateImage -> String
showsPrec :: Int -> CreateImage -> ShowS
$cshowsPrec :: Int -> CreateImage -> ShowS
Prelude.Show, forall x. Rep CreateImage x -> CreateImage
forall x. CreateImage -> Rep CreateImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateImage x -> CreateImage
$cfrom :: forall x. CreateImage -> Rep CreateImage x
Prelude.Generic)

-- |
-- Create a value of 'CreateImage' 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', 'createImage_blockDeviceMappings' - The block device mappings. This parameter cannot be used to modify the
-- encryption status of existing volumes or snapshots. To create an AMI
-- with encrypted snapshots, use the CopyImage action.
--
-- 'description', 'createImage_description' - A description for the new image.
--
-- 'dryRun', 'createImage_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@.
--
-- 'noReboot', 'createImage_noReboot' - By default, when Amazon EC2 creates the new AMI, it reboots the instance
-- so that it can take snapshots of the attached volumes while data is at
-- rest, in order to ensure a consistent state. You can set the @NoReboot@
-- parameter to @true@ in the API request, or use the @--no-reboot@ option
-- in the CLI to prevent Amazon EC2 from shutting down and rebooting the
-- instance.
--
-- If you choose to bypass the shutdown and reboot process by setting the
-- @NoReboot@ parameter to @true@ in the API request, or by using the
-- @--no-reboot@ option in the CLI, we can\'t guarantee the file system
-- integrity of the created image.
--
-- Default: @false@ (follow standard reboot process)
--
-- 'tagSpecifications', 'createImage_tagSpecifications' - The tags to apply to the AMI and snapshots on creation. You can tag the
-- AMI, the snapshots, or both.
--
-- -   To tag the AMI, the value for @ResourceType@ must be @image@.
--
-- -   To tag the snapshots that are created of the root volume and of
--     other Amazon EBS volumes that are attached to the instance, the
--     value for @ResourceType@ must be @snapshot@. The same tag is applied
--     to all of the snapshots that are created.
--
-- If you specify other values for @ResourceType@, the request fails.
--
-- To tag an AMI or snapshot after it has been created, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
--
-- 'instanceId', 'createImage_instanceId' - The ID of the instance.
--
-- 'name', 'createImage_name' - A name for the new image.
--
-- Constraints: 3-128 alphanumeric characters, parentheses (()), square
-- brackets ([]), spaces ( ), periods (.), slashes (\/), dashes (-), single
-- quotes (\'), at-signs (\@), or underscores(_)
newCreateImage ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateImage
newCreateImage :: Text -> Text -> CreateImage
newCreateImage Text
pInstanceId_ Text
pName_ =
  CreateImage'
    { $sel:blockDeviceMappings:CreateImage' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateImage' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateImage' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:noReboot:CreateImage' :: Maybe Bool
noReboot = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateImage' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:CreateImage' :: Text
instanceId = Text
pInstanceId_,
      $sel:name:CreateImage' :: Text
name = Text
pName_
    }

-- | The block device mappings. This parameter cannot be used to modify the
-- encryption status of existing volumes or snapshots. To create an AMI
-- with encrypted snapshots, use the CopyImage action.
createImage_blockDeviceMappings :: Lens.Lens' CreateImage (Prelude.Maybe [BlockDeviceMapping])
createImage_blockDeviceMappings :: Lens' CreateImage (Maybe [BlockDeviceMapping])
createImage_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:CreateImage' :: CreateImage -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: CreateImage
s@CreateImage' {} Maybe [BlockDeviceMapping]
a -> CreateImage
s {$sel:blockDeviceMappings:CreateImage' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: CreateImage) 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

-- | A description for the new image.
createImage_description :: Lens.Lens' CreateImage (Prelude.Maybe Prelude.Text)
createImage_description :: Lens' CreateImage (Maybe Text)
createImage_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Maybe Text
description :: Maybe Text
$sel:description:CreateImage' :: CreateImage -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateImage
s@CreateImage' {} Maybe Text
a -> CreateImage
s {$sel:description:CreateImage' :: Maybe Text
description = Maybe Text
a} :: CreateImage)

-- | 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@.
createImage_dryRun :: Lens.Lens' CreateImage (Prelude.Maybe Prelude.Bool)
createImage_dryRun :: Lens' CreateImage (Maybe Bool)
createImage_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateImage' :: CreateImage -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateImage
s@CreateImage' {} Maybe Bool
a -> CreateImage
s {$sel:dryRun:CreateImage' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateImage)

-- | By default, when Amazon EC2 creates the new AMI, it reboots the instance
-- so that it can take snapshots of the attached volumes while data is at
-- rest, in order to ensure a consistent state. You can set the @NoReboot@
-- parameter to @true@ in the API request, or use the @--no-reboot@ option
-- in the CLI to prevent Amazon EC2 from shutting down and rebooting the
-- instance.
--
-- If you choose to bypass the shutdown and reboot process by setting the
-- @NoReboot@ parameter to @true@ in the API request, or by using the
-- @--no-reboot@ option in the CLI, we can\'t guarantee the file system
-- integrity of the created image.
--
-- Default: @false@ (follow standard reboot process)
createImage_noReboot :: Lens.Lens' CreateImage (Prelude.Maybe Prelude.Bool)
createImage_noReboot :: Lens' CreateImage (Maybe Bool)
createImage_noReboot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Maybe Bool
noReboot :: Maybe Bool
$sel:noReboot:CreateImage' :: CreateImage -> Maybe Bool
noReboot} -> Maybe Bool
noReboot) (\s :: CreateImage
s@CreateImage' {} Maybe Bool
a -> CreateImage
s {$sel:noReboot:CreateImage' :: Maybe Bool
noReboot = Maybe Bool
a} :: CreateImage)

-- | The tags to apply to the AMI and snapshots on creation. You can tag the
-- AMI, the snapshots, or both.
--
-- -   To tag the AMI, the value for @ResourceType@ must be @image@.
--
-- -   To tag the snapshots that are created of the root volume and of
--     other Amazon EBS volumes that are attached to the instance, the
--     value for @ResourceType@ must be @snapshot@. The same tag is applied
--     to all of the snapshots that are created.
--
-- If you specify other values for @ResourceType@, the request fails.
--
-- To tag an AMI or snapshot after it has been created, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
createImage_tagSpecifications :: Lens.Lens' CreateImage (Prelude.Maybe [TagSpecification])
createImage_tagSpecifications :: Lens' CreateImage (Maybe [TagSpecification])
createImage_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateImage' :: CreateImage -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateImage
s@CreateImage' {} Maybe [TagSpecification]
a -> CreateImage
s {$sel:tagSpecifications:CreateImage' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateImage) 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 ID of the instance.
createImage_instanceId :: Lens.Lens' CreateImage Prelude.Text
createImage_instanceId :: Lens' CreateImage Text
createImage_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateImage' {Text
instanceId :: Text
$sel:instanceId:CreateImage' :: CreateImage -> Text
instanceId} -> Text
instanceId) (\s :: CreateImage
s@CreateImage' {} Text
a -> CreateImage
s {$sel:instanceId:CreateImage' :: Text
instanceId = Text
a} :: CreateImage)

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

instance Core.AWSRequest CreateImage where
  type AWSResponse CreateImage = CreateImageResponse
  request :: (Service -> Service) -> CreateImage -> Request CreateImage
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 CreateImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateImage)))
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 -> CreateImageResponse
CreateImageResponse'
            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 CreateImage where
  hashWithSalt :: Int -> CreateImage -> Int
hashWithSalt Int
_salt CreateImage' {Maybe Bool
Maybe [TagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Text
name :: Text
instanceId :: Text
tagSpecifications :: Maybe [TagSpecification]
noReboot :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:name:CreateImage' :: CreateImage -> Text
$sel:instanceId:CreateImage' :: CreateImage -> Text
$sel:tagSpecifications:CreateImage' :: CreateImage -> Maybe [TagSpecification]
$sel:noReboot:CreateImage' :: CreateImage -> Maybe Bool
$sel:dryRun:CreateImage' :: CreateImage -> Maybe Bool
$sel:description:CreateImage' :: CreateImage -> Maybe Text
$sel:blockDeviceMappings:CreateImage' :: CreateImage -> 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 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
noReboot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateImage where
  rnf :: CreateImage -> ()
rnf CreateImage' {Maybe Bool
Maybe [TagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Text
name :: Text
instanceId :: Text
tagSpecifications :: Maybe [TagSpecification]
noReboot :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:name:CreateImage' :: CreateImage -> Text
$sel:instanceId:CreateImage' :: CreateImage -> Text
$sel:tagSpecifications:CreateImage' :: CreateImage -> Maybe [TagSpecification]
$sel:noReboot:CreateImage' :: CreateImage -> Maybe Bool
$sel:dryRun:CreateImage' :: CreateImage -> Maybe Bool
$sel:description:CreateImage' :: CreateImage -> Maybe Text
$sel:blockDeviceMappings:CreateImage' :: CreateImage -> 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 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
noReboot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

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

instance Data.ToQuery CreateImage where
  toQuery :: CreateImage -> QueryString
toQuery CreateImage' {Maybe Bool
Maybe [TagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Text
name :: Text
instanceId :: Text
tagSpecifications :: Maybe [TagSpecification]
noReboot :: Maybe Bool
dryRun :: Maybe Bool
description :: Maybe Text
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:name:CreateImage' :: CreateImage -> Text
$sel:instanceId:CreateImage' :: CreateImage -> Text
$sel:tagSpecifications:CreateImage' :: CreateImage -> Maybe [TagSpecification]
$sel:noReboot:CreateImage' :: CreateImage -> Maybe Bool
$sel:dryRun:CreateImage' :: CreateImage -> Maybe Bool
$sel:description:CreateImage' :: CreateImage -> Maybe Text
$sel:blockDeviceMappings:CreateImage' :: CreateImage -> Maybe [BlockDeviceMapping]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateImage" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        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
"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
"NoReboot" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
noReboot,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name
      ]

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

-- |
-- Create a value of 'CreateImageResponse' 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', 'createImageResponse_imageId' - The ID of the new AMI.
--
-- 'httpStatus', 'createImageResponse_httpStatus' - The response's http status code.
newCreateImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateImageResponse
newCreateImageResponse :: Int -> CreateImageResponse
newCreateImageResponse Int
pHttpStatus_ =
  CreateImageResponse'
    { $sel:imageId:CreateImageResponse' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateImageResponse where
  rnf :: CreateImageResponse -> ()
rnf CreateImageResponse' {Int
Maybe Text
httpStatus :: Int
imageId :: Maybe Text
$sel:httpStatus:CreateImageResponse' :: CreateImageResponse -> Int
$sel:imageId:CreateImageResponse' :: CreateImageResponse -> 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