{-# 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.DescribeVolumeStatus
-- 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 status of the specified volumes. Volume status provides
-- the result of the checks performed on your volumes to determine events
-- that can impair the performance of your volumes. The performance of a
-- volume can be affected if an issue occurs on the volume\'s underlying
-- host. If the volume\'s underlying host experiences a power outage or
-- system issue, after the system is restored, there could be data
-- inconsistencies on the volume. Volume events notify you if this occurs.
-- Volume actions notify you if any action needs to be taken in response to
-- the event.
--
-- The @DescribeVolumeStatus@ operation provides the following information
-- about the specified volumes:
--
-- /Status/: Reflects the current status of the volume. The possible values
-- are @ok@, @impaired@ , @warning@, or @insufficient-data@. If all checks
-- pass, the overall status of the volume is @ok@. If the check fails, the
-- overall status is @impaired@. If the status is @insufficient-data@, then
-- the checks might still be taking place on your volume at the time. We
-- recommend that you retry the request. For more information about volume
-- status, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/monitoring-volume-status.html Monitor the status of your volumes>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- /Events/: Reflect the cause of a volume status and might require you to
-- take action. For example, if your volume returns an @impaired@ status,
-- then the volume event might be @potential-data-inconsistency@. This
-- means that your volume has been affected by an issue with the underlying
-- host, has all I\/O operations disabled, and might have inconsistent
-- data.
--
-- /Actions/: Reflect the actions you might have to take in response to an
-- event. For example, if the status of the volume is @impaired@ and the
-- volume event shows @potential-data-inconsistency@, then the action shows
-- @enable-volume-io@. This means that you may want to enable the I\/O
-- operations for the volume by calling the EnableVolumeIO action and then
-- check the volume for data consistency.
--
-- Volume status is based on the volume status checks, and does not reflect
-- the volume state. Therefore, volume status does not indicate volumes in
-- the @error@ state (for example, when a volume is incapable of accepting
-- I\/O.)
--
-- This operation returns paginated results.
module Amazonka.EC2.DescribeVolumeStatus
  ( -- * Creating a Request
    DescribeVolumeStatus (..),
    newDescribeVolumeStatus,

    -- * Request Lenses
    describeVolumeStatus_dryRun,
    describeVolumeStatus_filters,
    describeVolumeStatus_maxResults,
    describeVolumeStatus_nextToken,
    describeVolumeStatus_volumeIds,

    -- * Destructuring the Response
    DescribeVolumeStatusResponse (..),
    newDescribeVolumeStatusResponse,

    -- * Response Lenses
    describeVolumeStatusResponse_nextToken,
    describeVolumeStatusResponse_volumeStatuses,
    describeVolumeStatusResponse_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:/ 'newDescribeVolumeStatus' smart constructor.
data DescribeVolumeStatus = DescribeVolumeStatus'
  { -- | 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@.
    DescribeVolumeStatus -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The filters.
    --
    -- -   @action.code@ - The action code for the event (for example,
    --     @enable-volume-io@).
    --
    -- -   @action.description@ - A description of the action.
    --
    -- -   @action.event-id@ - The event ID associated with the action.
    --
    -- -   @availability-zone@ - The Availability Zone of the instance.
    --
    -- -   @event.description@ - A description of the event.
    --
    -- -   @event.event-id@ - The event ID.
    --
    -- -   @event.event-type@ - The event type (for @io-enabled@: @passed@ |
    --     @failed@; for @io-performance@: @io-performance:degraded@ |
    --     @io-performance:severely-degraded@ | @io-performance:stalled@).
    --
    -- -   @event.not-after@ - The latest end time for the event.
    --
    -- -   @event.not-before@ - The earliest start time for the event.
    --
    -- -   @volume-status.details-name@ - The cause for @volume-status.status@
    --     (@io-enabled@ | @io-performance@).
    --
    -- -   @volume-status.details-status@ - The status of
    --     @volume-status.details-name@ (for @io-enabled@: @passed@ | @failed@;
    --     for @io-performance@: @normal@ | @degraded@ | @severely-degraded@ |
    --     @stalled@).
    --
    -- -   @volume-status.status@ - The status of the volume (@ok@ | @impaired@
    --     | @warning@ | @insufficient-data@).
    DescribeVolumeStatus -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The maximum number of volume results returned by @DescribeVolumeStatus@
    -- in paginated output. When this parameter is used, the request 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 request with the returned @NextToken@ value.
    -- This value can be between 5 and 1,000; if @MaxResults@ is given a value
    -- larger than 1,000, only 1,000 results are returned. If this parameter is
    -- not used, then @DescribeVolumeStatus@ returns all results. You cannot
    -- specify this parameter and the volume IDs parameter in the same request.
    DescribeVolumeStatus -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The @NextToken@ value to include in a future @DescribeVolumeStatus@
    -- request. When the results of the 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.
    DescribeVolumeStatus -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the volumes.
    --
    -- Default: Describes all your volumes.
    DescribeVolumeStatus -> Maybe [Text]
volumeIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeVolumeStatus -> DescribeVolumeStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumeStatus -> DescribeVolumeStatus -> Bool
$c/= :: DescribeVolumeStatus -> DescribeVolumeStatus -> Bool
== :: DescribeVolumeStatus -> DescribeVolumeStatus -> Bool
$c== :: DescribeVolumeStatus -> DescribeVolumeStatus -> Bool
Prelude.Eq, ReadPrec [DescribeVolumeStatus]
ReadPrec DescribeVolumeStatus
Int -> ReadS DescribeVolumeStatus
ReadS [DescribeVolumeStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumeStatus]
$creadListPrec :: ReadPrec [DescribeVolumeStatus]
readPrec :: ReadPrec DescribeVolumeStatus
$creadPrec :: ReadPrec DescribeVolumeStatus
readList :: ReadS [DescribeVolumeStatus]
$creadList :: ReadS [DescribeVolumeStatus]
readsPrec :: Int -> ReadS DescribeVolumeStatus
$creadsPrec :: Int -> ReadS DescribeVolumeStatus
Prelude.Read, Int -> DescribeVolumeStatus -> ShowS
[DescribeVolumeStatus] -> ShowS
DescribeVolumeStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumeStatus] -> ShowS
$cshowList :: [DescribeVolumeStatus] -> ShowS
show :: DescribeVolumeStatus -> String
$cshow :: DescribeVolumeStatus -> String
showsPrec :: Int -> DescribeVolumeStatus -> ShowS
$cshowsPrec :: Int -> DescribeVolumeStatus -> ShowS
Prelude.Show, forall x. Rep DescribeVolumeStatus x -> DescribeVolumeStatus
forall x. DescribeVolumeStatus -> Rep DescribeVolumeStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeVolumeStatus x -> DescribeVolumeStatus
$cfrom :: forall x. DescribeVolumeStatus -> Rep DescribeVolumeStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumeStatus' 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', 'describeVolumeStatus_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', 'describeVolumeStatus_filters' - The filters.
--
-- -   @action.code@ - The action code for the event (for example,
--     @enable-volume-io@).
--
-- -   @action.description@ - A description of the action.
--
-- -   @action.event-id@ - The event ID associated with the action.
--
-- -   @availability-zone@ - The Availability Zone of the instance.
--
-- -   @event.description@ - A description of the event.
--
-- -   @event.event-id@ - The event ID.
--
-- -   @event.event-type@ - The event type (for @io-enabled@: @passed@ |
--     @failed@; for @io-performance@: @io-performance:degraded@ |
--     @io-performance:severely-degraded@ | @io-performance:stalled@).
--
-- -   @event.not-after@ - The latest end time for the event.
--
-- -   @event.not-before@ - The earliest start time for the event.
--
-- -   @volume-status.details-name@ - The cause for @volume-status.status@
--     (@io-enabled@ | @io-performance@).
--
-- -   @volume-status.details-status@ - The status of
--     @volume-status.details-name@ (for @io-enabled@: @passed@ | @failed@;
--     for @io-performance@: @normal@ | @degraded@ | @severely-degraded@ |
--     @stalled@).
--
-- -   @volume-status.status@ - The status of the volume (@ok@ | @impaired@
--     | @warning@ | @insufficient-data@).
--
-- 'maxResults', 'describeVolumeStatus_maxResults' - The maximum number of volume results returned by @DescribeVolumeStatus@
-- in paginated output. When this parameter is used, the request 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 request with the returned @NextToken@ value.
-- This value can be between 5 and 1,000; if @MaxResults@ is given a value
-- larger than 1,000, only 1,000 results are returned. If this parameter is
-- not used, then @DescribeVolumeStatus@ returns all results. You cannot
-- specify this parameter and the volume IDs parameter in the same request.
--
-- 'nextToken', 'describeVolumeStatus_nextToken' - The @NextToken@ value to include in a future @DescribeVolumeStatus@
-- request. When the results of the 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.
--
-- 'volumeIds', 'describeVolumeStatus_volumeIds' - The IDs of the volumes.
--
-- Default: Describes all your volumes.
newDescribeVolumeStatus ::
  DescribeVolumeStatus
newDescribeVolumeStatus :: DescribeVolumeStatus
newDescribeVolumeStatus =
  DescribeVolumeStatus'
    { $sel:dryRun:DescribeVolumeStatus' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeVolumeStatus' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeVolumeStatus' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeVolumeStatus' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeIds:DescribeVolumeStatus' :: 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@.
describeVolumeStatus_dryRun :: Lens.Lens' DescribeVolumeStatus (Prelude.Maybe Prelude.Bool)
describeVolumeStatus_dryRun :: Lens' DescribeVolumeStatus (Maybe Bool)
describeVolumeStatus_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatus' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeVolumeStatus
s@DescribeVolumeStatus' {} Maybe Bool
a -> DescribeVolumeStatus
s {$sel:dryRun:DescribeVolumeStatus' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeVolumeStatus)

-- | The filters.
--
-- -   @action.code@ - The action code for the event (for example,
--     @enable-volume-io@).
--
-- -   @action.description@ - A description of the action.
--
-- -   @action.event-id@ - The event ID associated with the action.
--
-- -   @availability-zone@ - The Availability Zone of the instance.
--
-- -   @event.description@ - A description of the event.
--
-- -   @event.event-id@ - The event ID.
--
-- -   @event.event-type@ - The event type (for @io-enabled@: @passed@ |
--     @failed@; for @io-performance@: @io-performance:degraded@ |
--     @io-performance:severely-degraded@ | @io-performance:stalled@).
--
-- -   @event.not-after@ - The latest end time for the event.
--
-- -   @event.not-before@ - The earliest start time for the event.
--
-- -   @volume-status.details-name@ - The cause for @volume-status.status@
--     (@io-enabled@ | @io-performance@).
--
-- -   @volume-status.details-status@ - The status of
--     @volume-status.details-name@ (for @io-enabled@: @passed@ | @failed@;
--     for @io-performance@: @normal@ | @degraded@ | @severely-degraded@ |
--     @stalled@).
--
-- -   @volume-status.status@ - The status of the volume (@ok@ | @impaired@
--     | @warning@ | @insufficient-data@).
describeVolumeStatus_filters :: Lens.Lens' DescribeVolumeStatus (Prelude.Maybe [Filter])
describeVolumeStatus_filters :: Lens' DescribeVolumeStatus (Maybe [Filter])
describeVolumeStatus_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatus' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeVolumeStatus
s@DescribeVolumeStatus' {} Maybe [Filter]
a -> DescribeVolumeStatus
s {$sel:filters:DescribeVolumeStatus' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeVolumeStatus) 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 @DescribeVolumeStatus@
-- in paginated output. When this parameter is used, the request 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 request with the returned @NextToken@ value.
-- This value can be between 5 and 1,000; if @MaxResults@ is given a value
-- larger than 1,000, only 1,000 results are returned. If this parameter is
-- not used, then @DescribeVolumeStatus@ returns all results. You cannot
-- specify this parameter and the volume IDs parameter in the same request.
describeVolumeStatus_maxResults :: Lens.Lens' DescribeVolumeStatus (Prelude.Maybe Prelude.Int)
describeVolumeStatus_maxResults :: Lens' DescribeVolumeStatus (Maybe Int)
describeVolumeStatus_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatus' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeVolumeStatus
s@DescribeVolumeStatus' {} Maybe Int
a -> DescribeVolumeStatus
s {$sel:maxResults:DescribeVolumeStatus' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeVolumeStatus)

-- | The @NextToken@ value to include in a future @DescribeVolumeStatus@
-- request. When the results of the 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.
describeVolumeStatus_nextToken :: Lens.Lens' DescribeVolumeStatus (Prelude.Maybe Prelude.Text)
describeVolumeStatus_nextToken :: Lens' DescribeVolumeStatus (Maybe Text)
describeVolumeStatus_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatus' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumeStatus
s@DescribeVolumeStatus' {} Maybe Text
a -> DescribeVolumeStatus
s {$sel:nextToken:DescribeVolumeStatus' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumeStatus)

-- | The IDs of the volumes.
--
-- Default: Describes all your volumes.
describeVolumeStatus_volumeIds :: Lens.Lens' DescribeVolumeStatus (Prelude.Maybe [Prelude.Text])
describeVolumeStatus_volumeIds :: Lens' DescribeVolumeStatus (Maybe [Text])
describeVolumeStatus_volumeIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatus' {Maybe [Text]
volumeIds :: Maybe [Text]
$sel:volumeIds:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Text]
volumeIds} -> Maybe [Text]
volumeIds) (\s :: DescribeVolumeStatus
s@DescribeVolumeStatus' {} Maybe [Text]
a -> DescribeVolumeStatus
s {$sel:volumeIds:DescribeVolumeStatus' :: Maybe [Text]
volumeIds = Maybe [Text]
a} :: DescribeVolumeStatus) 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 DescribeVolumeStatus where
  page :: DescribeVolumeStatus
-> AWSResponse DescribeVolumeStatus -> Maybe DescribeVolumeStatus
page DescribeVolumeStatus
rq AWSResponse DescribeVolumeStatus
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeVolumeStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumeStatusResponse (Maybe Text)
describeVolumeStatusResponse_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 DescribeVolumeStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumeStatusResponse (Maybe [VolumeStatusItem])
describeVolumeStatusResponse_volumeStatuses
            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.$ DescribeVolumeStatus
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeVolumeStatus (Maybe Text)
describeVolumeStatus_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeVolumeStatus
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeVolumeStatusResponse (Maybe Text)
describeVolumeStatusResponse_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 DescribeVolumeStatus where
  type
    AWSResponse DescribeVolumeStatus =
      DescribeVolumeStatusResponse
  request :: (Service -> Service)
-> DescribeVolumeStatus -> Request DescribeVolumeStatus
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 DescribeVolumeStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeVolumeStatus)))
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 [VolumeStatusItem] -> Int -> DescribeVolumeStatusResponse
DescribeVolumeStatusResponse'
            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
"volumeStatusSet"
                            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 DescribeVolumeStatus where
  hashWithSalt :: Int -> DescribeVolumeStatus -> Int
hashWithSalt Int
_salt DescribeVolumeStatus' {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:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Text]
$sel:nextToken:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Text
$sel:maxResults:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Int
$sel:filters:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Filter]
$sel:dryRun:DescribeVolumeStatus' :: DescribeVolumeStatus -> 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 DescribeVolumeStatus where
  rnf :: DescribeVolumeStatus -> ()
rnf DescribeVolumeStatus' {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:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Text]
$sel:nextToken:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Text
$sel:maxResults:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Int
$sel:filters:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Filter]
$sel:dryRun:DescribeVolumeStatus' :: DescribeVolumeStatus -> 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 DescribeVolumeStatus where
  toHeaders :: DescribeVolumeStatus -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeVolumeStatus where
  toQuery :: DescribeVolumeStatus -> QueryString
toQuery DescribeVolumeStatus' {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:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Text]
$sel:nextToken:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Text
$sel:maxResults:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Int
$sel:filters:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe [Filter]
$sel:dryRun:DescribeVolumeStatus' :: DescribeVolumeStatus -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeVolumeStatus" :: 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:/ 'newDescribeVolumeStatusResponse' smart constructor.
data DescribeVolumeStatusResponse = DescribeVolumeStatusResponse'
  { -- | The token to use to retrieve the next page of results. This value is
    -- @null@ when there are no more results to return.
    DescribeVolumeStatusResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the status of the volumes.
    DescribeVolumeStatusResponse -> Maybe [VolumeStatusItem]
volumeStatuses :: Prelude.Maybe [VolumeStatusItem],
    -- | The response's http status code.
    DescribeVolumeStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeVolumeStatusResponse
-> DescribeVolumeStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeVolumeStatusResponse
-> DescribeVolumeStatusResponse -> Bool
$c/= :: DescribeVolumeStatusResponse
-> DescribeVolumeStatusResponse -> Bool
== :: DescribeVolumeStatusResponse
-> DescribeVolumeStatusResponse -> Bool
$c== :: DescribeVolumeStatusResponse
-> DescribeVolumeStatusResponse -> Bool
Prelude.Eq, ReadPrec [DescribeVolumeStatusResponse]
ReadPrec DescribeVolumeStatusResponse
Int -> ReadS DescribeVolumeStatusResponse
ReadS [DescribeVolumeStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeVolumeStatusResponse]
$creadListPrec :: ReadPrec [DescribeVolumeStatusResponse]
readPrec :: ReadPrec DescribeVolumeStatusResponse
$creadPrec :: ReadPrec DescribeVolumeStatusResponse
readList :: ReadS [DescribeVolumeStatusResponse]
$creadList :: ReadS [DescribeVolumeStatusResponse]
readsPrec :: Int -> ReadS DescribeVolumeStatusResponse
$creadsPrec :: Int -> ReadS DescribeVolumeStatusResponse
Prelude.Read, Int -> DescribeVolumeStatusResponse -> ShowS
[DescribeVolumeStatusResponse] -> ShowS
DescribeVolumeStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeVolumeStatusResponse] -> ShowS
$cshowList :: [DescribeVolumeStatusResponse] -> ShowS
show :: DescribeVolumeStatusResponse -> String
$cshow :: DescribeVolumeStatusResponse -> String
showsPrec :: Int -> DescribeVolumeStatusResponse -> ShowS
$cshowsPrec :: Int -> DescribeVolumeStatusResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeVolumeStatusResponse x -> DescribeVolumeStatusResponse
forall x.
DescribeVolumeStatusResponse -> Rep DescribeVolumeStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeVolumeStatusResponse x -> DescribeVolumeStatusResponse
$cfrom :: forall x.
DescribeVolumeStatusResponse -> Rep DescribeVolumeStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeVolumeStatusResponse' 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', 'describeVolumeStatusResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
--
-- 'volumeStatuses', 'describeVolumeStatusResponse_volumeStatuses' - Information about the status of the volumes.
--
-- 'httpStatus', 'describeVolumeStatusResponse_httpStatus' - The response's http status code.
newDescribeVolumeStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeVolumeStatusResponse
newDescribeVolumeStatusResponse :: Int -> DescribeVolumeStatusResponse
newDescribeVolumeStatusResponse Int
pHttpStatus_ =
  DescribeVolumeStatusResponse'
    { $sel:nextToken:DescribeVolumeStatusResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumeStatuses:DescribeVolumeStatusResponse' :: Maybe [VolumeStatusItem]
volumeStatuses = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeVolumeStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
describeVolumeStatusResponse_nextToken :: Lens.Lens' DescribeVolumeStatusResponse (Prelude.Maybe Prelude.Text)
describeVolumeStatusResponse_nextToken :: Lens' DescribeVolumeStatusResponse (Maybe Text)
describeVolumeStatusResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatusResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeVolumeStatusResponse' :: DescribeVolumeStatusResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeVolumeStatusResponse
s@DescribeVolumeStatusResponse' {} Maybe Text
a -> DescribeVolumeStatusResponse
s {$sel:nextToken:DescribeVolumeStatusResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeVolumeStatusResponse)

-- | Information about the status of the volumes.
describeVolumeStatusResponse_volumeStatuses :: Lens.Lens' DescribeVolumeStatusResponse (Prelude.Maybe [VolumeStatusItem])
describeVolumeStatusResponse_volumeStatuses :: Lens' DescribeVolumeStatusResponse (Maybe [VolumeStatusItem])
describeVolumeStatusResponse_volumeStatuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatusResponse' {Maybe [VolumeStatusItem]
volumeStatuses :: Maybe [VolumeStatusItem]
$sel:volumeStatuses:DescribeVolumeStatusResponse' :: DescribeVolumeStatusResponse -> Maybe [VolumeStatusItem]
volumeStatuses} -> Maybe [VolumeStatusItem]
volumeStatuses) (\s :: DescribeVolumeStatusResponse
s@DescribeVolumeStatusResponse' {} Maybe [VolumeStatusItem]
a -> DescribeVolumeStatusResponse
s {$sel:volumeStatuses:DescribeVolumeStatusResponse' :: Maybe [VolumeStatusItem]
volumeStatuses = Maybe [VolumeStatusItem]
a} :: DescribeVolumeStatusResponse) 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.
describeVolumeStatusResponse_httpStatus :: Lens.Lens' DescribeVolumeStatusResponse Prelude.Int
describeVolumeStatusResponse_httpStatus :: Lens' DescribeVolumeStatusResponse Int
describeVolumeStatusResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeVolumeStatusResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeVolumeStatusResponse' :: DescribeVolumeStatusResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeVolumeStatusResponse
s@DescribeVolumeStatusResponse' {} Int
a -> DescribeVolumeStatusResponse
s {$sel:httpStatus:DescribeVolumeStatusResponse' :: Int
httpStatus = Int
a} :: DescribeVolumeStatusResponse)

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