{-# 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.FSx.CopyBackup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Copies an existing backup within the same Amazon Web Services account to
-- another Amazon Web Services Region (cross-Region copy) or within the
-- same Amazon Web Services Region (in-Region copy). You can have up to
-- five backup copy requests in progress to a single destination Region per
-- account.
--
-- You can use cross-Region backup copies for cross-Region disaster
-- recovery. You can periodically take backups and copy them to another
-- Region so that in the event of a disaster in the primary Region, you can
-- restore from backup and recover availability quickly in the other
-- Region. You can make cross-Region copies only within your Amazon Web
-- Services partition. A partition is a grouping of Regions. Amazon Web
-- Services currently has three partitions: @aws@ (Standard Regions),
-- @aws-cn@ (China Regions), and @aws-us-gov@ (Amazon Web Services GovCloud
-- [US] Regions).
--
-- You can also use backup copies to clone your file dataset to another
-- Region or within the same Region.
--
-- You can use the @SourceRegion@ parameter to specify the Amazon Web
-- Services Region from which the backup will be copied. For example, if
-- you make the call from the @us-west-1@ Region and want to copy a backup
-- from the @us-east-2@ Region, you specify @us-east-2@ in the
-- @SourceRegion@ parameter to make a cross-Region copy. If you don\'t
-- specify a Region, the backup copy is created in the same Region where
-- the request is sent from (in-Region copy).
--
-- For more information about creating backup copies, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/using-backups.html#copy-backups Copying backups>
-- in the /Amazon FSx for Windows User Guide/,
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/using-backups-fsx.html#copy-backups Copying backups>
-- in the /Amazon FSx for Lustre User Guide/, and
-- <https://docs.aws.amazon.com/fsx/latest/OpenZFSGuide/using-backups.html#copy-backups Copying backups>
-- in the /Amazon FSx for OpenZFS User Guide/.
module Amazonka.FSx.CopyBackup
  ( -- * Creating a Request
    CopyBackup (..),
    newCopyBackup,

    -- * Request Lenses
    copyBackup_clientRequestToken,
    copyBackup_copyTags,
    copyBackup_kmsKeyId,
    copyBackup_sourceRegion,
    copyBackup_tags,
    copyBackup_sourceBackupId,

    -- * Destructuring the Response
    CopyBackupResponse (..),
    newCopyBackupResponse,

    -- * Response Lenses
    copyBackupResponse_backup,
    copyBackupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCopyBackup' smart constructor.
data CopyBackup = CopyBackup'
  { CopyBackup -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A Boolean flag indicating whether tags from the source backup should be
    -- copied to the backup copy. This value defaults to @false@.
    --
    -- If you set @CopyTags@ to @true@ and the source backup has existing tags,
    -- you can use the @Tags@ parameter to create new tags, provided that the
    -- sum of the source backup tags and the new tags doesn\'t exceed 50. Both
    -- sets of tags are merged. If there are tag conflicts (for example, two
    -- tags with the same key but different values), the tags created with the
    -- @Tags@ parameter take precedence.
    CopyBackup -> Maybe Bool
copyTags :: Prelude.Maybe Prelude.Bool,
    CopyBackup -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The source Amazon Web Services Region of the backup. Specifies the
    -- Amazon Web Services Region from which the backup is being copied. The
    -- source and destination Regions must be in the same Amazon Web Services
    -- partition. If you don\'t specify a Region, @SourceRegion@ defaults to
    -- the Region where the request is sent from (in-Region copy).
    CopyBackup -> Maybe Text
sourceRegion :: Prelude.Maybe Prelude.Text,
    CopyBackup -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The ID of the source backup. Specifies the ID of the backup that\'s
    -- being copied.
    CopyBackup -> Text
sourceBackupId :: Prelude.Text
  }
  deriving (CopyBackup -> CopyBackup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyBackup -> CopyBackup -> Bool
$c/= :: CopyBackup -> CopyBackup -> Bool
== :: CopyBackup -> CopyBackup -> Bool
$c== :: CopyBackup -> CopyBackup -> Bool
Prelude.Eq, ReadPrec [CopyBackup]
ReadPrec CopyBackup
Int -> ReadS CopyBackup
ReadS [CopyBackup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyBackup]
$creadListPrec :: ReadPrec [CopyBackup]
readPrec :: ReadPrec CopyBackup
$creadPrec :: ReadPrec CopyBackup
readList :: ReadS [CopyBackup]
$creadList :: ReadS [CopyBackup]
readsPrec :: Int -> ReadS CopyBackup
$creadsPrec :: Int -> ReadS CopyBackup
Prelude.Read, Int -> CopyBackup -> ShowS
[CopyBackup] -> ShowS
CopyBackup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyBackup] -> ShowS
$cshowList :: [CopyBackup] -> ShowS
show :: CopyBackup -> String
$cshow :: CopyBackup -> String
showsPrec :: Int -> CopyBackup -> ShowS
$cshowsPrec :: Int -> CopyBackup -> ShowS
Prelude.Show, forall x. Rep CopyBackup x -> CopyBackup
forall x. CopyBackup -> Rep CopyBackup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyBackup x -> CopyBackup
$cfrom :: forall x. CopyBackup -> Rep CopyBackup x
Prelude.Generic)

-- |
-- Create a value of 'CopyBackup' 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:
--
-- 'clientRequestToken', 'copyBackup_clientRequestToken' - Undocumented member.
--
-- 'copyTags', 'copyBackup_copyTags' - A Boolean flag indicating whether tags from the source backup should be
-- copied to the backup copy. This value defaults to @false@.
--
-- If you set @CopyTags@ to @true@ and the source backup has existing tags,
-- you can use the @Tags@ parameter to create new tags, provided that the
-- sum of the source backup tags and the new tags doesn\'t exceed 50. Both
-- sets of tags are merged. If there are tag conflicts (for example, two
-- tags with the same key but different values), the tags created with the
-- @Tags@ parameter take precedence.
--
-- 'kmsKeyId', 'copyBackup_kmsKeyId' - Undocumented member.
--
-- 'sourceRegion', 'copyBackup_sourceRegion' - The source Amazon Web Services Region of the backup. Specifies the
-- Amazon Web Services Region from which the backup is being copied. The
-- source and destination Regions must be in the same Amazon Web Services
-- partition. If you don\'t specify a Region, @SourceRegion@ defaults to
-- the Region where the request is sent from (in-Region copy).
--
-- 'tags', 'copyBackup_tags' - Undocumented member.
--
-- 'sourceBackupId', 'copyBackup_sourceBackupId' - The ID of the source backup. Specifies the ID of the backup that\'s
-- being copied.
newCopyBackup ::
  -- | 'sourceBackupId'
  Prelude.Text ->
  CopyBackup
newCopyBackup :: Text -> CopyBackup
newCopyBackup Text
pSourceBackupId_ =
  CopyBackup'
    { $sel:clientRequestToken:CopyBackup' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:copyTags:CopyBackup' :: Maybe Bool
copyTags = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CopyBackup' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceRegion:CopyBackup' :: Maybe Text
sourceRegion = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CopyBackup' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceBackupId:CopyBackup' :: Text
sourceBackupId = Text
pSourceBackupId_
    }

-- | Undocumented member.
copyBackup_clientRequestToken :: Lens.Lens' CopyBackup (Prelude.Maybe Prelude.Text)
copyBackup_clientRequestToken :: Lens' CopyBackup (Maybe Text)
copyBackup_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CopyBackup' :: CopyBackup -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CopyBackup
s@CopyBackup' {} Maybe Text
a -> CopyBackup
s {$sel:clientRequestToken:CopyBackup' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CopyBackup)

-- | A Boolean flag indicating whether tags from the source backup should be
-- copied to the backup copy. This value defaults to @false@.
--
-- If you set @CopyTags@ to @true@ and the source backup has existing tags,
-- you can use the @Tags@ parameter to create new tags, provided that the
-- sum of the source backup tags and the new tags doesn\'t exceed 50. Both
-- sets of tags are merged. If there are tag conflicts (for example, two
-- tags with the same key but different values), the tags created with the
-- @Tags@ parameter take precedence.
copyBackup_copyTags :: Lens.Lens' CopyBackup (Prelude.Maybe Prelude.Bool)
copyBackup_copyTags :: Lens' CopyBackup (Maybe Bool)
copyBackup_copyTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Maybe Bool
copyTags :: Maybe Bool
$sel:copyTags:CopyBackup' :: CopyBackup -> Maybe Bool
copyTags} -> Maybe Bool
copyTags) (\s :: CopyBackup
s@CopyBackup' {} Maybe Bool
a -> CopyBackup
s {$sel:copyTags:CopyBackup' :: Maybe Bool
copyTags = Maybe Bool
a} :: CopyBackup)

-- | Undocumented member.
copyBackup_kmsKeyId :: Lens.Lens' CopyBackup (Prelude.Maybe Prelude.Text)
copyBackup_kmsKeyId :: Lens' CopyBackup (Maybe Text)
copyBackup_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CopyBackup' :: CopyBackup -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CopyBackup
s@CopyBackup' {} Maybe Text
a -> CopyBackup
s {$sel:kmsKeyId:CopyBackup' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CopyBackup)

-- | The source Amazon Web Services Region of the backup. Specifies the
-- Amazon Web Services Region from which the backup is being copied. The
-- source and destination Regions must be in the same Amazon Web Services
-- partition. If you don\'t specify a Region, @SourceRegion@ defaults to
-- the Region where the request is sent from (in-Region copy).
copyBackup_sourceRegion :: Lens.Lens' CopyBackup (Prelude.Maybe Prelude.Text)
copyBackup_sourceRegion :: Lens' CopyBackup (Maybe Text)
copyBackup_sourceRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Maybe Text
sourceRegion :: Maybe Text
$sel:sourceRegion:CopyBackup' :: CopyBackup -> Maybe Text
sourceRegion} -> Maybe Text
sourceRegion) (\s :: CopyBackup
s@CopyBackup' {} Maybe Text
a -> CopyBackup
s {$sel:sourceRegion:CopyBackup' :: Maybe Text
sourceRegion = Maybe Text
a} :: CopyBackup)

-- | Undocumented member.
copyBackup_tags :: Lens.Lens' CopyBackup (Prelude.Maybe (Prelude.NonEmpty Tag))
copyBackup_tags :: Lens' CopyBackup (Maybe (NonEmpty Tag))
copyBackup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CopyBackup' :: CopyBackup -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CopyBackup
s@CopyBackup' {} Maybe (NonEmpty Tag)
a -> CopyBackup
s {$sel:tags:CopyBackup' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CopyBackup) 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 ID of the source backup. Specifies the ID of the backup that\'s
-- being copied.
copyBackup_sourceBackupId :: Lens.Lens' CopyBackup Prelude.Text
copyBackup_sourceBackupId :: Lens' CopyBackup Text
copyBackup_sourceBackupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackup' {Text
sourceBackupId :: Text
$sel:sourceBackupId:CopyBackup' :: CopyBackup -> Text
sourceBackupId} -> Text
sourceBackupId) (\s :: CopyBackup
s@CopyBackup' {} Text
a -> CopyBackup
s {$sel:sourceBackupId:CopyBackup' :: Text
sourceBackupId = Text
a} :: CopyBackup)

instance Core.AWSRequest CopyBackup where
  type AWSResponse CopyBackup = CopyBackupResponse
  request :: (Service -> Service) -> CopyBackup -> Request CopyBackup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CopyBackup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CopyBackup)))
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 Backup -> Int -> CopyBackupResponse
CopyBackupResponse'
            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
"Backup")
            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 CopyBackup where
  hashWithSalt :: Int -> CopyBackup -> Int
hashWithSalt Int
_salt CopyBackup' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
sourceBackupId :: Text
tags :: Maybe (NonEmpty Tag)
sourceRegion :: Maybe Text
kmsKeyId :: Maybe Text
copyTags :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:sourceBackupId:CopyBackup' :: CopyBackup -> Text
$sel:tags:CopyBackup' :: CopyBackup -> Maybe (NonEmpty Tag)
$sel:sourceRegion:CopyBackup' :: CopyBackup -> Maybe Text
$sel:kmsKeyId:CopyBackup' :: CopyBackup -> Maybe Text
$sel:copyTags:CopyBackup' :: CopyBackup -> Maybe Bool
$sel:clientRequestToken:CopyBackup' :: CopyBackup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceBackupId

instance Prelude.NFData CopyBackup where
  rnf :: CopyBackup -> ()
rnf CopyBackup' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
sourceBackupId :: Text
tags :: Maybe (NonEmpty Tag)
sourceRegion :: Maybe Text
kmsKeyId :: Maybe Text
copyTags :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:sourceBackupId:CopyBackup' :: CopyBackup -> Text
$sel:tags:CopyBackup' :: CopyBackup -> Maybe (NonEmpty Tag)
$sel:sourceRegion:CopyBackup' :: CopyBackup -> Maybe Text
$sel:kmsKeyId:CopyBackup' :: CopyBackup -> Maybe Text
$sel:copyTags:CopyBackup' :: CopyBackup -> Maybe Bool
$sel:clientRequestToken:CopyBackup' :: CopyBackup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceBackupId

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

instance Data.ToJSON CopyBackup where
  toJSON :: CopyBackup -> Value
toJSON CopyBackup' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
sourceBackupId :: Text
tags :: Maybe (NonEmpty Tag)
sourceRegion :: Maybe Text
kmsKeyId :: Maybe Text
copyTags :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:sourceBackupId:CopyBackup' :: CopyBackup -> Text
$sel:tags:CopyBackup' :: CopyBackup -> Maybe (NonEmpty Tag)
$sel:sourceRegion:CopyBackup' :: CopyBackup -> Maybe Text
$sel:kmsKeyId:CopyBackup' :: CopyBackup -> Maybe Text
$sel:copyTags:CopyBackup' :: CopyBackup -> Maybe Bool
$sel:clientRequestToken:CopyBackup' :: CopyBackup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"CopyTags" 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 Bool
copyTags,
            (Key
"KmsKeyId" 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
kmsKeyId,
            (Key
"SourceRegion" 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
sourceRegion,
            (Key
"Tags" 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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceBackupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceBackupId)
          ]
      )

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

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

-- | /See:/ 'newCopyBackupResponse' smart constructor.
data CopyBackupResponse = CopyBackupResponse'
  { CopyBackupResponse -> Maybe Backup
backup :: Prelude.Maybe Backup,
    -- | The response's http status code.
    CopyBackupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CopyBackupResponse -> CopyBackupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyBackupResponse -> CopyBackupResponse -> Bool
$c/= :: CopyBackupResponse -> CopyBackupResponse -> Bool
== :: CopyBackupResponse -> CopyBackupResponse -> Bool
$c== :: CopyBackupResponse -> CopyBackupResponse -> Bool
Prelude.Eq, ReadPrec [CopyBackupResponse]
ReadPrec CopyBackupResponse
Int -> ReadS CopyBackupResponse
ReadS [CopyBackupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyBackupResponse]
$creadListPrec :: ReadPrec [CopyBackupResponse]
readPrec :: ReadPrec CopyBackupResponse
$creadPrec :: ReadPrec CopyBackupResponse
readList :: ReadS [CopyBackupResponse]
$creadList :: ReadS [CopyBackupResponse]
readsPrec :: Int -> ReadS CopyBackupResponse
$creadsPrec :: Int -> ReadS CopyBackupResponse
Prelude.Read, Int -> CopyBackupResponse -> ShowS
[CopyBackupResponse] -> ShowS
CopyBackupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyBackupResponse] -> ShowS
$cshowList :: [CopyBackupResponse] -> ShowS
show :: CopyBackupResponse -> String
$cshow :: CopyBackupResponse -> String
showsPrec :: Int -> CopyBackupResponse -> ShowS
$cshowsPrec :: Int -> CopyBackupResponse -> ShowS
Prelude.Show, forall x. Rep CopyBackupResponse x -> CopyBackupResponse
forall x. CopyBackupResponse -> Rep CopyBackupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyBackupResponse x -> CopyBackupResponse
$cfrom :: forall x. CopyBackupResponse -> Rep CopyBackupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CopyBackupResponse' 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:
--
-- 'backup', 'copyBackupResponse_backup' - Undocumented member.
--
-- 'httpStatus', 'copyBackupResponse_httpStatus' - The response's http status code.
newCopyBackupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyBackupResponse
newCopyBackupResponse :: Int -> CopyBackupResponse
newCopyBackupResponse Int
pHttpStatus_ =
  CopyBackupResponse'
    { $sel:backup:CopyBackupResponse' :: Maybe Backup
backup = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyBackupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyBackupResponse_backup :: Lens.Lens' CopyBackupResponse (Prelude.Maybe Backup)
copyBackupResponse_backup :: Lens' CopyBackupResponse (Maybe Backup)
copyBackupResponse_backup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyBackupResponse' {Maybe Backup
backup :: Maybe Backup
$sel:backup:CopyBackupResponse' :: CopyBackupResponse -> Maybe Backup
backup} -> Maybe Backup
backup) (\s :: CopyBackupResponse
s@CopyBackupResponse' {} Maybe Backup
a -> CopyBackupResponse
s {$sel:backup:CopyBackupResponse' :: Maybe Backup
backup = Maybe Backup
a} :: CopyBackupResponse)

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

instance Prelude.NFData CopyBackupResponse where
  rnf :: CopyBackupResponse -> ()
rnf CopyBackupResponse' {Int
Maybe Backup
httpStatus :: Int
backup :: Maybe Backup
$sel:httpStatus:CopyBackupResponse' :: CopyBackupResponse -> Int
$sel:backup:CopyBackupResponse' :: CopyBackupResponse -> Maybe Backup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Backup
backup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus