{-# 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.StartCopyJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a job to create a one-time copy of the specified resource.
--
-- Does not support continuous backups.
module Amazonka.Backup.StartCopyJob
  ( -- * Creating a Request
    StartCopyJob (..),
    newStartCopyJob,

    -- * Request Lenses
    startCopyJob_idempotencyToken,
    startCopyJob_lifecycle,
    startCopyJob_recoveryPointArn,
    startCopyJob_sourceBackupVaultName,
    startCopyJob_destinationBackupVaultArn,
    startCopyJob_iamRoleArn,

    -- * Destructuring the Response
    StartCopyJobResponse (..),
    newStartCopyJobResponse,

    -- * Response Lenses
    startCopyJobResponse_copyJobId,
    startCopyJobResponse_creationDate,
    startCopyJobResponse_isParent,
    startCopyJobResponse_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:/ 'newStartCopyJob' smart constructor.
data StartCopyJob = StartCopyJob'
  { -- | A customer-chosen string that you can use to distinguish between
    -- otherwise identical calls to @StartCopyJob@. Retrying a successful
    -- request with the same idempotency token results in a success message
    -- with no action taken.
    StartCopyJob -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    StartCopyJob -> Maybe Lifecycle
lifecycle :: Prelude.Maybe Lifecycle,
    -- | An ARN that uniquely identifies a recovery point to use for the copy
    -- job; for example,
    -- arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45.
    StartCopyJob -> Text
recoveryPointArn :: Prelude.Text,
    -- | The name of a logical source container where backups are stored. Backup
    -- vaults are identified by names that are unique to the account used to
    -- create them and the Amazon Web Services Region where they are created.
    -- They consist of lowercase letters, numbers, and hyphens.
    StartCopyJob -> Text
sourceBackupVaultName :: Prelude.Text,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a destination
    -- backup vault to copy to; for example,
    -- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
    StartCopyJob -> Text
destinationBackupVaultArn :: Prelude.Text,
    -- | Specifies the IAM role ARN used to copy the target recovery point; for
    -- example, @arn:aws:iam::123456789012:role\/S3Access@.
    StartCopyJob -> Text
iamRoleArn :: Prelude.Text
  }
  deriving (StartCopyJob -> StartCopyJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartCopyJob -> StartCopyJob -> Bool
$c/= :: StartCopyJob -> StartCopyJob -> Bool
== :: StartCopyJob -> StartCopyJob -> Bool
$c== :: StartCopyJob -> StartCopyJob -> Bool
Prelude.Eq, ReadPrec [StartCopyJob]
ReadPrec StartCopyJob
Int -> ReadS StartCopyJob
ReadS [StartCopyJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartCopyJob]
$creadListPrec :: ReadPrec [StartCopyJob]
readPrec :: ReadPrec StartCopyJob
$creadPrec :: ReadPrec StartCopyJob
readList :: ReadS [StartCopyJob]
$creadList :: ReadS [StartCopyJob]
readsPrec :: Int -> ReadS StartCopyJob
$creadsPrec :: Int -> ReadS StartCopyJob
Prelude.Read, Int -> StartCopyJob -> ShowS
[StartCopyJob] -> ShowS
StartCopyJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartCopyJob] -> ShowS
$cshowList :: [StartCopyJob] -> ShowS
show :: StartCopyJob -> String
$cshow :: StartCopyJob -> String
showsPrec :: Int -> StartCopyJob -> ShowS
$cshowsPrec :: Int -> StartCopyJob -> ShowS
Prelude.Show, forall x. Rep StartCopyJob x -> StartCopyJob
forall x. StartCopyJob -> Rep StartCopyJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartCopyJob x -> StartCopyJob
$cfrom :: forall x. StartCopyJob -> Rep StartCopyJob x
Prelude.Generic)

-- |
-- Create a value of 'StartCopyJob' 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:
--
-- 'idempotencyToken', 'startCopyJob_idempotencyToken' - A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @StartCopyJob@. Retrying a successful
-- request with the same idempotency token results in a success message
-- with no action taken.
--
-- 'lifecycle', 'startCopyJob_lifecycle' - Undocumented member.
--
-- 'recoveryPointArn', 'startCopyJob_recoveryPointArn' - An ARN that uniquely identifies a recovery point to use for the copy
-- job; for example,
-- arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45.
--
-- 'sourceBackupVaultName', 'startCopyJob_sourceBackupVaultName' - The name of a logical source container where backups are stored. Backup
-- vaults are identified by names that are unique to the account used to
-- create them and the Amazon Web Services Region where they are created.
-- They consist of lowercase letters, numbers, and hyphens.
--
-- 'destinationBackupVaultArn', 'startCopyJob_destinationBackupVaultArn' - An Amazon Resource Name (ARN) that uniquely identifies a destination
-- backup vault to copy to; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
--
-- 'iamRoleArn', 'startCopyJob_iamRoleArn' - Specifies the IAM role ARN used to copy the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
newStartCopyJob ::
  -- | 'recoveryPointArn'
  Prelude.Text ->
  -- | 'sourceBackupVaultName'
  Prelude.Text ->
  -- | 'destinationBackupVaultArn'
  Prelude.Text ->
  -- | 'iamRoleArn'
  Prelude.Text ->
  StartCopyJob
newStartCopyJob :: Text -> Text -> Text -> Text -> StartCopyJob
newStartCopyJob
  Text
pRecoveryPointArn_
  Text
pSourceBackupVaultName_
  Text
pDestinationBackupVaultArn_
  Text
pIamRoleArn_ =
    StartCopyJob'
      { $sel:idempotencyToken:StartCopyJob' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycle:StartCopyJob' :: Maybe Lifecycle
lifecycle = forall a. Maybe a
Prelude.Nothing,
        $sel:recoveryPointArn:StartCopyJob' :: Text
recoveryPointArn = Text
pRecoveryPointArn_,
        $sel:sourceBackupVaultName:StartCopyJob' :: Text
sourceBackupVaultName = Text
pSourceBackupVaultName_,
        $sel:destinationBackupVaultArn:StartCopyJob' :: Text
destinationBackupVaultArn =
          Text
pDestinationBackupVaultArn_,
        $sel:iamRoleArn:StartCopyJob' :: Text
iamRoleArn = Text
pIamRoleArn_
      }

-- | A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @StartCopyJob@. Retrying a successful
-- request with the same idempotency token results in a success message
-- with no action taken.
startCopyJob_idempotencyToken :: Lens.Lens' StartCopyJob (Prelude.Maybe Prelude.Text)
startCopyJob_idempotencyToken :: Lens' StartCopyJob (Maybe Text)
startCopyJob_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJob' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:StartCopyJob' :: StartCopyJob -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: StartCopyJob
s@StartCopyJob' {} Maybe Text
a -> StartCopyJob
s {$sel:idempotencyToken:StartCopyJob' :: Maybe Text
idempotencyToken = Maybe Text
a} :: StartCopyJob)

-- | Undocumented member.
startCopyJob_lifecycle :: Lens.Lens' StartCopyJob (Prelude.Maybe Lifecycle)
startCopyJob_lifecycle :: Lens' StartCopyJob (Maybe Lifecycle)
startCopyJob_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJob' {Maybe Lifecycle
lifecycle :: Maybe Lifecycle
$sel:lifecycle:StartCopyJob' :: StartCopyJob -> Maybe Lifecycle
lifecycle} -> Maybe Lifecycle
lifecycle) (\s :: StartCopyJob
s@StartCopyJob' {} Maybe Lifecycle
a -> StartCopyJob
s {$sel:lifecycle:StartCopyJob' :: Maybe Lifecycle
lifecycle = Maybe Lifecycle
a} :: StartCopyJob)

-- | An ARN that uniquely identifies a recovery point to use for the copy
-- job; for example,
-- arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45.
startCopyJob_recoveryPointArn :: Lens.Lens' StartCopyJob Prelude.Text
startCopyJob_recoveryPointArn :: Lens' StartCopyJob Text
startCopyJob_recoveryPointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJob' {Text
recoveryPointArn :: Text
$sel:recoveryPointArn:StartCopyJob' :: StartCopyJob -> Text
recoveryPointArn} -> Text
recoveryPointArn) (\s :: StartCopyJob
s@StartCopyJob' {} Text
a -> StartCopyJob
s {$sel:recoveryPointArn:StartCopyJob' :: Text
recoveryPointArn = Text
a} :: StartCopyJob)

-- | The name of a logical source container where backups are stored. Backup
-- vaults are identified by names that are unique to the account used to
-- create them and the Amazon Web Services Region where they are created.
-- They consist of lowercase letters, numbers, and hyphens.
startCopyJob_sourceBackupVaultName :: Lens.Lens' StartCopyJob Prelude.Text
startCopyJob_sourceBackupVaultName :: Lens' StartCopyJob Text
startCopyJob_sourceBackupVaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJob' {Text
sourceBackupVaultName :: Text
$sel:sourceBackupVaultName:StartCopyJob' :: StartCopyJob -> Text
sourceBackupVaultName} -> Text
sourceBackupVaultName) (\s :: StartCopyJob
s@StartCopyJob' {} Text
a -> StartCopyJob
s {$sel:sourceBackupVaultName:StartCopyJob' :: Text
sourceBackupVaultName = Text
a} :: StartCopyJob)

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

-- | Specifies the IAM role ARN used to copy the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
startCopyJob_iamRoleArn :: Lens.Lens' StartCopyJob Prelude.Text
startCopyJob_iamRoleArn :: Lens' StartCopyJob Text
startCopyJob_iamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJob' {Text
iamRoleArn :: Text
$sel:iamRoleArn:StartCopyJob' :: StartCopyJob -> Text
iamRoleArn} -> Text
iamRoleArn) (\s :: StartCopyJob
s@StartCopyJob' {} Text
a -> StartCopyJob
s {$sel:iamRoleArn:StartCopyJob' :: Text
iamRoleArn = Text
a} :: StartCopyJob)

instance Core.AWSRequest StartCopyJob where
  type AWSResponse StartCopyJob = StartCopyJobResponse
  request :: (Service -> Service) -> StartCopyJob -> Request StartCopyJob
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartCopyJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartCopyJob)))
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 Text
-> Maybe POSIX -> Maybe Bool -> Int -> StartCopyJobResponse
StartCopyJobResponse'
            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
"CopyJobId")
            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
"CreationDate")
            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
"IsParent")
            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 StartCopyJob where
  hashWithSalt :: Int -> StartCopyJob -> Int
hashWithSalt Int
_salt StartCopyJob' {Maybe Text
Maybe Lifecycle
Text
iamRoleArn :: Text
destinationBackupVaultArn :: Text
sourceBackupVaultName :: Text
recoveryPointArn :: Text
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
$sel:iamRoleArn:StartCopyJob' :: StartCopyJob -> Text
$sel:destinationBackupVaultArn:StartCopyJob' :: StartCopyJob -> Text
$sel:sourceBackupVaultName:StartCopyJob' :: StartCopyJob -> Text
$sel:recoveryPointArn:StartCopyJob' :: StartCopyJob -> Text
$sel:lifecycle:StartCopyJob' :: StartCopyJob -> Maybe Lifecycle
$sel:idempotencyToken:StartCopyJob' :: StartCopyJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Lifecycle
lifecycle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
recoveryPointArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceBackupVaultName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationBackupVaultArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamRoleArn

instance Prelude.NFData StartCopyJob where
  rnf :: StartCopyJob -> ()
rnf StartCopyJob' {Maybe Text
Maybe Lifecycle
Text
iamRoleArn :: Text
destinationBackupVaultArn :: Text
sourceBackupVaultName :: Text
recoveryPointArn :: Text
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
$sel:iamRoleArn:StartCopyJob' :: StartCopyJob -> Text
$sel:destinationBackupVaultArn:StartCopyJob' :: StartCopyJob -> Text
$sel:sourceBackupVaultName:StartCopyJob' :: StartCopyJob -> Text
$sel:recoveryPointArn:StartCopyJob' :: StartCopyJob -> Text
$sel:lifecycle:StartCopyJob' :: StartCopyJob -> Maybe Lifecycle
$sel:idempotencyToken:StartCopyJob' :: StartCopyJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Lifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
recoveryPointArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceBackupVaultName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationBackupVaultArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamRoleArn

instance Data.ToHeaders StartCopyJob where
  toHeaders :: StartCopyJob -> 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.ToJSON StartCopyJob where
  toJSON :: StartCopyJob -> Value
toJSON StartCopyJob' {Maybe Text
Maybe Lifecycle
Text
iamRoleArn :: Text
destinationBackupVaultArn :: Text
sourceBackupVaultName :: Text
recoveryPointArn :: Text
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
$sel:iamRoleArn:StartCopyJob' :: StartCopyJob -> Text
$sel:destinationBackupVaultArn:StartCopyJob' :: StartCopyJob -> Text
$sel:sourceBackupVaultName:StartCopyJob' :: StartCopyJob -> Text
$sel:recoveryPointArn:StartCopyJob' :: StartCopyJob -> Text
$sel:lifecycle:StartCopyJob' :: StartCopyJob -> Maybe Lifecycle
$sel:idempotencyToken:StartCopyJob' :: StartCopyJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdempotencyToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
idempotencyToken,
            (Key
"Lifecycle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Lifecycle
lifecycle,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RecoveryPointArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
recoveryPointArn),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"SourceBackupVaultName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceBackupVaultName
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DestinationBackupVaultArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationBackupVaultArn
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"IamRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
iamRoleArn)
          ]
      )

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

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

-- | /See:/ 'newStartCopyJobResponse' smart constructor.
data StartCopyJobResponse = StartCopyJobResponse'
  { -- | Uniquely identifies a copy job.
    StartCopyJobResponse -> Maybe Text
copyJobId :: Prelude.Maybe Prelude.Text,
    -- | The date and time that a copy job is created, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @CreationDate@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    StartCopyJobResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | This is a returned boolean value indicating this is a parent (composite)
    -- copy job.
    StartCopyJobResponse -> Maybe Bool
isParent :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    StartCopyJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartCopyJobResponse -> StartCopyJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartCopyJobResponse -> StartCopyJobResponse -> Bool
$c/= :: StartCopyJobResponse -> StartCopyJobResponse -> Bool
== :: StartCopyJobResponse -> StartCopyJobResponse -> Bool
$c== :: StartCopyJobResponse -> StartCopyJobResponse -> Bool
Prelude.Eq, ReadPrec [StartCopyJobResponse]
ReadPrec StartCopyJobResponse
Int -> ReadS StartCopyJobResponse
ReadS [StartCopyJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartCopyJobResponse]
$creadListPrec :: ReadPrec [StartCopyJobResponse]
readPrec :: ReadPrec StartCopyJobResponse
$creadPrec :: ReadPrec StartCopyJobResponse
readList :: ReadS [StartCopyJobResponse]
$creadList :: ReadS [StartCopyJobResponse]
readsPrec :: Int -> ReadS StartCopyJobResponse
$creadsPrec :: Int -> ReadS StartCopyJobResponse
Prelude.Read, Int -> StartCopyJobResponse -> ShowS
[StartCopyJobResponse] -> ShowS
StartCopyJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartCopyJobResponse] -> ShowS
$cshowList :: [StartCopyJobResponse] -> ShowS
show :: StartCopyJobResponse -> String
$cshow :: StartCopyJobResponse -> String
showsPrec :: Int -> StartCopyJobResponse -> ShowS
$cshowsPrec :: Int -> StartCopyJobResponse -> ShowS
Prelude.Show, forall x. Rep StartCopyJobResponse x -> StartCopyJobResponse
forall x. StartCopyJobResponse -> Rep StartCopyJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartCopyJobResponse x -> StartCopyJobResponse
$cfrom :: forall x. StartCopyJobResponse -> Rep StartCopyJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartCopyJobResponse' 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:
--
-- 'copyJobId', 'startCopyJobResponse_copyJobId' - Uniquely identifies a copy job.
--
-- 'creationDate', 'startCopyJobResponse_creationDate' - The date and time that a copy job is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'isParent', 'startCopyJobResponse_isParent' - This is a returned boolean value indicating this is a parent (composite)
-- copy job.
--
-- 'httpStatus', 'startCopyJobResponse_httpStatus' - The response's http status code.
newStartCopyJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartCopyJobResponse
newStartCopyJobResponse :: Int -> StartCopyJobResponse
newStartCopyJobResponse Int
pHttpStatus_ =
  StartCopyJobResponse'
    { $sel:copyJobId:StartCopyJobResponse' :: Maybe Text
copyJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:StartCopyJobResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:isParent:StartCopyJobResponse' :: Maybe Bool
isParent = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartCopyJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Uniquely identifies a copy job.
startCopyJobResponse_copyJobId :: Lens.Lens' StartCopyJobResponse (Prelude.Maybe Prelude.Text)
startCopyJobResponse_copyJobId :: Lens' StartCopyJobResponse (Maybe Text)
startCopyJobResponse_copyJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJobResponse' {Maybe Text
copyJobId :: Maybe Text
$sel:copyJobId:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe Text
copyJobId} -> Maybe Text
copyJobId) (\s :: StartCopyJobResponse
s@StartCopyJobResponse' {} Maybe Text
a -> StartCopyJobResponse
s {$sel:copyJobId:StartCopyJobResponse' :: Maybe Text
copyJobId = Maybe Text
a} :: StartCopyJobResponse)

-- | The date and time that a copy job is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
startCopyJobResponse_creationDate :: Lens.Lens' StartCopyJobResponse (Prelude.Maybe Prelude.UTCTime)
startCopyJobResponse_creationDate :: Lens' StartCopyJobResponse (Maybe UTCTime)
startCopyJobResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJobResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: StartCopyJobResponse
s@StartCopyJobResponse' {} Maybe POSIX
a -> StartCopyJobResponse
s {$sel:creationDate:StartCopyJobResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: StartCopyJobResponse) 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

-- | This is a returned boolean value indicating this is a parent (composite)
-- copy job.
startCopyJobResponse_isParent :: Lens.Lens' StartCopyJobResponse (Prelude.Maybe Prelude.Bool)
startCopyJobResponse_isParent :: Lens' StartCopyJobResponse (Maybe Bool)
startCopyJobResponse_isParent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCopyJobResponse' {Maybe Bool
isParent :: Maybe Bool
$sel:isParent:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe Bool
isParent} -> Maybe Bool
isParent) (\s :: StartCopyJobResponse
s@StartCopyJobResponse' {} Maybe Bool
a -> StartCopyJobResponse
s {$sel:isParent:StartCopyJobResponse' :: Maybe Bool
isParent = Maybe Bool
a} :: StartCopyJobResponse)

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

instance Prelude.NFData StartCopyJobResponse where
  rnf :: StartCopyJobResponse -> ()
rnf StartCopyJobResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
httpStatus :: Int
isParent :: Maybe Bool
creationDate :: Maybe POSIX
copyJobId :: Maybe Text
$sel:httpStatus:StartCopyJobResponse' :: StartCopyJobResponse -> Int
$sel:isParent:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe Bool
$sel:creationDate:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe POSIX
$sel:copyJobId:StartCopyJobResponse' :: StartCopyJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copyJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isParent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus