{-# 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.DrS.DescribeRecoverySnapshots
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all Recovery Snapshots for a single Source Server.
--
-- This operation returns paginated results.
module Amazonka.DrS.DescribeRecoverySnapshots
  ( -- * Creating a Request
    DescribeRecoverySnapshots (..),
    newDescribeRecoverySnapshots,

    -- * Request Lenses
    describeRecoverySnapshots_filters,
    describeRecoverySnapshots_maxResults,
    describeRecoverySnapshots_nextToken,
    describeRecoverySnapshots_order,
    describeRecoverySnapshots_sourceServerID,

    -- * Destructuring the Response
    DescribeRecoverySnapshotsResponse (..),
    newDescribeRecoverySnapshotsResponse,

    -- * Response Lenses
    describeRecoverySnapshotsResponse_items,
    describeRecoverySnapshotsResponse_nextToken,
    describeRecoverySnapshotsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DrS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeRecoverySnapshots' smart constructor.
data DescribeRecoverySnapshots = DescribeRecoverySnapshots'
  { -- | A set of filters by which to return Recovery Snapshots.
    DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshotsRequestFilters
filters :: Prelude.Maybe DescribeRecoverySnapshotsRequestFilters,
    -- | Maximum number of Recovery Snapshots to retrieve.
    DescribeRecoverySnapshots -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token of the next Recovery Snapshot to retrieve.
    DescribeRecoverySnapshots -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The sorted ordering by which to return Recovery Snapshots.
    DescribeRecoverySnapshots -> Maybe RecoverySnapshotsOrder
order :: Prelude.Maybe RecoverySnapshotsOrder,
    -- | Filter Recovery Snapshots by Source Server ID.
    DescribeRecoverySnapshots -> Text
sourceServerID :: Prelude.Text
  }
  deriving (DescribeRecoverySnapshots -> DescribeRecoverySnapshots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecoverySnapshots -> DescribeRecoverySnapshots -> Bool
$c/= :: DescribeRecoverySnapshots -> DescribeRecoverySnapshots -> Bool
== :: DescribeRecoverySnapshots -> DescribeRecoverySnapshots -> Bool
$c== :: DescribeRecoverySnapshots -> DescribeRecoverySnapshots -> Bool
Prelude.Eq, ReadPrec [DescribeRecoverySnapshots]
ReadPrec DescribeRecoverySnapshots
Int -> ReadS DescribeRecoverySnapshots
ReadS [DescribeRecoverySnapshots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecoverySnapshots]
$creadListPrec :: ReadPrec [DescribeRecoverySnapshots]
readPrec :: ReadPrec DescribeRecoverySnapshots
$creadPrec :: ReadPrec DescribeRecoverySnapshots
readList :: ReadS [DescribeRecoverySnapshots]
$creadList :: ReadS [DescribeRecoverySnapshots]
readsPrec :: Int -> ReadS DescribeRecoverySnapshots
$creadsPrec :: Int -> ReadS DescribeRecoverySnapshots
Prelude.Read, Int -> DescribeRecoverySnapshots -> ShowS
[DescribeRecoverySnapshots] -> ShowS
DescribeRecoverySnapshots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecoverySnapshots] -> ShowS
$cshowList :: [DescribeRecoverySnapshots] -> ShowS
show :: DescribeRecoverySnapshots -> String
$cshow :: DescribeRecoverySnapshots -> String
showsPrec :: Int -> DescribeRecoverySnapshots -> ShowS
$cshowsPrec :: Int -> DescribeRecoverySnapshots -> ShowS
Prelude.Show, forall x.
Rep DescribeRecoverySnapshots x -> DescribeRecoverySnapshots
forall x.
DescribeRecoverySnapshots -> Rep DescribeRecoverySnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeRecoverySnapshots x -> DescribeRecoverySnapshots
$cfrom :: forall x.
DescribeRecoverySnapshots -> Rep DescribeRecoverySnapshots x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecoverySnapshots' 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:
--
-- 'filters', 'describeRecoverySnapshots_filters' - A set of filters by which to return Recovery Snapshots.
--
-- 'maxResults', 'describeRecoverySnapshots_maxResults' - Maximum number of Recovery Snapshots to retrieve.
--
-- 'nextToken', 'describeRecoverySnapshots_nextToken' - The token of the next Recovery Snapshot to retrieve.
--
-- 'order', 'describeRecoverySnapshots_order' - The sorted ordering by which to return Recovery Snapshots.
--
-- 'sourceServerID', 'describeRecoverySnapshots_sourceServerID' - Filter Recovery Snapshots by Source Server ID.
newDescribeRecoverySnapshots ::
  -- | 'sourceServerID'
  Prelude.Text ->
  DescribeRecoverySnapshots
newDescribeRecoverySnapshots :: Text -> DescribeRecoverySnapshots
newDescribeRecoverySnapshots Text
pSourceServerID_ =
  DescribeRecoverySnapshots'
    { $sel:filters:DescribeRecoverySnapshots' :: Maybe DescribeRecoverySnapshotsRequestFilters
filters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeRecoverySnapshots' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeRecoverySnapshots' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:order:DescribeRecoverySnapshots' :: Maybe RecoverySnapshotsOrder
order = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceServerID:DescribeRecoverySnapshots' :: Text
sourceServerID = Text
pSourceServerID_
    }

-- | A set of filters by which to return Recovery Snapshots.
describeRecoverySnapshots_filters :: Lens.Lens' DescribeRecoverySnapshots (Prelude.Maybe DescribeRecoverySnapshotsRequestFilters)
describeRecoverySnapshots_filters :: Lens'
  DescribeRecoverySnapshots
  (Maybe DescribeRecoverySnapshotsRequestFilters)
describeRecoverySnapshots_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshots' {Maybe DescribeRecoverySnapshotsRequestFilters
filters :: Maybe DescribeRecoverySnapshotsRequestFilters
$sel:filters:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshotsRequestFilters
filters} -> Maybe DescribeRecoverySnapshotsRequestFilters
filters) (\s :: DescribeRecoverySnapshots
s@DescribeRecoverySnapshots' {} Maybe DescribeRecoverySnapshotsRequestFilters
a -> DescribeRecoverySnapshots
s {$sel:filters:DescribeRecoverySnapshots' :: Maybe DescribeRecoverySnapshotsRequestFilters
filters = Maybe DescribeRecoverySnapshotsRequestFilters
a} :: DescribeRecoverySnapshots)

-- | Maximum number of Recovery Snapshots to retrieve.
describeRecoverySnapshots_maxResults :: Lens.Lens' DescribeRecoverySnapshots (Prelude.Maybe Prelude.Natural)
describeRecoverySnapshots_maxResults :: Lens' DescribeRecoverySnapshots (Maybe Natural)
describeRecoverySnapshots_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshots' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeRecoverySnapshots
s@DescribeRecoverySnapshots' {} Maybe Natural
a -> DescribeRecoverySnapshots
s {$sel:maxResults:DescribeRecoverySnapshots' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeRecoverySnapshots)

-- | The token of the next Recovery Snapshot to retrieve.
describeRecoverySnapshots_nextToken :: Lens.Lens' DescribeRecoverySnapshots (Prelude.Maybe Prelude.Text)
describeRecoverySnapshots_nextToken :: Lens' DescribeRecoverySnapshots (Maybe Text)
describeRecoverySnapshots_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshots' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeRecoverySnapshots
s@DescribeRecoverySnapshots' {} Maybe Text
a -> DescribeRecoverySnapshots
s {$sel:nextToken:DescribeRecoverySnapshots' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeRecoverySnapshots)

-- | The sorted ordering by which to return Recovery Snapshots.
describeRecoverySnapshots_order :: Lens.Lens' DescribeRecoverySnapshots (Prelude.Maybe RecoverySnapshotsOrder)
describeRecoverySnapshots_order :: Lens' DescribeRecoverySnapshots (Maybe RecoverySnapshotsOrder)
describeRecoverySnapshots_order = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshots' {Maybe RecoverySnapshotsOrder
order :: Maybe RecoverySnapshotsOrder
$sel:order:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe RecoverySnapshotsOrder
order} -> Maybe RecoverySnapshotsOrder
order) (\s :: DescribeRecoverySnapshots
s@DescribeRecoverySnapshots' {} Maybe RecoverySnapshotsOrder
a -> DescribeRecoverySnapshots
s {$sel:order:DescribeRecoverySnapshots' :: Maybe RecoverySnapshotsOrder
order = Maybe RecoverySnapshotsOrder
a} :: DescribeRecoverySnapshots)

-- | Filter Recovery Snapshots by Source Server ID.
describeRecoverySnapshots_sourceServerID :: Lens.Lens' DescribeRecoverySnapshots Prelude.Text
describeRecoverySnapshots_sourceServerID :: Lens' DescribeRecoverySnapshots Text
describeRecoverySnapshots_sourceServerID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshots' {Text
sourceServerID :: Text
$sel:sourceServerID:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Text
sourceServerID} -> Text
sourceServerID) (\s :: DescribeRecoverySnapshots
s@DescribeRecoverySnapshots' {} Text
a -> DescribeRecoverySnapshots
s {$sel:sourceServerID:DescribeRecoverySnapshots' :: Text
sourceServerID = Text
a} :: DescribeRecoverySnapshots)

instance Core.AWSPager DescribeRecoverySnapshots where
  page :: DescribeRecoverySnapshots
-> AWSResponse DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshots
page DescribeRecoverySnapshots
rq AWSResponse DescribeRecoverySnapshots
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeRecoverySnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeRecoverySnapshotsResponse (Maybe Text)
describeRecoverySnapshotsResponse_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 DescribeRecoverySnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeRecoverySnapshotsResponse (Maybe [RecoverySnapshot])
describeRecoverySnapshotsResponse_items
            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.$ DescribeRecoverySnapshots
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeRecoverySnapshots (Maybe Text)
describeRecoverySnapshots_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeRecoverySnapshots
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeRecoverySnapshotsResponse (Maybe Text)
describeRecoverySnapshotsResponse_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 DescribeRecoverySnapshots where
  type
    AWSResponse DescribeRecoverySnapshots =
      DescribeRecoverySnapshotsResponse
  request :: (Service -> Service)
-> DescribeRecoverySnapshots -> Request DescribeRecoverySnapshots
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeRecoverySnapshots
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeRecoverySnapshots)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [RecoverySnapshot]
-> Maybe Text -> Int -> DescribeRecoverySnapshotsResponse
DescribeRecoverySnapshotsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"items" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            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 DescribeRecoverySnapshots where
  hashWithSalt :: Int -> DescribeRecoverySnapshots -> Int
hashWithSalt Int
_salt DescribeRecoverySnapshots' {Maybe Natural
Maybe Text
Maybe DescribeRecoverySnapshotsRequestFilters
Maybe RecoverySnapshotsOrder
Text
sourceServerID :: Text
order :: Maybe RecoverySnapshotsOrder
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe DescribeRecoverySnapshotsRequestFilters
$sel:sourceServerID:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Text
$sel:order:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe RecoverySnapshotsOrder
$sel:nextToken:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Text
$sel:maxResults:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Natural
$sel:filters:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshotsRequestFilters
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DescribeRecoverySnapshotsRequestFilters
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecoverySnapshotsOrder
order
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceServerID

instance Prelude.NFData DescribeRecoverySnapshots where
  rnf :: DescribeRecoverySnapshots -> ()
rnf DescribeRecoverySnapshots' {Maybe Natural
Maybe Text
Maybe DescribeRecoverySnapshotsRequestFilters
Maybe RecoverySnapshotsOrder
Text
sourceServerID :: Text
order :: Maybe RecoverySnapshotsOrder
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe DescribeRecoverySnapshotsRequestFilters
$sel:sourceServerID:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Text
$sel:order:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe RecoverySnapshotsOrder
$sel:nextToken:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Text
$sel:maxResults:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Natural
$sel:filters:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshotsRequestFilters
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DescribeRecoverySnapshotsRequestFilters
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
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 RecoverySnapshotsOrder
order
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceServerID

instance Data.ToHeaders DescribeRecoverySnapshots where
  toHeaders :: DescribeRecoverySnapshots -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeRecoverySnapshots where
  toJSON :: DescribeRecoverySnapshots -> Value
toJSON DescribeRecoverySnapshots' {Maybe Natural
Maybe Text
Maybe DescribeRecoverySnapshotsRequestFilters
Maybe RecoverySnapshotsOrder
Text
sourceServerID :: Text
order :: Maybe RecoverySnapshotsOrder
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe DescribeRecoverySnapshotsRequestFilters
$sel:sourceServerID:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Text
$sel:order:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe RecoverySnapshotsOrder
$sel:nextToken:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Text
$sel:maxResults:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots -> Maybe Natural
$sel:filters:DescribeRecoverySnapshots' :: DescribeRecoverySnapshots
-> Maybe DescribeRecoverySnapshotsRequestFilters
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DescribeRecoverySnapshotsRequestFilters
filters,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"order" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RecoverySnapshotsOrder
order,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sourceServerID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceServerID)
          ]
      )

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

instance Data.ToQuery DescribeRecoverySnapshots where
  toQuery :: DescribeRecoverySnapshots -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDescribeRecoverySnapshotsResponse' smart constructor.
data DescribeRecoverySnapshotsResponse = DescribeRecoverySnapshotsResponse'
  { -- | An array of Recovery Snapshots.
    DescribeRecoverySnapshotsResponse -> Maybe [RecoverySnapshot]
items :: Prelude.Maybe [RecoverySnapshot],
    -- | The token of the next Recovery Snapshot to retrieve.
    DescribeRecoverySnapshotsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeRecoverySnapshotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeRecoverySnapshotsResponse
-> DescribeRecoverySnapshotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecoverySnapshotsResponse
-> DescribeRecoverySnapshotsResponse -> Bool
$c/= :: DescribeRecoverySnapshotsResponse
-> DescribeRecoverySnapshotsResponse -> Bool
== :: DescribeRecoverySnapshotsResponse
-> DescribeRecoverySnapshotsResponse -> Bool
$c== :: DescribeRecoverySnapshotsResponse
-> DescribeRecoverySnapshotsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeRecoverySnapshotsResponse]
ReadPrec DescribeRecoverySnapshotsResponse
Int -> ReadS DescribeRecoverySnapshotsResponse
ReadS [DescribeRecoverySnapshotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecoverySnapshotsResponse]
$creadListPrec :: ReadPrec [DescribeRecoverySnapshotsResponse]
readPrec :: ReadPrec DescribeRecoverySnapshotsResponse
$creadPrec :: ReadPrec DescribeRecoverySnapshotsResponse
readList :: ReadS [DescribeRecoverySnapshotsResponse]
$creadList :: ReadS [DescribeRecoverySnapshotsResponse]
readsPrec :: Int -> ReadS DescribeRecoverySnapshotsResponse
$creadsPrec :: Int -> ReadS DescribeRecoverySnapshotsResponse
Prelude.Read, Int -> DescribeRecoverySnapshotsResponse -> ShowS
[DescribeRecoverySnapshotsResponse] -> ShowS
DescribeRecoverySnapshotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecoverySnapshotsResponse] -> ShowS
$cshowList :: [DescribeRecoverySnapshotsResponse] -> ShowS
show :: DescribeRecoverySnapshotsResponse -> String
$cshow :: DescribeRecoverySnapshotsResponse -> String
showsPrec :: Int -> DescribeRecoverySnapshotsResponse -> ShowS
$cshowsPrec :: Int -> DescribeRecoverySnapshotsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeRecoverySnapshotsResponse x
-> DescribeRecoverySnapshotsResponse
forall x.
DescribeRecoverySnapshotsResponse
-> Rep DescribeRecoverySnapshotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeRecoverySnapshotsResponse x
-> DescribeRecoverySnapshotsResponse
$cfrom :: forall x.
DescribeRecoverySnapshotsResponse
-> Rep DescribeRecoverySnapshotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecoverySnapshotsResponse' 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:
--
-- 'items', 'describeRecoverySnapshotsResponse_items' - An array of Recovery Snapshots.
--
-- 'nextToken', 'describeRecoverySnapshotsResponse_nextToken' - The token of the next Recovery Snapshot to retrieve.
--
-- 'httpStatus', 'describeRecoverySnapshotsResponse_httpStatus' - The response's http status code.
newDescribeRecoverySnapshotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeRecoverySnapshotsResponse
newDescribeRecoverySnapshotsResponse :: Int -> DescribeRecoverySnapshotsResponse
newDescribeRecoverySnapshotsResponse Int
pHttpStatus_ =
  DescribeRecoverySnapshotsResponse'
    { $sel:items:DescribeRecoverySnapshotsResponse' :: Maybe [RecoverySnapshot]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeRecoverySnapshotsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeRecoverySnapshotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of Recovery Snapshots.
describeRecoverySnapshotsResponse_items :: Lens.Lens' DescribeRecoverySnapshotsResponse (Prelude.Maybe [RecoverySnapshot])
describeRecoverySnapshotsResponse_items :: Lens' DescribeRecoverySnapshotsResponse (Maybe [RecoverySnapshot])
describeRecoverySnapshotsResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshotsResponse' {Maybe [RecoverySnapshot]
items :: Maybe [RecoverySnapshot]
$sel:items:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Maybe [RecoverySnapshot]
items} -> Maybe [RecoverySnapshot]
items) (\s :: DescribeRecoverySnapshotsResponse
s@DescribeRecoverySnapshotsResponse' {} Maybe [RecoverySnapshot]
a -> DescribeRecoverySnapshotsResponse
s {$sel:items:DescribeRecoverySnapshotsResponse' :: Maybe [RecoverySnapshot]
items = Maybe [RecoverySnapshot]
a} :: DescribeRecoverySnapshotsResponse) 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 token of the next Recovery Snapshot to retrieve.
describeRecoverySnapshotsResponse_nextToken :: Lens.Lens' DescribeRecoverySnapshotsResponse (Prelude.Maybe Prelude.Text)
describeRecoverySnapshotsResponse_nextToken :: Lens' DescribeRecoverySnapshotsResponse (Maybe Text)
describeRecoverySnapshotsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshotsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeRecoverySnapshotsResponse
s@DescribeRecoverySnapshotsResponse' {} Maybe Text
a -> DescribeRecoverySnapshotsResponse
s {$sel:nextToken:DescribeRecoverySnapshotsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeRecoverySnapshotsResponse)

-- | The response's http status code.
describeRecoverySnapshotsResponse_httpStatus :: Lens.Lens' DescribeRecoverySnapshotsResponse Prelude.Int
describeRecoverySnapshotsResponse_httpStatus :: Lens' DescribeRecoverySnapshotsResponse Int
describeRecoverySnapshotsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoverySnapshotsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeRecoverySnapshotsResponse
s@DescribeRecoverySnapshotsResponse' {} Int
a -> DescribeRecoverySnapshotsResponse
s {$sel:httpStatus:DescribeRecoverySnapshotsResponse' :: Int
httpStatus = Int
a} :: DescribeRecoverySnapshotsResponse)

instance
  Prelude.NFData
    DescribeRecoverySnapshotsResponse
  where
  rnf :: DescribeRecoverySnapshotsResponse -> ()
rnf DescribeRecoverySnapshotsResponse' {Int
Maybe [RecoverySnapshot]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
items :: Maybe [RecoverySnapshot]
$sel:httpStatus:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Int
$sel:nextToken:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Maybe Text
$sel:items:DescribeRecoverySnapshotsResponse' :: DescribeRecoverySnapshotsResponse -> Maybe [RecoverySnapshot]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [RecoverySnapshot]
items
      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 Int
httpStatus