{-# 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.Glacier.ListJobs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation lists jobs for a vault, including jobs that are
-- in-progress and jobs that have recently finished. The List Job operation
-- returns a list of these jobs sorted by job initiation time.
--
-- Amazon Glacier retains recently completed jobs for a period before
-- deleting them; however, it eventually removes completed jobs. The output
-- of completed jobs can be retrieved. Retaining completed jobs for a
-- period of time after they have completed enables you to get a job output
-- in the event you miss the job completion notification or your first
-- attempt to download it fails. For example, suppose you start an archive
-- retrieval job to download an archive. After the job completes, you start
-- to download the archive but encounter a network error. In this scenario,
-- you can retry and download the archive while the job exists.
--
-- The List Jobs operation supports pagination. You should always check the
-- response @Marker@ field. If there are no more jobs to list, the @Marker@
-- field is set to @null@. If there are more jobs to list, the @Marker@
-- field is set to a non-null value, which you can use to continue the
-- pagination of the list. To return a list of jobs that begins at a
-- specific job, set the marker request parameter to the @Marker@ value for
-- that job that you obtained from a previous List Jobs request.
--
-- You can set a maximum limit for the number of jobs returned in the
-- response by specifying the @limit@ parameter in the request. The default
-- limit is 50. The number of jobs returned might be fewer than the limit,
-- but the number of returned jobs never exceeds the limit.
--
-- Additionally, you can filter the jobs list returned by specifying the
-- optional @statuscode@ parameter or @completed@ parameter, or both. Using
-- the @statuscode@ parameter, you can specify to return only jobs that
-- match either the @InProgress@, @Succeeded@, or @Failed@ status. Using
-- the @completed@ parameter, you can specify to return only jobs that were
-- completed (@true@) or jobs that were not completed (@false@).
--
-- For more information about using this operation, see the documentation
-- for the underlying REST API
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-jobs-get.html List Jobs>.
--
-- This operation returns paginated results.
module Amazonka.Glacier.ListJobs
  ( -- * Creating a Request
    ListJobs (..),
    newListJobs,

    -- * Request Lenses
    listJobs_completed,
    listJobs_limit,
    listJobs_marker,
    listJobs_statuscode,
    listJobs_accountId,
    listJobs_vaultName,

    -- * Destructuring the Response
    ListJobsResponse (..),
    newListJobsResponse,

    -- * Response Lenses
    listJobsResponse_jobList,
    listJobsResponse_marker,
    listJobsResponse_httpStatus,
  )
where

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

-- | Provides options for retrieving a job list for an Amazon S3 Glacier
-- vault.
--
-- /See:/ 'newListJobs' smart constructor.
data ListJobs = ListJobs'
  { -- | The state of the jobs to return. You can specify @true@ or @false@.
    ListJobs -> Maybe Text
completed :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of jobs to be returned. The default limit is 50. The
    -- number of jobs returned might be fewer than the specified limit, but the
    -- number of returned jobs never exceeds the limit.
    ListJobs -> Maybe Text
limit :: Prelude.Maybe Prelude.Text,
    -- | An opaque string used for pagination. This value specifies the job at
    -- which the listing of jobs should begin. Get the marker value from a
    -- previous List Jobs response. You only need to include the marker if you
    -- are continuing the pagination of results started in a previous List Jobs
    -- request.
    ListJobs -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The type of job status to return. You can specify the following values:
    -- @InProgress@, @Succeeded@, or @Failed@.
    ListJobs -> Maybe Text
statuscode :: Prelude.Maybe Prelude.Text,
    -- | The @AccountId@ value is the AWS account ID of the account that owns the
    -- vault. You can either specify an AWS account ID or optionally a single
    -- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
    -- ID associated with the credentials used to sign the request. If you use
    -- an account ID, do not include any hyphens (\'-\') in the ID.
    ListJobs -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    ListJobs -> Text
vaultName :: Prelude.Text
  }
  deriving (ListJobs -> ListJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListJobs -> ListJobs -> Bool
$c/= :: ListJobs -> ListJobs -> Bool
== :: ListJobs -> ListJobs -> Bool
$c== :: ListJobs -> ListJobs -> Bool
Prelude.Eq, ReadPrec [ListJobs]
ReadPrec ListJobs
Int -> ReadS ListJobs
ReadS [ListJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListJobs]
$creadListPrec :: ReadPrec [ListJobs]
readPrec :: ReadPrec ListJobs
$creadPrec :: ReadPrec ListJobs
readList :: ReadS [ListJobs]
$creadList :: ReadS [ListJobs]
readsPrec :: Int -> ReadS ListJobs
$creadsPrec :: Int -> ReadS ListJobs
Prelude.Read, Int -> ListJobs -> ShowS
[ListJobs] -> ShowS
ListJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListJobs] -> ShowS
$cshowList :: [ListJobs] -> ShowS
show :: ListJobs -> String
$cshow :: ListJobs -> String
showsPrec :: Int -> ListJobs -> ShowS
$cshowsPrec :: Int -> ListJobs -> ShowS
Prelude.Show, forall x. Rep ListJobs x -> ListJobs
forall x. ListJobs -> Rep ListJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListJobs x -> ListJobs
$cfrom :: forall x. ListJobs -> Rep ListJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListJobs' 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:
--
-- 'completed', 'listJobs_completed' - The state of the jobs to return. You can specify @true@ or @false@.
--
-- 'limit', 'listJobs_limit' - The maximum number of jobs to be returned. The default limit is 50. The
-- number of jobs returned might be fewer than the specified limit, but the
-- number of returned jobs never exceeds the limit.
--
-- 'marker', 'listJobs_marker' - An opaque string used for pagination. This value specifies the job at
-- which the listing of jobs should begin. Get the marker value from a
-- previous List Jobs response. You only need to include the marker if you
-- are continuing the pagination of results started in a previous List Jobs
-- request.
--
-- 'statuscode', 'listJobs_statuscode' - The type of job status to return. You can specify the following values:
-- @InProgress@, @Succeeded@, or @Failed@.
--
-- 'accountId', 'listJobs_accountId' - The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
--
-- 'vaultName', 'listJobs_vaultName' - The name of the vault.
newListJobs ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  ListJobs
newListJobs :: Text -> Text -> ListJobs
newListJobs Text
pAccountId_ Text
pVaultName_ =
  ListJobs'
    { $sel:completed:ListJobs' :: Maybe Text
completed = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListJobs' :: Maybe Text
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListJobs' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:statuscode:ListJobs' :: Maybe Text
statuscode = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:ListJobs' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:ListJobs' :: Text
vaultName = Text
pVaultName_
    }

-- | The state of the jobs to return. You can specify @true@ or @false@.
listJobs_completed :: Lens.Lens' ListJobs (Prelude.Maybe Prelude.Text)
listJobs_completed :: Lens' ListJobs (Maybe Text)
listJobs_completed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Maybe Text
completed :: Maybe Text
$sel:completed:ListJobs' :: ListJobs -> Maybe Text
completed} -> Maybe Text
completed) (\s :: ListJobs
s@ListJobs' {} Maybe Text
a -> ListJobs
s {$sel:completed:ListJobs' :: Maybe Text
completed = Maybe Text
a} :: ListJobs)

-- | The maximum number of jobs to be returned. The default limit is 50. The
-- number of jobs returned might be fewer than the specified limit, but the
-- number of returned jobs never exceeds the limit.
listJobs_limit :: Lens.Lens' ListJobs (Prelude.Maybe Prelude.Text)
listJobs_limit :: Lens' ListJobs (Maybe Text)
listJobs_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Maybe Text
limit :: Maybe Text
$sel:limit:ListJobs' :: ListJobs -> Maybe Text
limit} -> Maybe Text
limit) (\s :: ListJobs
s@ListJobs' {} Maybe Text
a -> ListJobs
s {$sel:limit:ListJobs' :: Maybe Text
limit = Maybe Text
a} :: ListJobs)

-- | An opaque string used for pagination. This value specifies the job at
-- which the listing of jobs should begin. Get the marker value from a
-- previous List Jobs response. You only need to include the marker if you
-- are continuing the pagination of results started in a previous List Jobs
-- request.
listJobs_marker :: Lens.Lens' ListJobs (Prelude.Maybe Prelude.Text)
listJobs_marker :: Lens' ListJobs (Maybe Text)
listJobs_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Maybe Text
marker :: Maybe Text
$sel:marker:ListJobs' :: ListJobs -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListJobs
s@ListJobs' {} Maybe Text
a -> ListJobs
s {$sel:marker:ListJobs' :: Maybe Text
marker = Maybe Text
a} :: ListJobs)

-- | The type of job status to return. You can specify the following values:
-- @InProgress@, @Succeeded@, or @Failed@.
listJobs_statuscode :: Lens.Lens' ListJobs (Prelude.Maybe Prelude.Text)
listJobs_statuscode :: Lens' ListJobs (Maybe Text)
listJobs_statuscode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Maybe Text
statuscode :: Maybe Text
$sel:statuscode:ListJobs' :: ListJobs -> Maybe Text
statuscode} -> Maybe Text
statuscode) (\s :: ListJobs
s@ListJobs' {} Maybe Text
a -> ListJobs
s {$sel:statuscode:ListJobs' :: Maybe Text
statuscode = Maybe Text
a} :: ListJobs)

-- | The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
listJobs_accountId :: Lens.Lens' ListJobs Prelude.Text
listJobs_accountId :: Lens' ListJobs Text
listJobs_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Text
accountId :: Text
$sel:accountId:ListJobs' :: ListJobs -> Text
accountId} -> Text
accountId) (\s :: ListJobs
s@ListJobs' {} Text
a -> ListJobs
s {$sel:accountId:ListJobs' :: Text
accountId = Text
a} :: ListJobs)

-- | The name of the vault.
listJobs_vaultName :: Lens.Lens' ListJobs Prelude.Text
listJobs_vaultName :: Lens' ListJobs Text
listJobs_vaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobs' {Text
vaultName :: Text
$sel:vaultName:ListJobs' :: ListJobs -> Text
vaultName} -> Text
vaultName) (\s :: ListJobs
s@ListJobs' {} Text
a -> ListJobs
s {$sel:vaultName:ListJobs' :: Text
vaultName = Text
a} :: ListJobs)

instance Core.AWSPager ListJobs where
  page :: ListJobs -> AWSResponse ListJobs -> Maybe ListJobs
page ListJobs
rq AWSResponse ListJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsResponse (Maybe Text)
listJobsResponse_marker
            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 ListJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsResponse (Maybe [GlacierJobDescription])
listJobsResponse_jobList
            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.$ ListJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListJobs (Maybe Text)
listJobs_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListJobsResponse (Maybe Text)
listJobsResponse_marker
          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 ListJobs where
  type AWSResponse ListJobs = ListJobsResponse
  request :: (Service -> Service) -> ListJobs -> Request ListJobs
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 ListJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListJobs)))
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 [GlacierJobDescription]
-> Maybe Text -> Int -> ListJobsResponse
ListJobsResponse'
            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
"JobList" 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
"Marker")
            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 ListJobs where
  hashWithSalt :: Int -> ListJobs -> Int
hashWithSalt Int
_salt ListJobs' {Maybe Text
Text
vaultName :: Text
accountId :: Text
statuscode :: Maybe Text
marker :: Maybe Text
limit :: Maybe Text
completed :: Maybe Text
$sel:vaultName:ListJobs' :: ListJobs -> Text
$sel:accountId:ListJobs' :: ListJobs -> Text
$sel:statuscode:ListJobs' :: ListJobs -> Maybe Text
$sel:marker:ListJobs' :: ListJobs -> Maybe Text
$sel:limit:ListJobs' :: ListJobs -> Maybe Text
$sel:completed:ListJobs' :: ListJobs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
completed
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statuscode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vaultName

instance Prelude.NFData ListJobs where
  rnf :: ListJobs -> ()
rnf ListJobs' {Maybe Text
Text
vaultName :: Text
accountId :: Text
statuscode :: Maybe Text
marker :: Maybe Text
limit :: Maybe Text
completed :: Maybe Text
$sel:vaultName:ListJobs' :: ListJobs -> Text
$sel:accountId:ListJobs' :: ListJobs -> Text
$sel:statuscode:ListJobs' :: ListJobs -> Maybe Text
$sel:marker:ListJobs' :: ListJobs -> Maybe Text
$sel:limit:ListJobs' :: ListJobs -> Maybe Text
$sel:completed:ListJobs' :: ListJobs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
completed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statuscode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vaultName

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

instance Data.ToPath ListJobs where
  toPath :: ListJobs -> ByteString
toPath ListJobs' {Maybe Text
Text
vaultName :: Text
accountId :: Text
statuscode :: Maybe Text
marker :: Maybe Text
limit :: Maybe Text
completed :: Maybe Text
$sel:vaultName:ListJobs' :: ListJobs -> Text
$sel:accountId:ListJobs' :: ListJobs -> Text
$sel:statuscode:ListJobs' :: ListJobs -> Maybe Text
$sel:marker:ListJobs' :: ListJobs -> Maybe Text
$sel:limit:ListJobs' :: ListJobs -> Maybe Text
$sel:completed:ListJobs' :: ListJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
vaultName,
        ByteString
"/jobs"
      ]

instance Data.ToQuery ListJobs where
  toQuery :: ListJobs -> QueryString
toQuery ListJobs' {Maybe Text
Text
vaultName :: Text
accountId :: Text
statuscode :: Maybe Text
marker :: Maybe Text
limit :: Maybe Text
completed :: Maybe Text
$sel:vaultName:ListJobs' :: ListJobs -> Text
$sel:accountId:ListJobs' :: ListJobs -> Text
$sel:statuscode:ListJobs' :: ListJobs -> Maybe Text
$sel:marker:ListJobs' :: ListJobs -> Maybe Text
$sel:limit:ListJobs' :: ListJobs -> Maybe Text
$sel:completed:ListJobs' :: ListJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"completed" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
completed,
        ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
limit,
        ByteString
"marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"statuscode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
statuscode
      ]

-- | Contains the Amazon S3 Glacier response to your request.
--
-- /See:/ 'newListJobsResponse' smart constructor.
data ListJobsResponse = ListJobsResponse'
  { -- | A list of job objects. Each job object contains metadata describing the
    -- job.
    ListJobsResponse -> Maybe [GlacierJobDescription]
jobList :: Prelude.Maybe [GlacierJobDescription],
    -- | An opaque string used for pagination that specifies the job at which the
    -- listing of jobs should begin. You get the @marker@ value from a previous
    -- List Jobs response. You only need to include the marker if you are
    -- continuing the pagination of the results started in a previous List Jobs
    -- request.
    ListJobsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListJobsResponse -> ListJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListJobsResponse -> ListJobsResponse -> Bool
$c/= :: ListJobsResponse -> ListJobsResponse -> Bool
== :: ListJobsResponse -> ListJobsResponse -> Bool
$c== :: ListJobsResponse -> ListJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListJobsResponse]
ReadPrec ListJobsResponse
Int -> ReadS ListJobsResponse
ReadS [ListJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListJobsResponse]
$creadListPrec :: ReadPrec [ListJobsResponse]
readPrec :: ReadPrec ListJobsResponse
$creadPrec :: ReadPrec ListJobsResponse
readList :: ReadS [ListJobsResponse]
$creadList :: ReadS [ListJobsResponse]
readsPrec :: Int -> ReadS ListJobsResponse
$creadsPrec :: Int -> ReadS ListJobsResponse
Prelude.Read, Int -> ListJobsResponse -> ShowS
[ListJobsResponse] -> ShowS
ListJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListJobsResponse] -> ShowS
$cshowList :: [ListJobsResponse] -> ShowS
show :: ListJobsResponse -> String
$cshow :: ListJobsResponse -> String
showsPrec :: Int -> ListJobsResponse -> ShowS
$cshowsPrec :: Int -> ListJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListJobsResponse x -> ListJobsResponse
forall x. ListJobsResponse -> Rep ListJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListJobsResponse x -> ListJobsResponse
$cfrom :: forall x. ListJobsResponse -> Rep ListJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListJobsResponse' 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:
--
-- 'jobList', 'listJobsResponse_jobList' - A list of job objects. Each job object contains metadata describing the
-- job.
--
-- 'marker', 'listJobsResponse_marker' - An opaque string used for pagination that specifies the job at which the
-- listing of jobs should begin. You get the @marker@ value from a previous
-- List Jobs response. You only need to include the marker if you are
-- continuing the pagination of the results started in a previous List Jobs
-- request.
--
-- 'httpStatus', 'listJobsResponse_httpStatus' - The response's http status code.
newListJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListJobsResponse
newListJobsResponse :: Int -> ListJobsResponse
newListJobsResponse Int
pHttpStatus_ =
  ListJobsResponse'
    { $sel:jobList:ListJobsResponse' :: Maybe [GlacierJobDescription]
jobList = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListJobsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of job objects. Each job object contains metadata describing the
-- job.
listJobsResponse_jobList :: Lens.Lens' ListJobsResponse (Prelude.Maybe [GlacierJobDescription])
listJobsResponse_jobList :: Lens' ListJobsResponse (Maybe [GlacierJobDescription])
listJobsResponse_jobList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsResponse' {Maybe [GlacierJobDescription]
jobList :: Maybe [GlacierJobDescription]
$sel:jobList:ListJobsResponse' :: ListJobsResponse -> Maybe [GlacierJobDescription]
jobList} -> Maybe [GlacierJobDescription]
jobList) (\s :: ListJobsResponse
s@ListJobsResponse' {} Maybe [GlacierJobDescription]
a -> ListJobsResponse
s {$sel:jobList:ListJobsResponse' :: Maybe [GlacierJobDescription]
jobList = Maybe [GlacierJobDescription]
a} :: ListJobsResponse) 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

-- | An opaque string used for pagination that specifies the job at which the
-- listing of jobs should begin. You get the @marker@ value from a previous
-- List Jobs response. You only need to include the marker if you are
-- continuing the pagination of the results started in a previous List Jobs
-- request.
listJobsResponse_marker :: Lens.Lens' ListJobsResponse (Prelude.Maybe Prelude.Text)
listJobsResponse_marker :: Lens' ListJobsResponse (Maybe Text)
listJobsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListJobsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListJobsResponse' :: ListJobsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListJobsResponse
s@ListJobsResponse' {} Maybe Text
a -> ListJobsResponse
s {$sel:marker:ListJobsResponse' :: Maybe Text
marker = Maybe Text
a} :: ListJobsResponse)

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

instance Prelude.NFData ListJobsResponse where
  rnf :: ListJobsResponse -> ()
rnf ListJobsResponse' {Int
Maybe [GlacierJobDescription]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
jobList :: Maybe [GlacierJobDescription]
$sel:httpStatus:ListJobsResponse' :: ListJobsResponse -> Int
$sel:marker:ListJobsResponse' :: ListJobsResponse -> Maybe Text
$sel:jobList:ListJobsResponse' :: ListJobsResponse -> Maybe [GlacierJobDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GlacierJobDescription]
jobList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus