{-# 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.DescribeKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides detailed information about a KMS key. You can run @DescribeKey@
-- on a
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#customer-cmk customer managed key>
-- or an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#aws-managed-cmk Amazon Web Services managed key>.
--
-- This detailed information includes the key ARN, creation date (and
-- deletion date, if applicable), the key state, and the origin and
-- expiration date (if any) of the key material. It includes fields, like
-- @KeySpec@, that help you distinguish different types of KMS keys. It
-- also displays the key usage (encryption, signing, or generating and
-- verifying MACs) and the algorithms that the KMS key supports.
--
-- For
-- <kms/latest/developerguide/multi-region-keys-overview.html multi-Region keys>,
-- @DescribeKey@ displays the primary key and all related replica keys. For
-- KMS keys in
-- <kms/latest/developerguide/keystore-cloudhsm.html CloudHSM key stores>,
-- it includes information about the key store, such as the key store ID
-- and the CloudHSM cluster ID. For KMS keys in
-- <kms/latest/developerguide/keystore-external.html external key stores>,
-- it includes the custom key store ID and the ID of the external key.
--
-- @DescribeKey@ does not return the following information:
--
-- -   Aliases associated with the KMS key. To get this information, use
--     ListAliases.
--
-- -   Whether automatic key rotation is enabled on the KMS key. To get
--     this information, use GetKeyRotationStatus. Also, some key states
--     prevent a KMS key from being automatically rotated. For details, see
--     <https://docs.aws.amazon.com/kms/latest/developerguide/rotate-keys.html#rotate-keys-how-it-works How Automatic Key Rotation Works>
--     in the /Key Management Service Developer Guide/.
--
-- -   Tags on the KMS key. To get this information, use ListResourceTags.
--
-- -   Key policies and grants on the KMS key. To get this information, use
--     GetKeyPolicy and ListGrants.
--
-- In general, @DescribeKey@ is a non-mutating operation. It returns data
-- about KMS keys, but doesn\'t change them. However, Amazon Web Services
-- services use @DescribeKey@ to create
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#aws-managed-cmk Amazon Web Services managed keys>
-- from a /predefined Amazon Web Services alias/ with no key ID.
--
-- __Cross-account use__: Yes. To perform this operation with a KMS key in
-- a different Amazon Web Services account, specify the key ARN or alias
-- ARN in the value of the @KeyId@ parameter.
--
-- __Required permissions__:
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:DescribeKey>
-- (key policy)
--
-- __Related operations:__
--
-- -   GetKeyPolicy
--
-- -   GetKeyRotationStatus
--
-- -   ListAliases
--
-- -   ListGrants
--
-- -   ListKeys
--
-- -   ListResourceTags
--
-- -   ListRetirableGrants
module Amazonka.KMS.DescribeKey
  ( -- * Creating a Request
    DescribeKey (..),
    newDescribeKey,

    -- * Request Lenses
    describeKey_grantTokens,
    describeKey_keyId,

    -- * Destructuring the Response
    DescribeKeyResponse (..),
    newDescribeKeyResponse,

    -- * Response Lenses
    describeKeyResponse_keyMetadata,
    describeKeyResponse_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:/ 'newDescribeKey' smart constructor.
data DescribeKey = DescribeKey'
  { -- | 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/.
    DescribeKey -> Maybe [Text]
grantTokens :: Prelude.Maybe [Prelude.Text],
    -- | Describes the specified KMS key.
    --
    -- If you specify a predefined Amazon Web Services alias (an Amazon Web
    -- Services alias with no key ID), KMS associates the alias with an
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html##aws-managed-cmk Amazon Web Services managed key>
    -- and returns its @KeyId@ and @Arn@ in the response.
    --
    -- 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.
    DescribeKey -> Text
keyId :: Prelude.Text
  }
  deriving (DescribeKey -> DescribeKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeKey -> DescribeKey -> Bool
$c/= :: DescribeKey -> DescribeKey -> Bool
== :: DescribeKey -> DescribeKey -> Bool
$c== :: DescribeKey -> DescribeKey -> Bool
Prelude.Eq, ReadPrec [DescribeKey]
ReadPrec DescribeKey
Int -> ReadS DescribeKey
ReadS [DescribeKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeKey]
$creadListPrec :: ReadPrec [DescribeKey]
readPrec :: ReadPrec DescribeKey
$creadPrec :: ReadPrec DescribeKey
readList :: ReadS [DescribeKey]
$creadList :: ReadS [DescribeKey]
readsPrec :: Int -> ReadS DescribeKey
$creadsPrec :: Int -> ReadS DescribeKey
Prelude.Read, Int -> DescribeKey -> ShowS
[DescribeKey] -> ShowS
DescribeKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeKey] -> ShowS
$cshowList :: [DescribeKey] -> ShowS
show :: DescribeKey -> String
$cshow :: DescribeKey -> String
showsPrec :: Int -> DescribeKey -> ShowS
$cshowsPrec :: Int -> DescribeKey -> ShowS
Prelude.Show, forall x. Rep DescribeKey x -> DescribeKey
forall x. DescribeKey -> Rep DescribeKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeKey x -> DescribeKey
$cfrom :: forall x. DescribeKey -> Rep DescribeKey x
Prelude.Generic)

-- |
-- Create a value of 'DescribeKey' 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:
--
-- 'grantTokens', 'describeKey_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/.
--
-- 'keyId', 'describeKey_keyId' - Describes the specified KMS key.
--
-- If you specify a predefined Amazon Web Services alias (an Amazon Web
-- Services alias with no key ID), KMS associates the alias with an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html##aws-managed-cmk Amazon Web Services managed key>
-- and returns its @KeyId@ and @Arn@ in the response.
--
-- 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.
newDescribeKey ::
  -- | 'keyId'
  Prelude.Text ->
  DescribeKey
newDescribeKey :: Text -> DescribeKey
newDescribeKey Text
pKeyId_ =
  DescribeKey'
    { $sel:grantTokens:DescribeKey' :: Maybe [Text]
grantTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:keyId:DescribeKey' :: Text
keyId = Text
pKeyId_
    }

-- | 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/.
describeKey_grantTokens :: Lens.Lens' DescribeKey (Prelude.Maybe [Prelude.Text])
describeKey_grantTokens :: Lens' DescribeKey (Maybe [Text])
describeKey_grantTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeKey' {Maybe [Text]
grantTokens :: Maybe [Text]
$sel:grantTokens:DescribeKey' :: DescribeKey -> Maybe [Text]
grantTokens} -> Maybe [Text]
grantTokens) (\s :: DescribeKey
s@DescribeKey' {} Maybe [Text]
a -> DescribeKey
s {$sel:grantTokens:DescribeKey' :: Maybe [Text]
grantTokens = Maybe [Text]
a} :: DescribeKey) 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

-- | Describes the specified KMS key.
--
-- If you specify a predefined Amazon Web Services alias (an Amazon Web
-- Services alias with no key ID), KMS associates the alias with an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html##aws-managed-cmk Amazon Web Services managed key>
-- and returns its @KeyId@ and @Arn@ in the response.
--
-- 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.
describeKey_keyId :: Lens.Lens' DescribeKey Prelude.Text
describeKey_keyId :: Lens' DescribeKey Text
describeKey_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeKey' {Text
keyId :: Text
$sel:keyId:DescribeKey' :: DescribeKey -> Text
keyId} -> Text
keyId) (\s :: DescribeKey
s@DescribeKey' {} Text
a -> DescribeKey
s {$sel:keyId:DescribeKey' :: Text
keyId = Text
a} :: DescribeKey)

instance Core.AWSRequest DescribeKey where
  type AWSResponse DescribeKey = DescribeKeyResponse
  request :: (Service -> Service) -> DescribeKey -> Request DescribeKey
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 DescribeKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeKey)))
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 KeyMetadata -> Int -> DescribeKeyResponse
DescribeKeyResponse'
            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
"KeyMetadata")
            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 DescribeKey where
  hashWithSalt :: Int -> DescribeKey -> Int
hashWithSalt Int
_salt DescribeKey' {Maybe [Text]
Text
keyId :: Text
grantTokens :: Maybe [Text]
$sel:keyId:DescribeKey' :: DescribeKey -> Text
$sel:grantTokens:DescribeKey' :: DescribeKey -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
grantTokens
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId

instance Prelude.NFData DescribeKey where
  rnf :: DescribeKey -> ()
rnf DescribeKey' {Maybe [Text]
Text
keyId :: Text
grantTokens :: Maybe [Text]
$sel:keyId:DescribeKey' :: DescribeKey -> Text
$sel:grantTokens:DescribeKey' :: DescribeKey -> Maybe [Text]
..} =
    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 Text
keyId

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

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

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

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

-- |
-- Create a value of 'DescribeKeyResponse' 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:
--
-- 'keyMetadata', 'describeKeyResponse_keyMetadata' - Metadata associated with the key.
--
-- 'httpStatus', 'describeKeyResponse_httpStatus' - The response's http status code.
newDescribeKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeKeyResponse
newDescribeKeyResponse :: Int -> DescribeKeyResponse
newDescribeKeyResponse Int
pHttpStatus_ =
  DescribeKeyResponse'
    { $sel:keyMetadata:DescribeKeyResponse' :: Maybe KeyMetadata
keyMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Metadata associated with the key.
describeKeyResponse_keyMetadata :: Lens.Lens' DescribeKeyResponse (Prelude.Maybe KeyMetadata)
describeKeyResponse_keyMetadata :: Lens' DescribeKeyResponse (Maybe KeyMetadata)
describeKeyResponse_keyMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeKeyResponse' {Maybe KeyMetadata
keyMetadata :: Maybe KeyMetadata
$sel:keyMetadata:DescribeKeyResponse' :: DescribeKeyResponse -> Maybe KeyMetadata
keyMetadata} -> Maybe KeyMetadata
keyMetadata) (\s :: DescribeKeyResponse
s@DescribeKeyResponse' {} Maybe KeyMetadata
a -> DescribeKeyResponse
s {$sel:keyMetadata:DescribeKeyResponse' :: Maybe KeyMetadata
keyMetadata = Maybe KeyMetadata
a} :: DescribeKeyResponse)

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

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