{-# 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.CreateAlias
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a friendly name for a KMS key.
--
-- Adding, deleting, or updating an alias can allow or deny permission to
-- the KMS key. For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/abac.html ABAC for KMS>
-- in the /Key Management Service Developer Guide/.
--
-- You can use an alias to identify a KMS key in the KMS console, in the
-- DescribeKey operation and in
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#cryptographic-operations cryptographic operations>,
-- such as Encrypt and GenerateDataKey. You can also change the KMS key
-- that\'s associated with the alias (UpdateAlias) or delete the alias
-- (DeleteAlias) at any time. These operations don\'t affect the underlying
-- KMS key.
--
-- You can associate the alias with any customer managed key in the same
-- Amazon Web Services Region. Each alias is associated with only one KMS
-- key at a time, but a KMS key can have multiple aliases. A valid KMS key
-- is required. You can\'t create an alias without a KMS key.
--
-- The alias must be unique in the account and Region, but you can have
-- aliases with the same name in different Regions. For detailed
-- information about aliases, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-alias.html Using aliases>
-- in the /Key Management Service Developer Guide/.
--
-- This operation does not return a response. To get the alias that you
-- created, use the ListAliases operation.
--
-- 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 an alias
-- in a different Amazon Web Services account.
--
-- __Required permissions__
--
-- -   <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:CreateAlias>
--     on the alias (IAM policy).
--
-- -   <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:CreateAlias>
--     on the KMS key (key policy).
--
-- For details, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-alias.html#alias-access Controlling access to aliases>
-- in the /Key Management Service Developer Guide/.
--
-- __Related operations:__
--
-- -   DeleteAlias
--
-- -   ListAliases
--
-- -   UpdateAlias
module Amazonka.KMS.CreateAlias
  ( -- * Creating a Request
    CreateAlias (..),
    newCreateAlias,

    -- * Request Lenses
    createAlias_aliasName,
    createAlias_targetKeyId,

    -- * Destructuring the Response
    CreateAliasResponse (..),
    newCreateAliasResponse,
  )
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:/ 'newCreateAlias' smart constructor.
data CreateAlias = CreateAlias'
  { -- | Specifies the alias name. This value must begin with @alias\/@ followed
    -- by a name, such as @alias\/ExampleAlias@.
    --
    -- The @AliasName@ value must be string of 1-256 characters. It can contain
    -- only alphanumeric characters, forward slashes (\/), underscores (_), and
    -- dashes (-). The alias name cannot begin with @alias\/aws\/@. The
    -- @alias\/aws\/@ prefix is reserved for
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#aws-managed-cmk Amazon Web Services managed keys>.
    CreateAlias -> Text
aliasName :: Prelude.Text,
    -- | Associates the alias with the specified
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#customer-cmk customer managed key>.
    -- The KMS key must be in the same Amazon Web Services Region.
    --
    -- A valid key ID is required. If you supply a null or empty string value,
    -- this operation returns an error.
    --
    -- For help finding the key ID and ARN, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/viewing-keys.html#find-cmk-id-arn Finding the Key ID and ARN>
    -- in the //Key Management Service Developer Guide// .
    --
    -- 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.
    CreateAlias -> Text
targetKeyId :: Prelude.Text
  }
  deriving (CreateAlias -> CreateAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAlias -> CreateAlias -> Bool
$c/= :: CreateAlias -> CreateAlias -> Bool
== :: CreateAlias -> CreateAlias -> Bool
$c== :: CreateAlias -> CreateAlias -> Bool
Prelude.Eq, ReadPrec [CreateAlias]
ReadPrec CreateAlias
Int -> ReadS CreateAlias
ReadS [CreateAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAlias]
$creadListPrec :: ReadPrec [CreateAlias]
readPrec :: ReadPrec CreateAlias
$creadPrec :: ReadPrec CreateAlias
readList :: ReadS [CreateAlias]
$creadList :: ReadS [CreateAlias]
readsPrec :: Int -> ReadS CreateAlias
$creadsPrec :: Int -> ReadS CreateAlias
Prelude.Read, Int -> CreateAlias -> ShowS
[CreateAlias] -> ShowS
CreateAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAlias] -> ShowS
$cshowList :: [CreateAlias] -> ShowS
show :: CreateAlias -> String
$cshow :: CreateAlias -> String
showsPrec :: Int -> CreateAlias -> ShowS
$cshowsPrec :: Int -> CreateAlias -> ShowS
Prelude.Show, forall x. Rep CreateAlias x -> CreateAlias
forall x. CreateAlias -> Rep CreateAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAlias x -> CreateAlias
$cfrom :: forall x. CreateAlias -> Rep CreateAlias x
Prelude.Generic)

-- |
-- Create a value of 'CreateAlias' 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:
--
-- 'aliasName', 'createAlias_aliasName' - Specifies the alias name. This value must begin with @alias\/@ followed
-- by a name, such as @alias\/ExampleAlias@.
--
-- The @AliasName@ value must be string of 1-256 characters. It can contain
-- only alphanumeric characters, forward slashes (\/), underscores (_), and
-- dashes (-). The alias name cannot begin with @alias\/aws\/@. The
-- @alias\/aws\/@ prefix is reserved for
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#aws-managed-cmk Amazon Web Services managed keys>.
--
-- 'targetKeyId', 'createAlias_targetKeyId' - Associates the alias with the specified
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#customer-cmk customer managed key>.
-- The KMS key must be in the same Amazon Web Services Region.
--
-- A valid key ID is required. If you supply a null or empty string value,
-- this operation returns an error.
--
-- For help finding the key ID and ARN, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/viewing-keys.html#find-cmk-id-arn Finding the Key ID and ARN>
-- in the //Key Management Service Developer Guide// .
--
-- 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.
newCreateAlias ::
  -- | 'aliasName'
  Prelude.Text ->
  -- | 'targetKeyId'
  Prelude.Text ->
  CreateAlias
newCreateAlias :: Text -> Text -> CreateAlias
newCreateAlias Text
pAliasName_ Text
pTargetKeyId_ =
  CreateAlias'
    { $sel:aliasName:CreateAlias' :: Text
aliasName = Text
pAliasName_,
      $sel:targetKeyId:CreateAlias' :: Text
targetKeyId = Text
pTargetKeyId_
    }

-- | Specifies the alias name. This value must begin with @alias\/@ followed
-- by a name, such as @alias\/ExampleAlias@.
--
-- The @AliasName@ value must be string of 1-256 characters. It can contain
-- only alphanumeric characters, forward slashes (\/), underscores (_), and
-- dashes (-). The alias name cannot begin with @alias\/aws\/@. The
-- @alias\/aws\/@ prefix is reserved for
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#aws-managed-cmk Amazon Web Services managed keys>.
createAlias_aliasName :: Lens.Lens' CreateAlias Prelude.Text
createAlias_aliasName :: Lens' CreateAlias Text
createAlias_aliasName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
aliasName :: Text
$sel:aliasName:CreateAlias' :: CreateAlias -> Text
aliasName} -> Text
aliasName) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:aliasName:CreateAlias' :: Text
aliasName = Text
a} :: CreateAlias)

-- | Associates the alias with the specified
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#customer-cmk customer managed key>.
-- The KMS key must be in the same Amazon Web Services Region.
--
-- A valid key ID is required. If you supply a null or empty string value,
-- this operation returns an error.
--
-- For help finding the key ID and ARN, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/viewing-keys.html#find-cmk-id-arn Finding the Key ID and ARN>
-- in the //Key Management Service Developer Guide// .
--
-- 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.
createAlias_targetKeyId :: Lens.Lens' CreateAlias Prelude.Text
createAlias_targetKeyId :: Lens' CreateAlias Text
createAlias_targetKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
targetKeyId :: Text
$sel:targetKeyId:CreateAlias' :: CreateAlias -> Text
targetKeyId} -> Text
targetKeyId) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:targetKeyId:CreateAlias' :: Text
targetKeyId = Text
a} :: CreateAlias)

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

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

instance Prelude.NFData CreateAlias where
  rnf :: CreateAlias -> ()
rnf CreateAlias' {Text
targetKeyId :: Text
aliasName :: Text
$sel:targetKeyId:CreateAlias' :: CreateAlias -> Text
$sel:aliasName:CreateAlias' :: CreateAlias -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
aliasName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetKeyId

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

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

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

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

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

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