{-# 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.DescribeVolumes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified EBS volumes or all of your EBS volumes.
--
-- If you are describing a long list of volumes, we recommend that you
-- paginate the output to make the list more manageable. The @MaxResults@
-- parameter sets the maximum number of results returned in a single page.
-- If the list of results exceeds your @MaxResults@ value, then that number
-- of results is returned along with a @NextToken@ value that can be passed
-- to a subsequent @DescribeVolumes@ request to retrieve the remaining
-- results.
--
-- For more information about EBS volumes, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/EBSVolumes.html Amazon EBS volumes>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- This operation returns paginated results.
module Amazonka.EC2.DescribeVolumes
  ( -- * Creating a Request
    DescribeVolumes (..),
    newDescribeVolumes,

    -- * Request Lenses
    describeVolumes_dryRun,
    describeVolumes_filters,
    describeVolumes_maxResults,
    describeVolumes_nextToken,
    describeVolumes_volumeIds,

    -- * Destructuring the Response
    DescribeVolumesResponse (..),
    newDescribeVolumesResponse,

    -- * Response Lenses
    describeVolumesResponse_nextToken,
    describeVolumesResponse_volumes,
    describeVolumesResponse_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:/ 'newDescribeVolumes' smart constructor.
data DescribeVolumes = DescribeVolumes'
  { -- | 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@.
    DescribeVolumes -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The filters.
    --
    -- -   @attachment.attach-time@ - The time stamp when the attachment
    --     initiated.
    --
    -- -   @attachment.delete-on-termination@ - Whether the volume is deleted
    --     on instance termination.
    --
    -- -   @attachment.device@ - The device name specified in the block device
    --     mapping (for example, @\/dev\/sda1@).
    --
    -- -   @attachment.instance-id@ - The ID of the instance the volume is
    --     attached to.
    --
    -- -   @attachment.status@ - The attachment state (@attaching@ | @attached@
    --     | @detaching@).
    --
    -- -   @availability-zone@ - The Availability Zone in which the volume was
    --     created.
    --
    -- -   @create-time@ - The time stamp when the volume was created.
    --
    -- -   @encrypted@ - Indicates whether the volume is encrypted (@true@ |
    --     @false@)
    --
    -- -   @multi-attach-enabled@ - Indicates whether the volume is enabled for
    --     Multi-Attach (@true@ | @false@)
    --
    -- -   @fast-restored@ - Indicates whether the volume was created from a
    --     snapshot that is enabled for fast snapshot restore (@true@ |
    --     @false@).
    --
    -- -   @size@ - The size of the volume, in GiB.
    --
    -- -   @snapshot-id@ - The snapshot from which the volume was created.
    --
    -- -   @status@ - The state of the volume (@creating@ | @available@ |
    --     @in-use@ | @deleting@ | @deleted@ | @error@).
    --
    -- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
    --     resource. Use the tag key in the filter name and the tag value as
    --     the filter value. For example, to find all resources that have a tag
    --     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
    --     the filter name and @TeamA@ for the filter value.
    --
    -- -   @tag-key@ - The key of a tag assigned to the resource. Use this
    --     filter to find all resources assigned a tag with a specific key,
    --     regardless of the tag value.
    --
    -- -   @volume-id@ - The volume ID.
    --
    -- -   @volume-type@ - The Amazon EBS volume type (@gp2@ | @gp3@ | @io1@ |
    --     @io2@ | @st1@ | @sc1@| @standard@)
    DescribeVolumes -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The maximum number of volume results returned by @DescribeVolumes@ in
    -- paginated output. When this parameter is used, @DescribeVolumes@ only
    -- returns @MaxResults@ results in a single page along with a @NextToken@
    -- response element. The remaining results of the initial request can be
    -- seen by sending another @DescribeVolumes@ request with the returned
    -- @NextToken@ value. This value can be between 5 and 500; if @MaxResults@
    -- is given a value larger than 500, only 500 results are returned. If this
    -- parameter is not used, then @DescribeVolumes@ returns all results. You
    -- cannot specify this parameter and the volume IDs parameter in the same
    -- request.
    DescribeVolumes -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The @NextToken@ value returned from a previous paginated
    -- @DescribeVolumes@ request where @MaxResults@ was used and the results
    -- exceeded the value of that parameter. Pagination continues from the end
    -- of the previous results that returned the @NextToken@ value. This value
    -- is @null@ when there are no more results to return.
    DescribeVolumes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The volume IDs.
    DescribeVolumes -> Maybe [Text]
volumeIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeVolumes -> DescribeVolumes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumes -> DescribeVolumes -> Bool
$c/= :: DescribeVolumes -> DescribeVolumes -> Bool
== :: DescribeVolumes -> DescribeVolumes -> Bool
$c== :: DescribeVolumes -> DescribeVolumes -> Bool
Prelude.Eq, ReadPrec [DescribeVolumes]
ReadPrec DescribeVolumes
Int -> ReadS DescribeVolumes
ReadS [DescribeVolumes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumes]
$creadListPrec :: ReadPrec [DescribeVolumes]
readPrec :: ReadPrec DescribeVolumes
$creadPrec :: ReadPrec DescribeVolumes
readList :: ReadS [DescribeVolumes]
$creadList :: ReadS [DescribeVolumes]
readsPrec :: Int -> ReadS DescribeVolumes
$creadsPrec :: Int -> ReadS DescribeVolumes
Prelude.Read, Int -> DescribeVolumes -> ShowS
[DescribeVolumes] -> ShowS
DescribeVolumes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumes] -> ShowS
$cshowList :: [DescribeVolumes] -> ShowS
show :: DescribeVolumes -> String
$cshow :: DescribeVolumes -> String
showsPrec :: Int -> DescribeVolumes -> ShowS
$cshowsPrec :: Int -> DescribeVolumes -> ShowS
Prelude.Show, forall x. Rep DescribeVolumes x -> DescribeVolumes
forall x. DescribeVolumes -> Rep DescribeVolumes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeVolumes x -> DescribeVolumes
$cfrom :: forall x. DescribeVolumes -> Rep DescribeVolumes x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumes' 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:
--
-- 'dryRun', 'describeVolumes_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@.
--
-- 'filters', 'describeVolumes_filters' - The filters.
--
-- -   @attachment.attach-time@ - The time stamp when the attachment
--     initiated.
--
-- -   @attachment.delete-on-termination@ - Whether the volume is deleted
--     on instance termination.
--
-- -   @attachment.device@ - The device name specified in the block device
--     mapping (for example, @\/dev\/sda1@).
--
-- -   @attachment.instance-id@ - The ID of the instance the volume is
--     attached to.
--
-- -   @attachment.status@ - The attachment state (@attaching@ | @attached@
--     | @detaching@).
--
-- -   @availability-zone@ - The Availability Zone in which the volume was
--     created.
--
-- -   @create-time@ - The time stamp when the volume was created.
--
-- -   @encrypted@ - Indicates whether the volume is encrypted (@true@ |
--     @false@)
--
-- -   @multi-attach-enabled@ - Indicates whether the volume is enabled for
--     Multi-Attach (@true@ | @false@)
--
-- -   @fast-restored@ - Indicates whether the volume was created from a
--     snapshot that is enabled for fast snapshot restore (@true@ |
--     @false@).
--
-- -   @size@ - The size of the volume, in GiB.
--
-- -   @snapshot-id@ - The snapshot from which the volume was created.
--
-- -   @status@ - The state of the volume (@creating@ | @available@ |
--     @in-use@ | @deleting@ | @deleted@ | @error@).
--
-- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
--     resource. Use the tag key in the filter name and the tag value as
--     the filter value. For example, to find all resources that have a tag
--     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
--     the filter name and @TeamA@ for the filter value.
--
-- -   @tag-key@ - The key of a tag assigned to the resource. Use this
--     filter to find all resources assigned a tag with a specific key,
--     regardless of the tag value.
--
-- -   @volume-id@ - The volume ID.
--
-- -   @volume-type@ - The Amazon EBS volume type (@gp2@ | @gp3@ | @io1@ |
--     @io2@ | @st1@ | @sc1@| @standard@)
--
-- 'maxResults', 'describeVolumes_maxResults' - The maximum number of volume results returned by @DescribeVolumes@ in
-- paginated output. When this parameter is used, @DescribeVolumes@ only
-- returns @MaxResults@ results in a single page along with a @NextToken@
-- response element. The remaining results of the initial request can be
-- seen by sending another @DescribeVolumes@ request with the returned
-- @NextToken@ value. This value can be between 5 and 500; if @MaxResults@
-- is given a value larger than 500, only 500 results are returned. If this
-- parameter is not used, then @DescribeVolumes@ returns all results. You
-- cannot specify this parameter and the volume IDs parameter in the same
-- request.
--
-- 'nextToken', 'describeVolumes_nextToken' - The @NextToken@ value returned from a previous paginated
-- @DescribeVolumes@ request where @MaxResults@ was used and the results
-- exceeded the value of that parameter. Pagination continues from the end
-- of the previous results that returned the @NextToken@ value. This value
-- is @null@ when there are no more results to return.
--
-- 'volumeIds', 'describeVolumes_volumeIds' - The volume IDs.
newDescribeVolumes ::
  DescribeVolumes
newDescribeVolumes :: DescribeVolumes
newDescribeVolumes =
  DescribeVolumes'
    { $sel:dryRun:DescribeVolumes' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeVolumes' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeVolumes' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeVolumes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeIds:DescribeVolumes' :: Maybe [Text]
volumeIds = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The filters.
--
-- -   @attachment.attach-time@ - The time stamp when the attachment
--     initiated.
--
-- -   @attachment.delete-on-termination@ - Whether the volume is deleted
--     on instance termination.
--
-- -   @attachment.device@ - The device name specified in the block device
--     mapping (for example, @\/dev\/sda1@).
--
-- -   @attachment.instance-id@ - The ID of the instance the volume is
--     attached to.
--
-- -   @attachment.status@ - The attachment state (@attaching@ | @attached@
--     | @detaching@).
--
-- -   @availability-zone@ - The Availability Zone in which the volume was
--     created.
--
-- -   @create-time@ - The time stamp when the volume was created.
--
-- -   @encrypted@ - Indicates whether the volume is encrypted (@true@ |
--     @false@)
--
-- -   @multi-attach-enabled@ - Indicates whether the volume is enabled for
--     Multi-Attach (@true@ | @false@)
--
-- -   @fast-restored@ - Indicates whether the volume was created from a
--     snapshot that is enabled for fast snapshot restore (@true@ |
--     @false@).
--
-- -   @size@ - The size of the volume, in GiB.
--
-- -   @snapshot-id@ - The snapshot from which the volume was created.
--
-- -   @status@ - The state of the volume (@creating@ | @available@ |
--     @in-use@ | @deleting@ | @deleted@ | @error@).
--
-- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
--     resource. Use the tag key in the filter name and the tag value as
--     the filter value. For example, to find all resources that have a tag
--     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
--     the filter name and @TeamA@ for the filter value.
--
-- -   @tag-key@ - The key of a tag assigned to the resource. Use this
--     filter to find all resources assigned a tag with a specific key,
--     regardless of the tag value.
--
-- -   @volume-id@ - The volume ID.
--
-- -   @volume-type@ - The Amazon EBS volume type (@gp2@ | @gp3@ | @io1@ |
--     @io2@ | @st1@ | @sc1@| @standard@)
describeVolumes_filters :: Lens.Lens' DescribeVolumes (Prelude.Maybe [Filter])
describeVolumes_filters :: Lens' DescribeVolumes (Maybe [Filter])
describeVolumes_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumes' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeVolumes' :: DescribeVolumes -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeVolumes
s@DescribeVolumes' {} Maybe [Filter]
a -> DescribeVolumes
s {$sel:filters:DescribeVolumes' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeVolumes) 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 maximum number of volume results returned by @DescribeVolumes@ in
-- paginated output. When this parameter is used, @DescribeVolumes@ only
-- returns @MaxResults@ results in a single page along with a @NextToken@
-- response element. The remaining results of the initial request can be
-- seen by sending another @DescribeVolumes@ request with the returned
-- @NextToken@ value. This value can be between 5 and 500; if @MaxResults@
-- is given a value larger than 500, only 500 results are returned. If this
-- parameter is not used, then @DescribeVolumes@ returns all results. You
-- cannot specify this parameter and the volume IDs parameter in the same
-- request.
describeVolumes_maxResults :: Lens.Lens' DescribeVolumes (Prelude.Maybe Prelude.Int)
describeVolumes_maxResults :: Lens' DescribeVolumes (Maybe Int)
describeVolumes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumes' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeVolumes' :: DescribeVolumes -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeVolumes
s@DescribeVolumes' {} Maybe Int
a -> DescribeVolumes
s {$sel:maxResults:DescribeVolumes' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeVolumes)

-- | The @NextToken@ value returned from a previous paginated
-- @DescribeVolumes@ request where @MaxResults@ was used and the results
-- exceeded the value of that parameter. Pagination continues from the end
-- of the previous results that returned the @NextToken@ value. This value
-- is @null@ when there are no more results to return.
describeVolumes_nextToken :: Lens.Lens' DescribeVolumes (Prelude.Maybe Prelude.Text)
describeVolumes_nextToken :: Lens' DescribeVolumes (Maybe Text)
describeVolumes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumes' :: DescribeVolumes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumes
s@DescribeVolumes' {} Maybe Text
a -> DescribeVolumes
s {$sel:nextToken:DescribeVolumes' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumes)

-- | The volume IDs.
describeVolumes_volumeIds :: Lens.Lens' DescribeVolumes (Prelude.Maybe [Prelude.Text])
describeVolumes_volumeIds :: Lens' DescribeVolumes (Maybe [Text])
describeVolumes_volumeIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumes' {Maybe [Text]
volumeIds :: Maybe [Text]
$sel:volumeIds:DescribeVolumes' :: DescribeVolumes -> Maybe [Text]
volumeIds} -> Maybe [Text]
volumeIds) (\s :: DescribeVolumes
s@DescribeVolumes' {} Maybe [Text]
a -> DescribeVolumes
s {$sel:volumeIds:DescribeVolumes' :: Maybe [Text]
volumeIds = Maybe [Text]
a} :: DescribeVolumes) 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

instance Core.AWSPager DescribeVolumes where
  page :: DescribeVolumes
-> AWSResponse DescribeVolumes -> Maybe DescribeVolumes
page DescribeVolumes
rq AWSResponse DescribeVolumes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeVolumes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumesResponse (Maybe Text)
describeVolumesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeVolumes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeVolumes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeVolumes (Maybe Text)
describeVolumes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeVolumes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumesResponse (Maybe Text)
describeVolumesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeVolumes where
  type
    AWSResponse DescribeVolumes =
      DescribeVolumesResponse
  request :: (Service -> Service) -> DescribeVolumes -> Request DescribeVolumes
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 DescribeVolumes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeVolumes)))
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 -> Maybe [Volume] -> Int -> DescribeVolumesResponse
DescribeVolumesResponse'
            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
"nextToken")
            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
"volumeSet"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribeVolumes where
  hashWithSalt :: Int -> DescribeVolumes -> Int
hashWithSalt Int
_salt DescribeVolumes' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
volumeIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:volumeIds:DescribeVolumes' :: DescribeVolumes -> Maybe [Text]
$sel:nextToken:DescribeVolumes' :: DescribeVolumes -> Maybe Text
$sel:maxResults:DescribeVolumes' :: DescribeVolumes -> Maybe Int
$sel:filters:DescribeVolumes' :: DescribeVolumes -> Maybe [Filter]
$sel:dryRun:DescribeVolumes' :: DescribeVolumes -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
volumeIds

instance Prelude.NFData DescribeVolumes where
  rnf :: DescribeVolumes -> ()
rnf DescribeVolumes' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
volumeIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:volumeIds:DescribeVolumes' :: DescribeVolumes -> Maybe [Text]
$sel:nextToken:DescribeVolumes' :: DescribeVolumes -> Maybe Text
$sel:maxResults:DescribeVolumes' :: DescribeVolumes -> Maybe Int
$sel:filters:DescribeVolumes' :: DescribeVolumes -> Maybe [Filter]
$sel:dryRun:DescribeVolumes' :: DescribeVolumes -> Maybe Bool
..} =
    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 [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
volumeIds

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

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

instance Data.ToQuery DescribeVolumes where
  toQuery :: DescribeVolumes -> QueryString
toQuery DescribeVolumes' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
volumeIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:volumeIds:DescribeVolumes' :: DescribeVolumes -> Maybe [Text]
$sel:nextToken:DescribeVolumes' :: DescribeVolumes -> Maybe Text
$sel:maxResults:DescribeVolumes' :: DescribeVolumes -> Maybe Int
$sel:filters:DescribeVolumes' :: DescribeVolumes -> Maybe [Filter]
$sel:dryRun:DescribeVolumes' :: DescribeVolumes -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeVolumes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"VolumeId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
volumeIds)
      ]

-- | /See:/ 'newDescribeVolumesResponse' smart constructor.
data DescribeVolumesResponse = DescribeVolumesResponse'
  { -- | The @NextToken@ value to include in a future @DescribeVolumes@ request.
    -- When the results of a @DescribeVolumes@ request exceed @MaxResults@,
    -- this value can be used to retrieve the next page of results. This value
    -- is @null@ when there are no more results to return.
    DescribeVolumesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the volumes.
    DescribeVolumesResponse -> Maybe [Volume]
volumes :: Prelude.Maybe [Volume],
    -- | The response's http status code.
    DescribeVolumesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeVolumesResponse -> DescribeVolumesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumesResponse -> DescribeVolumesResponse -> Bool
$c/= :: DescribeVolumesResponse -> DescribeVolumesResponse -> Bool
== :: DescribeVolumesResponse -> DescribeVolumesResponse -> Bool
$c== :: DescribeVolumesResponse -> DescribeVolumesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeVolumesResponse]
ReadPrec DescribeVolumesResponse
Int -> ReadS DescribeVolumesResponse
ReadS [DescribeVolumesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumesResponse]
$creadListPrec :: ReadPrec [DescribeVolumesResponse]
readPrec :: ReadPrec DescribeVolumesResponse
$creadPrec :: ReadPrec DescribeVolumesResponse
readList :: ReadS [DescribeVolumesResponse]
$creadList :: ReadS [DescribeVolumesResponse]
readsPrec :: Int -> ReadS DescribeVolumesResponse
$creadsPrec :: Int -> ReadS DescribeVolumesResponse
Prelude.Read, Int -> DescribeVolumesResponse -> ShowS
[DescribeVolumesResponse] -> ShowS
DescribeVolumesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumesResponse] -> ShowS
$cshowList :: [DescribeVolumesResponse] -> ShowS
show :: DescribeVolumesResponse -> String
$cshow :: DescribeVolumesResponse -> String
showsPrec :: Int -> DescribeVolumesResponse -> ShowS
$cshowsPrec :: Int -> DescribeVolumesResponse -> ShowS
Prelude.Show, forall x. Rep DescribeVolumesResponse x -> DescribeVolumesResponse
forall x. DescribeVolumesResponse -> Rep DescribeVolumesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeVolumesResponse x -> DescribeVolumesResponse
$cfrom :: forall x. DescribeVolumesResponse -> Rep DescribeVolumesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumesResponse' 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:
--
-- 'nextToken', 'describeVolumesResponse_nextToken' - The @NextToken@ value to include in a future @DescribeVolumes@ request.
-- When the results of a @DescribeVolumes@ request exceed @MaxResults@,
-- this value can be used to retrieve the next page of results. This value
-- is @null@ when there are no more results to return.
--
-- 'volumes', 'describeVolumesResponse_volumes' - Information about the volumes.
--
-- 'httpStatus', 'describeVolumesResponse_httpStatus' - The response's http status code.
newDescribeVolumesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeVolumesResponse
newDescribeVolumesResponse :: Int -> DescribeVolumesResponse
newDescribeVolumesResponse Int
pHttpStatus_ =
  DescribeVolumesResponse'
    { $sel:nextToken:DescribeVolumesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumes:DescribeVolumesResponse' :: Maybe [Volume]
volumes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeVolumesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @NextToken@ value to include in a future @DescribeVolumes@ request.
-- When the results of a @DescribeVolumes@ request exceed @MaxResults@,
-- this value can be used to retrieve the next page of results. This value
-- is @null@ when there are no more results to return.
describeVolumesResponse_nextToken :: Lens.Lens' DescribeVolumesResponse (Prelude.Maybe Prelude.Text)
describeVolumesResponse_nextToken :: Lens' DescribeVolumesResponse (Maybe Text)
describeVolumesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumesResponse' :: DescribeVolumesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumesResponse
s@DescribeVolumesResponse' {} Maybe Text
a -> DescribeVolumesResponse
s {$sel:nextToken:DescribeVolumesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumesResponse)

-- | Information about the volumes.
describeVolumesResponse_volumes :: Lens.Lens' DescribeVolumesResponse (Prelude.Maybe [Volume])
describeVolumesResponse_volumes :: Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesResponse' {Maybe [Volume]
volumes :: Maybe [Volume]
$sel:volumes:DescribeVolumesResponse' :: DescribeVolumesResponse -> Maybe [Volume]
volumes} -> Maybe [Volume]
volumes) (\s :: DescribeVolumesResponse
s@DescribeVolumesResponse' {} Maybe [Volume]
a -> DescribeVolumesResponse
s {$sel:volumes:DescribeVolumesResponse' :: Maybe [Volume]
volumes = Maybe [Volume]
a} :: DescribeVolumesResponse) 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 response's http status code.
describeVolumesResponse_httpStatus :: Lens.Lens' DescribeVolumesResponse Prelude.Int
describeVolumesResponse_httpStatus :: Lens' DescribeVolumesResponse Int
describeVolumesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeVolumesResponse' :: DescribeVolumesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeVolumesResponse
s@DescribeVolumesResponse' {} Int
a -> DescribeVolumesResponse
s {$sel:httpStatus:DescribeVolumesResponse' :: Int
httpStatus = Int
a} :: DescribeVolumesResponse)

instance Prelude.NFData DescribeVolumesResponse where
  rnf :: DescribeVolumesResponse -> ()
rnf DescribeVolumesResponse' {Int
Maybe [Volume]
Maybe Text
httpStatus :: Int
volumes :: Maybe [Volume]
nextToken :: Maybe Text
$sel:httpStatus:DescribeVolumesResponse' :: DescribeVolumesResponse -> Int
$sel:volumes:DescribeVolumesResponse' :: DescribeVolumesResponse -> Maybe [Volume]
$sel:nextToken:DescribeVolumesResponse' :: DescribeVolumesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Volume]
volumes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus