{-# 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.EnableKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the key state of a KMS key to enabled. This allows you to use the
-- KMS key for
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#cryptographic-operations cryptographic operations>.
--
-- 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:EnableKey>
-- (key policy)
--
-- __Related operations__: DisableKey
module Amazonka.KMS.EnableKey
  ( -- * Creating a Request
    EnableKey (..),
    newEnableKey,

    -- * Request Lenses
    enableKey_keyId,

    -- * Destructuring the Response
    EnableKeyResponse (..),
    newEnableKeyResponse,
  )
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:/ 'newEnableKey' smart constructor.
data EnableKey = EnableKey'
  { -- | Identifies the KMS key to enable.
    --
    -- 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.
    EnableKey -> Text
keyId :: Prelude.Text
  }
  deriving (EnableKey -> EnableKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableKey -> EnableKey -> Bool
$c/= :: EnableKey -> EnableKey -> Bool
== :: EnableKey -> EnableKey -> Bool
$c== :: EnableKey -> EnableKey -> Bool
Prelude.Eq, ReadPrec [EnableKey]
ReadPrec EnableKey
Int -> ReadS EnableKey
ReadS [EnableKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableKey]
$creadListPrec :: ReadPrec [EnableKey]
readPrec :: ReadPrec EnableKey
$creadPrec :: ReadPrec EnableKey
readList :: ReadS [EnableKey]
$creadList :: ReadS [EnableKey]
readsPrec :: Int -> ReadS EnableKey
$creadsPrec :: Int -> ReadS EnableKey
Prelude.Read, Int -> EnableKey -> ShowS
[EnableKey] -> ShowS
EnableKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableKey] -> ShowS
$cshowList :: [EnableKey] -> ShowS
show :: EnableKey -> String
$cshow :: EnableKey -> String
showsPrec :: Int -> EnableKey -> ShowS
$cshowsPrec :: Int -> EnableKey -> ShowS
Prelude.Show, forall x. Rep EnableKey x -> EnableKey
forall x. EnableKey -> Rep EnableKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableKey x -> EnableKey
$cfrom :: forall x. EnableKey -> Rep EnableKey x
Prelude.Generic)

-- |
-- Create a value of 'EnableKey' 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', 'enableKey_keyId' - Identifies the KMS key to enable.
--
-- 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.
newEnableKey ::
  -- | 'keyId'
  Prelude.Text ->
  EnableKey
newEnableKey :: Text -> EnableKey
newEnableKey Text
pKeyId_ = EnableKey' {$sel:keyId:EnableKey' :: Text
keyId = Text
pKeyId_}

-- | Identifies the KMS key to enable.
--
-- 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.
enableKey_keyId :: Lens.Lens' EnableKey Prelude.Text
enableKey_keyId :: Lens' EnableKey Text
enableKey_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableKey' {Text
keyId :: Text
$sel:keyId:EnableKey' :: EnableKey -> Text
keyId} -> Text
keyId) (\s :: EnableKey
s@EnableKey' {} Text
a -> EnableKey
s {$sel:keyId:EnableKey' :: Text
keyId = Text
a} :: EnableKey)

instance Core.AWSRequest EnableKey where
  type AWSResponse EnableKey = EnableKeyResponse
  request :: (Service -> Service) -> EnableKey -> Request EnableKey
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 EnableKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse EnableKey)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull EnableKeyResponse
EnableKeyResponse'

instance Prelude.Hashable EnableKey where
  hashWithSalt :: Int -> EnableKey -> Int
hashWithSalt Int
_salt EnableKey' {Text
keyId :: Text
$sel:keyId:EnableKey' :: EnableKey -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId

instance Prelude.NFData EnableKey where
  rnf :: EnableKey -> ()
rnf EnableKey' {Text
keyId :: Text
$sel:keyId:EnableKey' :: EnableKey -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
keyId

instance Data.ToHeaders EnableKey where
  toHeaders :: EnableKey -> [Header]
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 -> [Header]
Data.=# (ByteString
"TrentService.EnableKey" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON EnableKey where
  toJSON :: EnableKey -> Value
toJSON EnableKey' {Text
keyId :: Text
$sel:keyId:EnableKey' :: EnableKey -> 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)]
      )

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

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

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

-- |
-- Create a value of 'EnableKeyResponse' 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.
newEnableKeyResponse ::
  EnableKeyResponse
newEnableKeyResponse :: EnableKeyResponse
newEnableKeyResponse = EnableKeyResponse
EnableKeyResponse'

instance Prelude.NFData EnableKeyResponse where
  rnf :: EnableKeyResponse -> ()
rnf EnableKeyResponse
_ = ()