{-# 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.MediaPackage.ListHarvestJobs
-- 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 a collection of HarvestJob records.
--
-- This operation returns paginated results.
module Amazonka.MediaPackage.ListHarvestJobs
  ( -- * Creating a Request
    ListHarvestJobs (..),
    newListHarvestJobs,

    -- * Request Lenses
    listHarvestJobs_includeChannelId,
    listHarvestJobs_includeStatus,
    listHarvestJobs_maxResults,
    listHarvestJobs_nextToken,

    -- * Destructuring the Response
    ListHarvestJobsResponse (..),
    newListHarvestJobsResponse,

    -- * Response Lenses
    listHarvestJobsResponse_harvestJobs,
    listHarvestJobsResponse_nextToken,
    listHarvestJobsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListHarvestJobs' smart constructor.
data ListHarvestJobs = ListHarvestJobs'
  { -- | When specified, the request will return only HarvestJobs associated with
    -- the given Channel ID.
    ListHarvestJobs -> Maybe Text
includeChannelId :: Prelude.Maybe Prelude.Text,
    -- | When specified, the request will return only HarvestJobs in the given
    -- status.
    ListHarvestJobs -> Maybe Text
includeStatus :: Prelude.Maybe Prelude.Text,
    -- | The upper bound on the number of records to return.
    ListHarvestJobs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token used to resume pagination from the end of a previous request.
    ListHarvestJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListHarvestJobs -> ListHarvestJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHarvestJobs -> ListHarvestJobs -> Bool
$c/= :: ListHarvestJobs -> ListHarvestJobs -> Bool
== :: ListHarvestJobs -> ListHarvestJobs -> Bool
$c== :: ListHarvestJobs -> ListHarvestJobs -> Bool
Prelude.Eq, ReadPrec [ListHarvestJobs]
ReadPrec ListHarvestJobs
Int -> ReadS ListHarvestJobs
ReadS [ListHarvestJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHarvestJobs]
$creadListPrec :: ReadPrec [ListHarvestJobs]
readPrec :: ReadPrec ListHarvestJobs
$creadPrec :: ReadPrec ListHarvestJobs
readList :: ReadS [ListHarvestJobs]
$creadList :: ReadS [ListHarvestJobs]
readsPrec :: Int -> ReadS ListHarvestJobs
$creadsPrec :: Int -> ReadS ListHarvestJobs
Prelude.Read, Int -> ListHarvestJobs -> ShowS
[ListHarvestJobs] -> ShowS
ListHarvestJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHarvestJobs] -> ShowS
$cshowList :: [ListHarvestJobs] -> ShowS
show :: ListHarvestJobs -> String
$cshow :: ListHarvestJobs -> String
showsPrec :: Int -> ListHarvestJobs -> ShowS
$cshowsPrec :: Int -> ListHarvestJobs -> ShowS
Prelude.Show, forall x. Rep ListHarvestJobs x -> ListHarvestJobs
forall x. ListHarvestJobs -> Rep ListHarvestJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHarvestJobs x -> ListHarvestJobs
$cfrom :: forall x. ListHarvestJobs -> Rep ListHarvestJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListHarvestJobs' 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:
--
-- 'includeChannelId', 'listHarvestJobs_includeChannelId' - When specified, the request will return only HarvestJobs associated with
-- the given Channel ID.
--
-- 'includeStatus', 'listHarvestJobs_includeStatus' - When specified, the request will return only HarvestJobs in the given
-- status.
--
-- 'maxResults', 'listHarvestJobs_maxResults' - The upper bound on the number of records to return.
--
-- 'nextToken', 'listHarvestJobs_nextToken' - A token used to resume pagination from the end of a previous request.
newListHarvestJobs ::
  ListHarvestJobs
newListHarvestJobs :: ListHarvestJobs
newListHarvestJobs =
  ListHarvestJobs'
    { $sel:includeChannelId:ListHarvestJobs' :: Maybe Text
includeChannelId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:includeStatus:ListHarvestJobs' :: Maybe Text
includeStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListHarvestJobs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListHarvestJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | When specified, the request will return only HarvestJobs associated with
-- the given Channel ID.
listHarvestJobs_includeChannelId :: Lens.Lens' ListHarvestJobs (Prelude.Maybe Prelude.Text)
listHarvestJobs_includeChannelId :: Lens' ListHarvestJobs (Maybe Text)
listHarvestJobs_includeChannelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobs' {Maybe Text
includeChannelId :: Maybe Text
$sel:includeChannelId:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
includeChannelId} -> Maybe Text
includeChannelId) (\s :: ListHarvestJobs
s@ListHarvestJobs' {} Maybe Text
a -> ListHarvestJobs
s {$sel:includeChannelId:ListHarvestJobs' :: Maybe Text
includeChannelId = Maybe Text
a} :: ListHarvestJobs)

-- | When specified, the request will return only HarvestJobs in the given
-- status.
listHarvestJobs_includeStatus :: Lens.Lens' ListHarvestJobs (Prelude.Maybe Prelude.Text)
listHarvestJobs_includeStatus :: Lens' ListHarvestJobs (Maybe Text)
listHarvestJobs_includeStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobs' {Maybe Text
includeStatus :: Maybe Text
$sel:includeStatus:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
includeStatus} -> Maybe Text
includeStatus) (\s :: ListHarvestJobs
s@ListHarvestJobs' {} Maybe Text
a -> ListHarvestJobs
s {$sel:includeStatus:ListHarvestJobs' :: Maybe Text
includeStatus = Maybe Text
a} :: ListHarvestJobs)

-- | The upper bound on the number of records to return.
listHarvestJobs_maxResults :: Lens.Lens' ListHarvestJobs (Prelude.Maybe Prelude.Natural)
listHarvestJobs_maxResults :: Lens' ListHarvestJobs (Maybe Natural)
listHarvestJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListHarvestJobs' :: ListHarvestJobs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListHarvestJobs
s@ListHarvestJobs' {} Maybe Natural
a -> ListHarvestJobs
s {$sel:maxResults:ListHarvestJobs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListHarvestJobs)

-- | A token used to resume pagination from the end of a previous request.
listHarvestJobs_nextToken :: Lens.Lens' ListHarvestJobs (Prelude.Maybe Prelude.Text)
listHarvestJobs_nextToken :: Lens' ListHarvestJobs (Maybe Text)
listHarvestJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListHarvestJobs
s@ListHarvestJobs' {} Maybe Text
a -> ListHarvestJobs
s {$sel:nextToken:ListHarvestJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListHarvestJobs)

instance Core.AWSPager ListHarvestJobs where
  page :: ListHarvestJobs
-> AWSResponse ListHarvestJobs -> Maybe ListHarvestJobs
page ListHarvestJobs
rq AWSResponse ListHarvestJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListHarvestJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHarvestJobsResponse (Maybe Text)
listHarvestJobsResponse_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 ListHarvestJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHarvestJobsResponse (Maybe [HarvestJob])
listHarvestJobsResponse_harvestJobs
            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.$ ListHarvestJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListHarvestJobs (Maybe Text)
listHarvestJobs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListHarvestJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHarvestJobsResponse (Maybe Text)
listHarvestJobsResponse_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 ListHarvestJobs where
  type
    AWSResponse ListHarvestJobs =
      ListHarvestJobsResponse
  request :: (Service -> Service) -> ListHarvestJobs -> Request ListHarvestJobs
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 ListHarvestJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListHarvestJobs)))
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 [HarvestJob] -> Maybe Text -> Int -> ListHarvestJobsResponse
ListHarvestJobsResponse'
            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
"harvestJobs" 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 ListHarvestJobs where
  hashWithSalt :: Int -> ListHarvestJobs -> Int
hashWithSalt Int
_salt ListHarvestJobs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeStatus :: Maybe Text
includeChannelId :: Maybe Text
$sel:nextToken:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:maxResults:ListHarvestJobs' :: ListHarvestJobs -> Maybe Natural
$sel:includeStatus:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:includeChannelId:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
includeChannelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
includeStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListHarvestJobs where
  rnf :: ListHarvestJobs -> ()
rnf ListHarvestJobs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeStatus :: Maybe Text
includeChannelId :: Maybe Text
$sel:nextToken:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:maxResults:ListHarvestJobs' :: ListHarvestJobs -> Maybe Natural
$sel:includeStatus:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:includeChannelId:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
includeChannelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
includeStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListHarvestJobs where
  toHeaders :: ListHarvestJobs -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance Data.ToQuery ListHarvestJobs where
  toQuery :: ListHarvestJobs -> QueryString
toQuery ListHarvestJobs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeStatus :: Maybe Text
includeChannelId :: Maybe Text
$sel:nextToken:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:maxResults:ListHarvestJobs' :: ListHarvestJobs -> Maybe Natural
$sel:includeStatus:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
$sel:includeChannelId:ListHarvestJobs' :: ListHarvestJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"includeChannelId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
includeChannelId,
        ByteString
"includeStatus" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
includeStatus,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListHarvestJobsResponse' smart constructor.
data ListHarvestJobsResponse = ListHarvestJobsResponse'
  { -- | A list of HarvestJob records.
    ListHarvestJobsResponse -> Maybe [HarvestJob]
harvestJobs :: Prelude.Maybe [HarvestJob],
    -- | A token that can be used to resume pagination from the end of the
    -- collection.
    ListHarvestJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListHarvestJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListHarvestJobsResponse -> ListHarvestJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHarvestJobsResponse -> ListHarvestJobsResponse -> Bool
$c/= :: ListHarvestJobsResponse -> ListHarvestJobsResponse -> Bool
== :: ListHarvestJobsResponse -> ListHarvestJobsResponse -> Bool
$c== :: ListHarvestJobsResponse -> ListHarvestJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListHarvestJobsResponse]
ReadPrec ListHarvestJobsResponse
Int -> ReadS ListHarvestJobsResponse
ReadS [ListHarvestJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHarvestJobsResponse]
$creadListPrec :: ReadPrec [ListHarvestJobsResponse]
readPrec :: ReadPrec ListHarvestJobsResponse
$creadPrec :: ReadPrec ListHarvestJobsResponse
readList :: ReadS [ListHarvestJobsResponse]
$creadList :: ReadS [ListHarvestJobsResponse]
readsPrec :: Int -> ReadS ListHarvestJobsResponse
$creadsPrec :: Int -> ReadS ListHarvestJobsResponse
Prelude.Read, Int -> ListHarvestJobsResponse -> ShowS
[ListHarvestJobsResponse] -> ShowS
ListHarvestJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHarvestJobsResponse] -> ShowS
$cshowList :: [ListHarvestJobsResponse] -> ShowS
show :: ListHarvestJobsResponse -> String
$cshow :: ListHarvestJobsResponse -> String
showsPrec :: Int -> ListHarvestJobsResponse -> ShowS
$cshowsPrec :: Int -> ListHarvestJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListHarvestJobsResponse x -> ListHarvestJobsResponse
forall x. ListHarvestJobsResponse -> Rep ListHarvestJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHarvestJobsResponse x -> ListHarvestJobsResponse
$cfrom :: forall x. ListHarvestJobsResponse -> Rep ListHarvestJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListHarvestJobsResponse' 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:
--
-- 'harvestJobs', 'listHarvestJobsResponse_harvestJobs' - A list of HarvestJob records.
--
-- 'nextToken', 'listHarvestJobsResponse_nextToken' - A token that can be used to resume pagination from the end of the
-- collection.
--
-- 'httpStatus', 'listHarvestJobsResponse_httpStatus' - The response's http status code.
newListHarvestJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListHarvestJobsResponse
newListHarvestJobsResponse :: Int -> ListHarvestJobsResponse
newListHarvestJobsResponse Int
pHttpStatus_ =
  ListHarvestJobsResponse'
    { $sel:harvestJobs:ListHarvestJobsResponse' :: Maybe [HarvestJob]
harvestJobs =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListHarvestJobsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListHarvestJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of HarvestJob records.
listHarvestJobsResponse_harvestJobs :: Lens.Lens' ListHarvestJobsResponse (Prelude.Maybe [HarvestJob])
listHarvestJobsResponse_harvestJobs :: Lens' ListHarvestJobsResponse (Maybe [HarvestJob])
listHarvestJobsResponse_harvestJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobsResponse' {Maybe [HarvestJob]
harvestJobs :: Maybe [HarvestJob]
$sel:harvestJobs:ListHarvestJobsResponse' :: ListHarvestJobsResponse -> Maybe [HarvestJob]
harvestJobs} -> Maybe [HarvestJob]
harvestJobs) (\s :: ListHarvestJobsResponse
s@ListHarvestJobsResponse' {} Maybe [HarvestJob]
a -> ListHarvestJobsResponse
s {$sel:harvestJobs:ListHarvestJobsResponse' :: Maybe [HarvestJob]
harvestJobs = Maybe [HarvestJob]
a} :: ListHarvestJobsResponse) 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 can be used to resume pagination from the end of the
-- collection.
listHarvestJobsResponse_nextToken :: Lens.Lens' ListHarvestJobsResponse (Prelude.Maybe Prelude.Text)
listHarvestJobsResponse_nextToken :: Lens' ListHarvestJobsResponse (Maybe Text)
listHarvestJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHarvestJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListHarvestJobsResponse' :: ListHarvestJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListHarvestJobsResponse
s@ListHarvestJobsResponse' {} Maybe Text
a -> ListHarvestJobsResponse
s {$sel:nextToken:ListHarvestJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListHarvestJobsResponse)

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

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