{-# 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.Backup.ListBackupSelections
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns an array containing metadata of the resources associated with
-- the target backup plan.
--
-- This operation returns paginated results.
module Amazonka.Backup.ListBackupSelections
  ( -- * Creating a Request
    ListBackupSelections (..),
    newListBackupSelections,

    -- * Request Lenses
    listBackupSelections_maxResults,
    listBackupSelections_nextToken,
    listBackupSelections_backupPlanId,

    -- * Destructuring the Response
    ListBackupSelectionsResponse (..),
    newListBackupSelectionsResponse,

    -- * Response Lenses
    listBackupSelectionsResponse_backupSelectionsList,
    listBackupSelectionsResponse_nextToken,
    listBackupSelectionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListBackupSelections' smart constructor.
data ListBackupSelections = ListBackupSelections'
  { -- | The maximum number of items to be returned.
    ListBackupSelections -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The next item following a partial list of returned items. For example,
    -- if a request is made to return @maxResults@ number of items, @NextToken@
    -- allows you to return more items in your list starting at the location
    -- pointed to by the next token.
    ListBackupSelections -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    ListBackupSelections -> Text
backupPlanId :: Prelude.Text
  }
  deriving (ListBackupSelections -> ListBackupSelections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBackupSelections -> ListBackupSelections -> Bool
$c/= :: ListBackupSelections -> ListBackupSelections -> Bool
== :: ListBackupSelections -> ListBackupSelections -> Bool
$c== :: ListBackupSelections -> ListBackupSelections -> Bool
Prelude.Eq, ReadPrec [ListBackupSelections]
ReadPrec ListBackupSelections
Int -> ReadS ListBackupSelections
ReadS [ListBackupSelections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBackupSelections]
$creadListPrec :: ReadPrec [ListBackupSelections]
readPrec :: ReadPrec ListBackupSelections
$creadPrec :: ReadPrec ListBackupSelections
readList :: ReadS [ListBackupSelections]
$creadList :: ReadS [ListBackupSelections]
readsPrec :: Int -> ReadS ListBackupSelections
$creadsPrec :: Int -> ReadS ListBackupSelections
Prelude.Read, Int -> ListBackupSelections -> ShowS
[ListBackupSelections] -> ShowS
ListBackupSelections -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBackupSelections] -> ShowS
$cshowList :: [ListBackupSelections] -> ShowS
show :: ListBackupSelections -> String
$cshow :: ListBackupSelections -> String
showsPrec :: Int -> ListBackupSelections -> ShowS
$cshowsPrec :: Int -> ListBackupSelections -> ShowS
Prelude.Show, forall x. Rep ListBackupSelections x -> ListBackupSelections
forall x. ListBackupSelections -> Rep ListBackupSelections x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBackupSelections x -> ListBackupSelections
$cfrom :: forall x. ListBackupSelections -> Rep ListBackupSelections x
Prelude.Generic)

-- |
-- Create a value of 'ListBackupSelections' 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:
--
-- 'maxResults', 'listBackupSelections_maxResults' - The maximum number of items to be returned.
--
-- 'nextToken', 'listBackupSelections_nextToken' - The next item following a partial list of returned items. For example,
-- if a request is made to return @maxResults@ number of items, @NextToken@
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
--
-- 'backupPlanId', 'listBackupSelections_backupPlanId' - Uniquely identifies a backup plan.
newListBackupSelections ::
  -- | 'backupPlanId'
  Prelude.Text ->
  ListBackupSelections
newListBackupSelections :: Text -> ListBackupSelections
newListBackupSelections Text
pBackupPlanId_ =
  ListBackupSelections'
    { $sel:maxResults:ListBackupSelections' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBackupSelections' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:ListBackupSelections' :: Text
backupPlanId = Text
pBackupPlanId_
    }

-- | The maximum number of items to be returned.
listBackupSelections_maxResults :: Lens.Lens' ListBackupSelections (Prelude.Maybe Prelude.Natural)
listBackupSelections_maxResults :: Lens' ListBackupSelections (Maybe Natural)
listBackupSelections_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupSelections' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListBackupSelections' :: ListBackupSelections -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListBackupSelections
s@ListBackupSelections' {} Maybe Natural
a -> ListBackupSelections
s {$sel:maxResults:ListBackupSelections' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListBackupSelections)

-- | The next item following a partial list of returned items. For example,
-- if a request is made to return @maxResults@ number of items, @NextToken@
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
listBackupSelections_nextToken :: Lens.Lens' ListBackupSelections (Prelude.Maybe Prelude.Text)
listBackupSelections_nextToken :: Lens' ListBackupSelections (Maybe Text)
listBackupSelections_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupSelections' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBackupSelections' :: ListBackupSelections -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBackupSelections
s@ListBackupSelections' {} Maybe Text
a -> ListBackupSelections
s {$sel:nextToken:ListBackupSelections' :: Maybe Text
nextToken = Maybe Text
a} :: ListBackupSelections)

-- | Uniquely identifies a backup plan.
listBackupSelections_backupPlanId :: Lens.Lens' ListBackupSelections Prelude.Text
listBackupSelections_backupPlanId :: Lens' ListBackupSelections Text
listBackupSelections_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupSelections' {Text
backupPlanId :: Text
$sel:backupPlanId:ListBackupSelections' :: ListBackupSelections -> Text
backupPlanId} -> Text
backupPlanId) (\s :: ListBackupSelections
s@ListBackupSelections' {} Text
a -> ListBackupSelections
s {$sel:backupPlanId:ListBackupSelections' :: Text
backupPlanId = Text
a} :: ListBackupSelections)

instance Core.AWSPager ListBackupSelections where
  page :: ListBackupSelections
-> AWSResponse ListBackupSelections -> Maybe ListBackupSelections
page ListBackupSelections
rq AWSResponse ListBackupSelections
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBackupSelections
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBackupSelectionsResponse (Maybe Text)
listBackupSelectionsResponse_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 ListBackupSelections
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListBackupSelectionsResponse (Maybe [BackupSelectionsListMember])
listBackupSelectionsResponse_backupSelectionsList
            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.$ ListBackupSelections
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBackupSelections (Maybe Text)
listBackupSelections_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBackupSelections
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBackupSelectionsResponse (Maybe Text)
listBackupSelectionsResponse_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 ListBackupSelections where
  type
    AWSResponse ListBackupSelections =
      ListBackupSelectionsResponse
  request :: (Service -> Service)
-> ListBackupSelections -> Request ListBackupSelections
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListBackupSelections
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListBackupSelections)))
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 [BackupSelectionsListMember]
-> Maybe Text -> Int -> ListBackupSelectionsResponse
ListBackupSelectionsResponse'
            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
"BackupSelectionsList"
                            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 ListBackupSelections where
  hashWithSalt :: Int -> ListBackupSelections -> Int
hashWithSalt Int
_salt ListBackupSelections' {Maybe Natural
Maybe Text
Text
backupPlanId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:backupPlanId:ListBackupSelections' :: ListBackupSelections -> Text
$sel:nextToken:ListBackupSelections' :: ListBackupSelections -> Maybe Text
$sel:maxResults:ListBackupSelections' :: ListBackupSelections -> Maybe Natural
..} =
    Int
_salt
      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` Text
backupPlanId

instance Prelude.NFData ListBackupSelections where
  rnf :: ListBackupSelections -> ()
rnf ListBackupSelections' {Maybe Natural
Maybe Text
Text
backupPlanId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:backupPlanId:ListBackupSelections' :: ListBackupSelections -> Text
$sel:nextToken:ListBackupSelections' :: ListBackupSelections -> Maybe Text
$sel:maxResults:ListBackupSelections' :: ListBackupSelections -> Maybe Natural
..} =
    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 Text
backupPlanId

instance Data.ToHeaders ListBackupSelections where
  toHeaders :: ListBackupSelections -> 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.ToPath ListBackupSelections where
  toPath :: ListBackupSelections -> ByteString
toPath ListBackupSelections' {Maybe Natural
Maybe Text
Text
backupPlanId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:backupPlanId:ListBackupSelections' :: ListBackupSelections -> Text
$sel:nextToken:ListBackupSelections' :: ListBackupSelections -> Maybe Text
$sel:maxResults:ListBackupSelections' :: ListBackupSelections -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup/plans/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupPlanId,
        ByteString
"/selections/"
      ]

instance Data.ToQuery ListBackupSelections where
  toQuery :: ListBackupSelections -> QueryString
toQuery ListBackupSelections' {Maybe Natural
Maybe Text
Text
backupPlanId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:backupPlanId:ListBackupSelections' :: ListBackupSelections -> Text
$sel:nextToken:ListBackupSelections' :: ListBackupSelections -> Maybe Text
$sel:maxResults:ListBackupSelections' :: ListBackupSelections -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListBackupSelectionsResponse' smart constructor.
data ListBackupSelectionsResponse = ListBackupSelectionsResponse'
  { -- | An array of backup selection list items containing metadata about each
    -- resource in the list.
    ListBackupSelectionsResponse -> Maybe [BackupSelectionsListMember]
backupSelectionsList :: Prelude.Maybe [BackupSelectionsListMember],
    -- | The next item following a partial list of returned items. For example,
    -- if a request is made to return @maxResults@ number of items, @NextToken@
    -- allows you to return more items in your list starting at the location
    -- pointed to by the next token.
    ListBackupSelectionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBackupSelectionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBackupSelectionsResponse
-> ListBackupSelectionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBackupSelectionsResponse
-> ListBackupSelectionsResponse -> Bool
$c/= :: ListBackupSelectionsResponse
-> ListBackupSelectionsResponse -> Bool
== :: ListBackupSelectionsResponse
-> ListBackupSelectionsResponse -> Bool
$c== :: ListBackupSelectionsResponse
-> ListBackupSelectionsResponse -> Bool
Prelude.Eq, ReadPrec [ListBackupSelectionsResponse]
ReadPrec ListBackupSelectionsResponse
Int -> ReadS ListBackupSelectionsResponse
ReadS [ListBackupSelectionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBackupSelectionsResponse]
$creadListPrec :: ReadPrec [ListBackupSelectionsResponse]
readPrec :: ReadPrec ListBackupSelectionsResponse
$creadPrec :: ReadPrec ListBackupSelectionsResponse
readList :: ReadS [ListBackupSelectionsResponse]
$creadList :: ReadS [ListBackupSelectionsResponse]
readsPrec :: Int -> ReadS ListBackupSelectionsResponse
$creadsPrec :: Int -> ReadS ListBackupSelectionsResponse
Prelude.Read, Int -> ListBackupSelectionsResponse -> ShowS
[ListBackupSelectionsResponse] -> ShowS
ListBackupSelectionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBackupSelectionsResponse] -> ShowS
$cshowList :: [ListBackupSelectionsResponse] -> ShowS
show :: ListBackupSelectionsResponse -> String
$cshow :: ListBackupSelectionsResponse -> String
showsPrec :: Int -> ListBackupSelectionsResponse -> ShowS
$cshowsPrec :: Int -> ListBackupSelectionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListBackupSelectionsResponse x -> ListBackupSelectionsResponse
forall x.
ListBackupSelectionsResponse -> Rep ListBackupSelectionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListBackupSelectionsResponse x -> ListBackupSelectionsResponse
$cfrom :: forall x.
ListBackupSelectionsResponse -> Rep ListBackupSelectionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBackupSelectionsResponse' 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:
--
-- 'backupSelectionsList', 'listBackupSelectionsResponse_backupSelectionsList' - An array of backup selection list items containing metadata about each
-- resource in the list.
--
-- 'nextToken', 'listBackupSelectionsResponse_nextToken' - The next item following a partial list of returned items. For example,
-- if a request is made to return @maxResults@ number of items, @NextToken@
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
--
-- 'httpStatus', 'listBackupSelectionsResponse_httpStatus' - The response's http status code.
newListBackupSelectionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBackupSelectionsResponse
newListBackupSelectionsResponse :: Int -> ListBackupSelectionsResponse
newListBackupSelectionsResponse Int
pHttpStatus_ =
  ListBackupSelectionsResponse'
    { $sel:backupSelectionsList:ListBackupSelectionsResponse' :: Maybe [BackupSelectionsListMember]
backupSelectionsList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBackupSelectionsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBackupSelectionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of backup selection list items containing metadata about each
-- resource in the list.
listBackupSelectionsResponse_backupSelectionsList :: Lens.Lens' ListBackupSelectionsResponse (Prelude.Maybe [BackupSelectionsListMember])
listBackupSelectionsResponse_backupSelectionsList :: Lens'
  ListBackupSelectionsResponse (Maybe [BackupSelectionsListMember])
listBackupSelectionsResponse_backupSelectionsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupSelectionsResponse' {Maybe [BackupSelectionsListMember]
backupSelectionsList :: Maybe [BackupSelectionsListMember]
$sel:backupSelectionsList:ListBackupSelectionsResponse' :: ListBackupSelectionsResponse -> Maybe [BackupSelectionsListMember]
backupSelectionsList} -> Maybe [BackupSelectionsListMember]
backupSelectionsList) (\s :: ListBackupSelectionsResponse
s@ListBackupSelectionsResponse' {} Maybe [BackupSelectionsListMember]
a -> ListBackupSelectionsResponse
s {$sel:backupSelectionsList:ListBackupSelectionsResponse' :: Maybe [BackupSelectionsListMember]
backupSelectionsList = Maybe [BackupSelectionsListMember]
a} :: ListBackupSelectionsResponse) 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 next item following a partial list of returned items. For example,
-- if a request is made to return @maxResults@ number of items, @NextToken@
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
listBackupSelectionsResponse_nextToken :: Lens.Lens' ListBackupSelectionsResponse (Prelude.Maybe Prelude.Text)
listBackupSelectionsResponse_nextToken :: Lens' ListBackupSelectionsResponse (Maybe Text)
listBackupSelectionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBackupSelectionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBackupSelectionsResponse' :: ListBackupSelectionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBackupSelectionsResponse
s@ListBackupSelectionsResponse' {} Maybe Text
a -> ListBackupSelectionsResponse
s {$sel:nextToken:ListBackupSelectionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBackupSelectionsResponse)

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

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