{-# 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.GameLift.ListBuilds
-- 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 build resources for all builds associated with the Amazon Web
-- Services account in use. You can limit results to builds that are in a
-- specific status by using the @Status@ parameter. Use the pagination
-- parameters to retrieve results in a set of sequential pages.
--
-- Build resources are not listed in any particular order.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-build-intro.html Upload a Custom Server Build>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
--
-- This operation returns paginated results.
module Amazonka.GameLift.ListBuilds
  ( -- * Creating a Request
    ListBuilds (..),
    newListBuilds,

    -- * Request Lenses
    listBuilds_limit,
    listBuilds_nextToken,
    listBuilds_status,

    -- * Destructuring the Response
    ListBuildsResponse (..),
    newListBuildsResponse,

    -- * Response Lenses
    listBuildsResponse_builds,
    listBuildsResponse_nextToken,
    listBuildsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListBuilds' smart constructor.
data ListBuilds = ListBuilds'
  { -- | The maximum number of results to return. Use this parameter with
    -- @NextToken@ to get results as a set of sequential pages.
    ListBuilds -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | A token that indicates the start of the next sequential page of results.
    -- Use the token that is returned with a previous call to this operation.
    -- To start at the beginning of the result set, do not specify a value.
    ListBuilds -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Build status to filter results by. To retrieve all builds, leave this
    -- parameter empty.
    --
    -- Possible build statuses include the following:
    --
    -- -   __INITIALIZED__ -- A new build has been defined, but no files have
    --     been uploaded. You cannot create fleets for builds that are in this
    --     status. When a build is successfully created, the build status is
    --     set to this value.
    --
    -- -   __READY__ -- The game build has been successfully uploaded. You can
    --     now create new fleets for this build.
    --
    -- -   __FAILED__ -- The game build upload failed. You cannot create new
    --     fleets for this build.
    ListBuilds -> Maybe BuildStatus
status :: Prelude.Maybe BuildStatus
  }
  deriving (ListBuilds -> ListBuilds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuilds -> ListBuilds -> Bool
$c/= :: ListBuilds -> ListBuilds -> Bool
== :: ListBuilds -> ListBuilds -> Bool
$c== :: ListBuilds -> ListBuilds -> Bool
Prelude.Eq, ReadPrec [ListBuilds]
ReadPrec ListBuilds
Int -> ReadS ListBuilds
ReadS [ListBuilds]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuilds]
$creadListPrec :: ReadPrec [ListBuilds]
readPrec :: ReadPrec ListBuilds
$creadPrec :: ReadPrec ListBuilds
readList :: ReadS [ListBuilds]
$creadList :: ReadS [ListBuilds]
readsPrec :: Int -> ReadS ListBuilds
$creadsPrec :: Int -> ReadS ListBuilds
Prelude.Read, Int -> ListBuilds -> ShowS
[ListBuilds] -> ShowS
ListBuilds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuilds] -> ShowS
$cshowList :: [ListBuilds] -> ShowS
show :: ListBuilds -> String
$cshow :: ListBuilds -> String
showsPrec :: Int -> ListBuilds -> ShowS
$cshowsPrec :: Int -> ListBuilds -> ShowS
Prelude.Show, forall x. Rep ListBuilds x -> ListBuilds
forall x. ListBuilds -> Rep ListBuilds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBuilds x -> ListBuilds
$cfrom :: forall x. ListBuilds -> Rep ListBuilds x
Prelude.Generic)

-- |
-- Create a value of 'ListBuilds' 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', 'listBuilds_limit' - The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
--
-- 'nextToken', 'listBuilds_nextToken' - A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
--
-- 'status', 'listBuilds_status' - Build status to filter results by. To retrieve all builds, leave this
-- parameter empty.
--
-- Possible build statuses include the following:
--
-- -   __INITIALIZED__ -- A new build has been defined, but no files have
--     been uploaded. You cannot create fleets for builds that are in this
--     status. When a build is successfully created, the build status is
--     set to this value.
--
-- -   __READY__ -- The game build has been successfully uploaded. You can
--     now create new fleets for this build.
--
-- -   __FAILED__ -- The game build upload failed. You cannot create new
--     fleets for this build.
newListBuilds ::
  ListBuilds
newListBuilds :: ListBuilds
newListBuilds =
  ListBuilds'
    { $sel:limit:ListBuilds' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuilds' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListBuilds' :: Maybe BuildStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to return. Use this parameter with
-- @NextToken@ to get results as a set of sequential pages.
listBuilds_limit :: Lens.Lens' ListBuilds (Prelude.Maybe Prelude.Natural)
listBuilds_limit :: Lens' ListBuilds (Maybe Natural)
listBuilds_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuilds' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListBuilds' :: ListBuilds -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListBuilds
s@ListBuilds' {} Maybe Natural
a -> ListBuilds
s {$sel:limit:ListBuilds' :: Maybe Natural
limit = Maybe Natural
a} :: ListBuilds)

-- | A token that indicates the start of the next sequential page of results.
-- Use the token that is returned with a previous call to this operation.
-- To start at the beginning of the result set, do not specify a value.
listBuilds_nextToken :: Lens.Lens' ListBuilds (Prelude.Maybe Prelude.Text)
listBuilds_nextToken :: Lens' ListBuilds (Maybe Text)
listBuilds_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuilds' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuilds' :: ListBuilds -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuilds
s@ListBuilds' {} Maybe Text
a -> ListBuilds
s {$sel:nextToken:ListBuilds' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuilds)

-- | Build status to filter results by. To retrieve all builds, leave this
-- parameter empty.
--
-- Possible build statuses include the following:
--
-- -   __INITIALIZED__ -- A new build has been defined, but no files have
--     been uploaded. You cannot create fleets for builds that are in this
--     status. When a build is successfully created, the build status is
--     set to this value.
--
-- -   __READY__ -- The game build has been successfully uploaded. You can
--     now create new fleets for this build.
--
-- -   __FAILED__ -- The game build upload failed. You cannot create new
--     fleets for this build.
listBuilds_status :: Lens.Lens' ListBuilds (Prelude.Maybe BuildStatus)
listBuilds_status :: Lens' ListBuilds (Maybe BuildStatus)
listBuilds_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuilds' {Maybe BuildStatus
status :: Maybe BuildStatus
$sel:status:ListBuilds' :: ListBuilds -> Maybe BuildStatus
status} -> Maybe BuildStatus
status) (\s :: ListBuilds
s@ListBuilds' {} Maybe BuildStatus
a -> ListBuilds
s {$sel:status:ListBuilds' :: Maybe BuildStatus
status = Maybe BuildStatus
a} :: ListBuilds)

instance Core.AWSPager ListBuilds where
  page :: ListBuilds -> AWSResponse ListBuilds -> Maybe ListBuilds
page ListBuilds
rq AWSResponse ListBuilds
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBuilds
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildsResponse (Maybe Text)
listBuildsResponse_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 ListBuilds
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildsResponse (Maybe [Build])
listBuildsResponse_builds
            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.$ ListBuilds
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBuilds (Maybe Text)
listBuilds_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBuilds
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBuildsResponse (Maybe Text)
listBuildsResponse_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 ListBuilds where
  type AWSResponse ListBuilds = ListBuildsResponse
  request :: (Service -> Service) -> ListBuilds -> Request ListBuilds
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 ListBuilds
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListBuilds)))
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 [Build] -> Maybe Text -> Int -> ListBuildsResponse
ListBuildsResponse'
            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
"Builds" 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 ListBuilds where
  hashWithSalt :: Int -> ListBuilds -> Int
hashWithSalt Int
_salt ListBuilds' {Maybe Natural
Maybe Text
Maybe BuildStatus
status :: Maybe BuildStatus
nextToken :: Maybe Text
limit :: Maybe Natural
$sel:status:ListBuilds' :: ListBuilds -> Maybe BuildStatus
$sel:nextToken:ListBuilds' :: ListBuilds -> Maybe Text
$sel:limit:ListBuilds' :: ListBuilds -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BuildStatus
status

instance Prelude.NFData ListBuilds where
  rnf :: ListBuilds -> ()
rnf ListBuilds' {Maybe Natural
Maybe Text
Maybe BuildStatus
status :: Maybe BuildStatus
nextToken :: Maybe Text
limit :: Maybe Natural
$sel:status:ListBuilds' :: ListBuilds -> Maybe BuildStatus
$sel:nextToken:ListBuilds' :: ListBuilds -> Maybe Text
$sel:limit:ListBuilds' :: ListBuilds -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BuildStatus
status

instance Data.ToHeaders ListBuilds where
  toHeaders :: ListBuilds -> 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
"GameLift.ListBuilds" :: 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 ListBuilds where
  toJSON :: ListBuilds -> Value
toJSON ListBuilds' {Maybe Natural
Maybe Text
Maybe BuildStatus
status :: Maybe BuildStatus
nextToken :: Maybe Text
limit :: Maybe Natural
$sel:status:ListBuilds' :: ListBuilds -> Maybe BuildStatus
$sel:nextToken:ListBuilds' :: ListBuilds -> Maybe Text
$sel:limit:ListBuilds' :: ListBuilds -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Limit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
limit,
            (Key
"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
"Status" 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 BuildStatus
status
          ]
      )

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

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

-- | /See:/ 'newListBuildsResponse' smart constructor.
data ListBuildsResponse = ListBuildsResponse'
  { -- | A collection of build resources that match the request.
    ListBuildsResponse -> Maybe [Build]
builds :: Prelude.Maybe [Build],
    -- | A token that indicates where to resume retrieving results on the next
    -- call to this operation. If no token is returned, these results represent
    -- the end of the list.
    ListBuildsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBuildsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBuildsResponse -> ListBuildsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuildsResponse -> ListBuildsResponse -> Bool
$c/= :: ListBuildsResponse -> ListBuildsResponse -> Bool
== :: ListBuildsResponse -> ListBuildsResponse -> Bool
$c== :: ListBuildsResponse -> ListBuildsResponse -> Bool
Prelude.Eq, ReadPrec [ListBuildsResponse]
ReadPrec ListBuildsResponse
Int -> ReadS ListBuildsResponse
ReadS [ListBuildsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuildsResponse]
$creadListPrec :: ReadPrec [ListBuildsResponse]
readPrec :: ReadPrec ListBuildsResponse
$creadPrec :: ReadPrec ListBuildsResponse
readList :: ReadS [ListBuildsResponse]
$creadList :: ReadS [ListBuildsResponse]
readsPrec :: Int -> ReadS ListBuildsResponse
$creadsPrec :: Int -> ReadS ListBuildsResponse
Prelude.Read, Int -> ListBuildsResponse -> ShowS
[ListBuildsResponse] -> ShowS
ListBuildsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuildsResponse] -> ShowS
$cshowList :: [ListBuildsResponse] -> ShowS
show :: ListBuildsResponse -> String
$cshow :: ListBuildsResponse -> String
showsPrec :: Int -> ListBuildsResponse -> ShowS
$cshowsPrec :: Int -> ListBuildsResponse -> ShowS
Prelude.Show, forall x. Rep ListBuildsResponse x -> ListBuildsResponse
forall x. ListBuildsResponse -> Rep ListBuildsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBuildsResponse x -> ListBuildsResponse
$cfrom :: forall x. ListBuildsResponse -> Rep ListBuildsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBuildsResponse' 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:
--
-- 'builds', 'listBuildsResponse_builds' - A collection of build resources that match the request.
--
-- 'nextToken', 'listBuildsResponse_nextToken' - A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
--
-- 'httpStatus', 'listBuildsResponse_httpStatus' - The response's http status code.
newListBuildsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBuildsResponse
newListBuildsResponse :: Int -> ListBuildsResponse
newListBuildsResponse Int
pHttpStatus_ =
  ListBuildsResponse'
    { $sel:builds:ListBuildsResponse' :: Maybe [Build]
builds = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuildsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBuildsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of build resources that match the request.
listBuildsResponse_builds :: Lens.Lens' ListBuildsResponse (Prelude.Maybe [Build])
listBuildsResponse_builds :: Lens' ListBuildsResponse (Maybe [Build])
listBuildsResponse_builds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildsResponse' {Maybe [Build]
builds :: Maybe [Build]
$sel:builds:ListBuildsResponse' :: ListBuildsResponse -> Maybe [Build]
builds} -> Maybe [Build]
builds) (\s :: ListBuildsResponse
s@ListBuildsResponse' {} Maybe [Build]
a -> ListBuildsResponse
s {$sel:builds:ListBuildsResponse' :: Maybe [Build]
builds = Maybe [Build]
a} :: ListBuildsResponse) 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

-- | A token that indicates where to resume retrieving results on the next
-- call to this operation. If no token is returned, these results represent
-- the end of the list.
listBuildsResponse_nextToken :: Lens.Lens' ListBuildsResponse (Prelude.Maybe Prelude.Text)
listBuildsResponse_nextToken :: Lens' ListBuildsResponse (Maybe Text)
listBuildsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuildsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuildsResponse' :: ListBuildsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuildsResponse
s@ListBuildsResponse' {} Maybe Text
a -> ListBuildsResponse
s {$sel:nextToken:ListBuildsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuildsResponse)

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

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