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

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

-- |
-- Module      : Amazonka.AutoScaling.Types.Ebs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AutoScaling.Types.Ebs where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Describes information used to set up an Amazon EBS volume specified in a
-- block device mapping.
--
-- /See:/ 'newEbs' smart constructor.
data Ebs = Ebs'
  { -- | Indicates whether the volume is deleted on instance termination. For
    -- Amazon EC2 Auto Scaling, the default value is @true@.
    Ebs -> Maybe Bool
deleteOnTermination :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether the volume should be encrypted. Encrypted EBS volumes
    -- can only 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>.
    -- If your AMI uses encrypted volumes, you can also only launch it on
    -- supported instance types.
    --
    -- If you are creating a volume from a snapshot, you cannot create an
    -- unencrypted volume from an encrypted snapshot. Also, you cannot specify
    -- a KMS key ID when using a launch configuration.
    --
    -- If you enable encryption by default, the EBS volumes that you create are
    -- always encrypted, either using the Amazon Web Services managed KMS key
    -- or a customer-managed KMS key, regardless of whether the snapshot was
    -- encrypted.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-data-protection.html#encryption Use Amazon Web Services KMS keys to encrypt Amazon EBS volumes>
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    Ebs -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The number of input\/output (I\/O) operations per second (IOPS) to
    -- provision for the volume. For @gp3@ and @io1@ 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
    --
    -- For @io1@ volumes, we guarantee 64,000 IOPS only for
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
    -- Other instance families guarantee performance up to 32,000 IOPS.
    --
    -- @Iops@ is supported when the volume type is @gp3@ or @io1@ and required
    -- only when the volume type is @io1@. (Not used with @standard@, @gp2@,
    -- @st1@, or @sc1@ volumes.)
    Ebs -> Maybe Natural
iops :: Prelude.Maybe Prelude.Natural,
    -- | The snapshot ID of the volume to use.
    --
    -- You must specify either a @VolumeSize@ or a @SnapshotId@.
    Ebs -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The throughput (MiBps) to provision for a @gp3@ volume.
    Ebs -> Maybe Natural
throughput :: Prelude.Maybe Prelude.Natural,
    -- | The volume size, in GiBs. The following are the supported volumes sizes
    -- for each volume type:
    --
    -- -   @gp2@ and @gp3@: 1-16,384
    --
    -- -   @io1@: 4-16,384
    --
    -- -   @st1@ and @sc1@: 125-16,384
    --
    -- -   @standard@: 1-1,024
    --
    -- You must specify either a @SnapshotId@ or a @VolumeSize@. If you specify
    -- both @SnapshotId@ and @VolumeSize@, the volume size must be equal or
    -- greater than the size of the snapshot.
    Ebs -> Maybe Natural
volumeSize :: Prelude.Maybe Prelude.Natural,
    -- | The volume type. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
    -- in the /Amazon EC2 User Guide for Linux Instances/.
    --
    -- Valid values: @standard@ | @io1@ | @gp2@ | @st1@ | @sc1@ | @gp3@
    Ebs -> Maybe Text
volumeType :: Prelude.Maybe Prelude.Text
  }
  deriving (Ebs -> Ebs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ebs -> Ebs -> Bool
$c/= :: Ebs -> Ebs -> Bool
== :: Ebs -> Ebs -> Bool
$c== :: Ebs -> Ebs -> Bool
Prelude.Eq, ReadPrec [Ebs]
ReadPrec Ebs
Int -> ReadS Ebs
ReadS [Ebs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ebs]
$creadListPrec :: ReadPrec [Ebs]
readPrec :: ReadPrec Ebs
$creadPrec :: ReadPrec Ebs
readList :: ReadS [Ebs]
$creadList :: ReadS [Ebs]
readsPrec :: Int -> ReadS Ebs
$creadsPrec :: Int -> ReadS Ebs
Prelude.Read, Int -> Ebs -> ShowS
[Ebs] -> ShowS
Ebs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ebs] -> ShowS
$cshowList :: [Ebs] -> ShowS
show :: Ebs -> String
$cshow :: Ebs -> String
showsPrec :: Int -> Ebs -> ShowS
$cshowsPrec :: Int -> Ebs -> ShowS
Prelude.Show, forall x. Rep Ebs x -> Ebs
forall x. Ebs -> Rep Ebs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ebs x -> Ebs
$cfrom :: forall x. Ebs -> Rep Ebs x
Prelude.Generic)

-- |
-- Create a value of 'Ebs' 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:
--
-- 'deleteOnTermination', 'ebs_deleteOnTermination' - Indicates whether the volume is deleted on instance termination. For
-- Amazon EC2 Auto Scaling, the default value is @true@.
--
-- 'encrypted', 'ebs_encrypted' - Specifies whether the volume should be encrypted. Encrypted EBS volumes
-- can only 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>.
-- If your AMI uses encrypted volumes, you can also only launch it on
-- supported instance types.
--
-- If you are creating a volume from a snapshot, you cannot create an
-- unencrypted volume from an encrypted snapshot. Also, you cannot specify
-- a KMS key ID when using a launch configuration.
--
-- If you enable encryption by default, the EBS volumes that you create are
-- always encrypted, either using the Amazon Web Services managed KMS key
-- or a customer-managed KMS key, regardless of whether the snapshot was
-- encrypted.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-data-protection.html#encryption Use Amazon Web Services KMS keys to encrypt Amazon EBS volumes>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- 'iops', 'ebs_iops' - The number of input\/output (I\/O) operations per second (IOPS) to
-- provision for the volume. For @gp3@ and @io1@ 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
--
-- For @io1@ volumes, we guarantee 64,000 IOPS only for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
-- Other instance families guarantee performance up to 32,000 IOPS.
--
-- @Iops@ is supported when the volume type is @gp3@ or @io1@ and required
-- only when the volume type is @io1@. (Not used with @standard@, @gp2@,
-- @st1@, or @sc1@ volumes.)
--
-- 'snapshotId', 'ebs_snapshotId' - The snapshot ID of the volume to use.
--
-- You must specify either a @VolumeSize@ or a @SnapshotId@.
--
-- 'throughput', 'ebs_throughput' - The throughput (MiBps) to provision for a @gp3@ volume.
--
-- 'volumeSize', 'ebs_volumeSize' - The volume size, in GiBs. The following are the supported volumes sizes
-- for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
--
-- You must specify either a @SnapshotId@ or a @VolumeSize@. If you specify
-- both @SnapshotId@ and @VolumeSize@, the volume size must be equal or
-- greater than the size of the snapshot.
--
-- 'volumeType', 'ebs_volumeType' - The volume type. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- Valid values: @standard@ | @io1@ | @gp2@ | @st1@ | @sc1@ | @gp3@
newEbs ::
  Ebs
newEbs :: Ebs
newEbs =
  Ebs'
    { $sel:deleteOnTermination:Ebs' :: Maybe Bool
deleteOnTermination = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:Ebs' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:iops:Ebs' :: Maybe Natural
iops = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:Ebs' :: Maybe Text
snapshotId = forall a. Maybe a
Prelude.Nothing,
      $sel:throughput:Ebs' :: Maybe Natural
throughput = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeSize:Ebs' :: Maybe Natural
volumeSize = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeType:Ebs' :: Maybe Text
volumeType = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether the volume is deleted on instance termination. For
-- Amazon EC2 Auto Scaling, the default value is @true@.
ebs_deleteOnTermination :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Bool)
ebs_deleteOnTermination :: Lens' Ebs (Maybe Bool)
ebs_deleteOnTermination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Bool
deleteOnTermination :: Maybe Bool
$sel:deleteOnTermination:Ebs' :: Ebs -> Maybe Bool
deleteOnTermination} -> Maybe Bool
deleteOnTermination) (\s :: Ebs
s@Ebs' {} Maybe Bool
a -> Ebs
s {$sel:deleteOnTermination:Ebs' :: Maybe Bool
deleteOnTermination = Maybe Bool
a} :: Ebs)

-- | Specifies whether the volume should be encrypted. Encrypted EBS volumes
-- can only 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>.
-- If your AMI uses encrypted volumes, you can also only launch it on
-- supported instance types.
--
-- If you are creating a volume from a snapshot, you cannot create an
-- unencrypted volume from an encrypted snapshot. Also, you cannot specify
-- a KMS key ID when using a launch configuration.
--
-- If you enable encryption by default, the EBS volumes that you create are
-- always encrypted, either using the Amazon Web Services managed KMS key
-- or a customer-managed KMS key, regardless of whether the snapshot was
-- encrypted.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-data-protection.html#encryption Use Amazon Web Services KMS keys to encrypt Amazon EBS volumes>
-- in the /Amazon EC2 Auto Scaling User Guide/.
ebs_encrypted :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Bool)
ebs_encrypted :: Lens' Ebs (Maybe Bool)
ebs_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:Ebs' :: Ebs -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: Ebs
s@Ebs' {} Maybe Bool
a -> Ebs
s {$sel:encrypted:Ebs' :: Maybe Bool
encrypted = Maybe Bool
a} :: Ebs)

-- | The number of input\/output (I\/O) operations per second (IOPS) to
-- provision for the volume. For @gp3@ and @io1@ 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
--
-- For @io1@ volumes, we guarantee 64,000 IOPS only for
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Instances built on the Nitro System>.
-- Other instance families guarantee performance up to 32,000 IOPS.
--
-- @Iops@ is supported when the volume type is @gp3@ or @io1@ and required
-- only when the volume type is @io1@. (Not used with @standard@, @gp2@,
-- @st1@, or @sc1@ volumes.)
ebs_iops :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Natural)
ebs_iops :: Lens' Ebs (Maybe Natural)
ebs_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Natural
iops :: Maybe Natural
$sel:iops:Ebs' :: Ebs -> Maybe Natural
iops} -> Maybe Natural
iops) (\s :: Ebs
s@Ebs' {} Maybe Natural
a -> Ebs
s {$sel:iops:Ebs' :: Maybe Natural
iops = Maybe Natural
a} :: Ebs)

-- | The snapshot ID of the volume to use.
--
-- You must specify either a @VolumeSize@ or a @SnapshotId@.
ebs_snapshotId :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Text)
ebs_snapshotId :: Lens' Ebs (Maybe Text)
ebs_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:Ebs' :: Ebs -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: Ebs
s@Ebs' {} Maybe Text
a -> Ebs
s {$sel:snapshotId:Ebs' :: Maybe Text
snapshotId = Maybe Text
a} :: Ebs)

-- | The throughput (MiBps) to provision for a @gp3@ volume.
ebs_throughput :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Natural)
ebs_throughput :: Lens' Ebs (Maybe Natural)
ebs_throughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Natural
throughput :: Maybe Natural
$sel:throughput:Ebs' :: Ebs -> Maybe Natural
throughput} -> Maybe Natural
throughput) (\s :: Ebs
s@Ebs' {} Maybe Natural
a -> Ebs
s {$sel:throughput:Ebs' :: Maybe Natural
throughput = Maybe Natural
a} :: Ebs)

-- | The volume size, in GiBs. The following are the supported volumes sizes
-- for each volume type:
--
-- -   @gp2@ and @gp3@: 1-16,384
--
-- -   @io1@: 4-16,384
--
-- -   @st1@ and @sc1@: 125-16,384
--
-- -   @standard@: 1-1,024
--
-- You must specify either a @SnapshotId@ or a @VolumeSize@. If you specify
-- both @SnapshotId@ and @VolumeSize@, the volume size must be equal or
-- greater than the size of the snapshot.
ebs_volumeSize :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Natural)
ebs_volumeSize :: Lens' Ebs (Maybe Natural)
ebs_volumeSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Natural
volumeSize :: Maybe Natural
$sel:volumeSize:Ebs' :: Ebs -> Maybe Natural
volumeSize} -> Maybe Natural
volumeSize) (\s :: Ebs
s@Ebs' {} Maybe Natural
a -> Ebs
s {$sel:volumeSize:Ebs' :: Maybe Natural
volumeSize = Maybe Natural
a} :: Ebs)

-- | The volume type. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumeTypes.html Amazon EBS volume types>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- Valid values: @standard@ | @io1@ | @gp2@ | @st1@ | @sc1@ | @gp3@
ebs_volumeType :: Lens.Lens' Ebs (Prelude.Maybe Prelude.Text)
ebs_volumeType :: Lens' Ebs (Maybe Text)
ebs_volumeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ebs' {Maybe Text
volumeType :: Maybe Text
$sel:volumeType:Ebs' :: Ebs -> Maybe Text
volumeType} -> Maybe Text
volumeType) (\s :: Ebs
s@Ebs' {} Maybe Text
a -> Ebs
s {$sel:volumeType:Ebs' :: Maybe Text
volumeType = Maybe Text
a} :: Ebs)

instance Data.FromXML Ebs where
  parseXML :: [Node] -> Either String Ebs
parseXML [Node]
x =
    Maybe Bool
-> Maybe Bool
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Ebs
Ebs'
      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
"DeleteOnTermination")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Encrypted")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Iops")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SnapshotId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Throughput")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VolumeSize")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VolumeType")

instance Prelude.Hashable Ebs where
  hashWithSalt :: Int -> Ebs -> Int
hashWithSalt Int
_salt Ebs' {Maybe Bool
Maybe Natural
Maybe Text
volumeType :: Maybe Text
volumeSize :: Maybe Natural
throughput :: Maybe Natural
snapshotId :: Maybe Text
iops :: Maybe Natural
encrypted :: Maybe Bool
deleteOnTermination :: Maybe Bool
$sel:volumeType:Ebs' :: Ebs -> Maybe Text
$sel:volumeSize:Ebs' :: Ebs -> Maybe Natural
$sel:throughput:Ebs' :: Ebs -> Maybe Natural
$sel:snapshotId:Ebs' :: Ebs -> Maybe Text
$sel:iops:Ebs' :: Ebs -> Maybe Natural
$sel:encrypted:Ebs' :: Ebs -> Maybe Bool
$sel:deleteOnTermination:Ebs' :: Ebs -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deleteOnTermination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
iops
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
throughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
volumeSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
volumeType

instance Prelude.NFData Ebs where
  rnf :: Ebs -> ()
rnf Ebs' {Maybe Bool
Maybe Natural
Maybe Text
volumeType :: Maybe Text
volumeSize :: Maybe Natural
throughput :: Maybe Natural
snapshotId :: Maybe Text
iops :: Maybe Natural
encrypted :: Maybe Bool
deleteOnTermination :: Maybe Bool
$sel:volumeType:Ebs' :: Ebs -> Maybe Text
$sel:volumeSize:Ebs' :: Ebs -> Maybe Natural
$sel:throughput:Ebs' :: Ebs -> Maybe Natural
$sel:snapshotId:Ebs' :: Ebs -> Maybe Text
$sel:iops:Ebs' :: Ebs -> Maybe Natural
$sel:encrypted:Ebs' :: Ebs -> Maybe Bool
$sel:deleteOnTermination:Ebs' :: Ebs -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteOnTermination
      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 Natural
iops
      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 Natural
throughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
volumeSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
volumeType

instance Data.ToQuery Ebs where
  toQuery :: Ebs -> QueryString
toQuery Ebs' {Maybe Bool
Maybe Natural
Maybe Text
volumeType :: Maybe Text
volumeSize :: Maybe Natural
throughput :: Maybe Natural
snapshotId :: Maybe Text
iops :: Maybe Natural
encrypted :: Maybe Bool
deleteOnTermination :: Maybe Bool
$sel:volumeType:Ebs' :: Ebs -> Maybe Text
$sel:volumeSize:Ebs' :: Ebs -> Maybe Natural
$sel:throughput:Ebs' :: Ebs -> Maybe Natural
$sel:snapshotId:Ebs' :: Ebs -> Maybe Text
$sel:iops:Ebs' :: Ebs -> Maybe Natural
$sel:encrypted:Ebs' :: Ebs -> Maybe Bool
$sel:deleteOnTermination:Ebs' :: Ebs -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"DeleteOnTermination" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deleteOnTermination,
        ByteString
"Encrypted" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
encrypted,
        ByteString
"Iops" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
iops,
        ByteString
"SnapshotId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotId,
        ByteString
"Throughput" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
throughput,
        ByteString
"VolumeSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
volumeSize,
        ByteString
"VolumeType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
volumeType
      ]