{-# 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.DescribeVolumesModifications
-- 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 most recent volume modification request for the specified
-- EBS volumes.
--
-- If a volume has never been modified, some information in the output will
-- be null. If a volume has been modified more than once, the output
-- includes only the most recent modification request.
--
-- You can also use CloudWatch Events to check the status of a modification
-- to an EBS volume. For information about CloudWatch Events, see the
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/events/ Amazon CloudWatch Events User Guide>.
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/monitoring-volume-modifications.html Monitor the progress of volume modifications>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- This operation returns paginated results.
module Amazonka.EC2.DescribeVolumesModifications
  ( -- * Creating a Request
    DescribeVolumesModifications (..),
    newDescribeVolumesModifications,

    -- * Request Lenses
    describeVolumesModifications_dryRun,
    describeVolumesModifications_filters,
    describeVolumesModifications_maxResults,
    describeVolumesModifications_nextToken,
    describeVolumesModifications_volumeIds,

    -- * Destructuring the Response
    DescribeVolumesModificationsResponse (..),
    newDescribeVolumesModificationsResponse,

    -- * Response Lenses
    describeVolumesModificationsResponse_nextToken,
    describeVolumesModificationsResponse_volumesModifications,
    describeVolumesModificationsResponse_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:/ 'newDescribeVolumesModifications' smart constructor.
data DescribeVolumesModifications = DescribeVolumesModifications'
  { -- | 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@.
    DescribeVolumesModifications -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The filters.
    --
    -- -   @modification-state@ - The current modification state (modifying |
    --     optimizing | completed | failed).
    --
    -- -   @original-iops@ - The original IOPS rate of the volume.
    --
    -- -   @original-size@ - The original size of the volume, in GiB.
    --
    -- -   @original-volume-type@ - The original volume type of the volume
    --     (standard | io1 | io2 | gp2 | sc1 | st1).
    --
    -- -   @originalMultiAttachEnabled@ - Indicates whether Multi-Attach
    --     support was enabled (true | false).
    --
    -- -   @start-time@ - The modification start time.
    --
    -- -   @target-iops@ - The target IOPS rate of the volume.
    --
    -- -   @target-size@ - The target size of the volume, in GiB.
    --
    -- -   @target-volume-type@ - The target volume type of the volume
    --     (standard | io1 | io2 | gp2 | sc1 | st1).
    --
    -- -   @targetMultiAttachEnabled@ - Indicates whether Multi-Attach support
    --     is to be enabled (true | false).
    --
    -- -   @volume-id@ - The ID of the volume.
    DescribeVolumesModifications -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The maximum number of results (up to a limit of 500) to be returned in a
    -- paginated request.
    DescribeVolumesModifications -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The @nextToken@ value returned by a previous paginated request.
    DescribeVolumesModifications -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the volumes.
    DescribeVolumesModifications -> Maybe [Text]
volumeIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeVolumesModifications
-> DescribeVolumesModifications -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumesModifications
-> DescribeVolumesModifications -> Bool
$c/= :: DescribeVolumesModifications
-> DescribeVolumesModifications -> Bool
== :: DescribeVolumesModifications
-> DescribeVolumesModifications -> Bool
$c== :: DescribeVolumesModifications
-> DescribeVolumesModifications -> Bool
Prelude.Eq, ReadPrec [DescribeVolumesModifications]
ReadPrec DescribeVolumesModifications
Int -> ReadS DescribeVolumesModifications
ReadS [DescribeVolumesModifications]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumesModifications]
$creadListPrec :: ReadPrec [DescribeVolumesModifications]
readPrec :: ReadPrec DescribeVolumesModifications
$creadPrec :: ReadPrec DescribeVolumesModifications
readList :: ReadS [DescribeVolumesModifications]
$creadList :: ReadS [DescribeVolumesModifications]
readsPrec :: Int -> ReadS DescribeVolumesModifications
$creadsPrec :: Int -> ReadS DescribeVolumesModifications
Prelude.Read, Int -> DescribeVolumesModifications -> ShowS
[DescribeVolumesModifications] -> ShowS
DescribeVolumesModifications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumesModifications] -> ShowS
$cshowList :: [DescribeVolumesModifications] -> ShowS
show :: DescribeVolumesModifications -> String
$cshow :: DescribeVolumesModifications -> String
showsPrec :: Int -> DescribeVolumesModifications -> ShowS
$cshowsPrec :: Int -> DescribeVolumesModifications -> ShowS
Prelude.Show, forall x.
Rep DescribeVolumesModifications x -> DescribeVolumesModifications
forall x.
DescribeVolumesModifications -> Rep DescribeVolumesModifications x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeVolumesModifications x -> DescribeVolumesModifications
$cfrom :: forall x.
DescribeVolumesModifications -> Rep DescribeVolumesModifications x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumesModifications' 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', 'describeVolumesModifications_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', 'describeVolumesModifications_filters' - The filters.
--
-- -   @modification-state@ - The current modification state (modifying |
--     optimizing | completed | failed).
--
-- -   @original-iops@ - The original IOPS rate of the volume.
--
-- -   @original-size@ - The original size of the volume, in GiB.
--
-- -   @original-volume-type@ - The original volume type of the volume
--     (standard | io1 | io2 | gp2 | sc1 | st1).
--
-- -   @originalMultiAttachEnabled@ - Indicates whether Multi-Attach
--     support was enabled (true | false).
--
-- -   @start-time@ - The modification start time.
--
-- -   @target-iops@ - The target IOPS rate of the volume.
--
-- -   @target-size@ - The target size of the volume, in GiB.
--
-- -   @target-volume-type@ - The target volume type of the volume
--     (standard | io1 | io2 | gp2 | sc1 | st1).
--
-- -   @targetMultiAttachEnabled@ - Indicates whether Multi-Attach support
--     is to be enabled (true | false).
--
-- -   @volume-id@ - The ID of the volume.
--
-- 'maxResults', 'describeVolumesModifications_maxResults' - The maximum number of results (up to a limit of 500) to be returned in a
-- paginated request.
--
-- 'nextToken', 'describeVolumesModifications_nextToken' - The @nextToken@ value returned by a previous paginated request.
--
-- 'volumeIds', 'describeVolumesModifications_volumeIds' - The IDs of the volumes.
newDescribeVolumesModifications ::
  DescribeVolumesModifications
newDescribeVolumesModifications :: DescribeVolumesModifications
newDescribeVolumesModifications =
  DescribeVolumesModifications'
    { $sel:dryRun:DescribeVolumesModifications' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeVolumesModifications' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeVolumesModifications' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeVolumesModifications' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeIds:DescribeVolumesModifications' :: 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@.
describeVolumesModifications_dryRun :: Lens.Lens' DescribeVolumesModifications (Prelude.Maybe Prelude.Bool)
describeVolumesModifications_dryRun :: Lens' DescribeVolumesModifications (Maybe Bool)
describeVolumesModifications_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModifications' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeVolumesModifications
s@DescribeVolumesModifications' {} Maybe Bool
a -> DescribeVolumesModifications
s {$sel:dryRun:DescribeVolumesModifications' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeVolumesModifications)

-- | The filters.
--
-- -   @modification-state@ - The current modification state (modifying |
--     optimizing | completed | failed).
--
-- -   @original-iops@ - The original IOPS rate of the volume.
--
-- -   @original-size@ - The original size of the volume, in GiB.
--
-- -   @original-volume-type@ - The original volume type of the volume
--     (standard | io1 | io2 | gp2 | sc1 | st1).
--
-- -   @originalMultiAttachEnabled@ - Indicates whether Multi-Attach
--     support was enabled (true | false).
--
-- -   @start-time@ - The modification start time.
--
-- -   @target-iops@ - The target IOPS rate of the volume.
--
-- -   @target-size@ - The target size of the volume, in GiB.
--
-- -   @target-volume-type@ - The target volume type of the volume
--     (standard | io1 | io2 | gp2 | sc1 | st1).
--
-- -   @targetMultiAttachEnabled@ - Indicates whether Multi-Attach support
--     is to be enabled (true | false).
--
-- -   @volume-id@ - The ID of the volume.
describeVolumesModifications_filters :: Lens.Lens' DescribeVolumesModifications (Prelude.Maybe [Filter])
describeVolumesModifications_filters :: Lens' DescribeVolumesModifications (Maybe [Filter])
describeVolumesModifications_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModifications' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeVolumesModifications
s@DescribeVolumesModifications' {} Maybe [Filter]
a -> DescribeVolumesModifications
s {$sel:filters:DescribeVolumesModifications' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeVolumesModifications) 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 results (up to a limit of 500) to be returned in a
-- paginated request.
describeVolumesModifications_maxResults :: Lens.Lens' DescribeVolumesModifications (Prelude.Maybe Prelude.Int)
describeVolumesModifications_maxResults :: Lens' DescribeVolumesModifications (Maybe Int)
describeVolumesModifications_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModifications' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeVolumesModifications
s@DescribeVolumesModifications' {} Maybe Int
a -> DescribeVolumesModifications
s {$sel:maxResults:DescribeVolumesModifications' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeVolumesModifications)

-- | The @nextToken@ value returned by a previous paginated request.
describeVolumesModifications_nextToken :: Lens.Lens' DescribeVolumesModifications (Prelude.Maybe Prelude.Text)
describeVolumesModifications_nextToken :: Lens' DescribeVolumesModifications (Maybe Text)
describeVolumesModifications_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModifications' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumesModifications
s@DescribeVolumesModifications' {} Maybe Text
a -> DescribeVolumesModifications
s {$sel:nextToken:DescribeVolumesModifications' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumesModifications)

-- | The IDs of the volumes.
describeVolumesModifications_volumeIds :: Lens.Lens' DescribeVolumesModifications (Prelude.Maybe [Prelude.Text])
describeVolumesModifications_volumeIds :: Lens' DescribeVolumesModifications (Maybe [Text])
describeVolumesModifications_volumeIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModifications' {Maybe [Text]
volumeIds :: Maybe [Text]
$sel:volumeIds:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Text]
volumeIds} -> Maybe [Text]
volumeIds) (\s :: DescribeVolumesModifications
s@DescribeVolumesModifications' {} Maybe [Text]
a -> DescribeVolumesModifications
s {$sel:volumeIds:DescribeVolumesModifications' :: Maybe [Text]
volumeIds = Maybe [Text]
a} :: DescribeVolumesModifications) 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 DescribeVolumesModifications where
  page :: DescribeVolumesModifications
-> AWSResponse DescribeVolumesModifications
-> Maybe DescribeVolumesModifications
page DescribeVolumesModifications
rq AWSResponse DescribeVolumesModifications
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeVolumesModifications
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumesModificationsResponse (Maybe Text)
describeVolumesModificationsResponse_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 DescribeVolumesModifications
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeVolumesModificationsResponse (Maybe [VolumeModification])
describeVolumesModificationsResponse_volumesModifications
            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.$ DescribeVolumesModifications
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeVolumesModifications (Maybe Text)
describeVolumesModifications_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeVolumesModifications
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumesModificationsResponse (Maybe Text)
describeVolumesModificationsResponse_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 DescribeVolumesModifications where
  type
    AWSResponse DescribeVolumesModifications =
      DescribeVolumesModificationsResponse
  request :: (Service -> Service)
-> DescribeVolumesModifications
-> Request DescribeVolumesModifications
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 DescribeVolumesModifications
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeVolumesModifications)))
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 [VolumeModification]
-> Int
-> DescribeVolumesModificationsResponse
DescribeVolumesModificationsResponse'
            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
"volumeModificationSet"
                            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
    DescribeVolumesModifications
  where
  hashWithSalt :: Int -> DescribeVolumesModifications -> Int
hashWithSalt Int
_salt DescribeVolumesModifications' {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:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Text]
$sel:nextToken:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Text
$sel:maxResults:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Int
$sel:filters:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Filter]
$sel:dryRun:DescribeVolumesModifications' :: DescribeVolumesModifications -> 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 DescribeVolumesModifications where
  rnf :: DescribeVolumesModifications -> ()
rnf DescribeVolumesModifications' {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:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Text]
$sel:nextToken:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Text
$sel:maxResults:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Int
$sel:filters:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Filter]
$sel:dryRun:DescribeVolumesModifications' :: DescribeVolumesModifications -> 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 DescribeVolumesModifications where
  toHeaders :: DescribeVolumesModifications -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeVolumesModifications where
  toQuery :: DescribeVolumesModifications -> QueryString
toQuery DescribeVolumesModifications' {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:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Text]
$sel:nextToken:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Text
$sel:maxResults:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Int
$sel:filters:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe [Filter]
$sel:dryRun:DescribeVolumesModifications' :: DescribeVolumesModifications -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DescribeVolumesModifications" ::
                      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:/ 'newDescribeVolumesModificationsResponse' smart constructor.
data DescribeVolumesModificationsResponse = DescribeVolumesModificationsResponse'
  { -- | Token for pagination, null if there are no more results
    DescribeVolumesModificationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the volume modifications.
    DescribeVolumesModificationsResponse -> Maybe [VolumeModification]
volumesModifications :: Prelude.Maybe [VolumeModification],
    -- | The response's http status code.
    DescribeVolumesModificationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeVolumesModificationsResponse
-> DescribeVolumesModificationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumesModificationsResponse
-> DescribeVolumesModificationsResponse -> Bool
$c/= :: DescribeVolumesModificationsResponse
-> DescribeVolumesModificationsResponse -> Bool
== :: DescribeVolumesModificationsResponse
-> DescribeVolumesModificationsResponse -> Bool
$c== :: DescribeVolumesModificationsResponse
-> DescribeVolumesModificationsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeVolumesModificationsResponse]
ReadPrec DescribeVolumesModificationsResponse
Int -> ReadS DescribeVolumesModificationsResponse
ReadS [DescribeVolumesModificationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumesModificationsResponse]
$creadListPrec :: ReadPrec [DescribeVolumesModificationsResponse]
readPrec :: ReadPrec DescribeVolumesModificationsResponse
$creadPrec :: ReadPrec DescribeVolumesModificationsResponse
readList :: ReadS [DescribeVolumesModificationsResponse]
$creadList :: ReadS [DescribeVolumesModificationsResponse]
readsPrec :: Int -> ReadS DescribeVolumesModificationsResponse
$creadsPrec :: Int -> ReadS DescribeVolumesModificationsResponse
Prelude.Read, Int -> DescribeVolumesModificationsResponse -> ShowS
[DescribeVolumesModificationsResponse] -> ShowS
DescribeVolumesModificationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumesModificationsResponse] -> ShowS
$cshowList :: [DescribeVolumesModificationsResponse] -> ShowS
show :: DescribeVolumesModificationsResponse -> String
$cshow :: DescribeVolumesModificationsResponse -> String
showsPrec :: Int -> DescribeVolumesModificationsResponse -> ShowS
$cshowsPrec :: Int -> DescribeVolumesModificationsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeVolumesModificationsResponse x
-> DescribeVolumesModificationsResponse
forall x.
DescribeVolumesModificationsResponse
-> Rep DescribeVolumesModificationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeVolumesModificationsResponse x
-> DescribeVolumesModificationsResponse
$cfrom :: forall x.
DescribeVolumesModificationsResponse
-> Rep DescribeVolumesModificationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumesModificationsResponse' 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', 'describeVolumesModificationsResponse_nextToken' - Token for pagination, null if there are no more results
--
-- 'volumesModifications', 'describeVolumesModificationsResponse_volumesModifications' - Information about the volume modifications.
--
-- 'httpStatus', 'describeVolumesModificationsResponse_httpStatus' - The response's http status code.
newDescribeVolumesModificationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeVolumesModificationsResponse
newDescribeVolumesModificationsResponse :: Int -> DescribeVolumesModificationsResponse
newDescribeVolumesModificationsResponse Int
pHttpStatus_ =
  DescribeVolumesModificationsResponse'
    { $sel:nextToken:DescribeVolumesModificationsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumesModifications:DescribeVolumesModificationsResponse' :: Maybe [VolumeModification]
volumesModifications =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeVolumesModificationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Token for pagination, null if there are no more results
describeVolumesModificationsResponse_nextToken :: Lens.Lens' DescribeVolumesModificationsResponse (Prelude.Maybe Prelude.Text)
describeVolumesModificationsResponse_nextToken :: Lens' DescribeVolumesModificationsResponse (Maybe Text)
describeVolumesModificationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModificationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumesModificationsResponse
s@DescribeVolumesModificationsResponse' {} Maybe Text
a -> DescribeVolumesModificationsResponse
s {$sel:nextToken:DescribeVolumesModificationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumesModificationsResponse)

-- | Information about the volume modifications.
describeVolumesModificationsResponse_volumesModifications :: Lens.Lens' DescribeVolumesModificationsResponse (Prelude.Maybe [VolumeModification])
describeVolumesModificationsResponse_volumesModifications :: Lens'
  DescribeVolumesModificationsResponse (Maybe [VolumeModification])
describeVolumesModificationsResponse_volumesModifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModificationsResponse' {Maybe [VolumeModification]
volumesModifications :: Maybe [VolumeModification]
$sel:volumesModifications:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> Maybe [VolumeModification]
volumesModifications} -> Maybe [VolumeModification]
volumesModifications) (\s :: DescribeVolumesModificationsResponse
s@DescribeVolumesModificationsResponse' {} Maybe [VolumeModification]
a -> DescribeVolumesModificationsResponse
s {$sel:volumesModifications:DescribeVolumesModificationsResponse' :: Maybe [VolumeModification]
volumesModifications = Maybe [VolumeModification]
a} :: DescribeVolumesModificationsResponse) 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.
describeVolumesModificationsResponse_httpStatus :: Lens.Lens' DescribeVolumesModificationsResponse Prelude.Int
describeVolumesModificationsResponse_httpStatus :: Lens' DescribeVolumesModificationsResponse Int
describeVolumesModificationsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumesModificationsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeVolumesModificationsResponse
s@DescribeVolumesModificationsResponse' {} Int
a -> DescribeVolumesModificationsResponse
s {$sel:httpStatus:DescribeVolumesModificationsResponse' :: Int
httpStatus = Int
a} :: DescribeVolumesModificationsResponse)

instance
  Prelude.NFData
    DescribeVolumesModificationsResponse
  where
  rnf :: DescribeVolumesModificationsResponse -> ()
rnf DescribeVolumesModificationsResponse' {Int
Maybe [VolumeModification]
Maybe Text
httpStatus :: Int
volumesModifications :: Maybe [VolumeModification]
nextToken :: Maybe Text
$sel:httpStatus:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> Int
$sel:volumesModifications:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> Maybe [VolumeModification]
$sel:nextToken:DescribeVolumesModificationsResponse' :: DescribeVolumesModificationsResponse -> 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 [VolumeModification]
volumesModifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus