{-# 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.Snowball.ListClusterJobs
-- 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 of @JobListEntry@ objects of the specified length. Each
-- @JobListEntry@ object is for a job in the specified cluster and contains
-- a job\'s state, a job\'s ID, and other information.
--
-- This operation returns paginated results.
module Amazonka.Snowball.ListClusterJobs
  ( -- * Creating a Request
    ListClusterJobs (..),
    newListClusterJobs,

    -- * Request Lenses
    listClusterJobs_maxResults,
    listClusterJobs_nextToken,
    listClusterJobs_clusterId,

    -- * Destructuring the Response
    ListClusterJobsResponse (..),
    newListClusterJobsResponse,

    -- * Response Lenses
    listClusterJobsResponse_jobListEntries,
    listClusterJobsResponse_nextToken,
    listClusterJobsResponse_httpStatus,
  )
where

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
import Amazonka.Snowball.Types

-- | /See:/ 'newListClusterJobs' smart constructor.
data ListClusterJobs = ListClusterJobs'
  { -- | The number of @JobListEntry@ objects to return.
    ListClusterJobs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | HTTP requests are stateless. To identify what object comes \"next\" in
    -- the list of @JobListEntry@ objects, you have the option of specifying
    -- @NextToken@ as the starting point for your returned list.
    ListClusterJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The 39-character ID for the cluster that you want to list, for example
    -- @CID123e4567-e89b-12d3-a456-426655440000@.
    ListClusterJobs -> Text
clusterId :: Prelude.Text
  }
  deriving (ListClusterJobs -> ListClusterJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListClusterJobs -> ListClusterJobs -> Bool
$c/= :: ListClusterJobs -> ListClusterJobs -> Bool
== :: ListClusterJobs -> ListClusterJobs -> Bool
$c== :: ListClusterJobs -> ListClusterJobs -> Bool
Prelude.Eq, ReadPrec [ListClusterJobs]
ReadPrec ListClusterJobs
Int -> ReadS ListClusterJobs
ReadS [ListClusterJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListClusterJobs]
$creadListPrec :: ReadPrec [ListClusterJobs]
readPrec :: ReadPrec ListClusterJobs
$creadPrec :: ReadPrec ListClusterJobs
readList :: ReadS [ListClusterJobs]
$creadList :: ReadS [ListClusterJobs]
readsPrec :: Int -> ReadS ListClusterJobs
$creadsPrec :: Int -> ReadS ListClusterJobs
Prelude.Read, Int -> ListClusterJobs -> ShowS
[ListClusterJobs] -> ShowS
ListClusterJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListClusterJobs] -> ShowS
$cshowList :: [ListClusterJobs] -> ShowS
show :: ListClusterJobs -> String
$cshow :: ListClusterJobs -> String
showsPrec :: Int -> ListClusterJobs -> ShowS
$cshowsPrec :: Int -> ListClusterJobs -> ShowS
Prelude.Show, forall x. Rep ListClusterJobs x -> ListClusterJobs
forall x. ListClusterJobs -> Rep ListClusterJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListClusterJobs x -> ListClusterJobs
$cfrom :: forall x. ListClusterJobs -> Rep ListClusterJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListClusterJobs' 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', 'listClusterJobs_maxResults' - The number of @JobListEntry@ objects to return.
--
-- 'nextToken', 'listClusterJobs_nextToken' - HTTP requests are stateless. To identify what object comes \"next\" in
-- the list of @JobListEntry@ objects, you have the option of specifying
-- @NextToken@ as the starting point for your returned list.
--
-- 'clusterId', 'listClusterJobs_clusterId' - The 39-character ID for the cluster that you want to list, for example
-- @CID123e4567-e89b-12d3-a456-426655440000@.
newListClusterJobs ::
  -- | 'clusterId'
  Prelude.Text ->
  ListClusterJobs
newListClusterJobs :: Text -> ListClusterJobs
newListClusterJobs Text
pClusterId_ =
  ListClusterJobs'
    { $sel:maxResults:ListClusterJobs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListClusterJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:ListClusterJobs' :: Text
clusterId = Text
pClusterId_
    }

-- | The number of @JobListEntry@ objects to return.
listClusterJobs_maxResults :: Lens.Lens' ListClusterJobs (Prelude.Maybe Prelude.Natural)
listClusterJobs_maxResults :: Lens' ListClusterJobs (Maybe Natural)
listClusterJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClusterJobs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListClusterJobs' :: ListClusterJobs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListClusterJobs
s@ListClusterJobs' {} Maybe Natural
a -> ListClusterJobs
s {$sel:maxResults:ListClusterJobs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListClusterJobs)

-- | HTTP requests are stateless. To identify what object comes \"next\" in
-- the list of @JobListEntry@ objects, you have the option of specifying
-- @NextToken@ as the starting point for your returned list.
listClusterJobs_nextToken :: Lens.Lens' ListClusterJobs (Prelude.Maybe Prelude.Text)
listClusterJobs_nextToken :: Lens' ListClusterJobs (Maybe Text)
listClusterJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClusterJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListClusterJobs' :: ListClusterJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListClusterJobs
s@ListClusterJobs' {} Maybe Text
a -> ListClusterJobs
s {$sel:nextToken:ListClusterJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListClusterJobs)

-- | The 39-character ID for the cluster that you want to list, for example
-- @CID123e4567-e89b-12d3-a456-426655440000@.
listClusterJobs_clusterId :: Lens.Lens' ListClusterJobs Prelude.Text
listClusterJobs_clusterId :: Lens' ListClusterJobs Text
listClusterJobs_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClusterJobs' {Text
clusterId :: Text
$sel:clusterId:ListClusterJobs' :: ListClusterJobs -> Text
clusterId} -> Text
clusterId) (\s :: ListClusterJobs
s@ListClusterJobs' {} Text
a -> ListClusterJobs
s {$sel:clusterId:ListClusterJobs' :: Text
clusterId = Text
a} :: ListClusterJobs)

instance Core.AWSPager ListClusterJobs where
  page :: ListClusterJobs
-> AWSResponse ListClusterJobs -> Maybe ListClusterJobs
page ListClusterJobs
rq AWSResponse ListClusterJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListClusterJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClusterJobsResponse (Maybe Text)
listClusterJobsResponse_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 ListClusterJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClusterJobsResponse (Maybe [JobListEntry])
listClusterJobsResponse_jobListEntries
            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.$ ListClusterJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListClusterJobs (Maybe Text)
listClusterJobs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListClusterJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListClusterJobsResponse (Maybe Text)
listClusterJobsResponse_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 ListClusterJobs where
  type
    AWSResponse ListClusterJobs =
      ListClusterJobsResponse
  request :: (Service -> Service) -> ListClusterJobs -> Request ListClusterJobs
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 ListClusterJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListClusterJobs)))
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 [JobListEntry]
-> Maybe Text -> Int -> ListClusterJobsResponse
ListClusterJobsResponse'
            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
"JobListEntries" 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 ListClusterJobs where
  hashWithSalt :: Int -> ListClusterJobs -> Int
hashWithSalt Int
_salt ListClusterJobs' {Maybe Natural
Maybe Text
Text
clusterId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:clusterId:ListClusterJobs' :: ListClusterJobs -> Text
$sel:nextToken:ListClusterJobs' :: ListClusterJobs -> Maybe Text
$sel:maxResults:ListClusterJobs' :: ListClusterJobs -> 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
clusterId

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

instance Data.ToHeaders ListClusterJobs where
  toHeaders :: ListClusterJobs -> 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
"AWSIESnowballJobManagementService.ListClusterJobs" ::
                          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 ListClusterJobs where
  toJSON :: ListClusterJobs -> Value
toJSON ListClusterJobs' {Maybe Natural
Maybe Text
Text
clusterId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:clusterId:ListClusterJobs' :: ListClusterJobs -> Text
$sel:nextToken:ListClusterJobs' :: ListClusterJobs -> Maybe Text
$sel:maxResults:ListClusterJobs' :: ListClusterJobs -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterId)
          ]
      )

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

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

-- | /See:/ 'newListClusterJobsResponse' smart constructor.
data ListClusterJobsResponse = ListClusterJobsResponse'
  { -- | Each @JobListEntry@ object contains a job\'s state, a job\'s ID, and a
    -- value that indicates whether the job is a job part, in the case of
    -- export jobs.
    ListClusterJobsResponse -> Maybe [JobListEntry]
jobListEntries :: Prelude.Maybe [JobListEntry],
    -- | HTTP requests are stateless. If you use the automatically generated
    -- @NextToken@ value in your next @ListClusterJobsResult@ call, your list
    -- of returned jobs will start from this point in the array.
    ListClusterJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListClusterJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListClusterJobsResponse -> ListClusterJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListClusterJobsResponse -> ListClusterJobsResponse -> Bool
$c/= :: ListClusterJobsResponse -> ListClusterJobsResponse -> Bool
== :: ListClusterJobsResponse -> ListClusterJobsResponse -> Bool
$c== :: ListClusterJobsResponse -> ListClusterJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListClusterJobsResponse]
ReadPrec ListClusterJobsResponse
Int -> ReadS ListClusterJobsResponse
ReadS [ListClusterJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListClusterJobsResponse]
$creadListPrec :: ReadPrec [ListClusterJobsResponse]
readPrec :: ReadPrec ListClusterJobsResponse
$creadPrec :: ReadPrec ListClusterJobsResponse
readList :: ReadS [ListClusterJobsResponse]
$creadList :: ReadS [ListClusterJobsResponse]
readsPrec :: Int -> ReadS ListClusterJobsResponse
$creadsPrec :: Int -> ReadS ListClusterJobsResponse
Prelude.Read, Int -> ListClusterJobsResponse -> ShowS
[ListClusterJobsResponse] -> ShowS
ListClusterJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListClusterJobsResponse] -> ShowS
$cshowList :: [ListClusterJobsResponse] -> ShowS
show :: ListClusterJobsResponse -> String
$cshow :: ListClusterJobsResponse -> String
showsPrec :: Int -> ListClusterJobsResponse -> ShowS
$cshowsPrec :: Int -> ListClusterJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListClusterJobsResponse x -> ListClusterJobsResponse
forall x. ListClusterJobsResponse -> Rep ListClusterJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListClusterJobsResponse x -> ListClusterJobsResponse
$cfrom :: forall x. ListClusterJobsResponse -> Rep ListClusterJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListClusterJobsResponse' 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:
--
-- 'jobListEntries', 'listClusterJobsResponse_jobListEntries' - Each @JobListEntry@ object contains a job\'s state, a job\'s ID, and a
-- value that indicates whether the job is a job part, in the case of
-- export jobs.
--
-- 'nextToken', 'listClusterJobsResponse_nextToken' - HTTP requests are stateless. If you use the automatically generated
-- @NextToken@ value in your next @ListClusterJobsResult@ call, your list
-- of returned jobs will start from this point in the array.
--
-- 'httpStatus', 'listClusterJobsResponse_httpStatus' - The response's http status code.
newListClusterJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListClusterJobsResponse
newListClusterJobsResponse :: Int -> ListClusterJobsResponse
newListClusterJobsResponse Int
pHttpStatus_ =
  ListClusterJobsResponse'
    { $sel:jobListEntries:ListClusterJobsResponse' :: Maybe [JobListEntry]
jobListEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListClusterJobsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListClusterJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Each @JobListEntry@ object contains a job\'s state, a job\'s ID, and a
-- value that indicates whether the job is a job part, in the case of
-- export jobs.
listClusterJobsResponse_jobListEntries :: Lens.Lens' ListClusterJobsResponse (Prelude.Maybe [JobListEntry])
listClusterJobsResponse_jobListEntries :: Lens' ListClusterJobsResponse (Maybe [JobListEntry])
listClusterJobsResponse_jobListEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClusterJobsResponse' {Maybe [JobListEntry]
jobListEntries :: Maybe [JobListEntry]
$sel:jobListEntries:ListClusterJobsResponse' :: ListClusterJobsResponse -> Maybe [JobListEntry]
jobListEntries} -> Maybe [JobListEntry]
jobListEntries) (\s :: ListClusterJobsResponse
s@ListClusterJobsResponse' {} Maybe [JobListEntry]
a -> ListClusterJobsResponse
s {$sel:jobListEntries:ListClusterJobsResponse' :: Maybe [JobListEntry]
jobListEntries = Maybe [JobListEntry]
a} :: ListClusterJobsResponse) 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

-- | HTTP requests are stateless. If you use the automatically generated
-- @NextToken@ value in your next @ListClusterJobsResult@ call, your list
-- of returned jobs will start from this point in the array.
listClusterJobsResponse_nextToken :: Lens.Lens' ListClusterJobsResponse (Prelude.Maybe Prelude.Text)
listClusterJobsResponse_nextToken :: Lens' ListClusterJobsResponse (Maybe Text)
listClusterJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClusterJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListClusterJobsResponse' :: ListClusterJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListClusterJobsResponse
s@ListClusterJobsResponse' {} Maybe Text
a -> ListClusterJobsResponse
s {$sel:nextToken:ListClusterJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListClusterJobsResponse)

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

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