{-# 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.Glacier.ListVaults
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation lists all vaults owned by the calling user\'s account.
-- The list returned in the response is ASCII-sorted by vault name.
--
-- By default, this operation returns up to 10 items. If there are more
-- vaults to list, the response @marker@ field contains the vault Amazon
-- Resource Name (ARN) at which to continue the list with a new List Vaults
-- request; otherwise, the @marker@ field is @null@. To return a list of
-- vaults that begins at a specific vault, set the @marker@ request
-- parameter to the vault ARN you obtained from a previous List Vaults
-- request. You can also limit the number of vaults returned in the
-- response by specifying the @limit@ parameter in the request.
--
-- An AWS account has full permission to perform all operations (actions).
-- However, AWS Identity and Access Management (IAM) users don\'t have any
-- permissions by default. You must grant them explicit permission to
-- perform specific actions. For more information, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/using-iam-with-amazon-glacier.html Access Control Using AWS Identity and Access Management (IAM)>.
--
-- For conceptual information and underlying REST API, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/retrieving-vault-info.html Retrieving Vault Metadata in Amazon S3 Glacier>
-- and
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-vaults-get.html List Vaults>
-- in the /Amazon Glacier Developer Guide/.
--
-- This operation returns paginated results.
module Amazonka.Glacier.ListVaults
  ( -- * Creating a Request
    ListVaults (..),
    newListVaults,

    -- * Request Lenses
    listVaults_limit,
    listVaults_marker,
    listVaults_accountId,

    -- * Destructuring the Response
    ListVaultsResponse (..),
    newListVaultsResponse,

    -- * Response Lenses
    listVaultsResponse_marker,
    listVaultsResponse_vaultList,
    listVaultsResponse_httpStatus,
  )
where

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

-- | Provides options to retrieve the vault list owned by the calling user\'s
-- account. The list provides metadata information for each vault.
--
-- /See:/ 'newListVaults' smart constructor.
data ListVaults = ListVaults'
  { -- | The maximum number of vaults to be returned. The default limit is 10.
    -- The number of vaults returned might be fewer than the specified limit,
    -- but the number of returned vaults never exceeds the limit.
    ListVaults -> Maybe Text
limit :: Prelude.Maybe Prelude.Text,
    -- | A string used for pagination. The marker specifies the vault ARN after
    -- which the listing of vaults should begin.
    ListVaults -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The @AccountId@ value is the AWS account ID. This value must match the
    -- AWS account ID associated with the credentials used to sign the request.
    -- You can either specify an AWS account ID or optionally a single \'@-@\'
    -- (hyphen), in which case Amazon Glacier uses the AWS account ID
    -- associated with the credentials used to sign the request. If you specify
    -- your account ID, do not include any hyphens (\'-\') in the ID.
    ListVaults -> Text
accountId :: Prelude.Text
  }
  deriving (ListVaults -> ListVaults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVaults -> ListVaults -> Bool
$c/= :: ListVaults -> ListVaults -> Bool
== :: ListVaults -> ListVaults -> Bool
$c== :: ListVaults -> ListVaults -> Bool
Prelude.Eq, ReadPrec [ListVaults]
ReadPrec ListVaults
Int -> ReadS ListVaults
ReadS [ListVaults]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVaults]
$creadListPrec :: ReadPrec [ListVaults]
readPrec :: ReadPrec ListVaults
$creadPrec :: ReadPrec ListVaults
readList :: ReadS [ListVaults]
$creadList :: ReadS [ListVaults]
readsPrec :: Int -> ReadS ListVaults
$creadsPrec :: Int -> ReadS ListVaults
Prelude.Read, Int -> ListVaults -> ShowS
[ListVaults] -> ShowS
ListVaults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVaults] -> ShowS
$cshowList :: [ListVaults] -> ShowS
show :: ListVaults -> String
$cshow :: ListVaults -> String
showsPrec :: Int -> ListVaults -> ShowS
$cshowsPrec :: Int -> ListVaults -> ShowS
Prelude.Show, forall x. Rep ListVaults x -> ListVaults
forall x. ListVaults -> Rep ListVaults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListVaults x -> ListVaults
$cfrom :: forall x. ListVaults -> Rep ListVaults x
Prelude.Generic)

-- |
-- Create a value of 'ListVaults' 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:
--
-- 'limit', 'listVaults_limit' - The maximum number of vaults to be returned. The default limit is 10.
-- The number of vaults returned might be fewer than the specified limit,
-- but the number of returned vaults never exceeds the limit.
--
-- 'marker', 'listVaults_marker' - A string used for pagination. The marker specifies the vault ARN after
-- which the listing of vaults should begin.
--
-- 'accountId', 'listVaults_accountId' - The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
newListVaults ::
  -- | 'accountId'
  Prelude.Text ->
  ListVaults
newListVaults :: Text -> ListVaults
newListVaults Text
pAccountId_ =
  ListVaults'
    { $sel:limit:ListVaults' :: Maybe Text
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListVaults' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:ListVaults' :: Text
accountId = Text
pAccountId_
    }

-- | The maximum number of vaults to be returned. The default limit is 10.
-- The number of vaults returned might be fewer than the specified limit,
-- but the number of returned vaults never exceeds the limit.
listVaults_limit :: Lens.Lens' ListVaults (Prelude.Maybe Prelude.Text)
listVaults_limit :: Lens' ListVaults (Maybe Text)
listVaults_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaults' {Maybe Text
limit :: Maybe Text
$sel:limit:ListVaults' :: ListVaults -> Maybe Text
limit} -> Maybe Text
limit) (\s :: ListVaults
s@ListVaults' {} Maybe Text
a -> ListVaults
s {$sel:limit:ListVaults' :: Maybe Text
limit = Maybe Text
a} :: ListVaults)

-- | A string used for pagination. The marker specifies the vault ARN after
-- which the listing of vaults should begin.
listVaults_marker :: Lens.Lens' ListVaults (Prelude.Maybe Prelude.Text)
listVaults_marker :: Lens' ListVaults (Maybe Text)
listVaults_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaults' {Maybe Text
marker :: Maybe Text
$sel:marker:ListVaults' :: ListVaults -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListVaults
s@ListVaults' {} Maybe Text
a -> ListVaults
s {$sel:marker:ListVaults' :: Maybe Text
marker = Maybe Text
a} :: ListVaults)

-- | The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
listVaults_accountId :: Lens.Lens' ListVaults Prelude.Text
listVaults_accountId :: Lens' ListVaults Text
listVaults_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaults' {Text
accountId :: Text
$sel:accountId:ListVaults' :: ListVaults -> Text
accountId} -> Text
accountId) (\s :: ListVaults
s@ListVaults' {} Text
a -> ListVaults
s {$sel:accountId:ListVaults' :: Text
accountId = Text
a} :: ListVaults)

instance Core.AWSPager ListVaults where
  page :: ListVaults -> AWSResponse ListVaults -> Maybe ListVaults
page ListVaults
rq AWSResponse ListVaults
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListVaults
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListVaultsResponse (Maybe Text)
listVaultsResponse_marker
            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 ListVaults
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListVaultsResponse (Maybe [DescribeVaultOutput])
listVaultsResponse_vaultList
            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.$ ListVaults
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListVaults (Maybe Text)
listVaults_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListVaults
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListVaultsResponse (Maybe Text)
listVaultsResponse_marker
          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 ListVaults where
  type AWSResponse ListVaults = ListVaultsResponse
  request :: (Service -> Service) -> ListVaults -> Request ListVaults
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 ListVaults
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListVaults)))
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 Text
-> Maybe [DescribeVaultOutput] -> Int -> ListVaultsResponse
ListVaultsResponse'
            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
"Marker")
            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
"VaultList" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListVaults where
  hashWithSalt :: Int -> ListVaults -> Int
hashWithSalt Int
_salt ListVaults' {Maybe Text
Text
accountId :: Text
marker :: Maybe Text
limit :: Maybe Text
$sel:accountId:ListVaults' :: ListVaults -> Text
$sel:marker:ListVaults' :: ListVaults -> Maybe Text
$sel:limit:ListVaults' :: ListVaults -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId

instance Prelude.NFData ListVaults where
  rnf :: ListVaults -> ()
rnf ListVaults' {Maybe Text
Text
accountId :: Text
marker :: Maybe Text
limit :: Maybe Text
$sel:accountId:ListVaults' :: ListVaults -> Text
$sel:marker:ListVaults' :: ListVaults -> Maybe Text
$sel:limit:ListVaults' :: ListVaults -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId

instance Data.ToHeaders ListVaults where
  toHeaders :: ListVaults -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListVaults where
  toPath :: ListVaults -> ByteString
toPath ListVaults' {Maybe Text
Text
accountId :: Text
marker :: Maybe Text
limit :: Maybe Text
$sel:accountId:ListVaults' :: ListVaults -> Text
$sel:marker:ListVaults' :: ListVaults -> Maybe Text
$sel:limit:ListVaults' :: ListVaults -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId, ByteString
"/vaults"]

instance Data.ToQuery ListVaults where
  toQuery :: ListVaults -> QueryString
toQuery ListVaults' {Maybe Text
Text
accountId :: Text
marker :: Maybe Text
limit :: Maybe Text
$sel:accountId:ListVaults' :: ListVaults -> Text
$sel:marker:ListVaults' :: ListVaults -> Maybe Text
$sel:limit:ListVaults' :: ListVaults -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
limit, ByteString
"marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker]

-- | Contains the Amazon S3 Glacier response to your request.
--
-- /See:/ 'newListVaultsResponse' smart constructor.
data ListVaultsResponse = ListVaultsResponse'
  { -- | The vault ARN at which to continue pagination of the results. You use
    -- the marker in another List Vaults request to obtain more vaults in the
    -- list.
    ListVaultsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | List of vaults.
    ListVaultsResponse -> Maybe [DescribeVaultOutput]
vaultList :: Prelude.Maybe [DescribeVaultOutput],
    -- | The response's http status code.
    ListVaultsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListVaultsResponse -> ListVaultsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVaultsResponse -> ListVaultsResponse -> Bool
$c/= :: ListVaultsResponse -> ListVaultsResponse -> Bool
== :: ListVaultsResponse -> ListVaultsResponse -> Bool
$c== :: ListVaultsResponse -> ListVaultsResponse -> Bool
Prelude.Eq, ReadPrec [ListVaultsResponse]
ReadPrec ListVaultsResponse
Int -> ReadS ListVaultsResponse
ReadS [ListVaultsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVaultsResponse]
$creadListPrec :: ReadPrec [ListVaultsResponse]
readPrec :: ReadPrec ListVaultsResponse
$creadPrec :: ReadPrec ListVaultsResponse
readList :: ReadS [ListVaultsResponse]
$creadList :: ReadS [ListVaultsResponse]
readsPrec :: Int -> ReadS ListVaultsResponse
$creadsPrec :: Int -> ReadS ListVaultsResponse
Prelude.Read, Int -> ListVaultsResponse -> ShowS
[ListVaultsResponse] -> ShowS
ListVaultsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVaultsResponse] -> ShowS
$cshowList :: [ListVaultsResponse] -> ShowS
show :: ListVaultsResponse -> String
$cshow :: ListVaultsResponse -> String
showsPrec :: Int -> ListVaultsResponse -> ShowS
$cshowsPrec :: Int -> ListVaultsResponse -> ShowS
Prelude.Show, forall x. Rep ListVaultsResponse x -> ListVaultsResponse
forall x. ListVaultsResponse -> Rep ListVaultsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListVaultsResponse x -> ListVaultsResponse
$cfrom :: forall x. ListVaultsResponse -> Rep ListVaultsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListVaultsResponse' 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:
--
-- 'marker', 'listVaultsResponse_marker' - The vault ARN at which to continue pagination of the results. You use
-- the marker in another List Vaults request to obtain more vaults in the
-- list.
--
-- 'vaultList', 'listVaultsResponse_vaultList' - List of vaults.
--
-- 'httpStatus', 'listVaultsResponse_httpStatus' - The response's http status code.
newListVaultsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListVaultsResponse
newListVaultsResponse :: Int -> ListVaultsResponse
newListVaultsResponse Int
pHttpStatus_ =
  ListVaultsResponse'
    { $sel:marker:ListVaultsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:vaultList:ListVaultsResponse' :: Maybe [DescribeVaultOutput]
vaultList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListVaultsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The vault ARN at which to continue pagination of the results. You use
-- the marker in another List Vaults request to obtain more vaults in the
-- list.
listVaultsResponse_marker :: Lens.Lens' ListVaultsResponse (Prelude.Maybe Prelude.Text)
listVaultsResponse_marker :: Lens' ListVaultsResponse (Maybe Text)
listVaultsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaultsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListVaultsResponse' :: ListVaultsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListVaultsResponse
s@ListVaultsResponse' {} Maybe Text
a -> ListVaultsResponse
s {$sel:marker:ListVaultsResponse' :: Maybe Text
marker = Maybe Text
a} :: ListVaultsResponse)

-- | List of vaults.
listVaultsResponse_vaultList :: Lens.Lens' ListVaultsResponse (Prelude.Maybe [DescribeVaultOutput])
listVaultsResponse_vaultList :: Lens' ListVaultsResponse (Maybe [DescribeVaultOutput])
listVaultsResponse_vaultList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaultsResponse' {Maybe [DescribeVaultOutput]
vaultList :: Maybe [DescribeVaultOutput]
$sel:vaultList:ListVaultsResponse' :: ListVaultsResponse -> Maybe [DescribeVaultOutput]
vaultList} -> Maybe [DescribeVaultOutput]
vaultList) (\s :: ListVaultsResponse
s@ListVaultsResponse' {} Maybe [DescribeVaultOutput]
a -> ListVaultsResponse
s {$sel:vaultList:ListVaultsResponse' :: Maybe [DescribeVaultOutput]
vaultList = Maybe [DescribeVaultOutput]
a} :: ListVaultsResponse) 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.
listVaultsResponse_httpStatus :: Lens.Lens' ListVaultsResponse Prelude.Int
listVaultsResponse_httpStatus :: Lens' ListVaultsResponse Int
listVaultsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVaultsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListVaultsResponse' :: ListVaultsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListVaultsResponse
s@ListVaultsResponse' {} Int
a -> ListVaultsResponse
s {$sel:httpStatus:ListVaultsResponse' :: Int
httpStatus = Int
a} :: ListVaultsResponse)

instance Prelude.NFData ListVaultsResponse where
  rnf :: ListVaultsResponse -> ()
rnf ListVaultsResponse' {Int
Maybe [DescribeVaultOutput]
Maybe Text
httpStatus :: Int
vaultList :: Maybe [DescribeVaultOutput]
marker :: Maybe Text
$sel:httpStatus:ListVaultsResponse' :: ListVaultsResponse -> Int
$sel:vaultList:ListVaultsResponse' :: ListVaultsResponse -> Maybe [DescribeVaultOutput]
$sel:marker:ListVaultsResponse' :: ListVaultsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DescribeVaultOutput]
vaultList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus