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

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

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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.Tag
import Amazonka.EC2.Types.VolumeAttachment
import Amazonka.EC2.Types.VolumeState
import Amazonka.EC2.Types.VolumeType
import qualified Amazonka.Prelude as Prelude

-- | Describes a volume.
--
-- /See:/ 'newVolume' smart constructor.
data Volume = Volume'
  { -- | Information about the volume attachments.
    Volume -> Maybe [VolumeAttachment]
attachments :: Prelude.Maybe [VolumeAttachment],
    -- | Indicates whether the volume was created using fast snapshot restore.
    Volume -> Maybe Bool
fastRestored :: 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.
    Volume -> Maybe Int
iops :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) KMS
    -- key that was used to protect the volume encryption key for the volume.
    Volume -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether Amazon EBS Multi-Attach is enabled.
    Volume -> Maybe Bool
multiAttachEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Outpost.
    Volume -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | Any tags assigned to the volume.
    Volume -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The throughput that the volume supports, in MiB\/s.
    Volume -> Maybe Int
throughput :: Prelude.Maybe Prelude.Int,
    -- | The Availability Zone for the volume.
    Volume -> Text
availabilityZone :: Prelude.Text,
    -- | The time stamp when volume creation was initiated.
    Volume -> ISO8601
createTime :: Data.ISO8601,
    -- | Indicates whether the volume is encrypted.
    Volume -> Bool
encrypted :: Prelude.Bool,
    -- | The size of the volume, in GiBs.
    Volume -> Int
size :: Prelude.Int,
    -- | The snapshot from which the volume was created, if applicable.
    Volume -> Text
snapshotId :: Prelude.Text,
    -- | The volume state.
    Volume -> VolumeState
state :: VolumeState,
    -- | The ID of the volume.
    Volume -> Text
volumeId :: Prelude.Text,
    -- | The volume type.
    Volume -> VolumeType
volumeType :: VolumeType
  }
  deriving (Volume -> Volume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Volume -> Volume -> Bool
$c/= :: Volume -> Volume -> Bool
== :: Volume -> Volume -> Bool
$c== :: Volume -> Volume -> Bool
Prelude.Eq, ReadPrec [Volume]
ReadPrec Volume
Int -> ReadS Volume
ReadS [Volume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Volume]
$creadListPrec :: ReadPrec [Volume]
readPrec :: ReadPrec Volume
$creadPrec :: ReadPrec Volume
readList :: ReadS [Volume]
$creadList :: ReadS [Volume]
readsPrec :: Int -> ReadS Volume
$creadsPrec :: Int -> ReadS Volume
Prelude.Read, Int -> Volume -> ShowS
[Volume] -> ShowS
Volume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Volume] -> ShowS
$cshowList :: [Volume] -> ShowS
show :: Volume -> String
$cshow :: Volume -> String
showsPrec :: Int -> Volume -> ShowS
$cshowsPrec :: Int -> Volume -> ShowS
Prelude.Show, forall x. Rep Volume x -> Volume
forall x. Volume -> Rep Volume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Volume x -> Volume
$cfrom :: forall x. Volume -> Rep Volume x
Prelude.Generic)

-- |
-- Create a value of 'Volume' 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:
--
-- 'attachments', 'volume_attachments' - Information about the volume attachments.
--
-- 'fastRestored', 'volume_fastRestored' - Indicates whether the volume was created using fast snapshot restore.
--
-- 'iops', 'volume_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.
--
-- 'kmsKeyId', 'volume_kmsKeyId' - The Amazon Resource Name (ARN) of the Key Management Service (KMS) KMS
-- key that was used to protect the volume encryption key for the volume.
--
-- 'multiAttachEnabled', 'volume_multiAttachEnabled' - Indicates whether Amazon EBS Multi-Attach is enabled.
--
-- 'outpostArn', 'volume_outpostArn' - The Amazon Resource Name (ARN) of the Outpost.
--
-- 'tags', 'volume_tags' - Any tags assigned to the volume.
--
-- 'throughput', 'volume_throughput' - The throughput that the volume supports, in MiB\/s.
--
-- 'availabilityZone', 'volume_availabilityZone' - The Availability Zone for the volume.
--
-- 'createTime', 'volume_createTime' - The time stamp when volume creation was initiated.
--
-- 'encrypted', 'volume_encrypted' - Indicates whether the volume is encrypted.
--
-- 'size', 'volume_size' - The size of the volume, in GiBs.
--
-- 'snapshotId', 'volume_snapshotId' - The snapshot from which the volume was created, if applicable.
--
-- 'state', 'volume_state' - The volume state.
--
-- 'volumeId', 'volume_volumeId' - The ID of the volume.
--
-- 'volumeType', 'volume_volumeType' - The volume type.
newVolume ::
  -- | 'availabilityZone'
  Prelude.Text ->
  -- | 'createTime'
  Prelude.UTCTime ->
  -- | 'encrypted'
  Prelude.Bool ->
  -- | 'size'
  Prelude.Int ->
  -- | 'snapshotId'
  Prelude.Text ->
  -- | 'state'
  VolumeState ->
  -- | 'volumeId'
  Prelude.Text ->
  -- | 'volumeType'
  VolumeType ->
  Volume
newVolume :: Text
-> UTCTime
-> Bool
-> Int
-> Text
-> VolumeState
-> Text
-> VolumeType
-> Volume
newVolume
  Text
pAvailabilityZone_
  UTCTime
pCreateTime_
  Bool
pEncrypted_
  Int
pSize_
  Text
pSnapshotId_
  VolumeState
pState_
  Text
pVolumeId_
  VolumeType
pVolumeType_ =
    Volume'
      { $sel:attachments:Volume' :: Maybe [VolumeAttachment]
attachments = forall a. Maybe a
Prelude.Nothing,
        $sel:fastRestored:Volume' :: Maybe Bool
fastRestored = forall a. Maybe a
Prelude.Nothing,
        $sel:iops:Volume' :: Maybe Int
iops = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:Volume' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:multiAttachEnabled:Volume' :: Maybe Bool
multiAttachEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:outpostArn:Volume' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:Volume' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:throughput:Volume' :: Maybe Int
throughput = forall a. Maybe a
Prelude.Nothing,
        $sel:availabilityZone:Volume' :: Text
availabilityZone = Text
pAvailabilityZone_,
        $sel:createTime:Volume' :: ISO8601
createTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_,
        $sel:encrypted:Volume' :: Bool
encrypted = Bool
pEncrypted_,
        $sel:size:Volume' :: Int
size = Int
pSize_,
        $sel:snapshotId:Volume' :: Text
snapshotId = Text
pSnapshotId_,
        $sel:state:Volume' :: VolumeState
state = VolumeState
pState_,
        $sel:volumeId:Volume' :: Text
volumeId = Text
pVolumeId_,
        $sel:volumeType:Volume' :: VolumeType
volumeType = VolumeType
pVolumeType_
      }

-- | Information about the volume attachments.
volume_attachments :: Lens.Lens' Volume (Prelude.Maybe [VolumeAttachment])
volume_attachments :: Lens' Volume (Maybe [VolumeAttachment])
volume_attachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe [VolumeAttachment]
attachments :: Maybe [VolumeAttachment]
$sel:attachments:Volume' :: Volume -> Maybe [VolumeAttachment]
attachments} -> Maybe [VolumeAttachment]
attachments) (\s :: Volume
s@Volume' {} Maybe [VolumeAttachment]
a -> Volume
s {$sel:attachments:Volume' :: Maybe [VolumeAttachment]
attachments = Maybe [VolumeAttachment]
a} :: Volume) 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

-- | Indicates whether the volume was created using fast snapshot restore.
volume_fastRestored :: Lens.Lens' Volume (Prelude.Maybe Prelude.Bool)
volume_fastRestored :: Lens' Volume (Maybe Bool)
volume_fastRestored = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe Bool
fastRestored :: Maybe Bool
$sel:fastRestored:Volume' :: Volume -> Maybe Bool
fastRestored} -> Maybe Bool
fastRestored) (\s :: Volume
s@Volume' {} Maybe Bool
a -> Volume
s {$sel:fastRestored:Volume' :: Maybe Bool
fastRestored = Maybe Bool
a} :: Volume)

-- | 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.
volume_iops :: Lens.Lens' Volume (Prelude.Maybe Prelude.Int)
volume_iops :: Lens' Volume (Maybe Int)
volume_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe Int
iops :: Maybe Int
$sel:iops:Volume' :: Volume -> Maybe Int
iops} -> Maybe Int
iops) (\s :: Volume
s@Volume' {} Maybe Int
a -> Volume
s {$sel:iops:Volume' :: Maybe Int
iops = Maybe Int
a} :: Volume)

-- | The Amazon Resource Name (ARN) of the Key Management Service (KMS) KMS
-- key that was used to protect the volume encryption key for the volume.
volume_kmsKeyId :: Lens.Lens' Volume (Prelude.Maybe Prelude.Text)
volume_kmsKeyId :: Lens' Volume (Maybe Text)
volume_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:Volume' :: Volume -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: Volume
s@Volume' {} Maybe Text
a -> Volume
s {$sel:kmsKeyId:Volume' :: Maybe Text
kmsKeyId = Maybe Text
a} :: Volume)

-- | Indicates whether Amazon EBS Multi-Attach is enabled.
volume_multiAttachEnabled :: Lens.Lens' Volume (Prelude.Maybe Prelude.Bool)
volume_multiAttachEnabled :: Lens' Volume (Maybe Bool)
volume_multiAttachEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe Bool
multiAttachEnabled :: Maybe Bool
$sel:multiAttachEnabled:Volume' :: Volume -> Maybe Bool
multiAttachEnabled} -> Maybe Bool
multiAttachEnabled) (\s :: Volume
s@Volume' {} Maybe Bool
a -> Volume
s {$sel:multiAttachEnabled:Volume' :: Maybe Bool
multiAttachEnabled = Maybe Bool
a} :: Volume)

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

-- | Any tags assigned to the volume.
volume_tags :: Lens.Lens' Volume (Prelude.Maybe [Tag])
volume_tags :: Lens' Volume (Maybe [Tag])
volume_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Volume' :: Volume -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Volume
s@Volume' {} Maybe [Tag]
a -> Volume
s {$sel:tags:Volume' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Volume) 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 that the volume supports, in MiB\/s.
volume_throughput :: Lens.Lens' Volume (Prelude.Maybe Prelude.Int)
volume_throughput :: Lens' Volume (Maybe Int)
volume_throughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Maybe Int
throughput :: Maybe Int
$sel:throughput:Volume' :: Volume -> Maybe Int
throughput} -> Maybe Int
throughput) (\s :: Volume
s@Volume' {} Maybe Int
a -> Volume
s {$sel:throughput:Volume' :: Maybe Int
throughput = Maybe Int
a} :: Volume)

-- | The Availability Zone for the volume.
volume_availabilityZone :: Lens.Lens' Volume Prelude.Text
volume_availabilityZone :: Lens' Volume Text
volume_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Text
availabilityZone :: Text
$sel:availabilityZone:Volume' :: Volume -> Text
availabilityZone} -> Text
availabilityZone) (\s :: Volume
s@Volume' {} Text
a -> Volume
s {$sel:availabilityZone:Volume' :: Text
availabilityZone = Text
a} :: Volume)

-- | The time stamp when volume creation was initiated.
volume_createTime :: Lens.Lens' Volume Prelude.UTCTime
volume_createTime :: Lens' Volume UTCTime
volume_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {ISO8601
createTime :: ISO8601
$sel:createTime:Volume' :: Volume -> ISO8601
createTime} -> ISO8601
createTime) (\s :: Volume
s@Volume' {} ISO8601
a -> Volume
s {$sel:createTime:Volume' :: ISO8601
createTime = ISO8601
a} :: Volume) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Indicates whether the volume is encrypted.
volume_encrypted :: Lens.Lens' Volume Prelude.Bool
volume_encrypted :: Lens' Volume Bool
volume_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Bool
encrypted :: Bool
$sel:encrypted:Volume' :: Volume -> Bool
encrypted} -> Bool
encrypted) (\s :: Volume
s@Volume' {} Bool
a -> Volume
s {$sel:encrypted:Volume' :: Bool
encrypted = Bool
a} :: Volume)

-- | The size of the volume, in GiBs.
volume_size :: Lens.Lens' Volume Prelude.Int
volume_size :: Lens' Volume Int
volume_size = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Int
size :: Int
$sel:size:Volume' :: Volume -> Int
size} -> Int
size) (\s :: Volume
s@Volume' {} Int
a -> Volume
s {$sel:size:Volume' :: Int
size = Int
a} :: Volume)

-- | The snapshot from which the volume was created, if applicable.
volume_snapshotId :: Lens.Lens' Volume Prelude.Text
volume_snapshotId :: Lens' Volume Text
volume_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Text
snapshotId :: Text
$sel:snapshotId:Volume' :: Volume -> Text
snapshotId} -> Text
snapshotId) (\s :: Volume
s@Volume' {} Text
a -> Volume
s {$sel:snapshotId:Volume' :: Text
snapshotId = Text
a} :: Volume)

-- | The volume state.
volume_state :: Lens.Lens' Volume VolumeState
volume_state :: Lens' Volume VolumeState
volume_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {VolumeState
state :: VolumeState
$sel:state:Volume' :: Volume -> VolumeState
state} -> VolumeState
state) (\s :: Volume
s@Volume' {} VolumeState
a -> Volume
s {$sel:state:Volume' :: VolumeState
state = VolumeState
a} :: Volume)

-- | The ID of the volume.
volume_volumeId :: Lens.Lens' Volume Prelude.Text
volume_volumeId :: Lens' Volume Text
volume_volumeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {Text
volumeId :: Text
$sel:volumeId:Volume' :: Volume -> Text
volumeId} -> Text
volumeId) (\s :: Volume
s@Volume' {} Text
a -> Volume
s {$sel:volumeId:Volume' :: Text
volumeId = Text
a} :: Volume)

-- | The volume type.
volume_volumeType :: Lens.Lens' Volume VolumeType
volume_volumeType :: Lens' Volume VolumeType
volume_volumeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Volume' {VolumeType
volumeType :: VolumeType
$sel:volumeType:Volume' :: Volume -> VolumeType
volumeType} -> VolumeType
volumeType) (\s :: Volume
s@Volume' {} VolumeType
a -> Volume
s {$sel:volumeType:Volume' :: VolumeType
volumeType = VolumeType
a} :: Volume)

instance Data.FromXML Volume where
  parseXML :: [Node] -> Either String Volume
parseXML [Node]
x =
    Maybe [VolumeAttachment]
-> Maybe Bool
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe [Tag]
-> Maybe Int
-> Text
-> ISO8601
-> Bool
-> Int
-> Text
-> VolumeState
-> Text
-> VolumeType
-> Volume
Volume'
      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
"attachmentSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"fastRestored")
      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
"kmsKeyId")
      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
"multiAttachEnabled")
      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
"outpostArn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tagSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"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 a
Data..@ Text
"availabilityZone")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"createTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"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 a
Data..@ Text
"size")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"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 a
Data..@ Text
"status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"volumeId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"volumeType")

instance Prelude.Hashable Volume where
  hashWithSalt :: Int -> Volume -> Int
hashWithSalt Int
_salt Volume' {Bool
Int
Maybe Bool
Maybe Int
Maybe [Tag]
Maybe [VolumeAttachment]
Maybe Text
Text
ISO8601
VolumeState
VolumeType
volumeType :: VolumeType
volumeId :: Text
state :: VolumeState
snapshotId :: Text
size :: Int
encrypted :: Bool
createTime :: ISO8601
availabilityZone :: Text
throughput :: Maybe Int
tags :: Maybe [Tag]
outpostArn :: Maybe Text
multiAttachEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
iops :: Maybe Int
fastRestored :: Maybe Bool
attachments :: Maybe [VolumeAttachment]
$sel:volumeType:Volume' :: Volume -> VolumeType
$sel:volumeId:Volume' :: Volume -> Text
$sel:state:Volume' :: Volume -> VolumeState
$sel:snapshotId:Volume' :: Volume -> Text
$sel:size:Volume' :: Volume -> Int
$sel:encrypted:Volume' :: Volume -> Bool
$sel:createTime:Volume' :: Volume -> ISO8601
$sel:availabilityZone:Volume' :: Volume -> Text
$sel:throughput:Volume' :: Volume -> Maybe Int
$sel:tags:Volume' :: Volume -> Maybe [Tag]
$sel:outpostArn:Volume' :: Volume -> Maybe Text
$sel:multiAttachEnabled:Volume' :: Volume -> Maybe Bool
$sel:kmsKeyId:Volume' :: Volume -> Maybe Text
$sel:iops:Volume' :: Volume -> Maybe Int
$sel:fastRestored:Volume' :: Volume -> Maybe Bool
$sel:attachments:Volume' :: Volume -> Maybe [VolumeAttachment]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VolumeAttachment]
attachments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
fastRestored
      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 [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
throughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
createTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
size
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VolumeState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VolumeType
volumeType

instance Prelude.NFData Volume where
  rnf :: Volume -> ()
rnf Volume' {Bool
Int
Maybe Bool
Maybe Int
Maybe [Tag]
Maybe [VolumeAttachment]
Maybe Text
Text
ISO8601
VolumeState
VolumeType
volumeType :: VolumeType
volumeId :: Text
state :: VolumeState
snapshotId :: Text
size :: Int
encrypted :: Bool
createTime :: ISO8601
availabilityZone :: Text
throughput :: Maybe Int
tags :: Maybe [Tag]
outpostArn :: Maybe Text
multiAttachEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
iops :: Maybe Int
fastRestored :: Maybe Bool
attachments :: Maybe [VolumeAttachment]
$sel:volumeType:Volume' :: Volume -> VolumeType
$sel:volumeId:Volume' :: Volume -> Text
$sel:state:Volume' :: Volume -> VolumeState
$sel:snapshotId:Volume' :: Volume -> Text
$sel:size:Volume' :: Volume -> Int
$sel:encrypted:Volume' :: Volume -> Bool
$sel:createTime:Volume' :: Volume -> ISO8601
$sel:availabilityZone:Volume' :: Volume -> Text
$sel:throughput:Volume' :: Volume -> Maybe Int
$sel:tags:Volume' :: Volume -> Maybe [Tag]
$sel:outpostArn:Volume' :: Volume -> Maybe Text
$sel:multiAttachEnabled:Volume' :: Volume -> Maybe Bool
$sel:kmsKeyId:Volume' :: Volume -> Maybe Text
$sel:iops:Volume' :: Volume -> Maybe Int
$sel:fastRestored:Volume' :: Volume -> Maybe Bool
$sel:attachments:Volume' :: Volume -> Maybe [VolumeAttachment]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [VolumeAttachment]
attachments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
fastRestored
      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 [Tag]
tags
      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 Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
size
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VolumeState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VolumeType
volumeType