{-# 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.DeleteCustomKeyStore
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a
-- <https://docs.aws.amazon.com/kms/latest/developerguide/custom-key-store-overview.html custom key store>.
-- This operation does not affect any backing elements of the custom key
-- store. It does not delete the CloudHSM cluster that is associated with
-- an CloudHSM key store, or affect any users or keys in the cluster. For
-- an external key store, it does not affect the external key store proxy,
-- external key manager, or any external keys.
--
-- This operation is part of the
-- <https://docs.aws.amazon.com/kms/latest/developerguide/custom-key-store-overview.html custom key stores>
-- feature in KMS, which combines the convenience and extensive integration
-- of KMS with the isolation and control of a key store that you own and
-- manage.
--
-- The custom key store that you delete cannot contain any
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#kms_keys KMS keys>.
-- Before deleting the key store, verify that you will never need to use
-- any of the KMS keys in the key store for any
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#cryptographic-operations cryptographic operations>.
-- Then, use ScheduleKeyDeletion to delete the KMS keys from the key store.
-- After the required waiting period expires and all KMS keys are deleted
-- from the custom key store, use DisconnectCustomKeyStore to disconnect
-- the key store from KMS. Then, you can delete the custom key store.
--
-- For keys in an CloudHSM key store, the @ScheduleKeyDeletion@ operation
-- makes a best effort to delete the key material from the associated
-- cluster. However, you might need to manually
-- <https://docs.aws.amazon.com/kms/latest/developerguide/fix-keystore.html#fix-keystore-orphaned-key delete the orphaned key material>
-- from the cluster and its backups. KMS never creates, manages, or deletes
-- cryptographic keys in the external key manager associated with an
-- external key store. You must manage them using your external key manager
-- tools.
--
-- Instead of deleting the custom key store, consider using the
-- DisconnectCustomKeyStore operation to disconnect the custom key store
-- from its backing key store. While the key store is disconnected, you
-- cannot create or use the KMS keys in the key store. But, you do not need
-- to delete KMS keys and you can reconnect a disconnected custom key store
-- at any time.
--
-- If the operation succeeds, it returns a JSON object with no properties.
--
-- __Cross-account use__: No. You cannot perform this operation on a custom
-- key store in a different Amazon Web Services account.
--
-- __Required permissions__:
-- <https://docs.aws.amazon.com/kms/latest/developerguide/kms-api-permissions-reference.html kms:DeleteCustomKeyStore>
-- (IAM policy)
--
-- __Related operations:__
--
-- -   ConnectCustomKeyStore
--
-- -   CreateCustomKeyStore
--
-- -   DescribeCustomKeyStores
--
-- -   DisconnectCustomKeyStore
--
-- -   UpdateCustomKeyStore
module Amazonka.KMS.DeleteCustomKeyStore
  ( -- * Creating a Request
    DeleteCustomKeyStore (..),
    newDeleteCustomKeyStore,

    -- * Request Lenses
    deleteCustomKeyStore_customKeyStoreId,

    -- * Destructuring the Response
    DeleteCustomKeyStoreResponse (..),
    newDeleteCustomKeyStoreResponse,

    -- * Response Lenses
    deleteCustomKeyStoreResponse_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:/ 'newDeleteCustomKeyStore' smart constructor.
data DeleteCustomKeyStore = DeleteCustomKeyStore'
  { -- | Enter the ID of the custom key store you want to delete. To find the ID
    -- of a custom key store, use the DescribeCustomKeyStores operation.
    DeleteCustomKeyStore -> Text
customKeyStoreId :: Prelude.Text
  }
  deriving (DeleteCustomKeyStore -> DeleteCustomKeyStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCustomKeyStore -> DeleteCustomKeyStore -> Bool
$c/= :: DeleteCustomKeyStore -> DeleteCustomKeyStore -> Bool
== :: DeleteCustomKeyStore -> DeleteCustomKeyStore -> Bool
$c== :: DeleteCustomKeyStore -> DeleteCustomKeyStore -> Bool
Prelude.Eq, ReadPrec [DeleteCustomKeyStore]
ReadPrec DeleteCustomKeyStore
Int -> ReadS DeleteCustomKeyStore
ReadS [DeleteCustomKeyStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCustomKeyStore]
$creadListPrec :: ReadPrec [DeleteCustomKeyStore]
readPrec :: ReadPrec DeleteCustomKeyStore
$creadPrec :: ReadPrec DeleteCustomKeyStore
readList :: ReadS [DeleteCustomKeyStore]
$creadList :: ReadS [DeleteCustomKeyStore]
readsPrec :: Int -> ReadS DeleteCustomKeyStore
$creadsPrec :: Int -> ReadS DeleteCustomKeyStore
Prelude.Read, Int -> DeleteCustomKeyStore -> ShowS
[DeleteCustomKeyStore] -> ShowS
DeleteCustomKeyStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCustomKeyStore] -> ShowS
$cshowList :: [DeleteCustomKeyStore] -> ShowS
show :: DeleteCustomKeyStore -> String
$cshow :: DeleteCustomKeyStore -> String
showsPrec :: Int -> DeleteCustomKeyStore -> ShowS
$cshowsPrec :: Int -> DeleteCustomKeyStore -> ShowS
Prelude.Show, forall x. Rep DeleteCustomKeyStore x -> DeleteCustomKeyStore
forall x. DeleteCustomKeyStore -> Rep DeleteCustomKeyStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteCustomKeyStore x -> DeleteCustomKeyStore
$cfrom :: forall x. DeleteCustomKeyStore -> Rep DeleteCustomKeyStore x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCustomKeyStore' 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:
--
-- 'customKeyStoreId', 'deleteCustomKeyStore_customKeyStoreId' - Enter the ID of the custom key store you want to delete. To find the ID
-- of a custom key store, use the DescribeCustomKeyStores operation.
newDeleteCustomKeyStore ::
  -- | 'customKeyStoreId'
  Prelude.Text ->
  DeleteCustomKeyStore
newDeleteCustomKeyStore :: Text -> DeleteCustomKeyStore
newDeleteCustomKeyStore Text
pCustomKeyStoreId_ =
  DeleteCustomKeyStore'
    { $sel:customKeyStoreId:DeleteCustomKeyStore' :: Text
customKeyStoreId =
        Text
pCustomKeyStoreId_
    }

-- | Enter the ID of the custom key store you want to delete. To find the ID
-- of a custom key store, use the DescribeCustomKeyStores operation.
deleteCustomKeyStore_customKeyStoreId :: Lens.Lens' DeleteCustomKeyStore Prelude.Text
deleteCustomKeyStore_customKeyStoreId :: Lens' DeleteCustomKeyStore Text
deleteCustomKeyStore_customKeyStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCustomKeyStore' {Text
customKeyStoreId :: Text
$sel:customKeyStoreId:DeleteCustomKeyStore' :: DeleteCustomKeyStore -> Text
customKeyStoreId} -> Text
customKeyStoreId) (\s :: DeleteCustomKeyStore
s@DeleteCustomKeyStore' {} Text
a -> DeleteCustomKeyStore
s {$sel:customKeyStoreId:DeleteCustomKeyStore' :: Text
customKeyStoreId = Text
a} :: DeleteCustomKeyStore)

instance Core.AWSRequest DeleteCustomKeyStore where
  type
    AWSResponse DeleteCustomKeyStore =
      DeleteCustomKeyStoreResponse
  request :: (Service -> Service)
-> DeleteCustomKeyStore -> Request DeleteCustomKeyStore
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 DeleteCustomKeyStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteCustomKeyStore)))
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 -> DeleteCustomKeyStoreResponse
DeleteCustomKeyStoreResponse'
            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 DeleteCustomKeyStore where
  hashWithSalt :: Int -> DeleteCustomKeyStore -> Int
hashWithSalt Int
_salt DeleteCustomKeyStore' {Text
customKeyStoreId :: Text
$sel:customKeyStoreId:DeleteCustomKeyStore' :: DeleteCustomKeyStore -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
customKeyStoreId

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

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

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

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

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

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

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

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