{-# 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.CreateVolume
-- 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 EBS volume that can be attached to an instance in the same
-- Availability Zone.
--
-- You can create a new empty volume or restore a volume from an EBS
-- snapshot. Any Amazon Web Services Marketplace product codes from the
-- snapshot are propagated to the volume.
--
-- You can create encrypted volumes. Encrypted volumes must be attached to
-- instances that support Amazon EBS encryption. Volumes that are created
-- from encrypted snapshots are also automatically encrypted. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html Amazon EBS encryption>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- You can tag your volumes during creation. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html Tag your Amazon EC2 resources>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-creating-volume.html Create an Amazon EBS volume>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateVolume
  ( -- * Creating a Request
    CreateVolume (..),
    newCreateVolume,

    -- * Request Lenses
    createVolume_clientToken,
    createVolume_dryRun,
    createVolume_encrypted,
    createVolume_iops,
    createVolume_kmsKeyId,
    createVolume_multiAttachEnabled,
    createVolume_outpostArn,
    createVolume_size,
    createVolume_snapshotId,
    createVolume_tagSpecifications,
    createVolume_throughput,
    createVolume_volumeType,
    createVolume_availabilityZone,

    -- * Destructuring the Response
    Volume (..),
    newVolume,

    -- * Response Lenses
    volume_attachments,
    volume_fastRestored,
    volume_iops,
    volume_kmsKeyId,
    volume_multiAttachEnabled,
    volume_outpostArn,
    volume_tags,
    volume_throughput,
    volume_availabilityZone,
    volume_createTime,
    volume_encrypted,
    volume_size,
    volume_snapshotId,
    volume_state,
    volume_volumeId,
    volume_volumeType,
  )
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:/ 'newCreateVolume' smart constructor.
data CreateVolume = CreateVolume'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensure Idempotency>.
    CreateVolume -> Maybe Text
clientToken :: 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@.
    CreateVolume -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether the volume should be encrypted. The effect of setting
    -- the encryption state to @true@ depends on the volume origin (new or from
    -- a snapshot), starting encryption state, ownership, and whether
    -- encryption by default is enabled. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default Encryption by default>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- Encrypted Amazon EBS volumes must be attached to instances that support
    -- Amazon EBS encryption. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#EBSEncryption_supported_instances Supported instance types>.
    CreateVolume -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The number of I\/O operations per second (IOPS). For @gp3@, @io1@, and
    -- @io2@ volumes, this represents the number of IOPS that are provisioned
    -- for the volume. For @gp2@ volumes, this represents the baseline
    -- performance of the volume and the rate at which the volume accumulates
    -- I\/O credits for bursting.
    --
    -- The following are the supported values for each volume type:
    --
    -- -   @gp3@: 3,000-16,000 IOPS
    --
    -- -   @io1@: 100-64,000 IOPS
    --
    -- -   @io2@: 100-64,000 IOPS
    --
    -- @io1@ and @io2@ volumes support up to 64,000 IOPS only on
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
    -- Other instance families support performance up to 32,000 IOPS.
    --
    -- This parameter is required for @io1@ and @io2@ volumes. The default for
    -- @gp3@ volumes is 3,000 IOPS. This parameter is not supported for @gp2@,
    -- @st1@, @sc1@, or @standard@ volumes.
    CreateVolume -> Maybe Int
iops :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the Key Management Service (KMS) KMS key to use for
    -- Amazon EBS encryption. If this parameter is not specified, your KMS key
    -- for Amazon EBS is used. If @KmsKeyId@ is specified, the encrypted state
    -- must be @true@.
    --
    -- You can specify the KMS key using any of the following:
    --
    -- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
    --
    -- -   Key alias. For example, alias\/ExampleAlias.
    --
    -- -   Key ARN. For example,
    --     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
    --
    -- -   Alias ARN. For example,
    --     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
    --
    -- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
    -- if you specify an ID, alias, or ARN that is not valid, the action can
    -- appear to complete, but eventually fails.
    CreateVolume -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to enable Amazon EBS Multi-Attach. If you enable
    -- Multi-Attach, you can attach the volume to up to 16
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>
    -- in the same Availability Zone. This parameter is supported with @io1@
    -- and @io2@ volumes only. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    CreateVolume -> Maybe Bool
multiAttachEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Outpost.
    CreateVolume -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The size of the volume, in GiBs. You must specify either a snapshot ID
    -- or a volume size. If you specify a snapshot, the default is the snapshot
    -- size. You can specify a volume size that is equal to or larger than the
    -- snapshot size.
    --
    -- The following are the supported volumes sizes for each volume type:
    --
    -- -   @gp2@ and @gp3@: 1-16,384
    --
    -- -   @io1@ and @io2@: 4-16,384
    --
    -- -   @st1@ and @sc1@: 125-16,384
    --
    -- -   @standard@: 1-1,024
    CreateVolume -> Maybe Int
size :: Prelude.Maybe Prelude.Int,
    -- | The snapshot from which to create the volume. You must specify either a
    -- snapshot ID or a volume size.
    CreateVolume -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the volume during creation.
    CreateVolume -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The throughput to provision for a volume, with a maximum of 1,000
    -- MiB\/s.
    --
    -- This parameter is valid only for @gp3@ volumes.
    --
    -- Valid Range: Minimum value of 125. Maximum value of 1000.
    CreateVolume -> Maybe Int
throughput :: Prelude.Maybe Prelude.Int,
    -- | The volume type. This parameter can be one of the following values:
    --
    -- -   General Purpose SSD: @gp2@ | @gp3@
    --
    -- -   Provisioned IOPS SSD: @io1@ | @io2@
    --
    -- -   Throughput Optimized HDD: @st1@
    --
    -- -   Cold HDD: @sc1@
    --
    -- -   Magnetic: @standard@
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- Default: @gp2@
    CreateVolume -> Maybe VolumeType
volumeType :: Prelude.Maybe VolumeType,
    -- | The Availability Zone in which to create the volume.
    CreateVolume -> Text
availabilityZone :: Prelude.Text
  }
  deriving (CreateVolume -> CreateVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVolume -> CreateVolume -> Bool
$c/= :: CreateVolume -> CreateVolume -> Bool
== :: CreateVolume -> CreateVolume -> Bool
$c== :: CreateVolume -> CreateVolume -> Bool
Prelude.Eq, ReadPrec [CreateVolume]
ReadPrec CreateVolume
Int -> ReadS CreateVolume
ReadS [CreateVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVolume]
$creadListPrec :: ReadPrec [CreateVolume]
readPrec :: ReadPrec CreateVolume
$creadPrec :: ReadPrec CreateVolume
readList :: ReadS [CreateVolume]
$creadList :: ReadS [CreateVolume]
readsPrec :: Int -> ReadS CreateVolume
$creadsPrec :: Int -> ReadS CreateVolume
Prelude.Read, Int -> CreateVolume -> ShowS
[CreateVolume] -> ShowS
CreateVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVolume] -> ShowS
$cshowList :: [CreateVolume] -> ShowS
show :: CreateVolume -> String
$cshow :: CreateVolume -> String
showsPrec :: Int -> CreateVolume -> ShowS
$cshowsPrec :: Int -> CreateVolume -> ShowS
Prelude.Show, forall x. Rep CreateVolume x -> CreateVolume
forall x. CreateVolume -> Rep CreateVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVolume x -> CreateVolume
$cfrom :: forall x. CreateVolume -> Rep CreateVolume x
Prelude.Generic)

-- |
-- Create a value of 'CreateVolume' 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:
--
-- 'clientToken', 'createVolume_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensure Idempotency>.
--
-- 'dryRun', 'createVolume_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@.
--
-- 'encrypted', 'createVolume_encrypted' - Indicates whether the volume should be encrypted. The effect of setting
-- the encryption state to @true@ depends on the volume origin (new or from
-- a snapshot), starting encryption state, ownership, and whether
-- encryption by default is enabled. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default Encryption by default>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Encrypted Amazon EBS volumes must be attached to instances that support
-- Amazon EBS encryption. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#EBSEncryption_supported_instances Supported instance types>.
--
-- 'iops', 'createVolume_iops' - The number of I\/O operations per second (IOPS). For @gp3@, @io1@, and
-- @io2@ volumes, this represents the number of IOPS that are provisioned
-- for the volume. For @gp2@ volumes, this represents the baseline
-- performance of the volume and the rate at which the volume accumulates
-- I\/O credits for bursting.
--
-- The following are the supported values for each volume type:
--
-- -   @gp3@: 3,000-16,000 IOPS
--
-- -   @io1@: 100-64,000 IOPS
--
-- -   @io2@: 100-64,000 IOPS
--
-- @io1@ and @io2@ volumes support up to 64,000 IOPS only on
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
-- Other instance families support performance up to 32,000 IOPS.
--
-- This parameter is required for @io1@ and @io2@ volumes. The default for
-- @gp3@ volumes is 3,000 IOPS. This parameter is not supported for @gp2@,
-- @st1@, @sc1@, or @standard@ volumes.
--
-- 'kmsKeyId', 'createVolume_kmsKeyId' - The identifier of the Key Management Service (KMS) KMS key to use for
-- Amazon EBS encryption. If this parameter is not specified, your KMS key
-- for Amazon EBS is used. If @KmsKeyId@ is specified, the encrypted state
-- must be @true@.
--
-- You can specify the KMS key using any of the following:
--
-- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Key alias. For example, alias\/ExampleAlias.
--
-- -   Key ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Alias ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
--
-- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
-- if you specify an ID, alias, or ARN that is not valid, the action can
-- appear to complete, but eventually fails.
--
-- 'multiAttachEnabled', 'createVolume_multiAttachEnabled' - Indicates whether to enable Amazon EBS Multi-Attach. If you enable
-- Multi-Attach, you can attach the volume to up to 16
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>
-- in the same Availability Zone. This parameter is supported with @io1@
-- and @io2@ volumes only. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- 'outpostArn', 'createVolume_outpostArn' - The Amazon Resource Name (ARN) of the Outpost.
--
-- 'size', 'createVolume_size' - The size of the volume, in GiBs. You must specify either a snapshot ID
-- or a volume size. If you specify a snapshot, the default is the snapshot
-- size. You can specify a volume size that is equal to or larger than the
-- snapshot size.
--
-- The following are the supported volumes sizes for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@ and @io2@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
--
-- 'snapshotId', 'createVolume_snapshotId' - The snapshot from which to create the volume. You must specify either a
-- snapshot ID or a volume size.
--
-- 'tagSpecifications', 'createVolume_tagSpecifications' - The tags to apply to the volume during creation.
--
-- 'throughput', 'createVolume_throughput' - The throughput to provision for a volume, with a maximum of 1,000
-- MiB\/s.
--
-- This parameter is valid only for @gp3@ volumes.
--
-- Valid Range: Minimum value of 125. Maximum value of 1000.
--
-- 'volumeType', 'createVolume_volumeType' - The volume type. This parameter can be one of the following values:
--
-- -   General Purpose SSD: @gp2@ | @gp3@
--
-- -   Provisioned IOPS SSD: @io1@ | @io2@
--
-- -   Throughput Optimized HDD: @st1@
--
-- -   Cold HDD: @sc1@
--
-- -   Magnetic: @standard@
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Default: @gp2@
--
-- 'availabilityZone', 'createVolume_availabilityZone' - The Availability Zone in which to create the volume.
newCreateVolume ::
  -- | 'availabilityZone'
  Prelude.Text ->
  CreateVolume
newCreateVolume :: Text -> CreateVolume
newCreateVolume Text
pAvailabilityZone_ =
  CreateVolume'
    { $sel:clientToken:CreateVolume' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateVolume' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:CreateVolume' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:iops:CreateVolume' :: Maybe Int
iops = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CreateVolume' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:multiAttachEnabled:CreateVolume' :: Maybe Bool
multiAttachEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:CreateVolume' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:size:CreateVolume' :: Maybe Int
size = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:CreateVolume' :: Maybe Text
snapshotId = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateVolume' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:throughput:CreateVolume' :: Maybe Int
throughput = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeType:CreateVolume' :: Maybe VolumeType
volumeType = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:CreateVolume' :: Text
availabilityZone = Text
pAvailabilityZone_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensure Idempotency>.
createVolume_clientToken :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Text)
createVolume_clientToken :: Lens' CreateVolume (Maybe Text)
createVolume_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateVolume' :: CreateVolume -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateVolume
s@CreateVolume' {} Maybe Text
a -> CreateVolume
s {$sel:clientToken:CreateVolume' :: Maybe Text
clientToken = Maybe Text
a} :: CreateVolume)

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

-- | Indicates whether the volume should be encrypted. The effect of setting
-- the encryption state to @true@ depends on the volume origin (new or from
-- a snapshot), starting encryption state, ownership, and whether
-- encryption by default is enabled. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#encryption-by-default Encryption by default>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Encrypted Amazon EBS volumes must be attached to instances that support
-- Amazon EBS encryption. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSEncryption.html#EBSEncryption_supported_instances Supported instance types>.
createVolume_encrypted :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Bool)
createVolume_encrypted :: Lens' CreateVolume (Maybe Bool)
createVolume_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:CreateVolume' :: CreateVolume -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: CreateVolume
s@CreateVolume' {} Maybe Bool
a -> CreateVolume
s {$sel:encrypted:CreateVolume' :: Maybe Bool
encrypted = Maybe Bool
a} :: CreateVolume)

-- | The number of I\/O operations per second (IOPS). For @gp3@, @io1@, and
-- @io2@ volumes, this represents the number of IOPS that are provisioned
-- for the volume. For @gp2@ volumes, this represents the baseline
-- performance of the volume and the rate at which the volume accumulates
-- I\/O credits for bursting.
--
-- The following are the supported values for each volume type:
--
-- -   @gp3@: 3,000-16,000 IOPS
--
-- -   @io1@: 100-64,000 IOPS
--
-- -   @io2@: 100-64,000 IOPS
--
-- @io1@ and @io2@ volumes support up to 64,000 IOPS only on
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
-- Other instance families support performance up to 32,000 IOPS.
--
-- This parameter is required for @io1@ and @io2@ volumes. The default for
-- @gp3@ volumes is 3,000 IOPS. This parameter is not supported for @gp2@,
-- @st1@, @sc1@, or @standard@ volumes.
createVolume_iops :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Int)
createVolume_iops :: Lens' CreateVolume (Maybe Int)
createVolume_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Int
iops :: Maybe Int
$sel:iops:CreateVolume' :: CreateVolume -> Maybe Int
iops} -> Maybe Int
iops) (\s :: CreateVolume
s@CreateVolume' {} Maybe Int
a -> CreateVolume
s {$sel:iops:CreateVolume' :: Maybe Int
iops = Maybe Int
a} :: CreateVolume)

-- | The identifier of the Key Management Service (KMS) KMS key to use for
-- Amazon EBS encryption. If this parameter is not specified, your KMS key
-- for Amazon EBS is used. If @KmsKeyId@ is specified, the encrypted state
-- must be @true@.
--
-- You can specify the KMS key using any of the following:
--
-- -   Key ID. For example, 1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Key alias. For example, alias\/ExampleAlias.
--
-- -   Key ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:key\/1234abcd-12ab-34cd-56ef-1234567890ab.
--
-- -   Alias ARN. For example,
--     arn:aws:kms:us-east-1:012345678910:alias\/ExampleAlias.
--
-- Amazon Web Services authenticates the KMS key asynchronously. Therefore,
-- if you specify an ID, alias, or ARN that is not valid, the action can
-- appear to complete, but eventually fails.
createVolume_kmsKeyId :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Text)
createVolume_kmsKeyId :: Lens' CreateVolume (Maybe Text)
createVolume_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateVolume' :: CreateVolume -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateVolume
s@CreateVolume' {} Maybe Text
a -> CreateVolume
s {$sel:kmsKeyId:CreateVolume' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateVolume)

-- | Indicates whether to enable Amazon EBS Multi-Attach. If you enable
-- Multi-Attach, you can attach the volume to up to 16
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>
-- in the same Availability Zone. This parameter is supported with @io1@
-- and @io2@ volumes only. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ebs-volumes-multi.html Amazon EBS Multi-Attach>
-- in the /Amazon Elastic Compute Cloud User Guide/.
createVolume_multiAttachEnabled :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Bool)
createVolume_multiAttachEnabled :: Lens' CreateVolume (Maybe Bool)
createVolume_multiAttachEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Bool
multiAttachEnabled :: Maybe Bool
$sel:multiAttachEnabled:CreateVolume' :: CreateVolume -> Maybe Bool
multiAttachEnabled} -> Maybe Bool
multiAttachEnabled) (\s :: CreateVolume
s@CreateVolume' {} Maybe Bool
a -> CreateVolume
s {$sel:multiAttachEnabled:CreateVolume' :: Maybe Bool
multiAttachEnabled = Maybe Bool
a} :: CreateVolume)

-- | The Amazon Resource Name (ARN) of the Outpost.
createVolume_outpostArn :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Text)
createVolume_outpostArn :: Lens' CreateVolume (Maybe Text)
createVolume_outpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Text
outpostArn :: Maybe Text
$sel:outpostArn:CreateVolume' :: CreateVolume -> Maybe Text
outpostArn} -> Maybe Text
outpostArn) (\s :: CreateVolume
s@CreateVolume' {} Maybe Text
a -> CreateVolume
s {$sel:outpostArn:CreateVolume' :: Maybe Text
outpostArn = Maybe Text
a} :: CreateVolume)

-- | The size of the volume, in GiBs. You must specify either a snapshot ID
-- or a volume size. If you specify a snapshot, the default is the snapshot
-- size. You can specify a volume size that is equal to or larger than the
-- snapshot size.
--
-- The following are the supported volumes sizes for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@ and @io2@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
createVolume_size :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Int)
createVolume_size :: Lens' CreateVolume (Maybe Int)
createVolume_size = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Int
size :: Maybe Int
$sel:size:CreateVolume' :: CreateVolume -> Maybe Int
size} -> Maybe Int
size) (\s :: CreateVolume
s@CreateVolume' {} Maybe Int
a -> CreateVolume
s {$sel:size:CreateVolume' :: Maybe Int
size = Maybe Int
a} :: CreateVolume)

-- | The snapshot from which to create the volume. You must specify either a
-- snapshot ID or a volume size.
createVolume_snapshotId :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Text)
createVolume_snapshotId :: Lens' CreateVolume (Maybe Text)
createVolume_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:CreateVolume' :: CreateVolume -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: CreateVolume
s@CreateVolume' {} Maybe Text
a -> CreateVolume
s {$sel:snapshotId:CreateVolume' :: Maybe Text
snapshotId = Maybe Text
a} :: CreateVolume)

-- | The tags to apply to the volume during creation.
createVolume_tagSpecifications :: Lens.Lens' CreateVolume (Prelude.Maybe [TagSpecification])
createVolume_tagSpecifications :: Lens' CreateVolume (Maybe [TagSpecification])
createVolume_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVolume' :: CreateVolume -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVolume
s@CreateVolume' {} Maybe [TagSpecification]
a -> CreateVolume
s {$sel:tagSpecifications:CreateVolume' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVolume) 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 throughput to provision for a volume, with a maximum of 1,000
-- MiB\/s.
--
-- This parameter is valid only for @gp3@ volumes.
--
-- Valid Range: Minimum value of 125. Maximum value of 1000.
createVolume_throughput :: Lens.Lens' CreateVolume (Prelude.Maybe Prelude.Int)
createVolume_throughput :: Lens' CreateVolume (Maybe Int)
createVolume_throughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe Int
throughput :: Maybe Int
$sel:throughput:CreateVolume' :: CreateVolume -> Maybe Int
throughput} -> Maybe Int
throughput) (\s :: CreateVolume
s@CreateVolume' {} Maybe Int
a -> CreateVolume
s {$sel:throughput:CreateVolume' :: Maybe Int
throughput = Maybe Int
a} :: CreateVolume)

-- | The volume type. This parameter can be one of the following values:
--
-- -   General Purpose SSD: @gp2@ | @gp3@
--
-- -   Provisioned IOPS SSD: @io1@ | @io2@
--
-- -   Throughput Optimized HDD: @st1@
--
-- -   Cold HDD: @sc1@
--
-- -   Magnetic: @standard@
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- Default: @gp2@
createVolume_volumeType :: Lens.Lens' CreateVolume (Prelude.Maybe VolumeType)
createVolume_volumeType :: Lens' CreateVolume (Maybe VolumeType)
createVolume_volumeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Maybe VolumeType
volumeType :: Maybe VolumeType
$sel:volumeType:CreateVolume' :: CreateVolume -> Maybe VolumeType
volumeType} -> Maybe VolumeType
volumeType) (\s :: CreateVolume
s@CreateVolume' {} Maybe VolumeType
a -> CreateVolume
s {$sel:volumeType:CreateVolume' :: Maybe VolumeType
volumeType = Maybe VolumeType
a} :: CreateVolume)

-- | The Availability Zone in which to create the volume.
createVolume_availabilityZone :: Lens.Lens' CreateVolume Prelude.Text
createVolume_availabilityZone :: Lens' CreateVolume Text
createVolume_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVolume' {Text
availabilityZone :: Text
$sel:availabilityZone:CreateVolume' :: CreateVolume -> Text
availabilityZone} -> Text
availabilityZone) (\s :: CreateVolume
s@CreateVolume' {} Text
a -> CreateVolume
s {$sel:availabilityZone:CreateVolume' :: Text
availabilityZone = Text
a} :: CreateVolume)

instance Core.AWSRequest CreateVolume where
  type AWSResponse CreateVolume = Volume
  request :: (Service -> Service) -> CreateVolume -> Request CreateVolume
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 CreateVolume
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateVolume)))
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 -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateVolume where
  hashWithSalt :: Int -> CreateVolume -> Int
hashWithSalt Int
_salt CreateVolume' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe VolumeType
Text
availabilityZone :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
tagSpecifications :: Maybe [TagSpecification]
snapshotId :: Maybe Text
size :: Maybe Int
outpostArn :: Maybe Text
multiAttachEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
iops :: Maybe Int
encrypted :: Maybe Bool
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:availabilityZone:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> Maybe VolumeType
$sel:throughput:CreateVolume' :: CreateVolume -> Maybe Int
$sel:tagSpecifications:CreateVolume' :: CreateVolume -> Maybe [TagSpecification]
$sel:snapshotId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:size:CreateVolume' :: CreateVolume -> Maybe Int
$sel:outpostArn:CreateVolume' :: CreateVolume -> Maybe Text
$sel:multiAttachEnabled:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:kmsKeyId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:iops:CreateVolume' :: CreateVolume -> Maybe Int
$sel:encrypted:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:dryRun:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:clientToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
iops
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
multiAttachEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
size
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
throughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VolumeType
volumeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
availabilityZone

instance Prelude.NFData CreateVolume where
  rnf :: CreateVolume -> ()
rnf CreateVolume' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe VolumeType
Text
availabilityZone :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
tagSpecifications :: Maybe [TagSpecification]
snapshotId :: Maybe Text
size :: Maybe Int
outpostArn :: Maybe Text
multiAttachEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
iops :: Maybe Int
encrypted :: Maybe Bool
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:availabilityZone:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> Maybe VolumeType
$sel:throughput:CreateVolume' :: CreateVolume -> Maybe Int
$sel:tagSpecifications:CreateVolume' :: CreateVolume -> Maybe [TagSpecification]
$sel:snapshotId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:size:CreateVolume' :: CreateVolume -> Maybe Int
$sel:outpostArn:CreateVolume' :: CreateVolume -> Maybe Text
$sel:multiAttachEnabled:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:kmsKeyId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:iops:CreateVolume' :: CreateVolume -> Maybe Int
$sel:encrypted:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:dryRun:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:clientToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      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
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
iops
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
multiAttachEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outpostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
size
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotId
      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 Maybe Int
throughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VolumeType
volumeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
availabilityZone

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

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

instance Data.ToQuery CreateVolume where
  toQuery :: CreateVolume -> QueryString
toQuery CreateVolume' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe VolumeType
Text
availabilityZone :: Text
volumeType :: Maybe VolumeType
throughput :: Maybe Int
tagSpecifications :: Maybe [TagSpecification]
snapshotId :: Maybe Text
size :: Maybe Int
outpostArn :: Maybe Text
multiAttachEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
iops :: Maybe Int
encrypted :: Maybe Bool
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:availabilityZone:CreateVolume' :: CreateVolume -> Text
$sel:volumeType:CreateVolume' :: CreateVolume -> Maybe VolumeType
$sel:throughput:CreateVolume' :: CreateVolume -> Maybe Int
$sel:tagSpecifications:CreateVolume' :: CreateVolume -> Maybe [TagSpecification]
$sel:snapshotId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:size:CreateVolume' :: CreateVolume -> Maybe Int
$sel:outpostArn:CreateVolume' :: CreateVolume -> Maybe Text
$sel:multiAttachEnabled:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:kmsKeyId:CreateVolume' :: CreateVolume -> Maybe Text
$sel:iops:CreateVolume' :: CreateVolume -> Maybe Int
$sel:encrypted:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:dryRun:CreateVolume' :: CreateVolume -> Maybe Bool
$sel:clientToken:CreateVolume' :: CreateVolume -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateVolume" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Encrypted" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
encrypted,
        ByteString
"Iops" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
iops,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"MultiAttachEnabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
multiAttachEnabled,
        ByteString
"OutpostArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outpostArn,
        ByteString
"Size" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
size,
        ByteString
"SnapshotId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotId,
        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
"Throughput" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
throughput,
        ByteString
"VolumeType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe VolumeType
volumeType,
        ByteString
"AvailabilityZone" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
availabilityZone
      ]