{-# 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.KMS.ReEncrypt
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Decrypts ciphertext and then reencrypts it entirely within KMS. You can
-- use this operation to change the KMS key under which data is encrypted,
-- such as when you
-- <https://docs.aws.amazon.com/kms/latest/developerguide/rotate-keys.html#rotate-keys-manually manually rotate>
-- a KMS key or change the KMS key that protects a ciphertext. You can also
-- use it to reencrypt ciphertext under the same KMS key, such as to change
-- the
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context encryption context>
-- of a ciphertext.
--
-- The @ReEncrypt@ operation can decrypt ciphertext that was encrypted by
-- using a KMS key in an KMS operation, such as Encrypt or GenerateDataKey.
-- It can also decrypt ciphertext that was encrypted by using the public
-- key of an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/symm-asymm-concepts.html#asymmetric-cmks asymmetric KMS key>
-- outside of KMS. However, it cannot decrypt ciphertext produced by other
-- libraries, such as the
-- <https://docs.aws.amazon.com/encryption-sdk/latest/developer-guide/ Amazon Web Services Encryption SDK>
-- or
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingClientSideEncryption.html Amazon S3 client-side encryption>.
-- These libraries return a ciphertext format that is incompatible with
-- KMS.
--
-- When you use the @ReEncrypt@ operation, you need to provide information
-- for the decrypt operation and the subsequent encrypt operation.
--
-- -   If your ciphertext was encrypted under an asymmetric KMS key, you
--     must use the @SourceKeyId@ parameter to identify the KMS key that
--     encrypted the ciphertext. You must also supply the encryption
--     algorithm that was used. This information is required to decrypt the
--     data.
--
-- -   If your ciphertext was encrypted under a symmetric encryption KMS
--     key, the @SourceKeyId@ parameter is optional. KMS can get this
--     information from metadata that it adds to the symmetric ciphertext
--     blob. This feature adds durability to your implementation by
--     ensuring that authorized users can decrypt ciphertext decades after
--     it was encrypted, even if they\'ve lost track of the key ID.
--     However, specifying the source KMS key is always recommended as a
--     best practice. When you use the @SourceKeyId@ parameter to specify a
--     KMS key, KMS uses only the KMS key you specify. If the ciphertext
--     was encrypted under a different KMS key, the @ReEncrypt@ operation
--     fails. This practice ensures that you use the KMS key that you
--     intend.
--
-- -   To reencrypt the data, you must use the @DestinationKeyId@ parameter
--     to specify the KMS key that re-encrypts the data after it is
--     decrypted. If the destination KMS key is an asymmetric KMS key, you
--     must also provide the encryption algorithm. The algorithm that you
--     choose must be compatible with the KMS key.
--
--     When you use an asymmetric KMS key to encrypt or reencrypt data, be
--     sure to record the KMS key and encryption algorithm that you choose.
--     You will be required to provide the same KMS key and encryption
--     algorithm when you decrypt the data. If the KMS key and algorithm do
--     not match the values used to encrypt the data, the decrypt operation
--     fails.
--
--     You are not required to supply the key ID and encryption algorithm
--     when you decrypt with symmetric encryption KMS keys because KMS
--     stores this information in the ciphertext blob. KMS cannot store
--     metadata in ciphertext generated with asymmetric keys. The standard
--     format for asymmetric key ciphertext does not include configurable
--     fields.
--
-- The KMS key that you use for this operation must be in a compatible key
-- state. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-state.html Key states of KMS keys>
-- in the /Key Management Service Developer Guide/.
--
-- __Cross-account use__: Yes. The source KMS key and destination KMS key
-- can be in different Amazon Web Services accounts. Either or both KMS
-- keys can be in a different account than the caller. To specify a KMS key
-- in a different account, you must use its key ARN or alias ARN.
--
-- __Required permissions__:
--
-- -   <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:ReEncryptFrom>
--     permission on the source KMS key (key policy)
--
-- -   <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:ReEncryptTo>
--     permission on the destination KMS key (key policy)
--
-- To permit reencryption from or to a KMS key, include the
-- @\"kms:ReEncrypt*\"@ permission in your
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html key policy>.
-- This permission is automatically included in the key policy when you use
-- the console to create a KMS key. But you must include it manually when
-- you create a KMS key programmatically or when you use the PutKeyPolicy
-- operation to set a key policy.
--
-- __Related operations:__
--
-- -   Decrypt
--
-- -   Encrypt
--
-- -   GenerateDataKey
--
-- -   GenerateDataKeyPair
module Amazonka.KMS.ReEncrypt
  ( -- * Creating a Request
    ReEncrypt (..),
    newReEncrypt,

    -- * Request Lenses
    reEncrypt_destinationEncryptionAlgorithm,
    reEncrypt_destinationEncryptionContext,
    reEncrypt_grantTokens,
    reEncrypt_sourceEncryptionAlgorithm,
    reEncrypt_sourceEncryptionContext,
    reEncrypt_sourceKeyId,
    reEncrypt_ciphertextBlob,
    reEncrypt_destinationKeyId,

    -- * Destructuring the Response
    ReEncryptResponse (..),
    newReEncryptResponse,

    -- * Response Lenses
    reEncryptResponse_ciphertextBlob,
    reEncryptResponse_destinationEncryptionAlgorithm,
    reEncryptResponse_keyId,
    reEncryptResponse_sourceEncryptionAlgorithm,
    reEncryptResponse_sourceKeyId,
    reEncryptResponse_httpStatus,
  )
where

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

-- | /See:/ 'newReEncrypt' smart constructor.
data ReEncrypt = ReEncrypt'
  { -- | Specifies the encryption algorithm that KMS will use to reecrypt the
    -- data after it has decrypted it. The default value, @SYMMETRIC_DEFAULT@,
    -- represents the encryption algorithm used for symmetric encryption KMS
    -- keys.
    --
    -- This parameter is required only when the destination KMS key is an
    -- asymmetric KMS key.
    ReEncrypt -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm :: Prelude.Maybe EncryptionAlgorithmSpec,
    -- | Specifies that encryption context to use when the reencrypting the data.
    --
    -- A destination encryption context is valid only when the destination KMS
    -- key is a symmetric encryption KMS key. The standard ciphertext format
    -- for asymmetric KMS keys does not include fields for metadata.
    --
    -- An /encryption context/ is a collection of non-secret key-value pairs
    -- that represent additional authenticated data. When you use an encryption
    -- context to encrypt data, you must specify the same (an exact
    -- case-sensitive match) encryption context to decrypt the data. An
    -- encryption context is supported only on operations with symmetric
    -- encryption KMS keys. On operations with symmetric encryption KMS keys,
    -- an encryption context is optional, but it is strongly recommended.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
    -- in the /Key Management Service Developer Guide/.
    ReEncrypt -> Maybe (HashMap Text Text)
destinationEncryptionContext :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of grant tokens.
    --
    -- Use a grant token when your permission to call this operation comes from
    -- a new grant that has not yet achieved /eventual consistency/. For more
    -- information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
    -- and
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
    -- in the /Key Management Service Developer Guide/.
    ReEncrypt -> Maybe [Text]
grantTokens :: Prelude.Maybe [Prelude.Text],
    -- | Specifies the encryption algorithm that KMS will use to decrypt the
    -- ciphertext before it is reencrypted. The default value,
    -- @SYMMETRIC_DEFAULT@, represents the algorithm used for symmetric
    -- encryption KMS keys.
    --
    -- Specify the same algorithm that was used to encrypt the ciphertext. If
    -- you specify a different algorithm, the decrypt attempt fails.
    --
    -- This parameter is required only when the ciphertext was encrypted under
    -- an asymmetric KMS key.
    ReEncrypt -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm :: Prelude.Maybe EncryptionAlgorithmSpec,
    -- | Specifies the encryption context to use to decrypt the ciphertext. Enter
    -- the same encryption context that was used to encrypt the ciphertext.
    --
    -- An /encryption context/ is a collection of non-secret key-value pairs
    -- that represent additional authenticated data. When you use an encryption
    -- context to encrypt data, you must specify the same (an exact
    -- case-sensitive match) encryption context to decrypt the data. An
    -- encryption context is supported only on operations with symmetric
    -- encryption KMS keys. On operations with symmetric encryption KMS keys,
    -- an encryption context is optional, but it is strongly recommended.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
    -- in the /Key Management Service Developer Guide/.
    ReEncrypt -> Maybe (HashMap Text Text)
sourceEncryptionContext :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies the KMS key that KMS will use to decrypt the ciphertext before
    -- it is re-encrypted.
    --
    -- Enter a key ID of the KMS key that was used to encrypt the ciphertext.
    -- If you identify a different KMS key, the @ReEncrypt@ operation throws an
    -- @IncorrectKeyException@.
    --
    -- This parameter is required only when the ciphertext was encrypted under
    -- an asymmetric KMS key. If you used a symmetric encryption KMS key, KMS
    -- can get the KMS key from metadata that it adds to the symmetric
    -- ciphertext blob. However, it is always recommended as a best practice.
    -- This practice ensures that you use the KMS key that you intend.
    --
    -- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
    -- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
    -- key in a different Amazon Web Services account, you must use the key ARN
    -- or alias ARN.
    --
    -- For example:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Alias name: @alias\/ExampleAlias@
    --
    -- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
    --
    -- To get the key ID and key ARN for a KMS key, use ListKeys or
    -- DescribeKey. To get the alias name and alias ARN, use ListAliases.
    ReEncrypt -> Maybe Text
sourceKeyId :: Prelude.Maybe Prelude.Text,
    -- | Ciphertext of the data to reencrypt.
    ReEncrypt -> Base64
ciphertextBlob :: Data.Base64,
    -- | A unique identifier for the KMS key that is used to reencrypt the data.
    -- Specify a symmetric encryption KMS key or an asymmetric KMS key with a
    -- @KeyUsage@ value of @ENCRYPT_DECRYPT@. To find the @KeyUsage@ value of a
    -- KMS key, use the DescribeKey operation.
    --
    -- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
    -- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
    -- key in a different Amazon Web Services account, you must use the key ARN
    -- or alias ARN.
    --
    -- For example:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Alias name: @alias\/ExampleAlias@
    --
    -- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
    --
    -- To get the key ID and key ARN for a KMS key, use ListKeys or
    -- DescribeKey. To get the alias name and alias ARN, use ListAliases.
    ReEncrypt -> Text
destinationKeyId :: Prelude.Text
  }
  deriving (ReEncrypt -> ReEncrypt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReEncrypt -> ReEncrypt -> Bool
$c/= :: ReEncrypt -> ReEncrypt -> Bool
== :: ReEncrypt -> ReEncrypt -> Bool
$c== :: ReEncrypt -> ReEncrypt -> Bool
Prelude.Eq, ReadPrec [ReEncrypt]
ReadPrec ReEncrypt
Int -> ReadS ReEncrypt
ReadS [ReEncrypt]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReEncrypt]
$creadListPrec :: ReadPrec [ReEncrypt]
readPrec :: ReadPrec ReEncrypt
$creadPrec :: ReadPrec ReEncrypt
readList :: ReadS [ReEncrypt]
$creadList :: ReadS [ReEncrypt]
readsPrec :: Int -> ReadS ReEncrypt
$creadsPrec :: Int -> ReadS ReEncrypt
Prelude.Read, Int -> ReEncrypt -> ShowS
[ReEncrypt] -> ShowS
ReEncrypt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReEncrypt] -> ShowS
$cshowList :: [ReEncrypt] -> ShowS
show :: ReEncrypt -> String
$cshow :: ReEncrypt -> String
showsPrec :: Int -> ReEncrypt -> ShowS
$cshowsPrec :: Int -> ReEncrypt -> ShowS
Prelude.Show, forall x. Rep ReEncrypt x -> ReEncrypt
forall x. ReEncrypt -> Rep ReEncrypt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReEncrypt x -> ReEncrypt
$cfrom :: forall x. ReEncrypt -> Rep ReEncrypt x
Prelude.Generic)

-- |
-- Create a value of 'ReEncrypt' 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:
--
-- 'destinationEncryptionAlgorithm', 'reEncrypt_destinationEncryptionAlgorithm' - Specifies the encryption algorithm that KMS will use to reecrypt the
-- data after it has decrypted it. The default value, @SYMMETRIC_DEFAULT@,
-- represents the encryption algorithm used for symmetric encryption KMS
-- keys.
--
-- This parameter is required only when the destination KMS key is an
-- asymmetric KMS key.
--
-- 'destinationEncryptionContext', 'reEncrypt_destinationEncryptionContext' - Specifies that encryption context to use when the reencrypting the data.
--
-- A destination encryption context is valid only when the destination KMS
-- key is a symmetric encryption KMS key. The standard ciphertext format
-- for asymmetric KMS keys does not include fields for metadata.
--
-- An /encryption context/ is a collection of non-secret key-value pairs
-- that represent additional authenticated data. When you use an encryption
-- context to encrypt data, you must specify the same (an exact
-- case-sensitive match) encryption context to decrypt the data. An
-- encryption context is supported only on operations with symmetric
-- encryption KMS keys. On operations with symmetric encryption KMS keys,
-- an encryption context is optional, but it is strongly recommended.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
-- in the /Key Management Service Developer Guide/.
--
-- 'grantTokens', 'reEncrypt_grantTokens' - A list of grant tokens.
--
-- Use a grant token when your permission to call this operation comes from
-- a new grant that has not yet achieved /eventual consistency/. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
-- in the /Key Management Service Developer Guide/.
--
-- 'sourceEncryptionAlgorithm', 'reEncrypt_sourceEncryptionAlgorithm' - Specifies the encryption algorithm that KMS will use to decrypt the
-- ciphertext before it is reencrypted. The default value,
-- @SYMMETRIC_DEFAULT@, represents the algorithm used for symmetric
-- encryption KMS keys.
--
-- Specify the same algorithm that was used to encrypt the ciphertext. If
-- you specify a different algorithm, the decrypt attempt fails.
--
-- This parameter is required only when the ciphertext was encrypted under
-- an asymmetric KMS key.
--
-- 'sourceEncryptionContext', 'reEncrypt_sourceEncryptionContext' - Specifies the encryption context to use to decrypt the ciphertext. Enter
-- the same encryption context that was used to encrypt the ciphertext.
--
-- An /encryption context/ is a collection of non-secret key-value pairs
-- that represent additional authenticated data. When you use an encryption
-- context to encrypt data, you must specify the same (an exact
-- case-sensitive match) encryption context to decrypt the data. An
-- encryption context is supported only on operations with symmetric
-- encryption KMS keys. On operations with symmetric encryption KMS keys,
-- an encryption context is optional, but it is strongly recommended.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
-- in the /Key Management Service Developer Guide/.
--
-- 'sourceKeyId', 'reEncrypt_sourceKeyId' - Specifies the KMS key that KMS will use to decrypt the ciphertext before
-- it is re-encrypted.
--
-- Enter a key ID of the KMS key that was used to encrypt the ciphertext.
-- If you identify a different KMS key, the @ReEncrypt@ operation throws an
-- @IncorrectKeyException@.
--
-- This parameter is required only when the ciphertext was encrypted under
-- an asymmetric KMS key. If you used a symmetric encryption KMS key, KMS
-- can get the KMS key from metadata that it adds to the symmetric
-- ciphertext blob. However, it is always recommended as a best practice.
-- This practice ensures that you use the KMS key that you intend.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- key in a different Amazon Web Services account, you must use the key ARN
-- or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
--
-- 'ciphertextBlob', 'reEncrypt_ciphertextBlob' - Ciphertext of the data to reencrypt.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'destinationKeyId', 'reEncrypt_destinationKeyId' - A unique identifier for the KMS key that is used to reencrypt the data.
-- Specify a symmetric encryption KMS key or an asymmetric KMS key with a
-- @KeyUsage@ value of @ENCRYPT_DECRYPT@. To find the @KeyUsage@ value of a
-- KMS key, use the DescribeKey operation.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- key in a different Amazon Web Services account, you must use the key ARN
-- or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
newReEncrypt ::
  -- | 'ciphertextBlob'
  Prelude.ByteString ->
  -- | 'destinationKeyId'
  Prelude.Text ->
  ReEncrypt
newReEncrypt :: ByteString -> Text -> ReEncrypt
newReEncrypt ByteString
pCiphertextBlob_ Text
pDestinationKeyId_ =
  ReEncrypt'
    { $sel:destinationEncryptionAlgorithm:ReEncrypt' :: Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinationEncryptionContext:ReEncrypt' :: Maybe (HashMap Text Text)
destinationEncryptionContext = forall a. Maybe a
Prelude.Nothing,
      $sel:grantTokens:ReEncrypt' :: Maybe [Text]
grantTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceEncryptionAlgorithm:ReEncrypt' :: Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceEncryptionContext:ReEncrypt' :: Maybe (HashMap Text Text)
sourceEncryptionContext = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceKeyId:ReEncrypt' :: Maybe Text
sourceKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:ciphertextBlob:ReEncrypt' :: Base64
ciphertextBlob =
        Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pCiphertextBlob_,
      $sel:destinationKeyId:ReEncrypt' :: Text
destinationKeyId = Text
pDestinationKeyId_
    }

-- | Specifies the encryption algorithm that KMS will use to reecrypt the
-- data after it has decrypted it. The default value, @SYMMETRIC_DEFAULT@,
-- represents the encryption algorithm used for symmetric encryption KMS
-- keys.
--
-- This parameter is required only when the destination KMS key is an
-- asymmetric KMS key.
reEncrypt_destinationEncryptionAlgorithm :: Lens.Lens' ReEncrypt (Prelude.Maybe EncryptionAlgorithmSpec)
reEncrypt_destinationEncryptionAlgorithm :: Lens' ReEncrypt (Maybe EncryptionAlgorithmSpec)
reEncrypt_destinationEncryptionAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:destinationEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm} -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe EncryptionAlgorithmSpec
a -> ReEncrypt
s {$sel:destinationEncryptionAlgorithm:ReEncrypt' :: Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm = Maybe EncryptionAlgorithmSpec
a} :: ReEncrypt)

-- | Specifies that encryption context to use when the reencrypting the data.
--
-- A destination encryption context is valid only when the destination KMS
-- key is a symmetric encryption KMS key. The standard ciphertext format
-- for asymmetric KMS keys does not include fields for metadata.
--
-- An /encryption context/ is a collection of non-secret key-value pairs
-- that represent additional authenticated data. When you use an encryption
-- context to encrypt data, you must specify the same (an exact
-- case-sensitive match) encryption context to decrypt the data. An
-- encryption context is supported only on operations with symmetric
-- encryption KMS keys. On operations with symmetric encryption KMS keys,
-- an encryption context is optional, but it is strongly recommended.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
-- in the /Key Management Service Developer Guide/.
reEncrypt_destinationEncryptionContext :: Lens.Lens' ReEncrypt (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
reEncrypt_destinationEncryptionContext :: Lens' ReEncrypt (Maybe (HashMap Text Text))
reEncrypt_destinationEncryptionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe (HashMap Text Text)
destinationEncryptionContext :: Maybe (HashMap Text Text)
$sel:destinationEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
destinationEncryptionContext} -> Maybe (HashMap Text Text)
destinationEncryptionContext) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe (HashMap Text Text)
a -> ReEncrypt
s {$sel:destinationEncryptionContext:ReEncrypt' :: Maybe (HashMap Text Text)
destinationEncryptionContext = Maybe (HashMap Text Text)
a} :: ReEncrypt) 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 list of grant tokens.
--
-- Use a grant token when your permission to call this operation comes from
-- a new grant that has not yet achieved /eventual consistency/. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grants.html#grant_token Grant token>
-- and
-- <https://docs.aws.amazon.com/kms/latest/developerguide/grant-manage.html#using-grant-token Using a grant token>
-- in the /Key Management Service Developer Guide/.
reEncrypt_grantTokens :: Lens.Lens' ReEncrypt (Prelude.Maybe [Prelude.Text])
reEncrypt_grantTokens :: Lens' ReEncrypt (Maybe [Text])
reEncrypt_grantTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe [Text]
grantTokens :: Maybe [Text]
$sel:grantTokens:ReEncrypt' :: ReEncrypt -> Maybe [Text]
grantTokens} -> Maybe [Text]
grantTokens) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe [Text]
a -> ReEncrypt
s {$sel:grantTokens:ReEncrypt' :: Maybe [Text]
grantTokens = Maybe [Text]
a} :: ReEncrypt) 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

-- | Specifies the encryption algorithm that KMS will use to decrypt the
-- ciphertext before it is reencrypted. The default value,
-- @SYMMETRIC_DEFAULT@, represents the algorithm used for symmetric
-- encryption KMS keys.
--
-- Specify the same algorithm that was used to encrypt the ciphertext. If
-- you specify a different algorithm, the decrypt attempt fails.
--
-- This parameter is required only when the ciphertext was encrypted under
-- an asymmetric KMS key.
reEncrypt_sourceEncryptionAlgorithm :: Lens.Lens' ReEncrypt (Prelude.Maybe EncryptionAlgorithmSpec)
reEncrypt_sourceEncryptionAlgorithm :: Lens' ReEncrypt (Maybe EncryptionAlgorithmSpec)
reEncrypt_sourceEncryptionAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:sourceEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm} -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe EncryptionAlgorithmSpec
a -> ReEncrypt
s {$sel:sourceEncryptionAlgorithm:ReEncrypt' :: Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm = Maybe EncryptionAlgorithmSpec
a} :: ReEncrypt)

-- | Specifies the encryption context to use to decrypt the ciphertext. Enter
-- the same encryption context that was used to encrypt the ciphertext.
--
-- An /encryption context/ is a collection of non-secret key-value pairs
-- that represent additional authenticated data. When you use an encryption
-- context to encrypt data, you must specify the same (an exact
-- case-sensitive match) encryption context to decrypt the data. An
-- encryption context is supported only on operations with symmetric
-- encryption KMS keys. On operations with symmetric encryption KMS keys,
-- an encryption context is optional, but it is strongly recommended.
--
-- For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#encrypt_context Encryption context>
-- in the /Key Management Service Developer Guide/.
reEncrypt_sourceEncryptionContext :: Lens.Lens' ReEncrypt (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
reEncrypt_sourceEncryptionContext :: Lens' ReEncrypt (Maybe (HashMap Text Text))
reEncrypt_sourceEncryptionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe (HashMap Text Text)
sourceEncryptionContext :: Maybe (HashMap Text Text)
$sel:sourceEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
sourceEncryptionContext} -> Maybe (HashMap Text Text)
sourceEncryptionContext) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe (HashMap Text Text)
a -> ReEncrypt
s {$sel:sourceEncryptionContext:ReEncrypt' :: Maybe (HashMap Text Text)
sourceEncryptionContext = Maybe (HashMap Text Text)
a} :: ReEncrypt) 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

-- | Specifies the KMS key that KMS will use to decrypt the ciphertext before
-- it is re-encrypted.
--
-- Enter a key ID of the KMS key that was used to encrypt the ciphertext.
-- If you identify a different KMS key, the @ReEncrypt@ operation throws an
-- @IncorrectKeyException@.
--
-- This parameter is required only when the ciphertext was encrypted under
-- an asymmetric KMS key. If you used a symmetric encryption KMS key, KMS
-- can get the KMS key from metadata that it adds to the symmetric
-- ciphertext blob. However, it is always recommended as a best practice.
-- This practice ensures that you use the KMS key that you intend.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- key in a different Amazon Web Services account, you must use the key ARN
-- or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
reEncrypt_sourceKeyId :: Lens.Lens' ReEncrypt (Prelude.Maybe Prelude.Text)
reEncrypt_sourceKeyId :: Lens' ReEncrypt (Maybe Text)
reEncrypt_sourceKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Maybe Text
sourceKeyId :: Maybe Text
$sel:sourceKeyId:ReEncrypt' :: ReEncrypt -> Maybe Text
sourceKeyId} -> Maybe Text
sourceKeyId) (\s :: ReEncrypt
s@ReEncrypt' {} Maybe Text
a -> ReEncrypt
s {$sel:sourceKeyId:ReEncrypt' :: Maybe Text
sourceKeyId = Maybe Text
a} :: ReEncrypt)

-- | Ciphertext of the data to reencrypt.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
reEncrypt_ciphertextBlob :: Lens.Lens' ReEncrypt Prelude.ByteString
reEncrypt_ciphertextBlob :: Lens' ReEncrypt ByteString
reEncrypt_ciphertextBlob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Base64
ciphertextBlob :: Base64
$sel:ciphertextBlob:ReEncrypt' :: ReEncrypt -> Base64
ciphertextBlob} -> Base64
ciphertextBlob) (\s :: ReEncrypt
s@ReEncrypt' {} Base64
a -> ReEncrypt
s {$sel:ciphertextBlob:ReEncrypt' :: Base64
ciphertextBlob = Base64
a} :: ReEncrypt) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | A unique identifier for the KMS key that is used to reencrypt the data.
-- Specify a symmetric encryption KMS key or an asymmetric KMS key with a
-- @KeyUsage@ value of @ENCRYPT_DECRYPT@. To find the @KeyUsage@ value of a
-- KMS key, use the DescribeKey operation.
--
-- To specify a KMS key, use its key ID, key ARN, alias name, or alias ARN.
-- When using an alias name, prefix it with @\"alias\/\"@. To specify a KMS
-- key in a different Amazon Web Services account, you must use the key ARN
-- or alias ARN.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias ARN: @arn:aws:kms:us-east-2:111122223333:alias\/ExampleAlias@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey. To get the alias name and alias ARN, use ListAliases.
reEncrypt_destinationKeyId :: Lens.Lens' ReEncrypt Prelude.Text
reEncrypt_destinationKeyId :: Lens' ReEncrypt Text
reEncrypt_destinationKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncrypt' {Text
destinationKeyId :: Text
$sel:destinationKeyId:ReEncrypt' :: ReEncrypt -> Text
destinationKeyId} -> Text
destinationKeyId) (\s :: ReEncrypt
s@ReEncrypt' {} Text
a -> ReEncrypt
s {$sel:destinationKeyId:ReEncrypt' :: Text
destinationKeyId = Text
a} :: ReEncrypt)

instance Core.AWSRequest ReEncrypt where
  type AWSResponse ReEncrypt = ReEncryptResponse
  request :: (Service -> Service) -> ReEncrypt -> Request ReEncrypt
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 ReEncrypt
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ReEncrypt)))
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 Base64
-> Maybe EncryptionAlgorithmSpec
-> Maybe Text
-> Maybe EncryptionAlgorithmSpec
-> Maybe Text
-> Int
-> ReEncryptResponse
ReEncryptResponse'
            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
"CiphertextBlob")
            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
"DestinationEncryptionAlgorithm")
            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
"KeyId")
            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
"SourceEncryptionAlgorithm")
            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
"SourceKeyId")
            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 ReEncrypt where
  hashWithSalt :: Int -> ReEncrypt -> Int
hashWithSalt Int
_salt ReEncrypt' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionAlgorithmSpec
Text
Base64
destinationKeyId :: Text
ciphertextBlob :: Base64
sourceKeyId :: Maybe Text
sourceEncryptionContext :: Maybe (HashMap Text Text)
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
grantTokens :: Maybe [Text]
destinationEncryptionContext :: Maybe (HashMap Text Text)
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:destinationKeyId:ReEncrypt' :: ReEncrypt -> Text
$sel:ciphertextBlob:ReEncrypt' :: ReEncrypt -> Base64
$sel:sourceKeyId:ReEncrypt' :: ReEncrypt -> Maybe Text
$sel:sourceEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:sourceEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
$sel:grantTokens:ReEncrypt' :: ReEncrypt -> Maybe [Text]
$sel:destinationEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:destinationEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
destinationEncryptionContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
grantTokens
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
sourceEncryptionContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
ciphertextBlob
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationKeyId

instance Prelude.NFData ReEncrypt where
  rnf :: ReEncrypt -> ()
rnf ReEncrypt' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionAlgorithmSpec
Text
Base64
destinationKeyId :: Text
ciphertextBlob :: Base64
sourceKeyId :: Maybe Text
sourceEncryptionContext :: Maybe (HashMap Text Text)
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
grantTokens :: Maybe [Text]
destinationEncryptionContext :: Maybe (HashMap Text Text)
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:destinationKeyId:ReEncrypt' :: ReEncrypt -> Text
$sel:ciphertextBlob:ReEncrypt' :: ReEncrypt -> Base64
$sel:sourceKeyId:ReEncrypt' :: ReEncrypt -> Maybe Text
$sel:sourceEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:sourceEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
$sel:grantTokens:ReEncrypt' :: ReEncrypt -> Maybe [Text]
$sel:destinationEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:destinationEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
destinationEncryptionContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
grantTokens
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
sourceEncryptionContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
ciphertextBlob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationKeyId

instance Data.ToHeaders ReEncrypt where
  toHeaders :: ReEncrypt -> 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
"TrentService.ReEncrypt" :: 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 ReEncrypt where
  toJSON :: ReEncrypt -> Value
toJSON ReEncrypt' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionAlgorithmSpec
Text
Base64
destinationKeyId :: Text
ciphertextBlob :: Base64
sourceKeyId :: Maybe Text
sourceEncryptionContext :: Maybe (HashMap Text Text)
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
grantTokens :: Maybe [Text]
destinationEncryptionContext :: Maybe (HashMap Text Text)
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:destinationKeyId:ReEncrypt' :: ReEncrypt -> Text
$sel:ciphertextBlob:ReEncrypt' :: ReEncrypt -> Base64
$sel:sourceKeyId:ReEncrypt' :: ReEncrypt -> Maybe Text
$sel:sourceEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:sourceEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
$sel:grantTokens:ReEncrypt' :: ReEncrypt -> Maybe [Text]
$sel:destinationEncryptionContext:ReEncrypt' :: ReEncrypt -> Maybe (HashMap Text Text)
$sel:destinationEncryptionAlgorithm:ReEncrypt' :: ReEncrypt -> Maybe EncryptionAlgorithmSpec
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DestinationEncryptionAlgorithm" 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 EncryptionAlgorithmSpec
destinationEncryptionAlgorithm,
            (Key
"DestinationEncryptionContext" 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 (HashMap Text Text)
destinationEncryptionContext,
            (Key
"GrantTokens" 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]
grantTokens,
            (Key
"SourceEncryptionAlgorithm" 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 EncryptionAlgorithmSpec
sourceEncryptionAlgorithm,
            (Key
"SourceEncryptionContext" 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 (HashMap Text Text)
sourceEncryptionContext,
            (Key
"SourceKeyId" 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
sourceKeyId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CiphertextBlob" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
ciphertextBlob),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationKeyId)
          ]
      )

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

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

-- | /See:/ 'newReEncryptResponse' smart constructor.
data ReEncryptResponse = ReEncryptResponse'
  { -- | The reencrypted data. When you use the HTTP API or the Amazon Web
    -- Services CLI, the value is Base64-encoded. Otherwise, it is not
    -- Base64-encoded.
    ReEncryptResponse -> Maybe Base64
ciphertextBlob :: Prelude.Maybe Data.Base64,
    -- | The encryption algorithm that was used to reencrypt the data.
    ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm :: Prelude.Maybe EncryptionAlgorithmSpec,
    -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
    -- of the KMS key that was used to reencrypt the data.
    ReEncryptResponse -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text,
    -- | The encryption algorithm that was used to decrypt the ciphertext before
    -- it was reencrypted.
    ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm :: Prelude.Maybe EncryptionAlgorithmSpec,
    -- | Unique identifier of the KMS key used to originally encrypt the data.
    ReEncryptResponse -> Maybe Text
sourceKeyId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ReEncryptResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ReEncryptResponse -> ReEncryptResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReEncryptResponse -> ReEncryptResponse -> Bool
$c/= :: ReEncryptResponse -> ReEncryptResponse -> Bool
== :: ReEncryptResponse -> ReEncryptResponse -> Bool
$c== :: ReEncryptResponse -> ReEncryptResponse -> Bool
Prelude.Eq, ReadPrec [ReEncryptResponse]
ReadPrec ReEncryptResponse
Int -> ReadS ReEncryptResponse
ReadS [ReEncryptResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReEncryptResponse]
$creadListPrec :: ReadPrec [ReEncryptResponse]
readPrec :: ReadPrec ReEncryptResponse
$creadPrec :: ReadPrec ReEncryptResponse
readList :: ReadS [ReEncryptResponse]
$creadList :: ReadS [ReEncryptResponse]
readsPrec :: Int -> ReadS ReEncryptResponse
$creadsPrec :: Int -> ReadS ReEncryptResponse
Prelude.Read, Int -> ReEncryptResponse -> ShowS
[ReEncryptResponse] -> ShowS
ReEncryptResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReEncryptResponse] -> ShowS
$cshowList :: [ReEncryptResponse] -> ShowS
show :: ReEncryptResponse -> String
$cshow :: ReEncryptResponse -> String
showsPrec :: Int -> ReEncryptResponse -> ShowS
$cshowsPrec :: Int -> ReEncryptResponse -> ShowS
Prelude.Show, forall x. Rep ReEncryptResponse x -> ReEncryptResponse
forall x. ReEncryptResponse -> Rep ReEncryptResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReEncryptResponse x -> ReEncryptResponse
$cfrom :: forall x. ReEncryptResponse -> Rep ReEncryptResponse x
Prelude.Generic)

-- |
-- Create a value of 'ReEncryptResponse' 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:
--
-- 'ciphertextBlob', 'reEncryptResponse_ciphertextBlob' - The reencrypted data. When you use the HTTP API or the Amazon Web
-- Services CLI, the value is Base64-encoded. Otherwise, it is not
-- Base64-encoded.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'destinationEncryptionAlgorithm', 'reEncryptResponse_destinationEncryptionAlgorithm' - The encryption algorithm that was used to reencrypt the data.
--
-- 'keyId', 'reEncryptResponse_keyId' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
-- of the KMS key that was used to reencrypt the data.
--
-- 'sourceEncryptionAlgorithm', 'reEncryptResponse_sourceEncryptionAlgorithm' - The encryption algorithm that was used to decrypt the ciphertext before
-- it was reencrypted.
--
-- 'sourceKeyId', 'reEncryptResponse_sourceKeyId' - Unique identifier of the KMS key used to originally encrypt the data.
--
-- 'httpStatus', 'reEncryptResponse_httpStatus' - The response's http status code.
newReEncryptResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ReEncryptResponse
newReEncryptResponse :: Int -> ReEncryptResponse
newReEncryptResponse Int
pHttpStatus_ =
  ReEncryptResponse'
    { $sel:ciphertextBlob:ReEncryptResponse' :: Maybe Base64
ciphertextBlob =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinationEncryptionAlgorithm:ReEncryptResponse' :: Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:keyId:ReEncryptResponse' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceEncryptionAlgorithm:ReEncryptResponse' :: Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceKeyId:ReEncryptResponse' :: Maybe Text
sourceKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ReEncryptResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The reencrypted data. When you use the HTTP API or the Amazon Web
-- Services CLI, the value is Base64-encoded. Otherwise, it is not
-- Base64-encoded.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
reEncryptResponse_ciphertextBlob :: Lens.Lens' ReEncryptResponse (Prelude.Maybe Prelude.ByteString)
reEncryptResponse_ciphertextBlob :: Lens' ReEncryptResponse (Maybe ByteString)
reEncryptResponse_ciphertextBlob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncryptResponse' {Maybe Base64
ciphertextBlob :: Maybe Base64
$sel:ciphertextBlob:ReEncryptResponse' :: ReEncryptResponse -> Maybe Base64
ciphertextBlob} -> Maybe Base64
ciphertextBlob) (\s :: ReEncryptResponse
s@ReEncryptResponse' {} Maybe Base64
a -> ReEncryptResponse
s {$sel:ciphertextBlob:ReEncryptResponse' :: Maybe Base64
ciphertextBlob = Maybe Base64
a} :: ReEncryptResponse) 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 Iso' Base64 ByteString
Data._Base64

-- | The encryption algorithm that was used to reencrypt the data.
reEncryptResponse_destinationEncryptionAlgorithm :: Lens.Lens' ReEncryptResponse (Prelude.Maybe EncryptionAlgorithmSpec)
reEncryptResponse_destinationEncryptionAlgorithm :: Lens' ReEncryptResponse (Maybe EncryptionAlgorithmSpec)
reEncryptResponse_destinationEncryptionAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncryptResponse' {Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:destinationEncryptionAlgorithm:ReEncryptResponse' :: ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm} -> Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm) (\s :: ReEncryptResponse
s@ReEncryptResponse' {} Maybe EncryptionAlgorithmSpec
a -> ReEncryptResponse
s {$sel:destinationEncryptionAlgorithm:ReEncryptResponse' :: Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm = Maybe EncryptionAlgorithmSpec
a} :: ReEncryptResponse)

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
-- of the KMS key that was used to reencrypt the data.
reEncryptResponse_keyId :: Lens.Lens' ReEncryptResponse (Prelude.Maybe Prelude.Text)
reEncryptResponse_keyId :: Lens' ReEncryptResponse (Maybe Text)
reEncryptResponse_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncryptResponse' {Maybe Text
keyId :: Maybe Text
$sel:keyId:ReEncryptResponse' :: ReEncryptResponse -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: ReEncryptResponse
s@ReEncryptResponse' {} Maybe Text
a -> ReEncryptResponse
s {$sel:keyId:ReEncryptResponse' :: Maybe Text
keyId = Maybe Text
a} :: ReEncryptResponse)

-- | The encryption algorithm that was used to decrypt the ciphertext before
-- it was reencrypted.
reEncryptResponse_sourceEncryptionAlgorithm :: Lens.Lens' ReEncryptResponse (Prelude.Maybe EncryptionAlgorithmSpec)
reEncryptResponse_sourceEncryptionAlgorithm :: Lens' ReEncryptResponse (Maybe EncryptionAlgorithmSpec)
reEncryptResponse_sourceEncryptionAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncryptResponse' {Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
$sel:sourceEncryptionAlgorithm:ReEncryptResponse' :: ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm} -> Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm) (\s :: ReEncryptResponse
s@ReEncryptResponse' {} Maybe EncryptionAlgorithmSpec
a -> ReEncryptResponse
s {$sel:sourceEncryptionAlgorithm:ReEncryptResponse' :: Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm = Maybe EncryptionAlgorithmSpec
a} :: ReEncryptResponse)

-- | Unique identifier of the KMS key used to originally encrypt the data.
reEncryptResponse_sourceKeyId :: Lens.Lens' ReEncryptResponse (Prelude.Maybe Prelude.Text)
reEncryptResponse_sourceKeyId :: Lens' ReEncryptResponse (Maybe Text)
reEncryptResponse_sourceKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReEncryptResponse' {Maybe Text
sourceKeyId :: Maybe Text
$sel:sourceKeyId:ReEncryptResponse' :: ReEncryptResponse -> Maybe Text
sourceKeyId} -> Maybe Text
sourceKeyId) (\s :: ReEncryptResponse
s@ReEncryptResponse' {} Maybe Text
a -> ReEncryptResponse
s {$sel:sourceKeyId:ReEncryptResponse' :: Maybe Text
sourceKeyId = Maybe Text
a} :: ReEncryptResponse)

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

instance Prelude.NFData ReEncryptResponse where
  rnf :: ReEncryptResponse -> ()
rnf ReEncryptResponse' {Int
Maybe Text
Maybe Base64
Maybe EncryptionAlgorithmSpec
httpStatus :: Int
sourceKeyId :: Maybe Text
sourceEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
keyId :: Maybe Text
destinationEncryptionAlgorithm :: Maybe EncryptionAlgorithmSpec
ciphertextBlob :: Maybe Base64
$sel:httpStatus:ReEncryptResponse' :: ReEncryptResponse -> Int
$sel:sourceKeyId:ReEncryptResponse' :: ReEncryptResponse -> Maybe Text
$sel:sourceEncryptionAlgorithm:ReEncryptResponse' :: ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
$sel:keyId:ReEncryptResponse' :: ReEncryptResponse -> Maybe Text
$sel:destinationEncryptionAlgorithm:ReEncryptResponse' :: ReEncryptResponse -> Maybe EncryptionAlgorithmSpec
$sel:ciphertextBlob:ReEncryptResponse' :: ReEncryptResponse -> Maybe Base64
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
ciphertextBlob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAlgorithmSpec
destinationEncryptionAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAlgorithmSpec
sourceEncryptionAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus