{-# 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.ElasticTranscoder.ListJobsByStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The ListJobsByStatus operation gets a list of jobs that have a specified
-- status. The response body contains one element for each job that
-- satisfies the search criteria.
--
-- This operation returns paginated results.
module Amazonka.ElasticTranscoder.ListJobsByStatus
  ( -- * Creating a Request
    ListJobsByStatus (..),
    newListJobsByStatus,

    -- * Request Lenses
    listJobsByStatus_ascending,
    listJobsByStatus_pageToken,
    listJobsByStatus_status,

    -- * Destructuring the Response
    ListJobsByStatusResponse (..),
    newListJobsByStatusResponse,

    -- * Response Lenses
    listJobsByStatusResponse_jobs,
    listJobsByStatusResponse_nextPageToken,
    listJobsByStatusResponse_httpStatus,
  )
where

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

-- | The @ListJobsByStatusRequest@ structure.
--
-- /See:/ 'newListJobsByStatus' smart constructor.
data ListJobsByStatus = ListJobsByStatus'
  { -- | To list jobs in chronological order by the date and time that they were
    -- submitted, enter @true@. To list jobs in reverse chronological order,
    -- enter @false@.
    ListJobsByStatus -> Maybe Text
ascending :: Prelude.Maybe Prelude.Text,
    -- | When Elastic Transcoder returns more than one page of results, use
    -- @pageToken@ in subsequent @GET@ requests to get each successive page of
    -- results.
    ListJobsByStatus -> Maybe Text
pageToken :: Prelude.Maybe Prelude.Text,
    -- | To get information about all of the jobs associated with the current AWS
    -- account that have a given status, specify the following status:
    -- @Submitted@, @Progressing@, @Complete@, @Canceled@, or @Error@.
    ListJobsByStatus -> Text
status :: Prelude.Text
  }
  deriving (ListJobsByStatus -> ListJobsByStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListJobsByStatus -> ListJobsByStatus -> Bool
$c/= :: ListJobsByStatus -> ListJobsByStatus -> Bool
== :: ListJobsByStatus -> ListJobsByStatus -> Bool
$c== :: ListJobsByStatus -> ListJobsByStatus -> Bool
Prelude.Eq, ReadPrec [ListJobsByStatus]
ReadPrec ListJobsByStatus
Int -> ReadS ListJobsByStatus
ReadS [ListJobsByStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListJobsByStatus]
$creadListPrec :: ReadPrec [ListJobsByStatus]
readPrec :: ReadPrec ListJobsByStatus
$creadPrec :: ReadPrec ListJobsByStatus
readList :: ReadS [ListJobsByStatus]
$creadList :: ReadS [ListJobsByStatus]
readsPrec :: Int -> ReadS ListJobsByStatus
$creadsPrec :: Int -> ReadS ListJobsByStatus
Prelude.Read, Int -> ListJobsByStatus -> ShowS
[ListJobsByStatus] -> ShowS
ListJobsByStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListJobsByStatus] -> ShowS
$cshowList :: [ListJobsByStatus] -> ShowS
show :: ListJobsByStatus -> String
$cshow :: ListJobsByStatus -> String
showsPrec :: Int -> ListJobsByStatus -> ShowS
$cshowsPrec :: Int -> ListJobsByStatus -> ShowS
Prelude.Show, forall x. Rep ListJobsByStatus x -> ListJobsByStatus
forall x. ListJobsByStatus -> Rep ListJobsByStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListJobsByStatus x -> ListJobsByStatus
$cfrom :: forall x. ListJobsByStatus -> Rep ListJobsByStatus x
Prelude.Generic)

-- |
-- Create a value of 'ListJobsByStatus' 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:
--
-- 'ascending', 'listJobsByStatus_ascending' - To list jobs in chronological order by the date and time that they were
-- submitted, enter @true@. To list jobs in reverse chronological order,
-- enter @false@.
--
-- 'pageToken', 'listJobsByStatus_pageToken' - When Elastic Transcoder returns more than one page of results, use
-- @pageToken@ in subsequent @GET@ requests to get each successive page of
-- results.
--
-- 'status', 'listJobsByStatus_status' - To get information about all of the jobs associated with the current AWS
-- account that have a given status, specify the following status:
-- @Submitted@, @Progressing@, @Complete@, @Canceled@, or @Error@.
newListJobsByStatus ::
  -- | 'status'
  Prelude.Text ->
  ListJobsByStatus
newListJobsByStatus :: Text -> ListJobsByStatus
newListJobsByStatus Text
pStatus_ =
  ListJobsByStatus'
    { $sel:ascending:ListJobsByStatus' :: Maybe Text
ascending = forall a. Maybe a
Prelude.Nothing,
      $sel:pageToken:ListJobsByStatus' :: Maybe Text
pageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListJobsByStatus' :: Text
status = Text
pStatus_
    }

-- | To list jobs in chronological order by the date and time that they were
-- submitted, enter @true@. To list jobs in reverse chronological order,
-- enter @false@.
listJobsByStatus_ascending :: Lens.Lens' ListJobsByStatus (Prelude.Maybe Prelude.Text)
listJobsByStatus_ascending :: Lens' ListJobsByStatus (Maybe Text)
listJobsByStatus_ascending = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsByStatus' {Maybe Text
ascending :: Maybe Text
$sel:ascending:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
ascending} -> Maybe Text
ascending) (\s :: ListJobsByStatus
s@ListJobsByStatus' {} Maybe Text
a -> ListJobsByStatus
s {$sel:ascending:ListJobsByStatus' :: Maybe Text
ascending = Maybe Text
a} :: ListJobsByStatus)

-- | When Elastic Transcoder returns more than one page of results, use
-- @pageToken@ in subsequent @GET@ requests to get each successive page of
-- results.
listJobsByStatus_pageToken :: Lens.Lens' ListJobsByStatus (Prelude.Maybe Prelude.Text)
listJobsByStatus_pageToken :: Lens' ListJobsByStatus (Maybe Text)
listJobsByStatus_pageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsByStatus' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
pageToken} -> Maybe Text
pageToken) (\s :: ListJobsByStatus
s@ListJobsByStatus' {} Maybe Text
a -> ListJobsByStatus
s {$sel:pageToken:ListJobsByStatus' :: Maybe Text
pageToken = Maybe Text
a} :: ListJobsByStatus)

-- | To get information about all of the jobs associated with the current AWS
-- account that have a given status, specify the following status:
-- @Submitted@, @Progressing@, @Complete@, @Canceled@, or @Error@.
listJobsByStatus_status :: Lens.Lens' ListJobsByStatus Prelude.Text
listJobsByStatus_status :: Lens' ListJobsByStatus Text
listJobsByStatus_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsByStatus' {Text
status :: Text
$sel:status:ListJobsByStatus' :: ListJobsByStatus -> Text
status} -> Text
status) (\s :: ListJobsByStatus
s@ListJobsByStatus' {} Text
a -> ListJobsByStatus
s {$sel:status:ListJobsByStatus' :: Text
status = Text
a} :: ListJobsByStatus)

instance Core.AWSPager ListJobsByStatus where
  page :: ListJobsByStatus
-> AWSResponse ListJobsByStatus -> Maybe ListJobsByStatus
page ListJobsByStatus
rq AWSResponse ListJobsByStatus
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListJobsByStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsByStatusResponse (Maybe Text)
listJobsByStatusResponse_nextPageToken
            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 ListJobsByStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsByStatusResponse (Maybe [Job])
listJobsByStatusResponse_jobs
            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.$ ListJobsByStatus
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListJobsByStatus (Maybe Text)
listJobsByStatus_pageToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListJobsByStatus
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsByStatusResponse (Maybe Text)
listJobsByStatusResponse_nextPageToken
          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 ListJobsByStatus where
  type
    AWSResponse ListJobsByStatus =
      ListJobsByStatusResponse
  request :: (Service -> Service)
-> ListJobsByStatus -> Request ListJobsByStatus
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 ListJobsByStatus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListJobsByStatus)))
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 [Job] -> Maybe Text -> Int -> ListJobsByStatusResponse
ListJobsByStatusResponse'
            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
"Jobs" 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
"NextPageToken")
            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 ListJobsByStatus where
  hashWithSalt :: Int -> ListJobsByStatus -> Int
hashWithSalt Int
_salt ListJobsByStatus' {Maybe Text
Text
status :: Text
pageToken :: Maybe Text
ascending :: Maybe Text
$sel:status:ListJobsByStatus' :: ListJobsByStatus -> Text
$sel:pageToken:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
$sel:ascending:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ascending
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
status

instance Prelude.NFData ListJobsByStatus where
  rnf :: ListJobsByStatus -> ()
rnf ListJobsByStatus' {Maybe Text
Text
status :: Text
pageToken :: Maybe Text
ascending :: Maybe Text
$sel:status:ListJobsByStatus' :: ListJobsByStatus -> Text
$sel:pageToken:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
$sel:ascending:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ascending
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
status

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

instance Data.ToPath ListJobsByStatus where
  toPath :: ListJobsByStatus -> ByteString
toPath ListJobsByStatus' {Maybe Text
Text
status :: Text
pageToken :: Maybe Text
ascending :: Maybe Text
$sel:status:ListJobsByStatus' :: ListJobsByStatus -> Text
$sel:pageToken:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
$sel:ascending:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2012-09-25/jobsByStatus/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
status]

instance Data.ToQuery ListJobsByStatus where
  toQuery :: ListJobsByStatus -> QueryString
toQuery ListJobsByStatus' {Maybe Text
Text
status :: Text
pageToken :: Maybe Text
ascending :: Maybe Text
$sel:status:ListJobsByStatus' :: ListJobsByStatus -> Text
$sel:pageToken:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
$sel:ascending:ListJobsByStatus' :: ListJobsByStatus -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Ascending" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ascending,
        ByteString
"PageToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
pageToken
      ]

-- | The @ListJobsByStatusResponse@ structure.
--
-- /See:/ 'newListJobsByStatusResponse' smart constructor.
data ListJobsByStatusResponse = ListJobsByStatusResponse'
  { -- | An array of @Job@ objects that have the specified status.
    ListJobsByStatusResponse -> Maybe [Job]
jobs :: Prelude.Maybe [Job],
    -- | A value that you use to access the second and subsequent pages of
    -- results, if any. When the jobs in the specified pipeline fit on one page
    -- or when you\'ve reached the last page of results, the value of
    -- @NextPageToken@ is @null@.
    ListJobsByStatusResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListJobsByStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListJobsByStatusResponse -> ListJobsByStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListJobsByStatusResponse -> ListJobsByStatusResponse -> Bool
$c/= :: ListJobsByStatusResponse -> ListJobsByStatusResponse -> Bool
== :: ListJobsByStatusResponse -> ListJobsByStatusResponse -> Bool
$c== :: ListJobsByStatusResponse -> ListJobsByStatusResponse -> Bool
Prelude.Eq, ReadPrec [ListJobsByStatusResponse]
ReadPrec ListJobsByStatusResponse
Int -> ReadS ListJobsByStatusResponse
ReadS [ListJobsByStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListJobsByStatusResponse]
$creadListPrec :: ReadPrec [ListJobsByStatusResponse]
readPrec :: ReadPrec ListJobsByStatusResponse
$creadPrec :: ReadPrec ListJobsByStatusResponse
readList :: ReadS [ListJobsByStatusResponse]
$creadList :: ReadS [ListJobsByStatusResponse]
readsPrec :: Int -> ReadS ListJobsByStatusResponse
$creadsPrec :: Int -> ReadS ListJobsByStatusResponse
Prelude.Read, Int -> ListJobsByStatusResponse -> ShowS
[ListJobsByStatusResponse] -> ShowS
ListJobsByStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListJobsByStatusResponse] -> ShowS
$cshowList :: [ListJobsByStatusResponse] -> ShowS
show :: ListJobsByStatusResponse -> String
$cshow :: ListJobsByStatusResponse -> String
showsPrec :: Int -> ListJobsByStatusResponse -> ShowS
$cshowsPrec :: Int -> ListJobsByStatusResponse -> ShowS
Prelude.Show, forall x.
Rep ListJobsByStatusResponse x -> ListJobsByStatusResponse
forall x.
ListJobsByStatusResponse -> Rep ListJobsByStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListJobsByStatusResponse x -> ListJobsByStatusResponse
$cfrom :: forall x.
ListJobsByStatusResponse -> Rep ListJobsByStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListJobsByStatusResponse' 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:
--
-- 'jobs', 'listJobsByStatusResponse_jobs' - An array of @Job@ objects that have the specified status.
--
-- 'nextPageToken', 'listJobsByStatusResponse_nextPageToken' - A value that you use to access the second and subsequent pages of
-- results, if any. When the jobs in the specified pipeline fit on one page
-- or when you\'ve reached the last page of results, the value of
-- @NextPageToken@ is @null@.
--
-- 'httpStatus', 'listJobsByStatusResponse_httpStatus' - The response's http status code.
newListJobsByStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListJobsByStatusResponse
newListJobsByStatusResponse :: Int -> ListJobsByStatusResponse
newListJobsByStatusResponse Int
pHttpStatus_ =
  ListJobsByStatusResponse'
    { $sel:jobs:ListJobsByStatusResponse' :: Maybe [Job]
jobs = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:ListJobsByStatusResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListJobsByStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of @Job@ objects that have the specified status.
listJobsByStatusResponse_jobs :: Lens.Lens' ListJobsByStatusResponse (Prelude.Maybe [Job])
listJobsByStatusResponse_jobs :: Lens' ListJobsByStatusResponse (Maybe [Job])
listJobsByStatusResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsByStatusResponse' {Maybe [Job]
jobs :: Maybe [Job]
$sel:jobs:ListJobsByStatusResponse' :: ListJobsByStatusResponse -> Maybe [Job]
jobs} -> Maybe [Job]
jobs) (\s :: ListJobsByStatusResponse
s@ListJobsByStatusResponse' {} Maybe [Job]
a -> ListJobsByStatusResponse
s {$sel:jobs:ListJobsByStatusResponse' :: Maybe [Job]
jobs = Maybe [Job]
a} :: ListJobsByStatusResponse) 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 value that you use to access the second and subsequent pages of
-- results, if any. When the jobs in the specified pipeline fit on one page
-- or when you\'ve reached the last page of results, the value of
-- @NextPageToken@ is @null@.
listJobsByStatusResponse_nextPageToken :: Lens.Lens' ListJobsByStatusResponse (Prelude.Maybe Prelude.Text)
listJobsByStatusResponse_nextPageToken :: Lens' ListJobsByStatusResponse (Maybe Text)
listJobsByStatusResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsByStatusResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:ListJobsByStatusResponse' :: ListJobsByStatusResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: ListJobsByStatusResponse
s@ListJobsByStatusResponse' {} Maybe Text
a -> ListJobsByStatusResponse
s {$sel:nextPageToken:ListJobsByStatusResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: ListJobsByStatusResponse)

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

instance Prelude.NFData ListJobsByStatusResponse where
  rnf :: ListJobsByStatusResponse -> ()
rnf ListJobsByStatusResponse' {Int
Maybe [Job]
Maybe Text
httpStatus :: Int
nextPageToken :: Maybe Text
jobs :: Maybe [Job]
$sel:httpStatus:ListJobsByStatusResponse' :: ListJobsByStatusResponse -> Int
$sel:nextPageToken:ListJobsByStatusResponse' :: ListJobsByStatusResponse -> Maybe Text
$sel:jobs:ListJobsByStatusResponse' :: ListJobsByStatusResponse -> Maybe [Job]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Job]
jobs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus