{-# 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.DisconnectCustomKeyStore
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disconnects the
-- <https://docs.aws.amazon.com/kms/latest/developerguide/custom-key-store-overview.html custom key store>
-- from its backing key store. This operation disconnects an CloudHSM key
-- store from its associated CloudHSM cluster or disconnects an external
-- key store from the external key store proxy that communicates with your
-- external key manager.
--
-- 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.
--
-- While a custom key store is disconnected, you can manage the custom key
-- store and its KMS keys, but you cannot create or use its KMS keys. You
-- can reconnect the custom key store at any time.
--
-- While a custom key store is disconnected, all attempts to create KMS
-- keys in the custom key store or to use existing KMS keys in
-- <https://docs.aws.amazon.com/kms/latest/developerguide/concepts.html#cryptographic-operations cryptographic operations>
-- will fail. This action can prevent users from storing and accessing
-- sensitive data.
--
-- When you disconnect a custom key store, its @ConnectionState@ changes to
-- @Disconnected@. To find the connection state of a custom key store, use
-- the DescribeCustomKeyStores operation. To reconnect a custom key store,
-- use the ConnectCustomKeyStore operation.
--
-- 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:DisconnectCustomKeyStore>
-- (IAM policy)
--
-- __Related operations:__
--
-- -   ConnectCustomKeyStore
--
-- -   CreateCustomKeyStore
--
-- -   DeleteCustomKeyStore
--
-- -   DescribeCustomKeyStores
--
-- -   UpdateCustomKeyStore
module Amazonka.KMS.DisconnectCustomKeyStore
  ( -- * Creating a Request
    DisconnectCustomKeyStore (..),
    newDisconnectCustomKeyStore,

    -- * Request Lenses
    disconnectCustomKeyStore_customKeyStoreId,

    -- * Destructuring the Response
    DisconnectCustomKeyStoreResponse (..),
    newDisconnectCustomKeyStoreResponse,

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

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

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

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

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

instance Data.ToHeaders DisconnectCustomKeyStore where
  toHeaders :: DisconnectCustomKeyStore -> 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.DisconnectCustomKeyStore" ::
                          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 DisconnectCustomKeyStore where
  toJSON :: DisconnectCustomKeyStore -> Value
toJSON DisconnectCustomKeyStore' {Text
customKeyStoreId :: Text
$sel:customKeyStoreId:DisconnectCustomKeyStore' :: DisconnectCustomKeyStore -> 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 DisconnectCustomKeyStore where
  toPath :: DisconnectCustomKeyStore -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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