{-# 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.ImportKeyMaterial
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports key material into an existing symmetric encryption KMS key that
-- was created without key material. After you successfully import key
-- material into a KMS key, you can
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys.html#reimport-key-material reimport the same key material>
-- into that KMS key, but you cannot import different 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. For
-- more information about creating KMS keys with no key material and then
-- importing key material, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys.html Importing Key Material>
-- in the /Key Management Service Developer Guide/.
--
-- Before using this operation, call GetParametersForImport. Its response
-- includes a public key and an import token. Use the public key to encrypt
-- the key material. Then, submit the import token from the same
-- @GetParametersForImport@ response.
--
-- When calling this operation, you must specify the following values:
--
-- -   The key ID or key ARN of a KMS key with no key material. Its
--     @Origin@ must be @EXTERNAL@.
--
--     To create a KMS key with no key material, call CreateKey and set the
--     value of its @Origin@ parameter to @EXTERNAL@. To get the @Origin@
--     of a KMS key, call DescribeKey.)
--
-- -   The encrypted key material. To get the public key to encrypt the key
--     material, call GetParametersForImport.
--
-- -   The import token that GetParametersForImport returned. You must use
--     a public key and token from the same @GetParametersForImport@
--     response.
--
-- -   Whether the key material expires (@ExpirationModel@) and, if so,
--     when (@ValidTo@). If you set an expiration date, on the specified
--     date, KMS deletes the key material from the KMS key, making the KMS
--     key unusable. To use the KMS key in cryptographic operations again,
--     you must reimport the same key material. The only way to change the
--     expiration model or expiration date is by reimporting the same key
--     material and specifying a new expiration date.
--
-- When this operation is successful, the key state of the KMS key changes
-- from @PendingImport@ to @Enabled@, and you can use the KMS key.
--
-- If this operation fails, use the exception to help determine the
-- problem. If the error is related to the key material, the import token,
-- or wrapping key, use GetParametersForImport to get a new public key and
-- import token for the KMS key and repeat the import procedure. For help,
-- see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/importing-keys.html#importing-keys-overview How To Import Key Material>
-- in the /Key Management Service Developer Guide/.
--
-- 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:ImportKeyMaterial>
-- (key policy)
--
-- __Related operations:__
--
-- -   DeleteImportedKeyMaterial
--
-- -   GetParametersForImport
module Amazonka.KMS.ImportKeyMaterial
  ( -- * Creating a Request
    ImportKeyMaterial (..),
    newImportKeyMaterial,

    -- * Request Lenses
    importKeyMaterial_expirationModel,
    importKeyMaterial_validTo,
    importKeyMaterial_keyId,
    importKeyMaterial_importToken,
    importKeyMaterial_encryptedKeyMaterial,

    -- * Destructuring the Response
    ImportKeyMaterialResponse (..),
    newImportKeyMaterialResponse,

    -- * Response Lenses
    importKeyMaterialResponse_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:/ 'newImportKeyMaterial' smart constructor.
data ImportKeyMaterial = ImportKeyMaterial'
  { -- | Specifies whether the key material expires. The default is
    -- @KEY_MATERIAL_EXPIRES@.
    --
    -- When the value of @ExpirationModel@ is @KEY_MATERIAL_EXPIRES@, you must
    -- specify a value for the @ValidTo@ parameter. When value is
    -- @KEY_MATERIAL_DOES_NOT_EXPIRE@, you must omit the @ValidTo@ parameter.
    --
    -- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
    -- current import after the request completes. To change either value, you
    -- must delete (DeleteImportedKeyMaterial) and reimport the key material.
    ImportKeyMaterial -> Maybe ExpirationModelType
expirationModel :: Prelude.Maybe ExpirationModelType,
    -- | The date and time when the imported key material expires. This parameter
    -- is required when the value of the @ExpirationModel@ parameter is
    -- @KEY_MATERIAL_EXPIRES@. Otherwise it is not valid.
    --
    -- The value of this parameter must be a future date and time. The maximum
    -- value is 365 days from the request date.
    --
    -- When the key material expires, KMS deletes the key material from the KMS
    -- key. Without its key material, the KMS key is unusable. To use the KMS
    -- key in cryptographic operations, you must reimport the same key
    -- material.
    --
    -- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
    -- current import after the request completes. To change either value, you
    -- must delete (DeleteImportedKeyMaterial) and reimport the key material.
    ImportKeyMaterial -> Maybe POSIX
validTo :: Prelude.Maybe Data.POSIX,
    -- | The identifier of the symmetric encryption KMS key that receives the
    -- imported key material. This must be the same KMS key specified in the
    -- @KeyID@ parameter of the corresponding GetParametersForImport request.
    -- The @Origin@ of the KMS key must be @EXTERNAL@. You cannot perform this
    -- operation on an asymmetric KMS key, an HMAC KMS key, a KMS key in a
    -- custom key store, or on a KMS key in a different Amazon Web Services
    -- account
    --
    -- 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.
    ImportKeyMaterial -> Text
keyId :: Prelude.Text,
    -- | The import token that you received in the response to a previous
    -- GetParametersForImport request. It must be from the same response that
    -- contained the public key that you used to encrypt the key material.
    ImportKeyMaterial -> Base64
importToken :: Data.Base64,
    -- | The encrypted key material to import. The key material must be encrypted
    -- with the public wrapping key that GetParametersForImport returned, using
    -- the wrapping algorithm that you specified in the same
    -- @GetParametersForImport@ request.
    ImportKeyMaterial -> Base64
encryptedKeyMaterial :: Data.Base64
  }
  deriving (ImportKeyMaterial -> ImportKeyMaterial -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportKeyMaterial -> ImportKeyMaterial -> Bool
$c/= :: ImportKeyMaterial -> ImportKeyMaterial -> Bool
== :: ImportKeyMaterial -> ImportKeyMaterial -> Bool
$c== :: ImportKeyMaterial -> ImportKeyMaterial -> Bool
Prelude.Eq, ReadPrec [ImportKeyMaterial]
ReadPrec ImportKeyMaterial
Int -> ReadS ImportKeyMaterial
ReadS [ImportKeyMaterial]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportKeyMaterial]
$creadListPrec :: ReadPrec [ImportKeyMaterial]
readPrec :: ReadPrec ImportKeyMaterial
$creadPrec :: ReadPrec ImportKeyMaterial
readList :: ReadS [ImportKeyMaterial]
$creadList :: ReadS [ImportKeyMaterial]
readsPrec :: Int -> ReadS ImportKeyMaterial
$creadsPrec :: Int -> ReadS ImportKeyMaterial
Prelude.Read, Int -> ImportKeyMaterial -> ShowS
[ImportKeyMaterial] -> ShowS
ImportKeyMaterial -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportKeyMaterial] -> ShowS
$cshowList :: [ImportKeyMaterial] -> ShowS
show :: ImportKeyMaterial -> String
$cshow :: ImportKeyMaterial -> String
showsPrec :: Int -> ImportKeyMaterial -> ShowS
$cshowsPrec :: Int -> ImportKeyMaterial -> ShowS
Prelude.Show, forall x. Rep ImportKeyMaterial x -> ImportKeyMaterial
forall x. ImportKeyMaterial -> Rep ImportKeyMaterial x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportKeyMaterial x -> ImportKeyMaterial
$cfrom :: forall x. ImportKeyMaterial -> Rep ImportKeyMaterial x
Prelude.Generic)

-- |
-- Create a value of 'ImportKeyMaterial' 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:
--
-- 'expirationModel', 'importKeyMaterial_expirationModel' - Specifies whether the key material expires. The default is
-- @KEY_MATERIAL_EXPIRES@.
--
-- When the value of @ExpirationModel@ is @KEY_MATERIAL_EXPIRES@, you must
-- specify a value for the @ValidTo@ parameter. When value is
-- @KEY_MATERIAL_DOES_NOT_EXPIRE@, you must omit the @ValidTo@ parameter.
--
-- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
-- current import after the request completes. To change either value, you
-- must delete (DeleteImportedKeyMaterial) and reimport the key material.
--
-- 'validTo', 'importKeyMaterial_validTo' - The date and time when the imported key material expires. This parameter
-- is required when the value of the @ExpirationModel@ parameter is
-- @KEY_MATERIAL_EXPIRES@. Otherwise it is not valid.
--
-- The value of this parameter must be a future date and time. The maximum
-- value is 365 days from the request date.
--
-- When the key material expires, KMS deletes the key material from the KMS
-- key. Without its key material, the KMS key is unusable. To use the KMS
-- key in cryptographic operations, you must reimport the same key
-- material.
--
-- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
-- current import after the request completes. To change either value, you
-- must delete (DeleteImportedKeyMaterial) and reimport the key material.
--
-- 'keyId', 'importKeyMaterial_keyId' - The identifier of the symmetric encryption KMS key that receives the
-- imported key material. This must be the same KMS key specified in the
-- @KeyID@ parameter of the corresponding GetParametersForImport request.
-- The @Origin@ of the KMS key must be @EXTERNAL@. You cannot perform this
-- operation on an asymmetric KMS key, an HMAC KMS key, a KMS key in a
-- custom key store, or on a KMS key in a different Amazon Web Services
-- account
--
-- 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.
--
-- 'importToken', 'importKeyMaterial_importToken' - The import token that you received in the response to a previous
-- GetParametersForImport request. It must be from the same response that
-- contained the public key that you used to encrypt the key material.--
-- -- /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.
--
-- 'encryptedKeyMaterial', 'importKeyMaterial_encryptedKeyMaterial' - The encrypted key material to import. The key material must be encrypted
-- with the public wrapping key that GetParametersForImport returned, using
-- the wrapping algorithm that you specified in the same
-- @GetParametersForImport@ 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.
newImportKeyMaterial ::
  -- | 'keyId'
  Prelude.Text ->
  -- | 'importToken'
  Prelude.ByteString ->
  -- | 'encryptedKeyMaterial'
  Prelude.ByteString ->
  ImportKeyMaterial
newImportKeyMaterial :: Text -> ByteString -> ByteString -> ImportKeyMaterial
newImportKeyMaterial
  Text
pKeyId_
  ByteString
pImportToken_
  ByteString
pEncryptedKeyMaterial_ =
    ImportKeyMaterial'
      { $sel:expirationModel:ImportKeyMaterial' :: Maybe ExpirationModelType
expirationModel =
          forall a. Maybe a
Prelude.Nothing,
        $sel:validTo:ImportKeyMaterial' :: Maybe POSIX
validTo = forall a. Maybe a
Prelude.Nothing,
        $sel:keyId:ImportKeyMaterial' :: Text
keyId = Text
pKeyId_,
        $sel:importToken:ImportKeyMaterial' :: Base64
importToken = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pImportToken_,
        $sel:encryptedKeyMaterial:ImportKeyMaterial' :: Base64
encryptedKeyMaterial =
          Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pEncryptedKeyMaterial_
      }

-- | Specifies whether the key material expires. The default is
-- @KEY_MATERIAL_EXPIRES@.
--
-- When the value of @ExpirationModel@ is @KEY_MATERIAL_EXPIRES@, you must
-- specify a value for the @ValidTo@ parameter. When value is
-- @KEY_MATERIAL_DOES_NOT_EXPIRE@, you must omit the @ValidTo@ parameter.
--
-- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
-- current import after the request completes. To change either value, you
-- must delete (DeleteImportedKeyMaterial) and reimport the key material.
importKeyMaterial_expirationModel :: Lens.Lens' ImportKeyMaterial (Prelude.Maybe ExpirationModelType)
importKeyMaterial_expirationModel :: Lens' ImportKeyMaterial (Maybe ExpirationModelType)
importKeyMaterial_expirationModel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyMaterial' {Maybe ExpirationModelType
expirationModel :: Maybe ExpirationModelType
$sel:expirationModel:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe ExpirationModelType
expirationModel} -> Maybe ExpirationModelType
expirationModel) (\s :: ImportKeyMaterial
s@ImportKeyMaterial' {} Maybe ExpirationModelType
a -> ImportKeyMaterial
s {$sel:expirationModel:ImportKeyMaterial' :: Maybe ExpirationModelType
expirationModel = Maybe ExpirationModelType
a} :: ImportKeyMaterial)

-- | The date and time when the imported key material expires. This parameter
-- is required when the value of the @ExpirationModel@ parameter is
-- @KEY_MATERIAL_EXPIRES@. Otherwise it is not valid.
--
-- The value of this parameter must be a future date and time. The maximum
-- value is 365 days from the request date.
--
-- When the key material expires, KMS deletes the key material from the KMS
-- key. Without its key material, the KMS key is unusable. To use the KMS
-- key in cryptographic operations, you must reimport the same key
-- material.
--
-- You cannot change the @ExpirationModel@ or @ValidTo@ values for the
-- current import after the request completes. To change either value, you
-- must delete (DeleteImportedKeyMaterial) and reimport the key material.
importKeyMaterial_validTo :: Lens.Lens' ImportKeyMaterial (Prelude.Maybe Prelude.UTCTime)
importKeyMaterial_validTo :: Lens' ImportKeyMaterial (Maybe UTCTime)
importKeyMaterial_validTo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyMaterial' {Maybe POSIX
validTo :: Maybe POSIX
$sel:validTo:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe POSIX
validTo} -> Maybe POSIX
validTo) (\s :: ImportKeyMaterial
s@ImportKeyMaterial' {} Maybe POSIX
a -> ImportKeyMaterial
s {$sel:validTo:ImportKeyMaterial' :: Maybe POSIX
validTo = Maybe POSIX
a} :: ImportKeyMaterial) 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 identifier of the symmetric encryption KMS key that receives the
-- imported key material. This must be the same KMS key specified in the
-- @KeyID@ parameter of the corresponding GetParametersForImport request.
-- The @Origin@ of the KMS key must be @EXTERNAL@. You cannot perform this
-- operation on an asymmetric KMS key, an HMAC KMS key, a KMS key in a
-- custom key store, or on a KMS key in a different Amazon Web Services
-- account
--
-- 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.
importKeyMaterial_keyId :: Lens.Lens' ImportKeyMaterial Prelude.Text
importKeyMaterial_keyId :: Lens' ImportKeyMaterial Text
importKeyMaterial_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyMaterial' {Text
keyId :: Text
$sel:keyId:ImportKeyMaterial' :: ImportKeyMaterial -> Text
keyId} -> Text
keyId) (\s :: ImportKeyMaterial
s@ImportKeyMaterial' {} Text
a -> ImportKeyMaterial
s {$sel:keyId:ImportKeyMaterial' :: Text
keyId = Text
a} :: ImportKeyMaterial)

-- | The import token that you received in the response to a previous
-- GetParametersForImport request. It must be from the same response that
-- contained the public key that you used to encrypt the key material.--
-- -- /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.
importKeyMaterial_importToken :: Lens.Lens' ImportKeyMaterial Prelude.ByteString
importKeyMaterial_importToken :: Lens' ImportKeyMaterial ByteString
importKeyMaterial_importToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyMaterial' {Base64
importToken :: Base64
$sel:importToken:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
importToken} -> Base64
importToken) (\s :: ImportKeyMaterial
s@ImportKeyMaterial' {} Base64
a -> ImportKeyMaterial
s {$sel:importToken:ImportKeyMaterial' :: Base64
importToken = Base64
a} :: ImportKeyMaterial) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The encrypted key material to import. The key material must be encrypted
-- with the public wrapping key that GetParametersForImport returned, using
-- the wrapping algorithm that you specified in the same
-- @GetParametersForImport@ 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.
importKeyMaterial_encryptedKeyMaterial :: Lens.Lens' ImportKeyMaterial Prelude.ByteString
importKeyMaterial_encryptedKeyMaterial :: Lens' ImportKeyMaterial ByteString
importKeyMaterial_encryptedKeyMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyMaterial' {Base64
encryptedKeyMaterial :: Base64
$sel:encryptedKeyMaterial:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
encryptedKeyMaterial} -> Base64
encryptedKeyMaterial) (\s :: ImportKeyMaterial
s@ImportKeyMaterial' {} Base64
a -> ImportKeyMaterial
s {$sel:encryptedKeyMaterial:ImportKeyMaterial' :: Base64
encryptedKeyMaterial = Base64
a} :: ImportKeyMaterial) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Core.AWSRequest ImportKeyMaterial where
  type
    AWSResponse ImportKeyMaterial =
      ImportKeyMaterialResponse
  request :: (Service -> Service)
-> ImportKeyMaterial -> Request ImportKeyMaterial
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 ImportKeyMaterial
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportKeyMaterial)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> ImportKeyMaterialResponse
ImportKeyMaterialResponse'
            forall (f :: * -> *) a b. Functor 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 ImportKeyMaterial where
  hashWithSalt :: Int -> ImportKeyMaterial -> Int
hashWithSalt Int
_salt ImportKeyMaterial' {Maybe POSIX
Maybe ExpirationModelType
Text
Base64
encryptedKeyMaterial :: Base64
importToken :: Base64
keyId :: Text
validTo :: Maybe POSIX
expirationModel :: Maybe ExpirationModelType
$sel:encryptedKeyMaterial:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:importToken:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:keyId:ImportKeyMaterial' :: ImportKeyMaterial -> Text
$sel:validTo:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe POSIX
$sel:expirationModel:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe ExpirationModelType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExpirationModelType
expirationModel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
validTo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
importToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
encryptedKeyMaterial

instance Prelude.NFData ImportKeyMaterial where
  rnf :: ImportKeyMaterial -> ()
rnf ImportKeyMaterial' {Maybe POSIX
Maybe ExpirationModelType
Text
Base64
encryptedKeyMaterial :: Base64
importToken :: Base64
keyId :: Text
validTo :: Maybe POSIX
expirationModel :: Maybe ExpirationModelType
$sel:encryptedKeyMaterial:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:importToken:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:keyId:ImportKeyMaterial' :: ImportKeyMaterial -> Text
$sel:validTo:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe POSIX
$sel:expirationModel:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe ExpirationModelType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ExpirationModelType
expirationModel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
validTo
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Base64
importToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
encryptedKeyMaterial

instance Data.ToHeaders ImportKeyMaterial where
  toHeaders :: ImportKeyMaterial -> 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.ImportKeyMaterial" ::
                          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 ImportKeyMaterial where
  toJSON :: ImportKeyMaterial -> Value
toJSON ImportKeyMaterial' {Maybe POSIX
Maybe ExpirationModelType
Text
Base64
encryptedKeyMaterial :: Base64
importToken :: Base64
keyId :: Text
validTo :: Maybe POSIX
expirationModel :: Maybe ExpirationModelType
$sel:encryptedKeyMaterial:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:importToken:ImportKeyMaterial' :: ImportKeyMaterial -> Base64
$sel:keyId:ImportKeyMaterial' :: ImportKeyMaterial -> Text
$sel:validTo:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe POSIX
$sel:expirationModel:ImportKeyMaterial' :: ImportKeyMaterial -> Maybe ExpirationModelType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExpirationModel" 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 ExpirationModelType
expirationModel,
            (Key
"ValidTo" 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 POSIX
validTo,
            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
"ImportToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
importToken),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EncryptedKeyMaterial"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
encryptedKeyMaterial
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'ImportKeyMaterialResponse' 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:
--
-- 'httpStatus', 'importKeyMaterialResponse_httpStatus' - The response's http status code.
newImportKeyMaterialResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportKeyMaterialResponse
newImportKeyMaterialResponse :: Int -> ImportKeyMaterialResponse
newImportKeyMaterialResponse Int
pHttpStatus_ =
  ImportKeyMaterialResponse'
    { $sel:httpStatus:ImportKeyMaterialResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData ImportKeyMaterialResponse where
  rnf :: ImportKeyMaterialResponse -> ()
rnf ImportKeyMaterialResponse' {Int
httpStatus :: Int
$sel:httpStatus:ImportKeyMaterialResponse' :: ImportKeyMaterialResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus