{-# 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.DynamoDB.ListBackups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List backups associated with an Amazon Web Services account. To list
-- backups for a given table, specify @TableName@. @ListBackups@ returns a
-- paginated list of results with at most 1 MB worth of items in a page.
-- You can also specify a maximum number of entries to be returned in a
-- page.
--
-- In the request, start time is inclusive, but end time is exclusive. Note
-- that these boundaries are for the time at which the original backup was
-- requested.
--
-- You can call @ListBackups@ a maximum of five times per second.
--
-- This operation returns paginated results.
module Amazonka.DynamoDB.ListBackups
  ( -- * Creating a Request
    ListBackups (..),
    newListBackups,

    -- * Request Lenses
    listBackups_backupType,
    listBackups_exclusiveStartBackupArn,
    listBackups_limit,
    listBackups_tableName,
    listBackups_timeRangeLowerBound,
    listBackups_timeRangeUpperBound,

    -- * Destructuring the Response
    ListBackupsResponse (..),
    newListBackupsResponse,

    -- * Response Lenses
    listBackupsResponse_backupSummaries,
    listBackupsResponse_lastEvaluatedBackupArn,
    listBackupsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListBackups' smart constructor.
data ListBackups = ListBackups'
  { -- | The backups from the table specified by @BackupType@ are listed.
    --
    -- Where @BackupType@ can be:
    --
    -- -   @USER@ - On-demand backup created by you. (The default setting if no
    --     other backup types are specified.)
    --
    -- -   @SYSTEM@ - On-demand backup automatically created by DynamoDB.
    --
    -- -   @ALL@ - All types of on-demand backups (USER and SYSTEM).
    ListBackups -> Maybe BackupTypeFilter
backupType :: Prelude.Maybe BackupTypeFilter,
    -- | @LastEvaluatedBackupArn@ is the Amazon Resource Name (ARN) of the backup
    -- last evaluated when the current page of results was returned, inclusive
    -- of the current page of results. This value may be specified as the
    -- @ExclusiveStartBackupArn@ of a new @ListBackups@ operation in order to
    -- fetch the next page of results.
    ListBackups -> Maybe Text
exclusiveStartBackupArn :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of backups to return at once.
    ListBackups -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The backups from the table specified by @TableName@ are listed.
    ListBackups -> Maybe Text
tableName :: Prelude.Maybe Prelude.Text,
    -- | Only backups created after this time are listed. @TimeRangeLowerBound@
    -- is inclusive.
    ListBackups -> Maybe POSIX
timeRangeLowerBound :: Prelude.Maybe Data.POSIX,
    -- | Only backups created before this time are listed. @TimeRangeUpperBound@
    -- is exclusive.
    ListBackups -> Maybe POSIX
timeRangeUpperBound :: Prelude.Maybe Data.POSIX
  }
  deriving (ListBackups -> ListBackups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBackups -> ListBackups -> Bool
$c/= :: ListBackups -> ListBackups -> Bool
== :: ListBackups -> ListBackups -> Bool
$c== :: ListBackups -> ListBackups -> Bool
Prelude.Eq, ReadPrec [ListBackups]
ReadPrec ListBackups
Int -> ReadS ListBackups
ReadS [ListBackups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBackups]
$creadListPrec :: ReadPrec [ListBackups]
readPrec :: ReadPrec ListBackups
$creadPrec :: ReadPrec ListBackups
readList :: ReadS [ListBackups]
$creadList :: ReadS [ListBackups]
readsPrec :: Int -> ReadS ListBackups
$creadsPrec :: Int -> ReadS ListBackups
Prelude.Read, Int -> ListBackups -> ShowS
[ListBackups] -> ShowS
ListBackups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBackups] -> ShowS
$cshowList :: [ListBackups] -> ShowS
show :: ListBackups -> String
$cshow :: ListBackups -> String
showsPrec :: Int -> ListBackups -> ShowS
$cshowsPrec :: Int -> ListBackups -> ShowS
Prelude.Show, forall x. Rep ListBackups x -> ListBackups
forall x. ListBackups -> Rep ListBackups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBackups x -> ListBackups
$cfrom :: forall x. ListBackups -> Rep ListBackups x
Prelude.Generic)

-- |
-- Create a value of 'ListBackups' 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:
--
-- 'backupType', 'listBackups_backupType' - The backups from the table specified by @BackupType@ are listed.
--
-- Where @BackupType@ can be:
--
-- -   @USER@ - On-demand backup created by you. (The default setting if no
--     other backup types are specified.)
--
-- -   @SYSTEM@ - On-demand backup automatically created by DynamoDB.
--
-- -   @ALL@ - All types of on-demand backups (USER and SYSTEM).
--
-- 'exclusiveStartBackupArn', 'listBackups_exclusiveStartBackupArn' - @LastEvaluatedBackupArn@ is the Amazon Resource Name (ARN) of the backup
-- last evaluated when the current page of results was returned, inclusive
-- of the current page of results. This value may be specified as the
-- @ExclusiveStartBackupArn@ of a new @ListBackups@ operation in order to
-- fetch the next page of results.
--
-- 'limit', 'listBackups_limit' - Maximum number of backups to return at once.
--
-- 'tableName', 'listBackups_tableName' - The backups from the table specified by @TableName@ are listed.
--
-- 'timeRangeLowerBound', 'listBackups_timeRangeLowerBound' - Only backups created after this time are listed. @TimeRangeLowerBound@
-- is inclusive.
--
-- 'timeRangeUpperBound', 'listBackups_timeRangeUpperBound' - Only backups created before this time are listed. @TimeRangeUpperBound@
-- is exclusive.
newListBackups ::
  ListBackups
newListBackups :: ListBackups
newListBackups =
  ListBackups'
    { $sel:backupType:ListBackups' :: Maybe BackupTypeFilter
backupType = forall a. Maybe a
Prelude.Nothing,
      $sel:exclusiveStartBackupArn:ListBackups' :: Maybe Text
exclusiveStartBackupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListBackups' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:ListBackups' :: Maybe Text
tableName = forall a. Maybe a
Prelude.Nothing,
      $sel:timeRangeLowerBound:ListBackups' :: Maybe POSIX
timeRangeLowerBound = forall a. Maybe a
Prelude.Nothing,
      $sel:timeRangeUpperBound:ListBackups' :: Maybe POSIX
timeRangeUpperBound = forall a. Maybe a
Prelude.Nothing
    }

-- | The backups from the table specified by @BackupType@ are listed.
--
-- Where @BackupType@ can be:
--
-- -   @USER@ - On-demand backup created by you. (The default setting if no
--     other backup types are specified.)
--
-- -   @SYSTEM@ - On-demand backup automatically created by DynamoDB.
--
-- -   @ALL@ - All types of on-demand backups (USER and SYSTEM).
listBackups_backupType :: Lens.Lens' ListBackups (Prelude.Maybe BackupTypeFilter)
listBackups_backupType :: Lens' ListBackups (Maybe BackupTypeFilter)
listBackups_backupType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe BackupTypeFilter
backupType :: Maybe BackupTypeFilter
$sel:backupType:ListBackups' :: ListBackups -> Maybe BackupTypeFilter
backupType} -> Maybe BackupTypeFilter
backupType) (\s :: ListBackups
s@ListBackups' {} Maybe BackupTypeFilter
a -> ListBackups
s {$sel:backupType:ListBackups' :: Maybe BackupTypeFilter
backupType = Maybe BackupTypeFilter
a} :: ListBackups)

-- | @LastEvaluatedBackupArn@ is the Amazon Resource Name (ARN) of the backup
-- last evaluated when the current page of results was returned, inclusive
-- of the current page of results. This value may be specified as the
-- @ExclusiveStartBackupArn@ of a new @ListBackups@ operation in order to
-- fetch the next page of results.
listBackups_exclusiveStartBackupArn :: Lens.Lens' ListBackups (Prelude.Maybe Prelude.Text)
listBackups_exclusiveStartBackupArn :: Lens' ListBackups (Maybe Text)
listBackups_exclusiveStartBackupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe Text
exclusiveStartBackupArn :: Maybe Text
$sel:exclusiveStartBackupArn:ListBackups' :: ListBackups -> Maybe Text
exclusiveStartBackupArn} -> Maybe Text
exclusiveStartBackupArn) (\s :: ListBackups
s@ListBackups' {} Maybe Text
a -> ListBackups
s {$sel:exclusiveStartBackupArn:ListBackups' :: Maybe Text
exclusiveStartBackupArn = Maybe Text
a} :: ListBackups)

-- | Maximum number of backups to return at once.
listBackups_limit :: Lens.Lens' ListBackups (Prelude.Maybe Prelude.Natural)
listBackups_limit :: Lens' ListBackups (Maybe Natural)
listBackups_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListBackups' :: ListBackups -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListBackups
s@ListBackups' {} Maybe Natural
a -> ListBackups
s {$sel:limit:ListBackups' :: Maybe Natural
limit = Maybe Natural
a} :: ListBackups)

-- | The backups from the table specified by @TableName@ are listed.
listBackups_tableName :: Lens.Lens' ListBackups (Prelude.Maybe Prelude.Text)
listBackups_tableName :: Lens' ListBackups (Maybe Text)
listBackups_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe Text
tableName :: Maybe Text
$sel:tableName:ListBackups' :: ListBackups -> Maybe Text
tableName} -> Maybe Text
tableName) (\s :: ListBackups
s@ListBackups' {} Maybe Text
a -> ListBackups
s {$sel:tableName:ListBackups' :: Maybe Text
tableName = Maybe Text
a} :: ListBackups)

-- | Only backups created after this time are listed. @TimeRangeLowerBound@
-- is inclusive.
listBackups_timeRangeLowerBound :: Lens.Lens' ListBackups (Prelude.Maybe Prelude.UTCTime)
listBackups_timeRangeLowerBound :: Lens' ListBackups (Maybe UTCTime)
listBackups_timeRangeLowerBound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe POSIX
timeRangeLowerBound :: Maybe POSIX
$sel:timeRangeLowerBound:ListBackups' :: ListBackups -> Maybe POSIX
timeRangeLowerBound} -> Maybe POSIX
timeRangeLowerBound) (\s :: ListBackups
s@ListBackups' {} Maybe POSIX
a -> ListBackups
s {$sel:timeRangeLowerBound:ListBackups' :: Maybe POSIX
timeRangeLowerBound = Maybe POSIX
a} :: ListBackups) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Only backups created before this time are listed. @TimeRangeUpperBound@
-- is exclusive.
listBackups_timeRangeUpperBound :: Lens.Lens' ListBackups (Prelude.Maybe Prelude.UTCTime)
listBackups_timeRangeUpperBound :: Lens' ListBackups (Maybe UTCTime)
listBackups_timeRangeUpperBound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackups' {Maybe POSIX
timeRangeUpperBound :: Maybe POSIX
$sel:timeRangeUpperBound:ListBackups' :: ListBackups -> Maybe POSIX
timeRangeUpperBound} -> Maybe POSIX
timeRangeUpperBound) (\s :: ListBackups
s@ListBackups' {} Maybe POSIX
a -> ListBackups
s {$sel:timeRangeUpperBound:ListBackups' :: Maybe POSIX
timeRangeUpperBound = Maybe POSIX
a} :: ListBackups) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager ListBackups where
  page :: ListBackups -> AWSResponse ListBackups -> Maybe ListBackups
page ListBackups
rq AWSResponse ListBackups
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBackups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBackupsResponse (Maybe Text)
listBackupsResponse_lastEvaluatedBackupArn
            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 ListBackups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBackupsResponse (Maybe [BackupSummary])
listBackupsResponse_backupSummaries
            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.$ ListBackups
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBackups (Maybe Text)
listBackups_exclusiveStartBackupArn
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBackups
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBackupsResponse (Maybe Text)
listBackupsResponse_lastEvaluatedBackupArn
          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 ListBackups where
  type AWSResponse ListBackups = ListBackupsResponse
  request :: (Service -> Service) -> ListBackups -> Request ListBackups
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 ListBackups
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListBackups)))
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 [BackupSummary] -> Maybe Text -> Int -> ListBackupsResponse
ListBackupsResponse'
            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
"BackupSummaries"
                            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
"LastEvaluatedBackupArn")
            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 ListBackups where
  hashWithSalt :: Int -> ListBackups -> Int
hashWithSalt Int
_salt ListBackups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe BackupTypeFilter
timeRangeUpperBound :: Maybe POSIX
timeRangeLowerBound :: Maybe POSIX
tableName :: Maybe Text
limit :: Maybe Natural
exclusiveStartBackupArn :: Maybe Text
backupType :: Maybe BackupTypeFilter
$sel:timeRangeUpperBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:timeRangeLowerBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:tableName:ListBackups' :: ListBackups -> Maybe Text
$sel:limit:ListBackups' :: ListBackups -> Maybe Natural
$sel:exclusiveStartBackupArn:ListBackups' :: ListBackups -> Maybe Text
$sel:backupType:ListBackups' :: ListBackups -> Maybe BackupTypeFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BackupTypeFilter
backupType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
exclusiveStartBackupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
timeRangeLowerBound
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
timeRangeUpperBound

instance Prelude.NFData ListBackups where
  rnf :: ListBackups -> ()
rnf ListBackups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe BackupTypeFilter
timeRangeUpperBound :: Maybe POSIX
timeRangeLowerBound :: Maybe POSIX
tableName :: Maybe Text
limit :: Maybe Natural
exclusiveStartBackupArn :: Maybe Text
backupType :: Maybe BackupTypeFilter
$sel:timeRangeUpperBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:timeRangeLowerBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:tableName:ListBackups' :: ListBackups -> Maybe Text
$sel:limit:ListBackups' :: ListBackups -> Maybe Natural
$sel:exclusiveStartBackupArn:ListBackups' :: ListBackups -> Maybe Text
$sel:backupType:ListBackups' :: ListBackups -> Maybe BackupTypeFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BackupTypeFilter
backupType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
exclusiveStartBackupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
timeRangeLowerBound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
timeRangeUpperBound

instance Data.ToHeaders ListBackups where
  toHeaders :: ListBackups -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DynamoDB_20120810.ListBackups" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListBackups where
  toJSON :: ListBackups -> Value
toJSON ListBackups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe BackupTypeFilter
timeRangeUpperBound :: Maybe POSIX
timeRangeLowerBound :: Maybe POSIX
tableName :: Maybe Text
limit :: Maybe Natural
exclusiveStartBackupArn :: Maybe Text
backupType :: Maybe BackupTypeFilter
$sel:timeRangeUpperBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:timeRangeLowerBound:ListBackups' :: ListBackups -> Maybe POSIX
$sel:tableName:ListBackups' :: ListBackups -> Maybe Text
$sel:limit:ListBackups' :: ListBackups -> Maybe Natural
$sel:exclusiveStartBackupArn:ListBackups' :: ListBackups -> Maybe Text
$sel:backupType:ListBackups' :: ListBackups -> Maybe BackupTypeFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BackupType" 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 BackupTypeFilter
backupType,
            (Key
"ExclusiveStartBackupArn" 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
exclusiveStartBackupArn,
            (Key
"Limit" 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
limit,
            (Key
"TableName" 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
tableName,
            (Key
"TimeRangeLowerBound" 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 POSIX
timeRangeLowerBound,
            (Key
"TimeRangeUpperBound" 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 POSIX
timeRangeUpperBound
          ]
      )

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

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

-- | /See:/ 'newListBackupsResponse' smart constructor.
data ListBackupsResponse = ListBackupsResponse'
  { -- | List of @BackupSummary@ objects.
    ListBackupsResponse -> Maybe [BackupSummary]
backupSummaries :: Prelude.Maybe [BackupSummary],
    -- | The ARN of the backup last evaluated when the current page of results
    -- was returned, inclusive of the current page of results. This value may
    -- be specified as the @ExclusiveStartBackupArn@ of a new @ListBackups@
    -- operation in order to fetch the next page of results.
    --
    -- If @LastEvaluatedBackupArn@ is empty, then the last page of results has
    -- been processed and there are no more results to be retrieved.
    --
    -- If @LastEvaluatedBackupArn@ is not empty, this may or may not indicate
    -- that there is more data to be returned. All results are guaranteed to
    -- have been returned if and only if no value for @LastEvaluatedBackupArn@
    -- is returned.
    ListBackupsResponse -> Maybe Text
lastEvaluatedBackupArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBackupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBackupsResponse -> ListBackupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBackupsResponse -> ListBackupsResponse -> Bool
$c/= :: ListBackupsResponse -> ListBackupsResponse -> Bool
== :: ListBackupsResponse -> ListBackupsResponse -> Bool
$c== :: ListBackupsResponse -> ListBackupsResponse -> Bool
Prelude.Eq, ReadPrec [ListBackupsResponse]
ReadPrec ListBackupsResponse
Int -> ReadS ListBackupsResponse
ReadS [ListBackupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBackupsResponse]
$creadListPrec :: ReadPrec [ListBackupsResponse]
readPrec :: ReadPrec ListBackupsResponse
$creadPrec :: ReadPrec ListBackupsResponse
readList :: ReadS [ListBackupsResponse]
$creadList :: ReadS [ListBackupsResponse]
readsPrec :: Int -> ReadS ListBackupsResponse
$creadsPrec :: Int -> ReadS ListBackupsResponse
Prelude.Read, Int -> ListBackupsResponse -> ShowS
[ListBackupsResponse] -> ShowS
ListBackupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBackupsResponse] -> ShowS
$cshowList :: [ListBackupsResponse] -> ShowS
show :: ListBackupsResponse -> String
$cshow :: ListBackupsResponse -> String
showsPrec :: Int -> ListBackupsResponse -> ShowS
$cshowsPrec :: Int -> ListBackupsResponse -> ShowS
Prelude.Show, forall x. Rep ListBackupsResponse x -> ListBackupsResponse
forall x. ListBackupsResponse -> Rep ListBackupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBackupsResponse x -> ListBackupsResponse
$cfrom :: forall x. ListBackupsResponse -> Rep ListBackupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBackupsResponse' 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:
--
-- 'backupSummaries', 'listBackupsResponse_backupSummaries' - List of @BackupSummary@ objects.
--
-- 'lastEvaluatedBackupArn', 'listBackupsResponse_lastEvaluatedBackupArn' - The ARN of the backup last evaluated when the current page of results
-- was returned, inclusive of the current page of results. This value may
-- be specified as the @ExclusiveStartBackupArn@ of a new @ListBackups@
-- operation in order to fetch the next page of results.
--
-- If @LastEvaluatedBackupArn@ is empty, then the last page of results has
-- been processed and there are no more results to be retrieved.
--
-- If @LastEvaluatedBackupArn@ is not empty, this may or may not indicate
-- that there is more data to be returned. All results are guaranteed to
-- have been returned if and only if no value for @LastEvaluatedBackupArn@
-- is returned.
--
-- 'httpStatus', 'listBackupsResponse_httpStatus' - The response's http status code.
newListBackupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBackupsResponse
newListBackupsResponse :: Int -> ListBackupsResponse
newListBackupsResponse Int
pHttpStatus_ =
  ListBackupsResponse'
    { $sel:backupSummaries:ListBackupsResponse' :: Maybe [BackupSummary]
backupSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastEvaluatedBackupArn:ListBackupsResponse' :: Maybe Text
lastEvaluatedBackupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBackupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of @BackupSummary@ objects.
listBackupsResponse_backupSummaries :: Lens.Lens' ListBackupsResponse (Prelude.Maybe [BackupSummary])
listBackupsResponse_backupSummaries :: Lens' ListBackupsResponse (Maybe [BackupSummary])
listBackupsResponse_backupSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupsResponse' {Maybe [BackupSummary]
backupSummaries :: Maybe [BackupSummary]
$sel:backupSummaries:ListBackupsResponse' :: ListBackupsResponse -> Maybe [BackupSummary]
backupSummaries} -> Maybe [BackupSummary]
backupSummaries) (\s :: ListBackupsResponse
s@ListBackupsResponse' {} Maybe [BackupSummary]
a -> ListBackupsResponse
s {$sel:backupSummaries:ListBackupsResponse' :: Maybe [BackupSummary]
backupSummaries = Maybe [BackupSummary]
a} :: ListBackupsResponse) 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 ARN of the backup last evaluated when the current page of results
-- was returned, inclusive of the current page of results. This value may
-- be specified as the @ExclusiveStartBackupArn@ of a new @ListBackups@
-- operation in order to fetch the next page of results.
--
-- If @LastEvaluatedBackupArn@ is empty, then the last page of results has
-- been processed and there are no more results to be retrieved.
--
-- If @LastEvaluatedBackupArn@ is not empty, this may or may not indicate
-- that there is more data to be returned. All results are guaranteed to
-- have been returned if and only if no value for @LastEvaluatedBackupArn@
-- is returned.
listBackupsResponse_lastEvaluatedBackupArn :: Lens.Lens' ListBackupsResponse (Prelude.Maybe Prelude.Text)
listBackupsResponse_lastEvaluatedBackupArn :: Lens' ListBackupsResponse (Maybe Text)
listBackupsResponse_lastEvaluatedBackupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupsResponse' {Maybe Text
lastEvaluatedBackupArn :: Maybe Text
$sel:lastEvaluatedBackupArn:ListBackupsResponse' :: ListBackupsResponse -> Maybe Text
lastEvaluatedBackupArn} -> Maybe Text
lastEvaluatedBackupArn) (\s :: ListBackupsResponse
s@ListBackupsResponse' {} Maybe Text
a -> ListBackupsResponse
s {$sel:lastEvaluatedBackupArn:ListBackupsResponse' :: Maybe Text
lastEvaluatedBackupArn = Maybe Text
a} :: ListBackupsResponse)

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

instance Prelude.NFData ListBackupsResponse where
  rnf :: ListBackupsResponse -> ()
rnf ListBackupsResponse' {Int
Maybe [BackupSummary]
Maybe Text
httpStatus :: Int
lastEvaluatedBackupArn :: Maybe Text
backupSummaries :: Maybe [BackupSummary]
$sel:httpStatus:ListBackupsResponse' :: ListBackupsResponse -> Int
$sel:lastEvaluatedBackupArn:ListBackupsResponse' :: ListBackupsResponse -> Maybe Text
$sel:backupSummaries:ListBackupsResponse' :: ListBackupsResponse -> Maybe [BackupSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BackupSummary]
backupSummaries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastEvaluatedBackupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus