{-# 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.GetParametersForImport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the items you need to import key material into a symmetric
-- encryption KMS key. For more information about importing key material
-- into KMS, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys.html Importing key material>
-- in the /Key Management Service Developer Guide/.
--
-- This operation returns a public key and an import token. Use the public
-- key to encrypt the symmetric key material. Store the import token to
-- send with a subsequent ImportKeyMaterial request.
--
-- You must specify the key ID of the symmetric encryption KMS key into
-- which you will import key material. The KMS key @Origin@ must be
-- @EXTERNAL@. You must also specify the wrapping algorithm and type of
-- wrapping key (public key) that you will use to encrypt the key material.
-- You cannot perform this operation on an asymmetric KMS key, an HMAC KMS
-- key, or on any KMS key in a different Amazon Web Services account.
--
-- To import key material, you must use the public key and import token
-- from the same response. These items are valid for 24 hours. The
-- expiration date and time appear in the @GetParametersForImport@
-- response. You cannot use an expired token in an ImportKeyMaterial
-- request. If your key and token expire, send another
-- @GetParametersForImport@ request.
--
-- 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__: No. You cannot perform this operation on a KMS
-- key in a different Amazon Web Services account.
--
-- __Required permissions__:
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:GetParametersForImport>
-- (key policy)
--
-- __Related operations:__
--
-- -   ImportKeyMaterial
--
-- -   DeleteImportedKeyMaterial
module Amazonka.KMS.GetParametersForImport
  ( -- * Creating a Request
    GetParametersForImport (..),
    newGetParametersForImport,

    -- * Request Lenses
    getParametersForImport_keyId,
    getParametersForImport_wrappingAlgorithm,
    getParametersForImport_wrappingKeySpec,

    -- * Destructuring the Response
    GetParametersForImportResponse (..),
    newGetParametersForImportResponse,

    -- * Response Lenses
    getParametersForImportResponse_importToken,
    getParametersForImportResponse_keyId,
    getParametersForImportResponse_parametersValidTo,
    getParametersForImportResponse_publicKey,
    getParametersForImportResponse_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:/ 'newGetParametersForImport' smart constructor.
data GetParametersForImport = GetParametersForImport'
  { -- | The identifier of the symmetric encryption KMS key into which you will
    -- import key material. The @Origin@ of the KMS key must be @EXTERNAL@.
    --
    -- Specify the key ID or key ARN of the KMS key.
    --
    -- For example:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- To get the key ID and key ARN for a KMS key, use ListKeys or
    -- DescribeKey.
    GetParametersForImport -> Text
keyId :: Prelude.Text,
    -- | The algorithm you will use to encrypt the key material before importing
    -- it with ImportKeyMaterial. For more information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys-encrypt-key-material.html Encrypt the Key Material>
    -- in the /Key Management Service Developer Guide/.
    GetParametersForImport -> AlgorithmSpec
wrappingAlgorithm :: AlgorithmSpec,
    -- | The type of wrapping key (public key) to return in the response. Only
    -- 2048-bit RSA public keys are supported.
    GetParametersForImport -> WrappingKeySpec
wrappingKeySpec :: WrappingKeySpec
  }
  deriving (GetParametersForImport -> GetParametersForImport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetParametersForImport -> GetParametersForImport -> Bool
$c/= :: GetParametersForImport -> GetParametersForImport -> Bool
== :: GetParametersForImport -> GetParametersForImport -> Bool
$c== :: GetParametersForImport -> GetParametersForImport -> Bool
Prelude.Eq, ReadPrec [GetParametersForImport]
ReadPrec GetParametersForImport
Int -> ReadS GetParametersForImport
ReadS [GetParametersForImport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetParametersForImport]
$creadListPrec :: ReadPrec [GetParametersForImport]
readPrec :: ReadPrec GetParametersForImport
$creadPrec :: ReadPrec GetParametersForImport
readList :: ReadS [GetParametersForImport]
$creadList :: ReadS [GetParametersForImport]
readsPrec :: Int -> ReadS GetParametersForImport
$creadsPrec :: Int -> ReadS GetParametersForImport
Prelude.Read, Int -> GetParametersForImport -> ShowS
[GetParametersForImport] -> ShowS
GetParametersForImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetParametersForImport] -> ShowS
$cshowList :: [GetParametersForImport] -> ShowS
show :: GetParametersForImport -> String
$cshow :: GetParametersForImport -> String
showsPrec :: Int -> GetParametersForImport -> ShowS
$cshowsPrec :: Int -> GetParametersForImport -> ShowS
Prelude.Show, forall x. Rep GetParametersForImport x -> GetParametersForImport
forall x. GetParametersForImport -> Rep GetParametersForImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetParametersForImport x -> GetParametersForImport
$cfrom :: forall x. GetParametersForImport -> Rep GetParametersForImport x
Prelude.Generic)

-- |
-- Create a value of 'GetParametersForImport' 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:
--
-- 'keyId', 'getParametersForImport_keyId' - The identifier of the symmetric encryption KMS key into which you will
-- import key material. The @Origin@ of the KMS key must be @EXTERNAL@.
--
-- Specify the key ID or key ARN of the KMS key.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey.
--
-- 'wrappingAlgorithm', 'getParametersForImport_wrappingAlgorithm' - The algorithm you will use to encrypt the key material before importing
-- it with ImportKeyMaterial. For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys-encrypt-key-material.html Encrypt the Key Material>
-- in the /Key Management Service Developer Guide/.
--
-- 'wrappingKeySpec', 'getParametersForImport_wrappingKeySpec' - The type of wrapping key (public key) to return in the response. Only
-- 2048-bit RSA public keys are supported.
newGetParametersForImport ::
  -- | 'keyId'
  Prelude.Text ->
  -- | 'wrappingAlgorithm'
  AlgorithmSpec ->
  -- | 'wrappingKeySpec'
  WrappingKeySpec ->
  GetParametersForImport
newGetParametersForImport :: Text -> AlgorithmSpec -> WrappingKeySpec -> GetParametersForImport
newGetParametersForImport
  Text
pKeyId_
  AlgorithmSpec
pWrappingAlgorithm_
  WrappingKeySpec
pWrappingKeySpec_ =
    GetParametersForImport'
      { $sel:keyId:GetParametersForImport' :: Text
keyId = Text
pKeyId_,
        $sel:wrappingAlgorithm:GetParametersForImport' :: AlgorithmSpec
wrappingAlgorithm = AlgorithmSpec
pWrappingAlgorithm_,
        $sel:wrappingKeySpec:GetParametersForImport' :: WrappingKeySpec
wrappingKeySpec = WrappingKeySpec
pWrappingKeySpec_
      }

-- | The identifier of the symmetric encryption KMS key into which you will
-- import key material. The @Origin@ of the KMS key must be @EXTERNAL@.
--
-- Specify the key ID or key ARN of the KMS key.
--
-- For example:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-east-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- To get the key ID and key ARN for a KMS key, use ListKeys or
-- DescribeKey.
getParametersForImport_keyId :: Lens.Lens' GetParametersForImport Prelude.Text
getParametersForImport_keyId :: Lens' GetParametersForImport Text
getParametersForImport_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImport' {Text
keyId :: Text
$sel:keyId:GetParametersForImport' :: GetParametersForImport -> Text
keyId} -> Text
keyId) (\s :: GetParametersForImport
s@GetParametersForImport' {} Text
a -> GetParametersForImport
s {$sel:keyId:GetParametersForImport' :: Text
keyId = Text
a} :: GetParametersForImport)

-- | The algorithm you will use to encrypt the key material before importing
-- it with ImportKeyMaterial. For more information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys-encrypt-key-material.html Encrypt the Key Material>
-- in the /Key Management Service Developer Guide/.
getParametersForImport_wrappingAlgorithm :: Lens.Lens' GetParametersForImport AlgorithmSpec
getParametersForImport_wrappingAlgorithm :: Lens' GetParametersForImport AlgorithmSpec
getParametersForImport_wrappingAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImport' {AlgorithmSpec
wrappingAlgorithm :: AlgorithmSpec
$sel:wrappingAlgorithm:GetParametersForImport' :: GetParametersForImport -> AlgorithmSpec
wrappingAlgorithm} -> AlgorithmSpec
wrappingAlgorithm) (\s :: GetParametersForImport
s@GetParametersForImport' {} AlgorithmSpec
a -> GetParametersForImport
s {$sel:wrappingAlgorithm:GetParametersForImport' :: AlgorithmSpec
wrappingAlgorithm = AlgorithmSpec
a} :: GetParametersForImport)

-- | The type of wrapping key (public key) to return in the response. Only
-- 2048-bit RSA public keys are supported.
getParametersForImport_wrappingKeySpec :: Lens.Lens' GetParametersForImport WrappingKeySpec
getParametersForImport_wrappingKeySpec :: Lens' GetParametersForImport WrappingKeySpec
getParametersForImport_wrappingKeySpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImport' {WrappingKeySpec
wrappingKeySpec :: WrappingKeySpec
$sel:wrappingKeySpec:GetParametersForImport' :: GetParametersForImport -> WrappingKeySpec
wrappingKeySpec} -> WrappingKeySpec
wrappingKeySpec) (\s :: GetParametersForImport
s@GetParametersForImport' {} WrappingKeySpec
a -> GetParametersForImport
s {$sel:wrappingKeySpec:GetParametersForImport' :: WrappingKeySpec
wrappingKeySpec = WrappingKeySpec
a} :: GetParametersForImport)

instance Core.AWSRequest GetParametersForImport where
  type
    AWSResponse GetParametersForImport =
      GetParametersForImportResponse
  request :: (Service -> Service)
-> GetParametersForImport -> Request GetParametersForImport
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 GetParametersForImport
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetParametersForImport)))
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 Text
-> Maybe POSIX
-> Maybe (Sensitive Base64)
-> Int
-> GetParametersForImportResponse
GetParametersForImportResponse'
            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
"ImportToken")
            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
"ParametersValidTo")
            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
"PublicKey")
            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 GetParametersForImport where
  hashWithSalt :: Int -> GetParametersForImport -> Int
hashWithSalt Int
_salt GetParametersForImport' {Text
AlgorithmSpec
WrappingKeySpec
wrappingKeySpec :: WrappingKeySpec
wrappingAlgorithm :: AlgorithmSpec
keyId :: Text
$sel:wrappingKeySpec:GetParametersForImport' :: GetParametersForImport -> WrappingKeySpec
$sel:wrappingAlgorithm:GetParametersForImport' :: GetParametersForImport -> AlgorithmSpec
$sel:keyId:GetParametersForImport' :: GetParametersForImport -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlgorithmSpec
wrappingAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WrappingKeySpec
wrappingKeySpec

instance Prelude.NFData GetParametersForImport where
  rnf :: GetParametersForImport -> ()
rnf GetParametersForImport' {Text
AlgorithmSpec
WrappingKeySpec
wrappingKeySpec :: WrappingKeySpec
wrappingAlgorithm :: AlgorithmSpec
keyId :: Text
$sel:wrappingKeySpec:GetParametersForImport' :: GetParametersForImport -> WrappingKeySpec
$sel:wrappingAlgorithm:GetParametersForImport' :: GetParametersForImport -> AlgorithmSpec
$sel:keyId:GetParametersForImport' :: GetParametersForImport -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
keyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AlgorithmSpec
wrappingAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WrappingKeySpec
wrappingKeySpec

instance Data.ToHeaders GetParametersForImport where
  toHeaders :: GetParametersForImport -> 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.GetParametersForImport" ::
                          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 GetParametersForImport where
  toJSON :: GetParametersForImport -> Value
toJSON GetParametersForImport' {Text
AlgorithmSpec
WrappingKeySpec
wrappingKeySpec :: WrappingKeySpec
wrappingAlgorithm :: AlgorithmSpec
keyId :: Text
$sel:wrappingKeySpec:GetParametersForImport' :: GetParametersForImport -> WrappingKeySpec
$sel:wrappingAlgorithm:GetParametersForImport' :: GetParametersForImport -> AlgorithmSpec
$sel:keyId:GetParametersForImport' :: GetParametersForImport -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"KeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"WrappingAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlgorithmSpec
wrappingAlgorithm),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"WrappingKeySpec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= WrappingKeySpec
wrappingKeySpec)
          ]
      )

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

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

-- | /See:/ 'newGetParametersForImportResponse' smart constructor.
data GetParametersForImportResponse = GetParametersForImportResponse'
  { -- | The import token to send in a subsequent ImportKeyMaterial request.
    GetParametersForImportResponse -> Maybe Base64
importToken :: Prelude.Maybe Data.Base64,
    -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
    -- of the KMS key to use in a subsequent ImportKeyMaterial request. This is
    -- the same KMS key specified in the @GetParametersForImport@ request.
    GetParametersForImportResponse -> Maybe Text
keyId :: Prelude.Maybe Prelude.Text,
    -- | The time at which the import token and public key are no longer valid.
    -- After this time, you cannot use them to make an ImportKeyMaterial
    -- request and you must send another @GetParametersForImport@ request to
    -- get new ones.
    GetParametersForImportResponse -> Maybe POSIX
parametersValidTo :: Prelude.Maybe Data.POSIX,
    -- | The public key to use to encrypt the key material before importing it
    -- with ImportKeyMaterial.
    GetParametersForImportResponse -> Maybe (Sensitive Base64)
publicKey :: Prelude.Maybe (Data.Sensitive Data.Base64),
    -- | The response's http status code.
    GetParametersForImportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetParametersForImportResponse
-> GetParametersForImportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetParametersForImportResponse
-> GetParametersForImportResponse -> Bool
$c/= :: GetParametersForImportResponse
-> GetParametersForImportResponse -> Bool
== :: GetParametersForImportResponse
-> GetParametersForImportResponse -> Bool
$c== :: GetParametersForImportResponse
-> GetParametersForImportResponse -> Bool
Prelude.Eq, Int -> GetParametersForImportResponse -> ShowS
[GetParametersForImportResponse] -> ShowS
GetParametersForImportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetParametersForImportResponse] -> ShowS
$cshowList :: [GetParametersForImportResponse] -> ShowS
show :: GetParametersForImportResponse -> String
$cshow :: GetParametersForImportResponse -> String
showsPrec :: Int -> GetParametersForImportResponse -> ShowS
$cshowsPrec :: Int -> GetParametersForImportResponse -> ShowS
Prelude.Show, forall x.
Rep GetParametersForImportResponse x
-> GetParametersForImportResponse
forall x.
GetParametersForImportResponse
-> Rep GetParametersForImportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetParametersForImportResponse x
-> GetParametersForImportResponse
$cfrom :: forall x.
GetParametersForImportResponse
-> Rep GetParametersForImportResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetParametersForImportResponse' 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:
--
-- 'importToken', 'getParametersForImportResponse_importToken' - The import token to send in a subsequent ImportKeyMaterial request.--
-- -- /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.
--
-- 'keyId', 'getParametersForImportResponse_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 to use in a subsequent ImportKeyMaterial request. This is
-- the same KMS key specified in the @GetParametersForImport@ request.
--
-- 'parametersValidTo', 'getParametersForImportResponse_parametersValidTo' - The time at which the import token and public key are no longer valid.
-- After this time, you cannot use them to make an ImportKeyMaterial
-- request and you must send another @GetParametersForImport@ request to
-- get new ones.
--
-- 'publicKey', 'getParametersForImportResponse_publicKey' - The public key to use to encrypt the key material before importing it
-- with ImportKeyMaterial.--
-- -- /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.
--
-- 'httpStatus', 'getParametersForImportResponse_httpStatus' - The response's http status code.
newGetParametersForImportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetParametersForImportResponse
newGetParametersForImportResponse :: Int -> GetParametersForImportResponse
newGetParametersForImportResponse Int
pHttpStatus_ =
  GetParametersForImportResponse'
    { $sel:importToken:GetParametersForImportResponse' :: Maybe Base64
importToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:keyId:GetParametersForImportResponse' :: Maybe Text
keyId = forall a. Maybe a
Prelude.Nothing,
      $sel:parametersValidTo:GetParametersForImportResponse' :: Maybe POSIX
parametersValidTo = forall a. Maybe a
Prelude.Nothing,
      $sel:publicKey:GetParametersForImportResponse' :: Maybe (Sensitive Base64)
publicKey = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetParametersForImportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The import token to send in a subsequent ImportKeyMaterial request.--
-- -- /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.
getParametersForImportResponse_importToken :: Lens.Lens' GetParametersForImportResponse (Prelude.Maybe Prelude.ByteString)
getParametersForImportResponse_importToken :: Lens' GetParametersForImportResponse (Maybe ByteString)
getParametersForImportResponse_importToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImportResponse' {Maybe Base64
importToken :: Maybe Base64
$sel:importToken:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe Base64
importToken} -> Maybe Base64
importToken) (\s :: GetParametersForImportResponse
s@GetParametersForImportResponse' {} Maybe Base64
a -> GetParametersForImportResponse
s {$sel:importToken:GetParametersForImportResponse' :: Maybe Base64
importToken = Maybe Base64
a} :: GetParametersForImportResponse) 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 Amazon Resource Name
-- (<https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#key-id-key-ARN key ARN>)
-- of the KMS key to use in a subsequent ImportKeyMaterial request. This is
-- the same KMS key specified in the @GetParametersForImport@ request.
getParametersForImportResponse_keyId :: Lens.Lens' GetParametersForImportResponse (Prelude.Maybe Prelude.Text)
getParametersForImportResponse_keyId :: Lens' GetParametersForImportResponse (Maybe Text)
getParametersForImportResponse_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImportResponse' {Maybe Text
keyId :: Maybe Text
$sel:keyId:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe Text
keyId} -> Maybe Text
keyId) (\s :: GetParametersForImportResponse
s@GetParametersForImportResponse' {} Maybe Text
a -> GetParametersForImportResponse
s {$sel:keyId:GetParametersForImportResponse' :: Maybe Text
keyId = Maybe Text
a} :: GetParametersForImportResponse)

-- | The time at which the import token and public key are no longer valid.
-- After this time, you cannot use them to make an ImportKeyMaterial
-- request and you must send another @GetParametersForImport@ request to
-- get new ones.
getParametersForImportResponse_parametersValidTo :: Lens.Lens' GetParametersForImportResponse (Prelude.Maybe Prelude.UTCTime)
getParametersForImportResponse_parametersValidTo :: Lens' GetParametersForImportResponse (Maybe UTCTime)
getParametersForImportResponse_parametersValidTo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImportResponse' {Maybe POSIX
parametersValidTo :: Maybe POSIX
$sel:parametersValidTo:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe POSIX
parametersValidTo} -> Maybe POSIX
parametersValidTo) (\s :: GetParametersForImportResponse
s@GetParametersForImportResponse' {} Maybe POSIX
a -> GetParametersForImportResponse
s {$sel:parametersValidTo:GetParametersForImportResponse' :: Maybe POSIX
parametersValidTo = Maybe POSIX
a} :: GetParametersForImportResponse) 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

-- | The public key to use to encrypt the key material before importing it
-- with ImportKeyMaterial.--
-- -- /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.
getParametersForImportResponse_publicKey :: Lens.Lens' GetParametersForImportResponse (Prelude.Maybe Prelude.ByteString)
getParametersForImportResponse_publicKey :: Lens' GetParametersForImportResponse (Maybe ByteString)
getParametersForImportResponse_publicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetParametersForImportResponse' {Maybe (Sensitive Base64)
publicKey :: Maybe (Sensitive Base64)
$sel:publicKey:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe (Sensitive Base64)
publicKey} -> Maybe (Sensitive Base64)
publicKey) (\s :: GetParametersForImportResponse
s@GetParametersForImportResponse' {} Maybe (Sensitive Base64)
a -> GetParametersForImportResponse
s {$sel:publicKey:GetParametersForImportResponse' :: Maybe (Sensitive Base64)
publicKey = Maybe (Sensitive Base64)
a} :: GetParametersForImportResponse) 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. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64)

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

instance
  Prelude.NFData
    GetParametersForImportResponse
  where
  rnf :: GetParametersForImportResponse -> ()
rnf GetParametersForImportResponse' {Int
Maybe Text
Maybe Base64
Maybe (Sensitive Base64)
Maybe POSIX
httpStatus :: Int
publicKey :: Maybe (Sensitive Base64)
parametersValidTo :: Maybe POSIX
keyId :: Maybe Text
importToken :: Maybe Base64
$sel:httpStatus:GetParametersForImportResponse' :: GetParametersForImportResponse -> Int
$sel:publicKey:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe (Sensitive Base64)
$sel:parametersValidTo:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe POSIX
$sel:keyId:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe Text
$sel:importToken:GetParametersForImportResponse' :: GetParametersForImportResponse -> Maybe Base64
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
importToken
      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 POSIX
parametersValidTo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Base64)
publicKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus