{-# 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.Backup.ListCopyJobs
-- 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 metadata about your copy jobs.
--
-- This operation returns paginated results.
module Amazonka.Backup.ListCopyJobs
  ( -- * Creating a Request
    ListCopyJobs (..),
    newListCopyJobs,

    -- * Request Lenses
    listCopyJobs_byAccountId,
    listCopyJobs_byCompleteAfter,
    listCopyJobs_byCompleteBefore,
    listCopyJobs_byCreatedAfter,
    listCopyJobs_byCreatedBefore,
    listCopyJobs_byDestinationVaultArn,
    listCopyJobs_byParentJobId,
    listCopyJobs_byResourceArn,
    listCopyJobs_byResourceType,
    listCopyJobs_byState,
    listCopyJobs_maxResults,
    listCopyJobs_nextToken,

    -- * Destructuring the Response
    ListCopyJobsResponse (..),
    newListCopyJobsResponse,

    -- * Response Lenses
    listCopyJobsResponse_copyJobs,
    listCopyJobsResponse_nextToken,
    listCopyJobsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCopyJobs' smart constructor.
data ListCopyJobs = ListCopyJobs'
  { -- | The account ID to list the jobs from. Returns only copy jobs associated
    -- with the specified account ID.
    ListCopyJobs -> Maybe Text
byAccountId :: Prelude.Maybe Prelude.Text,
    -- | Returns only copy jobs completed after a date expressed in Unix format
    -- and Coordinated Universal Time (UTC).
    ListCopyJobs -> Maybe POSIX
byCompleteAfter :: Prelude.Maybe Data.POSIX,
    -- | Returns only copy jobs completed before a date expressed in Unix format
    -- and Coordinated Universal Time (UTC).
    ListCopyJobs -> Maybe POSIX
byCompleteBefore :: Prelude.Maybe Data.POSIX,
    -- | Returns only copy jobs that were created after the specified date.
    ListCopyJobs -> Maybe POSIX
byCreatedAfter :: Prelude.Maybe Data.POSIX,
    -- | Returns only copy jobs that were created before the specified date.
    ListCopyJobs -> Maybe POSIX
byCreatedBefore :: Prelude.Maybe Data.POSIX,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a source backup
    -- vault to copy from; for example,
    -- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
    ListCopyJobs -> Maybe Text
byDestinationVaultArn :: Prelude.Maybe Prelude.Text,
    -- | This is a filter to list child (nested) jobs based on parent job ID.
    ListCopyJobs -> Maybe Text
byParentJobId :: Prelude.Maybe Prelude.Text,
    -- | Returns only copy jobs that match the specified resource Amazon Resource
    -- Name (ARN).
    ListCopyJobs -> Maybe Text
byResourceArn :: Prelude.Maybe Prelude.Text,
    -- | Returns only backup jobs for the specified resources:
    --
    -- -   @Aurora@ for Amazon Aurora
    --
    -- -   @DocumentDB@ for Amazon DocumentDB (with MongoDB compatibility)
    --
    -- -   @DynamoDB@ for Amazon DynamoDB
    --
    -- -   @EBS@ for Amazon Elastic Block Store
    --
    -- -   @EC2@ for Amazon Elastic Compute Cloud
    --
    -- -   @EFS@ for Amazon Elastic File System
    --
    -- -   @FSx@ for Amazon FSx
    --
    -- -   @Neptune@ for Amazon Neptune
    --
    -- -   @RDS@ for Amazon Relational Database Service
    --
    -- -   @Storage Gateway@ for Storage Gateway
    --
    -- -   @S3@ for Amazon S3
    --
    -- -   @VirtualMachine@ for virtual machines
    ListCopyJobs -> Maybe Text
byResourceType :: Prelude.Maybe Prelude.Text,
    -- | Returns only copy jobs that are in the specified state.
    ListCopyJobs -> Maybe CopyJobState
byState :: Prelude.Maybe CopyJobState,
    -- | The maximum number of items to be returned.
    ListCopyJobs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The next item following a partial list of returned items. For example,
    -- if a request is made to return maxResults number of items, NextToken
    -- allows you to return more items in your list starting at the location
    -- pointed to by the next token.
    ListCopyJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCopyJobs -> ListCopyJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCopyJobs -> ListCopyJobs -> Bool
$c/= :: ListCopyJobs -> ListCopyJobs -> Bool
== :: ListCopyJobs -> ListCopyJobs -> Bool
$c== :: ListCopyJobs -> ListCopyJobs -> Bool
Prelude.Eq, ReadPrec [ListCopyJobs]
ReadPrec ListCopyJobs
Int -> ReadS ListCopyJobs
ReadS [ListCopyJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCopyJobs]
$creadListPrec :: ReadPrec [ListCopyJobs]
readPrec :: ReadPrec ListCopyJobs
$creadPrec :: ReadPrec ListCopyJobs
readList :: ReadS [ListCopyJobs]
$creadList :: ReadS [ListCopyJobs]
readsPrec :: Int -> ReadS ListCopyJobs
$creadsPrec :: Int -> ReadS ListCopyJobs
Prelude.Read, Int -> ListCopyJobs -> ShowS
[ListCopyJobs] -> ShowS
ListCopyJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCopyJobs] -> ShowS
$cshowList :: [ListCopyJobs] -> ShowS
show :: ListCopyJobs -> String
$cshow :: ListCopyJobs -> String
showsPrec :: Int -> ListCopyJobs -> ShowS
$cshowsPrec :: Int -> ListCopyJobs -> ShowS
Prelude.Show, forall x. Rep ListCopyJobs x -> ListCopyJobs
forall x. ListCopyJobs -> Rep ListCopyJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCopyJobs x -> ListCopyJobs
$cfrom :: forall x. ListCopyJobs -> Rep ListCopyJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListCopyJobs' 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:
--
-- 'byAccountId', 'listCopyJobs_byAccountId' - The account ID to list the jobs from. Returns only copy jobs associated
-- with the specified account ID.
--
-- 'byCompleteAfter', 'listCopyJobs_byCompleteAfter' - Returns only copy jobs completed after a date expressed in Unix format
-- and Coordinated Universal Time (UTC).
--
-- 'byCompleteBefore', 'listCopyJobs_byCompleteBefore' - Returns only copy jobs completed before a date expressed in Unix format
-- and Coordinated Universal Time (UTC).
--
-- 'byCreatedAfter', 'listCopyJobs_byCreatedAfter' - Returns only copy jobs that were created after the specified date.
--
-- 'byCreatedBefore', 'listCopyJobs_byCreatedBefore' - Returns only copy jobs that were created before the specified date.
--
-- 'byDestinationVaultArn', 'listCopyJobs_byDestinationVaultArn' - An Amazon Resource Name (ARN) that uniquely identifies a source backup
-- vault to copy from; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
--
-- 'byParentJobId', 'listCopyJobs_byParentJobId' - This is a filter to list child (nested) jobs based on parent job ID.
--
-- 'byResourceArn', 'listCopyJobs_byResourceArn' - Returns only copy jobs that match the specified resource Amazon Resource
-- Name (ARN).
--
-- 'byResourceType', 'listCopyJobs_byResourceType' - Returns only backup jobs for the specified resources:
--
-- -   @Aurora@ for Amazon Aurora
--
-- -   @DocumentDB@ for Amazon DocumentDB (with MongoDB compatibility)
--
-- -   @DynamoDB@ for Amazon DynamoDB
--
-- -   @EBS@ for Amazon Elastic Block Store
--
-- -   @EC2@ for Amazon Elastic Compute Cloud
--
-- -   @EFS@ for Amazon Elastic File System
--
-- -   @FSx@ for Amazon FSx
--
-- -   @Neptune@ for Amazon Neptune
--
-- -   @RDS@ for Amazon Relational Database Service
--
-- -   @Storage Gateway@ for Storage Gateway
--
-- -   @S3@ for Amazon S3
--
-- -   @VirtualMachine@ for virtual machines
--
-- 'byState', 'listCopyJobs_byState' - Returns only copy jobs that are in the specified state.
--
-- 'maxResults', 'listCopyJobs_maxResults' - The maximum number of items to be returned.
--
-- 'nextToken', 'listCopyJobs_nextToken' - The next item following a partial list of returned items. For example,
-- if a request is made to return maxResults number of items, NextToken
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
newListCopyJobs ::
  ListCopyJobs
newListCopyJobs :: ListCopyJobs
newListCopyJobs =
  ListCopyJobs'
    { $sel:byAccountId:ListCopyJobs' :: Maybe Text
byAccountId = forall a. Maybe a
Prelude.Nothing,
      $sel:byCompleteAfter:ListCopyJobs' :: Maybe POSIX
byCompleteAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:byCompleteBefore:ListCopyJobs' :: Maybe POSIX
byCompleteBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:byCreatedAfter:ListCopyJobs' :: Maybe POSIX
byCreatedAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:byCreatedBefore:ListCopyJobs' :: Maybe POSIX
byCreatedBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:byDestinationVaultArn:ListCopyJobs' :: Maybe Text
byDestinationVaultArn = forall a. Maybe a
Prelude.Nothing,
      $sel:byParentJobId:ListCopyJobs' :: Maybe Text
byParentJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:byResourceArn:ListCopyJobs' :: Maybe Text
byResourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:byResourceType:ListCopyJobs' :: Maybe Text
byResourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:byState:ListCopyJobs' :: Maybe CopyJobState
byState = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListCopyJobs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCopyJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The account ID to list the jobs from. Returns only copy jobs associated
-- with the specified account ID.
listCopyJobs_byAccountId :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_byAccountId :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_byAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
byAccountId :: Maybe Text
$sel:byAccountId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
byAccountId} -> Maybe Text
byAccountId) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:byAccountId:ListCopyJobs' :: Maybe Text
byAccountId = Maybe Text
a} :: ListCopyJobs)

-- | Returns only copy jobs completed after a date expressed in Unix format
-- and Coordinated Universal Time (UTC).
listCopyJobs_byCompleteAfter :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.UTCTime)
listCopyJobs_byCompleteAfter :: Lens' ListCopyJobs (Maybe UTCTime)
listCopyJobs_byCompleteAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe POSIX
byCompleteAfter :: Maybe POSIX
$sel:byCompleteAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
byCompleteAfter} -> Maybe POSIX
byCompleteAfter) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe POSIX
a -> ListCopyJobs
s {$sel:byCompleteAfter:ListCopyJobs' :: Maybe POSIX
byCompleteAfter = Maybe POSIX
a} :: ListCopyJobs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Returns only copy jobs completed before a date expressed in Unix format
-- and Coordinated Universal Time (UTC).
listCopyJobs_byCompleteBefore :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.UTCTime)
listCopyJobs_byCompleteBefore :: Lens' ListCopyJobs (Maybe UTCTime)
listCopyJobs_byCompleteBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe POSIX
byCompleteBefore :: Maybe POSIX
$sel:byCompleteBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
byCompleteBefore} -> Maybe POSIX
byCompleteBefore) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe POSIX
a -> ListCopyJobs
s {$sel:byCompleteBefore:ListCopyJobs' :: Maybe POSIX
byCompleteBefore = Maybe POSIX
a} :: ListCopyJobs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Returns only copy jobs that were created after the specified date.
listCopyJobs_byCreatedAfter :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.UTCTime)
listCopyJobs_byCreatedAfter :: Lens' ListCopyJobs (Maybe UTCTime)
listCopyJobs_byCreatedAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe POSIX
byCreatedAfter :: Maybe POSIX
$sel:byCreatedAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
byCreatedAfter} -> Maybe POSIX
byCreatedAfter) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe POSIX
a -> ListCopyJobs
s {$sel:byCreatedAfter:ListCopyJobs' :: Maybe POSIX
byCreatedAfter = Maybe POSIX
a} :: ListCopyJobs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Returns only copy jobs that were created before the specified date.
listCopyJobs_byCreatedBefore :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.UTCTime)
listCopyJobs_byCreatedBefore :: Lens' ListCopyJobs (Maybe UTCTime)
listCopyJobs_byCreatedBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe POSIX
byCreatedBefore :: Maybe POSIX
$sel:byCreatedBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
byCreatedBefore} -> Maybe POSIX
byCreatedBefore) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe POSIX
a -> ListCopyJobs
s {$sel:byCreatedBefore:ListCopyJobs' :: Maybe POSIX
byCreatedBefore = Maybe POSIX
a} :: ListCopyJobs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | An Amazon Resource Name (ARN) that uniquely identifies a source backup
-- vault to copy from; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
listCopyJobs_byDestinationVaultArn :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_byDestinationVaultArn :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_byDestinationVaultArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
byDestinationVaultArn :: Maybe Text
$sel:byDestinationVaultArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
byDestinationVaultArn} -> Maybe Text
byDestinationVaultArn) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:byDestinationVaultArn:ListCopyJobs' :: Maybe Text
byDestinationVaultArn = Maybe Text
a} :: ListCopyJobs)

-- | This is a filter to list child (nested) jobs based on parent job ID.
listCopyJobs_byParentJobId :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_byParentJobId :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_byParentJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
byParentJobId :: Maybe Text
$sel:byParentJobId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
byParentJobId} -> Maybe Text
byParentJobId) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:byParentJobId:ListCopyJobs' :: Maybe Text
byParentJobId = Maybe Text
a} :: ListCopyJobs)

-- | Returns only copy jobs that match the specified resource Amazon Resource
-- Name (ARN).
listCopyJobs_byResourceArn :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_byResourceArn :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_byResourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
byResourceArn :: Maybe Text
$sel:byResourceArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
byResourceArn} -> Maybe Text
byResourceArn) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:byResourceArn:ListCopyJobs' :: Maybe Text
byResourceArn = Maybe Text
a} :: ListCopyJobs)

-- | Returns only backup jobs for the specified resources:
--
-- -   @Aurora@ for Amazon Aurora
--
-- -   @DocumentDB@ for Amazon DocumentDB (with MongoDB compatibility)
--
-- -   @DynamoDB@ for Amazon DynamoDB
--
-- -   @EBS@ for Amazon Elastic Block Store
--
-- -   @EC2@ for Amazon Elastic Compute Cloud
--
-- -   @EFS@ for Amazon Elastic File System
--
-- -   @FSx@ for Amazon FSx
--
-- -   @Neptune@ for Amazon Neptune
--
-- -   @RDS@ for Amazon Relational Database Service
--
-- -   @Storage Gateway@ for Storage Gateway
--
-- -   @S3@ for Amazon S3
--
-- -   @VirtualMachine@ for virtual machines
listCopyJobs_byResourceType :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_byResourceType :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_byResourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
byResourceType :: Maybe Text
$sel:byResourceType:ListCopyJobs' :: ListCopyJobs -> Maybe Text
byResourceType} -> Maybe Text
byResourceType) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:byResourceType:ListCopyJobs' :: Maybe Text
byResourceType = Maybe Text
a} :: ListCopyJobs)

-- | Returns only copy jobs that are in the specified state.
listCopyJobs_byState :: Lens.Lens' ListCopyJobs (Prelude.Maybe CopyJobState)
listCopyJobs_byState :: Lens' ListCopyJobs (Maybe CopyJobState)
listCopyJobs_byState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe CopyJobState
byState :: Maybe CopyJobState
$sel:byState:ListCopyJobs' :: ListCopyJobs -> Maybe CopyJobState
byState} -> Maybe CopyJobState
byState) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe CopyJobState
a -> ListCopyJobs
s {$sel:byState:ListCopyJobs' :: Maybe CopyJobState
byState = Maybe CopyJobState
a} :: ListCopyJobs)

-- | The maximum number of items to be returned.
listCopyJobs_maxResults :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Natural)
listCopyJobs_maxResults :: Lens' ListCopyJobs (Maybe Natural)
listCopyJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCopyJobs' :: ListCopyJobs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Natural
a -> ListCopyJobs
s {$sel:maxResults:ListCopyJobs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCopyJobs)

-- | The next item following a partial list of returned items. For example,
-- if a request is made to return maxResults number of items, NextToken
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
listCopyJobs_nextToken :: Lens.Lens' ListCopyJobs (Prelude.Maybe Prelude.Text)
listCopyJobs_nextToken :: Lens' ListCopyJobs (Maybe Text)
listCopyJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCopyJobs' :: ListCopyJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCopyJobs
s@ListCopyJobs' {} Maybe Text
a -> ListCopyJobs
s {$sel:nextToken:ListCopyJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListCopyJobs)

instance Core.AWSPager ListCopyJobs where
  page :: ListCopyJobs -> AWSResponse ListCopyJobs -> Maybe ListCopyJobs
page ListCopyJobs
rq AWSResponse ListCopyJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCopyJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCopyJobsResponse (Maybe Text)
listCopyJobsResponse_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 ListCopyJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCopyJobsResponse (Maybe [CopyJob])
listCopyJobsResponse_copyJobs
            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.$ ListCopyJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCopyJobs (Maybe Text)
listCopyJobs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCopyJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCopyJobsResponse (Maybe Text)
listCopyJobsResponse_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 ListCopyJobs where
  type AWSResponse ListCopyJobs = ListCopyJobsResponse
  request :: (Service -> Service) -> ListCopyJobs -> Request ListCopyJobs
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 ListCopyJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCopyJobs)))
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 [CopyJob] -> Maybe Text -> Int -> ListCopyJobsResponse
ListCopyJobsResponse'
            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
"CopyJobs" 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 ListCopyJobs where
  hashWithSalt :: Int -> ListCopyJobs -> Int
hashWithSalt Int
_salt ListCopyJobs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe CopyJobState
nextToken :: Maybe Text
maxResults :: Maybe Natural
byState :: Maybe CopyJobState
byResourceType :: Maybe Text
byResourceArn :: Maybe Text
byParentJobId :: Maybe Text
byDestinationVaultArn :: Maybe Text
byCreatedBefore :: Maybe POSIX
byCreatedAfter :: Maybe POSIX
byCompleteBefore :: Maybe POSIX
byCompleteAfter :: Maybe POSIX
byAccountId :: Maybe Text
$sel:nextToken:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:maxResults:ListCopyJobs' :: ListCopyJobs -> Maybe Natural
$sel:byState:ListCopyJobs' :: ListCopyJobs -> Maybe CopyJobState
$sel:byResourceType:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byResourceArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byParentJobId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byDestinationVaultArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byCreatedBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCreatedAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byAccountId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
byAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
byCompleteAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
byCompleteBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
byCreatedAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
byCreatedBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
byDestinationVaultArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
byParentJobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
byResourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
byResourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CopyJobState
byState
      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 ListCopyJobs where
  rnf :: ListCopyJobs -> ()
rnf ListCopyJobs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe CopyJobState
nextToken :: Maybe Text
maxResults :: Maybe Natural
byState :: Maybe CopyJobState
byResourceType :: Maybe Text
byResourceArn :: Maybe Text
byParentJobId :: Maybe Text
byDestinationVaultArn :: Maybe Text
byCreatedBefore :: Maybe POSIX
byCreatedAfter :: Maybe POSIX
byCompleteBefore :: Maybe POSIX
byCompleteAfter :: Maybe POSIX
byAccountId :: Maybe Text
$sel:nextToken:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:maxResults:ListCopyJobs' :: ListCopyJobs -> Maybe Natural
$sel:byState:ListCopyJobs' :: ListCopyJobs -> Maybe CopyJobState
$sel:byResourceType:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byResourceArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byParentJobId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byDestinationVaultArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byCreatedBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCreatedAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byAccountId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
byAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
byCompleteAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
byCompleteBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
byCreatedAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
byCreatedBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
byDestinationVaultArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
byParentJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
byResourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
byResourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CopyJobState
byState
      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 ListCopyJobs where
  toHeaders :: ListCopyJobs -> 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 ListCopyJobs where
  toPath :: ListCopyJobs -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/copy-jobs/"

instance Data.ToQuery ListCopyJobs where
  toQuery :: ListCopyJobs -> QueryString
toQuery ListCopyJobs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe CopyJobState
nextToken :: Maybe Text
maxResults :: Maybe Natural
byState :: Maybe CopyJobState
byResourceType :: Maybe Text
byResourceArn :: Maybe Text
byParentJobId :: Maybe Text
byDestinationVaultArn :: Maybe Text
byCreatedBefore :: Maybe POSIX
byCreatedAfter :: Maybe POSIX
byCompleteBefore :: Maybe POSIX
byCompleteAfter :: Maybe POSIX
byAccountId :: Maybe Text
$sel:nextToken:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:maxResults:ListCopyJobs' :: ListCopyJobs -> Maybe Natural
$sel:byState:ListCopyJobs' :: ListCopyJobs -> Maybe CopyJobState
$sel:byResourceType:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byResourceArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byParentJobId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byDestinationVaultArn:ListCopyJobs' :: ListCopyJobs -> Maybe Text
$sel:byCreatedBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCreatedAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteBefore:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byCompleteAfter:ListCopyJobs' :: ListCopyJobs -> Maybe POSIX
$sel:byAccountId:ListCopyJobs' :: ListCopyJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"accountId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
byAccountId,
        ByteString
"completeAfter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
byCompleteAfter,
        ByteString
"completeBefore" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
byCompleteBefore,
        ByteString
"createdAfter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
byCreatedAfter,
        ByteString
"createdBefore" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
byCreatedBefore,
        ByteString
"destinationVaultArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
byDestinationVaultArn,
        ByteString
"parentJobId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
byParentJobId,
        ByteString
"resourceArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
byResourceArn,
        ByteString
"resourceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
byResourceType,
        ByteString
"state" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CopyJobState
byState,
        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:/ 'newListCopyJobsResponse' smart constructor.
data ListCopyJobsResponse = ListCopyJobsResponse'
  { -- | An array of structures containing metadata about your copy jobs returned
    -- in JSON format.
    ListCopyJobsResponse -> Maybe [CopyJob]
copyJobs :: Prelude.Maybe [CopyJob],
    -- | The next item following a partial list of returned items. For example,
    -- if a request is made to return maxResults number of items, NextToken
    -- allows you to return more items in your list starting at the location
    -- pointed to by the next token.
    ListCopyJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCopyJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCopyJobsResponse -> ListCopyJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCopyJobsResponse -> ListCopyJobsResponse -> Bool
$c/= :: ListCopyJobsResponse -> ListCopyJobsResponse -> Bool
== :: ListCopyJobsResponse -> ListCopyJobsResponse -> Bool
$c== :: ListCopyJobsResponse -> ListCopyJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListCopyJobsResponse]
ReadPrec ListCopyJobsResponse
Int -> ReadS ListCopyJobsResponse
ReadS [ListCopyJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCopyJobsResponse]
$creadListPrec :: ReadPrec [ListCopyJobsResponse]
readPrec :: ReadPrec ListCopyJobsResponse
$creadPrec :: ReadPrec ListCopyJobsResponse
readList :: ReadS [ListCopyJobsResponse]
$creadList :: ReadS [ListCopyJobsResponse]
readsPrec :: Int -> ReadS ListCopyJobsResponse
$creadsPrec :: Int -> ReadS ListCopyJobsResponse
Prelude.Read, Int -> ListCopyJobsResponse -> ShowS
[ListCopyJobsResponse] -> ShowS
ListCopyJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCopyJobsResponse] -> ShowS
$cshowList :: [ListCopyJobsResponse] -> ShowS
show :: ListCopyJobsResponse -> String
$cshow :: ListCopyJobsResponse -> String
showsPrec :: Int -> ListCopyJobsResponse -> ShowS
$cshowsPrec :: Int -> ListCopyJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListCopyJobsResponse x -> ListCopyJobsResponse
forall x. ListCopyJobsResponse -> Rep ListCopyJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCopyJobsResponse x -> ListCopyJobsResponse
$cfrom :: forall x. ListCopyJobsResponse -> Rep ListCopyJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCopyJobsResponse' 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:
--
-- 'copyJobs', 'listCopyJobsResponse_copyJobs' - An array of structures containing metadata about your copy jobs returned
-- in JSON format.
--
-- 'nextToken', 'listCopyJobsResponse_nextToken' - The next item following a partial list of returned items. For example,
-- if a request is made to return maxResults number of items, NextToken
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
--
-- 'httpStatus', 'listCopyJobsResponse_httpStatus' - The response's http status code.
newListCopyJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCopyJobsResponse
newListCopyJobsResponse :: Int -> ListCopyJobsResponse
newListCopyJobsResponse Int
pHttpStatus_ =
  ListCopyJobsResponse'
    { $sel:copyJobs:ListCopyJobsResponse' :: Maybe [CopyJob]
copyJobs = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCopyJobsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCopyJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of structures containing metadata about your copy jobs returned
-- in JSON format.
listCopyJobsResponse_copyJobs :: Lens.Lens' ListCopyJobsResponse (Prelude.Maybe [CopyJob])
listCopyJobsResponse_copyJobs :: Lens' ListCopyJobsResponse (Maybe [CopyJob])
listCopyJobsResponse_copyJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobsResponse' {Maybe [CopyJob]
copyJobs :: Maybe [CopyJob]
$sel:copyJobs:ListCopyJobsResponse' :: ListCopyJobsResponse -> Maybe [CopyJob]
copyJobs} -> Maybe [CopyJob]
copyJobs) (\s :: ListCopyJobsResponse
s@ListCopyJobsResponse' {} Maybe [CopyJob]
a -> ListCopyJobsResponse
s {$sel:copyJobs:ListCopyJobsResponse' :: Maybe [CopyJob]
copyJobs = Maybe [CopyJob]
a} :: ListCopyJobsResponse) 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

-- | The next item following a partial list of returned items. For example,
-- if a request is made to return maxResults number of items, NextToken
-- allows you to return more items in your list starting at the location
-- pointed to by the next token.
listCopyJobsResponse_nextToken :: Lens.Lens' ListCopyJobsResponse (Prelude.Maybe Prelude.Text)
listCopyJobsResponse_nextToken :: Lens' ListCopyJobsResponse (Maybe Text)
listCopyJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCopyJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCopyJobsResponse' :: ListCopyJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCopyJobsResponse
s@ListCopyJobsResponse' {} Maybe Text
a -> ListCopyJobsResponse
s {$sel:nextToken:ListCopyJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCopyJobsResponse)

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

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