{-# 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.Mobile.ListBundles
-- 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 all available bundles.
--
-- This operation returns paginated results.
module Amazonka.Mobile.ListBundles
  ( -- * Creating a Request
    ListBundles (..),
    newListBundles,

    -- * Request Lenses
    listBundles_maxResults,
    listBundles_nextToken,

    -- * Destructuring the Response
    ListBundlesResponse (..),
    newListBundlesResponse,

    -- * Response Lenses
    listBundlesResponse_bundleList,
    listBundlesResponse_nextToken,
    listBundlesResponse_httpStatus,
  )
where

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

-- | Request structure to request all available bundles.
--
-- /See:/ 'newListBundles' smart constructor.
data ListBundles = ListBundles'
  { -- | Maximum number of records to list in a single response.
    ListBundles -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Pagination token. Set to null to start listing bundles from start. If
    -- non-null pagination token is returned in a result, then pass its value
    -- in here in another request to list more bundles.
    ListBundles -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListBundles -> ListBundles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBundles -> ListBundles -> Bool
$c/= :: ListBundles -> ListBundles -> Bool
== :: ListBundles -> ListBundles -> Bool
$c== :: ListBundles -> ListBundles -> Bool
Prelude.Eq, ReadPrec [ListBundles]
ReadPrec ListBundles
Int -> ReadS ListBundles
ReadS [ListBundles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBundles]
$creadListPrec :: ReadPrec [ListBundles]
readPrec :: ReadPrec ListBundles
$creadPrec :: ReadPrec ListBundles
readList :: ReadS [ListBundles]
$creadList :: ReadS [ListBundles]
readsPrec :: Int -> ReadS ListBundles
$creadsPrec :: Int -> ReadS ListBundles
Prelude.Read, Int -> ListBundles -> ShowS
[ListBundles] -> ShowS
ListBundles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBundles] -> ShowS
$cshowList :: [ListBundles] -> ShowS
show :: ListBundles -> String
$cshow :: ListBundles -> String
showsPrec :: Int -> ListBundles -> ShowS
$cshowsPrec :: Int -> ListBundles -> ShowS
Prelude.Show, forall x. Rep ListBundles x -> ListBundles
forall x. ListBundles -> Rep ListBundles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBundles x -> ListBundles
$cfrom :: forall x. ListBundles -> Rep ListBundles x
Prelude.Generic)

-- |
-- Create a value of 'ListBundles' 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', 'listBundles_maxResults' - Maximum number of records to list in a single response.
--
-- 'nextToken', 'listBundles_nextToken' - Pagination token. Set to null to start listing bundles from start. If
-- non-null pagination token is returned in a result, then pass its value
-- in here in another request to list more bundles.
newListBundles ::
  ListBundles
newListBundles :: ListBundles
newListBundles =
  ListBundles'
    { $sel:maxResults:ListBundles' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBundles' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Maximum number of records to list in a single response.
listBundles_maxResults :: Lens.Lens' ListBundles (Prelude.Maybe Prelude.Int)
listBundles_maxResults :: Lens' ListBundles (Maybe Int)
listBundles_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBundles' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListBundles' :: ListBundles -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListBundles
s@ListBundles' {} Maybe Int
a -> ListBundles
s {$sel:maxResults:ListBundles' :: Maybe Int
maxResults = Maybe Int
a} :: ListBundles)

-- | Pagination token. Set to null to start listing bundles from start. If
-- non-null pagination token is returned in a result, then pass its value
-- in here in another request to list more bundles.
listBundles_nextToken :: Lens.Lens' ListBundles (Prelude.Maybe Prelude.Text)
listBundles_nextToken :: Lens' ListBundles (Maybe Text)
listBundles_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBundles' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBundles' :: ListBundles -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBundles
s@ListBundles' {} Maybe Text
a -> ListBundles
s {$sel:nextToken:ListBundles' :: Maybe Text
nextToken = Maybe Text
a} :: ListBundles)

instance Core.AWSPager ListBundles where
  page :: ListBundles -> AWSResponse ListBundles -> Maybe ListBundles
page ListBundles
rq AWSResponse ListBundles
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBundles
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBundlesResponse (Maybe Text)
listBundlesResponse_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 ListBundles
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBundlesResponse (Maybe [BundleDetails])
listBundlesResponse_bundleList
            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.$ ListBundles
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBundles (Maybe Text)
listBundles_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBundles
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBundlesResponse (Maybe Text)
listBundlesResponse_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 ListBundles where
  type AWSResponse ListBundles = ListBundlesResponse
  request :: (Service -> Service) -> ListBundles -> Request ListBundles
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 ListBundles
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListBundles)))
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 [BundleDetails] -> Maybe Text -> Int -> ListBundlesResponse
ListBundlesResponse'
            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
"bundleList" 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 ListBundles where
  hashWithSalt :: Int -> ListBundles -> Int
hashWithSalt Int
_salt ListBundles' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListBundles' :: ListBundles -> Maybe Text
$sel:maxResults:ListBundles' :: ListBundles -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListBundles where
  rnf :: ListBundles -> ()
rnf ListBundles' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListBundles' :: ListBundles -> Maybe Text
$sel:maxResults:ListBundles' :: ListBundles -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListBundles where
  toHeaders :: ListBundles -> 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 ListBundles where
  toPath :: ListBundles -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/bundles"

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

-- | Result structure contains a list of all available bundles with details.
--
-- /See:/ 'newListBundlesResponse' smart constructor.
data ListBundlesResponse = ListBundlesResponse'
  { -- | A list of bundles.
    ListBundlesResponse -> Maybe [BundleDetails]
bundleList :: Prelude.Maybe [BundleDetails],
    -- | Pagination token. If non-null pagination token is returned in a result,
    -- then pass its value in another request to fetch more entries.
    ListBundlesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBundlesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBundlesResponse -> ListBundlesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBundlesResponse -> ListBundlesResponse -> Bool
$c/= :: ListBundlesResponse -> ListBundlesResponse -> Bool
== :: ListBundlesResponse -> ListBundlesResponse -> Bool
$c== :: ListBundlesResponse -> ListBundlesResponse -> Bool
Prelude.Eq, ReadPrec [ListBundlesResponse]
ReadPrec ListBundlesResponse
Int -> ReadS ListBundlesResponse
ReadS [ListBundlesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBundlesResponse]
$creadListPrec :: ReadPrec [ListBundlesResponse]
readPrec :: ReadPrec ListBundlesResponse
$creadPrec :: ReadPrec ListBundlesResponse
readList :: ReadS [ListBundlesResponse]
$creadList :: ReadS [ListBundlesResponse]
readsPrec :: Int -> ReadS ListBundlesResponse
$creadsPrec :: Int -> ReadS ListBundlesResponse
Prelude.Read, Int -> ListBundlesResponse -> ShowS
[ListBundlesResponse] -> ShowS
ListBundlesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBundlesResponse] -> ShowS
$cshowList :: [ListBundlesResponse] -> ShowS
show :: ListBundlesResponse -> String
$cshow :: ListBundlesResponse -> String
showsPrec :: Int -> ListBundlesResponse -> ShowS
$cshowsPrec :: Int -> ListBundlesResponse -> ShowS
Prelude.Show, forall x. Rep ListBundlesResponse x -> ListBundlesResponse
forall x. ListBundlesResponse -> Rep ListBundlesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBundlesResponse x -> ListBundlesResponse
$cfrom :: forall x. ListBundlesResponse -> Rep ListBundlesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBundlesResponse' 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:
--
-- 'bundleList', 'listBundlesResponse_bundleList' - A list of bundles.
--
-- 'nextToken', 'listBundlesResponse_nextToken' - Pagination token. If non-null pagination token is returned in a result,
-- then pass its value in another request to fetch more entries.
--
-- 'httpStatus', 'listBundlesResponse_httpStatus' - The response's http status code.
newListBundlesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBundlesResponse
newListBundlesResponse :: Int -> ListBundlesResponse
newListBundlesResponse Int
pHttpStatus_ =
  ListBundlesResponse'
    { $sel:bundleList:ListBundlesResponse' :: Maybe [BundleDetails]
bundleList = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBundlesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBundlesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of bundles.
listBundlesResponse_bundleList :: Lens.Lens' ListBundlesResponse (Prelude.Maybe [BundleDetails])
listBundlesResponse_bundleList :: Lens' ListBundlesResponse (Maybe [BundleDetails])
listBundlesResponse_bundleList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBundlesResponse' {Maybe [BundleDetails]
bundleList :: Maybe [BundleDetails]
$sel:bundleList:ListBundlesResponse' :: ListBundlesResponse -> Maybe [BundleDetails]
bundleList} -> Maybe [BundleDetails]
bundleList) (\s :: ListBundlesResponse
s@ListBundlesResponse' {} Maybe [BundleDetails]
a -> ListBundlesResponse
s {$sel:bundleList:ListBundlesResponse' :: Maybe [BundleDetails]
bundleList = Maybe [BundleDetails]
a} :: ListBundlesResponse) 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

-- | Pagination token. If non-null pagination token is returned in a result,
-- then pass its value in another request to fetch more entries.
listBundlesResponse_nextToken :: Lens.Lens' ListBundlesResponse (Prelude.Maybe Prelude.Text)
listBundlesResponse_nextToken :: Lens' ListBundlesResponse (Maybe Text)
listBundlesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBundlesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBundlesResponse' :: ListBundlesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBundlesResponse
s@ListBundlesResponse' {} Maybe Text
a -> ListBundlesResponse
s {$sel:nextToken:ListBundlesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBundlesResponse)

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

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