{-# 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.CodeBuild.ListBuildBatchesForProject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the identifiers of the build batches for a specific project.
--
-- This operation returns paginated results.
module Amazonka.CodeBuild.ListBuildBatchesForProject
  ( -- * Creating a Request
    ListBuildBatchesForProject (..),
    newListBuildBatchesForProject,

    -- * Request Lenses
    listBuildBatchesForProject_filter,
    listBuildBatchesForProject_maxResults,
    listBuildBatchesForProject_nextToken,
    listBuildBatchesForProject_projectName,
    listBuildBatchesForProject_sortOrder,

    -- * Destructuring the Response
    ListBuildBatchesForProjectResponse (..),
    newListBuildBatchesForProjectResponse,

    -- * Response Lenses
    listBuildBatchesForProjectResponse_ids,
    listBuildBatchesForProjectResponse_nextToken,
    listBuildBatchesForProjectResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.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:/ 'newListBuildBatchesForProject' smart constructor.
data ListBuildBatchesForProject = ListBuildBatchesForProject'
  { -- | A @BuildBatchFilter@ object that specifies the filters for the search.
    ListBuildBatchesForProject -> Maybe BuildBatchFilter
filter' :: Prelude.Maybe BuildBatchFilter,
    -- | The maximum number of results to return.
    ListBuildBatchesForProject -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ value returned from a previous call to
    -- @ListBuildBatchesForProject@. This specifies the next item to return. To
    -- return the beginning of the list, exclude this parameter.
    ListBuildBatchesForProject -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the project.
    ListBuildBatchesForProject -> Maybe Text
projectName :: Prelude.Maybe Prelude.Text,
    -- | Specifies the sort order of the returned items. Valid values include:
    --
    -- -   @ASCENDING@: List the batch build identifiers in ascending order by
    --     identifier.
    --
    -- -   @DESCENDING@: List the batch build identifiers in descending order
    --     by identifier.
    ListBuildBatchesForProject -> Maybe SortOrderType
sortOrder :: Prelude.Maybe SortOrderType
  }
  deriving (ListBuildBatchesForProject -> ListBuildBatchesForProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuildBatchesForProject -> ListBuildBatchesForProject -> Bool
$c/= :: ListBuildBatchesForProject -> ListBuildBatchesForProject -> Bool
== :: ListBuildBatchesForProject -> ListBuildBatchesForProject -> Bool
$c== :: ListBuildBatchesForProject -> ListBuildBatchesForProject -> Bool
Prelude.Eq, ReadPrec [ListBuildBatchesForProject]
ReadPrec ListBuildBatchesForProject
Int -> ReadS ListBuildBatchesForProject
ReadS [ListBuildBatchesForProject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuildBatchesForProject]
$creadListPrec :: ReadPrec [ListBuildBatchesForProject]
readPrec :: ReadPrec ListBuildBatchesForProject
$creadPrec :: ReadPrec ListBuildBatchesForProject
readList :: ReadS [ListBuildBatchesForProject]
$creadList :: ReadS [ListBuildBatchesForProject]
readsPrec :: Int -> ReadS ListBuildBatchesForProject
$creadsPrec :: Int -> ReadS ListBuildBatchesForProject
Prelude.Read, Int -> ListBuildBatchesForProject -> ShowS
[ListBuildBatchesForProject] -> ShowS
ListBuildBatchesForProject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuildBatchesForProject] -> ShowS
$cshowList :: [ListBuildBatchesForProject] -> ShowS
show :: ListBuildBatchesForProject -> String
$cshow :: ListBuildBatchesForProject -> String
showsPrec :: Int -> ListBuildBatchesForProject -> ShowS
$cshowsPrec :: Int -> ListBuildBatchesForProject -> ShowS
Prelude.Show, forall x.
Rep ListBuildBatchesForProject x -> ListBuildBatchesForProject
forall x.
ListBuildBatchesForProject -> Rep ListBuildBatchesForProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListBuildBatchesForProject x -> ListBuildBatchesForProject
$cfrom :: forall x.
ListBuildBatchesForProject -> Rep ListBuildBatchesForProject x
Prelude.Generic)

-- |
-- Create a value of 'ListBuildBatchesForProject' 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:
--
-- 'filter'', 'listBuildBatchesForProject_filter' - A @BuildBatchFilter@ object that specifies the filters for the search.
--
-- 'maxResults', 'listBuildBatchesForProject_maxResults' - The maximum number of results to return.
--
-- 'nextToken', 'listBuildBatchesForProject_nextToken' - The @nextToken@ value returned from a previous call to
-- @ListBuildBatchesForProject@. This specifies the next item to return. To
-- return the beginning of the list, exclude this parameter.
--
-- 'projectName', 'listBuildBatchesForProject_projectName' - The name of the project.
--
-- 'sortOrder', 'listBuildBatchesForProject_sortOrder' - Specifies the sort order of the returned items. Valid values include:
--
-- -   @ASCENDING@: List the batch build identifiers in ascending order by
--     identifier.
--
-- -   @DESCENDING@: List the batch build identifiers in descending order
--     by identifier.
newListBuildBatchesForProject ::
  ListBuildBatchesForProject
newListBuildBatchesForProject :: ListBuildBatchesForProject
newListBuildBatchesForProject =
  ListBuildBatchesForProject'
    { $sel:filter':ListBuildBatchesForProject' :: Maybe BuildBatchFilter
filter' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListBuildBatchesForProject' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuildBatchesForProject' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:projectName:ListBuildBatchesForProject' :: Maybe Text
projectName = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListBuildBatchesForProject' :: Maybe SortOrderType
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | A @BuildBatchFilter@ object that specifies the filters for the search.
listBuildBatchesForProject_filter :: Lens.Lens' ListBuildBatchesForProject (Prelude.Maybe BuildBatchFilter)
listBuildBatchesForProject_filter :: Lens' ListBuildBatchesForProject (Maybe BuildBatchFilter)
listBuildBatchesForProject_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProject' {Maybe BuildBatchFilter
filter' :: Maybe BuildBatchFilter
$sel:filter':ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe BuildBatchFilter
filter'} -> Maybe BuildBatchFilter
filter') (\s :: ListBuildBatchesForProject
s@ListBuildBatchesForProject' {} Maybe BuildBatchFilter
a -> ListBuildBatchesForProject
s {$sel:filter':ListBuildBatchesForProject' :: Maybe BuildBatchFilter
filter' = Maybe BuildBatchFilter
a} :: ListBuildBatchesForProject)

-- | The maximum number of results to return.
listBuildBatchesForProject_maxResults :: Lens.Lens' ListBuildBatchesForProject (Prelude.Maybe Prelude.Natural)
listBuildBatchesForProject_maxResults :: Lens' ListBuildBatchesForProject (Maybe Natural)
listBuildBatchesForProject_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProject' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListBuildBatchesForProject
s@ListBuildBatchesForProject' {} Maybe Natural
a -> ListBuildBatchesForProject
s {$sel:maxResults:ListBuildBatchesForProject' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListBuildBatchesForProject)

-- | The @nextToken@ value returned from a previous call to
-- @ListBuildBatchesForProject@. This specifies the next item to return. To
-- return the beginning of the list, exclude this parameter.
listBuildBatchesForProject_nextToken :: Lens.Lens' ListBuildBatchesForProject (Prelude.Maybe Prelude.Text)
listBuildBatchesForProject_nextToken :: Lens' ListBuildBatchesForProject (Maybe Text)
listBuildBatchesForProject_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProject' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuildBatchesForProject
s@ListBuildBatchesForProject' {} Maybe Text
a -> ListBuildBatchesForProject
s {$sel:nextToken:ListBuildBatchesForProject' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuildBatchesForProject)

-- | The name of the project.
listBuildBatchesForProject_projectName :: Lens.Lens' ListBuildBatchesForProject (Prelude.Maybe Prelude.Text)
listBuildBatchesForProject_projectName :: Lens' ListBuildBatchesForProject (Maybe Text)
listBuildBatchesForProject_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProject' {Maybe Text
projectName :: Maybe Text
$sel:projectName:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
projectName} -> Maybe Text
projectName) (\s :: ListBuildBatchesForProject
s@ListBuildBatchesForProject' {} Maybe Text
a -> ListBuildBatchesForProject
s {$sel:projectName:ListBuildBatchesForProject' :: Maybe Text
projectName = Maybe Text
a} :: ListBuildBatchesForProject)

-- | Specifies the sort order of the returned items. Valid values include:
--
-- -   @ASCENDING@: List the batch build identifiers in ascending order by
--     identifier.
--
-- -   @DESCENDING@: List the batch build identifiers in descending order
--     by identifier.
listBuildBatchesForProject_sortOrder :: Lens.Lens' ListBuildBatchesForProject (Prelude.Maybe SortOrderType)
listBuildBatchesForProject_sortOrder :: Lens' ListBuildBatchesForProject (Maybe SortOrderType)
listBuildBatchesForProject_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProject' {Maybe SortOrderType
sortOrder :: Maybe SortOrderType
$sel:sortOrder:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe SortOrderType
sortOrder} -> Maybe SortOrderType
sortOrder) (\s :: ListBuildBatchesForProject
s@ListBuildBatchesForProject' {} Maybe SortOrderType
a -> ListBuildBatchesForProject
s {$sel:sortOrder:ListBuildBatchesForProject' :: Maybe SortOrderType
sortOrder = Maybe SortOrderType
a} :: ListBuildBatchesForProject)

instance Core.AWSPager ListBuildBatchesForProject where
  page :: ListBuildBatchesForProject
-> AWSResponse ListBuildBatchesForProject
-> Maybe ListBuildBatchesForProject
page ListBuildBatchesForProject
rq AWSResponse ListBuildBatchesForProject
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBuildBatchesForProject
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildBatchesForProjectResponse (Maybe Text)
listBuildBatchesForProjectResponse_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 ListBuildBatchesForProject
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildBatchesForProjectResponse (Maybe [Text])
listBuildBatchesForProjectResponse_ids
            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.$ ListBuildBatchesForProject
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBuildBatchesForProject (Maybe Text)
listBuildBatchesForProject_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBuildBatchesForProject
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildBatchesForProjectResponse (Maybe Text)
listBuildBatchesForProjectResponse_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 ListBuildBatchesForProject where
  type
    AWSResponse ListBuildBatchesForProject =
      ListBuildBatchesForProjectResponse
  request :: (Service -> Service)
-> ListBuildBatchesForProject -> Request ListBuildBatchesForProject
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 ListBuildBatchesForProject
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListBuildBatchesForProject)))
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 Text -> Int -> ListBuildBatchesForProjectResponse
ListBuildBatchesForProjectResponse'
            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
"ids" 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 ListBuildBatchesForProject where
  hashWithSalt :: Int -> ListBuildBatchesForProject -> Int
hashWithSalt Int
_salt ListBuildBatchesForProject' {Maybe Natural
Maybe Text
Maybe SortOrderType
Maybe BuildBatchFilter
sortOrder :: Maybe SortOrderType
projectName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe BuildBatchFilter
$sel:sortOrder:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe SortOrderType
$sel:projectName:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:nextToken:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:maxResults:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Natural
$sel:filter':ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe BuildBatchFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BuildBatchFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
projectName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrderType
sortOrder

instance Prelude.NFData ListBuildBatchesForProject where
  rnf :: ListBuildBatchesForProject -> ()
rnf ListBuildBatchesForProject' {Maybe Natural
Maybe Text
Maybe SortOrderType
Maybe BuildBatchFilter
sortOrder :: Maybe SortOrderType
projectName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe BuildBatchFilter
$sel:sortOrder:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe SortOrderType
$sel:projectName:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:nextToken:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:maxResults:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Natural
$sel:filter':ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe BuildBatchFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BuildBatchFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrderType
sortOrder

instance Data.ToHeaders ListBuildBatchesForProject where
  toHeaders :: ListBuildBatchesForProject -> 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
"CodeBuild_20161006.ListBuildBatchesForProject" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListBuildBatchesForProject where
  toJSON :: ListBuildBatchesForProject -> Value
toJSON ListBuildBatchesForProject' {Maybe Natural
Maybe Text
Maybe SortOrderType
Maybe BuildBatchFilter
sortOrder :: Maybe SortOrderType
projectName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe BuildBatchFilter
$sel:sortOrder:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe SortOrderType
$sel:projectName:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:nextToken:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Text
$sel:maxResults:ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe Natural
$sel:filter':ListBuildBatchesForProject' :: ListBuildBatchesForProject -> Maybe BuildBatchFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filter" 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 BuildBatchFilter
filter',
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"projectName" 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
projectName,
            (Key
"sortOrder" 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 SortOrderType
sortOrder
          ]
      )

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

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

-- | /See:/ 'newListBuildBatchesForProjectResponse' smart constructor.
data ListBuildBatchesForProjectResponse = ListBuildBatchesForProjectResponse'
  { -- | An array of strings that contains the batch build identifiers.
    ListBuildBatchesForProjectResponse -> Maybe [Text]
ids :: Prelude.Maybe [Prelude.Text],
    -- | If there are more items to return, this contains a token that is passed
    -- to a subsequent call to @ListBuildBatchesForProject@ to retrieve the
    -- next set of items.
    ListBuildBatchesForProjectResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBuildBatchesForProjectResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBuildBatchesForProjectResponse
-> ListBuildBatchesForProjectResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuildBatchesForProjectResponse
-> ListBuildBatchesForProjectResponse -> Bool
$c/= :: ListBuildBatchesForProjectResponse
-> ListBuildBatchesForProjectResponse -> Bool
== :: ListBuildBatchesForProjectResponse
-> ListBuildBatchesForProjectResponse -> Bool
$c== :: ListBuildBatchesForProjectResponse
-> ListBuildBatchesForProjectResponse -> Bool
Prelude.Eq, ReadPrec [ListBuildBatchesForProjectResponse]
ReadPrec ListBuildBatchesForProjectResponse
Int -> ReadS ListBuildBatchesForProjectResponse
ReadS [ListBuildBatchesForProjectResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuildBatchesForProjectResponse]
$creadListPrec :: ReadPrec [ListBuildBatchesForProjectResponse]
readPrec :: ReadPrec ListBuildBatchesForProjectResponse
$creadPrec :: ReadPrec ListBuildBatchesForProjectResponse
readList :: ReadS [ListBuildBatchesForProjectResponse]
$creadList :: ReadS [ListBuildBatchesForProjectResponse]
readsPrec :: Int -> ReadS ListBuildBatchesForProjectResponse
$creadsPrec :: Int -> ReadS ListBuildBatchesForProjectResponse
Prelude.Read, Int -> ListBuildBatchesForProjectResponse -> ShowS
[ListBuildBatchesForProjectResponse] -> ShowS
ListBuildBatchesForProjectResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuildBatchesForProjectResponse] -> ShowS
$cshowList :: [ListBuildBatchesForProjectResponse] -> ShowS
show :: ListBuildBatchesForProjectResponse -> String
$cshow :: ListBuildBatchesForProjectResponse -> String
showsPrec :: Int -> ListBuildBatchesForProjectResponse -> ShowS
$cshowsPrec :: Int -> ListBuildBatchesForProjectResponse -> ShowS
Prelude.Show, forall x.
Rep ListBuildBatchesForProjectResponse x
-> ListBuildBatchesForProjectResponse
forall x.
ListBuildBatchesForProjectResponse
-> Rep ListBuildBatchesForProjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListBuildBatchesForProjectResponse x
-> ListBuildBatchesForProjectResponse
$cfrom :: forall x.
ListBuildBatchesForProjectResponse
-> Rep ListBuildBatchesForProjectResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBuildBatchesForProjectResponse' 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:
--
-- 'ids', 'listBuildBatchesForProjectResponse_ids' - An array of strings that contains the batch build identifiers.
--
-- 'nextToken', 'listBuildBatchesForProjectResponse_nextToken' - If there are more items to return, this contains a token that is passed
-- to a subsequent call to @ListBuildBatchesForProject@ to retrieve the
-- next set of items.
--
-- 'httpStatus', 'listBuildBatchesForProjectResponse_httpStatus' - The response's http status code.
newListBuildBatchesForProjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBuildBatchesForProjectResponse
newListBuildBatchesForProjectResponse :: Int -> ListBuildBatchesForProjectResponse
newListBuildBatchesForProjectResponse Int
pHttpStatus_ =
  ListBuildBatchesForProjectResponse'
    { $sel:ids:ListBuildBatchesForProjectResponse' :: Maybe [Text]
ids =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuildBatchesForProjectResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBuildBatchesForProjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of strings that contains the batch build identifiers.
listBuildBatchesForProjectResponse_ids :: Lens.Lens' ListBuildBatchesForProjectResponse (Prelude.Maybe [Prelude.Text])
listBuildBatchesForProjectResponse_ids :: Lens' ListBuildBatchesForProjectResponse (Maybe [Text])
listBuildBatchesForProjectResponse_ids = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProjectResponse' {Maybe [Text]
ids :: Maybe [Text]
$sel:ids:ListBuildBatchesForProjectResponse' :: ListBuildBatchesForProjectResponse -> Maybe [Text]
ids} -> Maybe [Text]
ids) (\s :: ListBuildBatchesForProjectResponse
s@ListBuildBatchesForProjectResponse' {} Maybe [Text]
a -> ListBuildBatchesForProjectResponse
s {$sel:ids:ListBuildBatchesForProjectResponse' :: Maybe [Text]
ids = Maybe [Text]
a} :: ListBuildBatchesForProjectResponse) 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

-- | If there are more items to return, this contains a token that is passed
-- to a subsequent call to @ListBuildBatchesForProject@ to retrieve the
-- next set of items.
listBuildBatchesForProjectResponse_nextToken :: Lens.Lens' ListBuildBatchesForProjectResponse (Prelude.Maybe Prelude.Text)
listBuildBatchesForProjectResponse_nextToken :: Lens' ListBuildBatchesForProjectResponse (Maybe Text)
listBuildBatchesForProjectResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildBatchesForProjectResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuildBatchesForProjectResponse' :: ListBuildBatchesForProjectResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuildBatchesForProjectResponse
s@ListBuildBatchesForProjectResponse' {} Maybe Text
a -> ListBuildBatchesForProjectResponse
s {$sel:nextToken:ListBuildBatchesForProjectResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuildBatchesForProjectResponse)

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

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