{-# 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.Redshift.DeleteHsmConfiguration
-- 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 the specified Amazon Redshift HSM configuration.
module Amazonka.Redshift.DeleteHsmConfiguration
  ( -- * Creating a Request
    DeleteHsmConfiguration (..),
    newDeleteHsmConfiguration,

    -- * Request Lenses
    deleteHsmConfiguration_hsmConfigurationIdentifier,

    -- * Destructuring the Response
    DeleteHsmConfigurationResponse (..),
    newDeleteHsmConfigurationResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDeleteHsmConfiguration' smart constructor.
data DeleteHsmConfiguration = DeleteHsmConfiguration'
  { -- | The identifier of the Amazon Redshift HSM configuration to be deleted.
    DeleteHsmConfiguration -> Text
hsmConfigurationIdentifier :: Prelude.Text
  }
  deriving (DeleteHsmConfiguration -> DeleteHsmConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteHsmConfiguration -> DeleteHsmConfiguration -> Bool
$c/= :: DeleteHsmConfiguration -> DeleteHsmConfiguration -> Bool
== :: DeleteHsmConfiguration -> DeleteHsmConfiguration -> Bool
$c== :: DeleteHsmConfiguration -> DeleteHsmConfiguration -> Bool
Prelude.Eq, ReadPrec [DeleteHsmConfiguration]
ReadPrec DeleteHsmConfiguration
Int -> ReadS DeleteHsmConfiguration
ReadS [DeleteHsmConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteHsmConfiguration]
$creadListPrec :: ReadPrec [DeleteHsmConfiguration]
readPrec :: ReadPrec DeleteHsmConfiguration
$creadPrec :: ReadPrec DeleteHsmConfiguration
readList :: ReadS [DeleteHsmConfiguration]
$creadList :: ReadS [DeleteHsmConfiguration]
readsPrec :: Int -> ReadS DeleteHsmConfiguration
$creadsPrec :: Int -> ReadS DeleteHsmConfiguration
Prelude.Read, Int -> DeleteHsmConfiguration -> ShowS
[DeleteHsmConfiguration] -> ShowS
DeleteHsmConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteHsmConfiguration] -> ShowS
$cshowList :: [DeleteHsmConfiguration] -> ShowS
show :: DeleteHsmConfiguration -> String
$cshow :: DeleteHsmConfiguration -> String
showsPrec :: Int -> DeleteHsmConfiguration -> ShowS
$cshowsPrec :: Int -> DeleteHsmConfiguration -> ShowS
Prelude.Show, forall x. Rep DeleteHsmConfiguration x -> DeleteHsmConfiguration
forall x. DeleteHsmConfiguration -> Rep DeleteHsmConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteHsmConfiguration x -> DeleteHsmConfiguration
$cfrom :: forall x. DeleteHsmConfiguration -> Rep DeleteHsmConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DeleteHsmConfiguration' 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:
--
-- 'hsmConfigurationIdentifier', 'deleteHsmConfiguration_hsmConfigurationIdentifier' - The identifier of the Amazon Redshift HSM configuration to be deleted.
newDeleteHsmConfiguration ::
  -- | 'hsmConfigurationIdentifier'
  Prelude.Text ->
  DeleteHsmConfiguration
newDeleteHsmConfiguration :: Text -> DeleteHsmConfiguration
newDeleteHsmConfiguration
  Text
pHsmConfigurationIdentifier_ =
    DeleteHsmConfiguration'
      { $sel:hsmConfigurationIdentifier:DeleteHsmConfiguration' :: Text
hsmConfigurationIdentifier =
          Text
pHsmConfigurationIdentifier_
      }

-- | The identifier of the Amazon Redshift HSM configuration to be deleted.
deleteHsmConfiguration_hsmConfigurationIdentifier :: Lens.Lens' DeleteHsmConfiguration Prelude.Text
deleteHsmConfiguration_hsmConfigurationIdentifier :: Lens' DeleteHsmConfiguration Text
deleteHsmConfiguration_hsmConfigurationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHsmConfiguration' {Text
hsmConfigurationIdentifier :: Text
$sel:hsmConfigurationIdentifier:DeleteHsmConfiguration' :: DeleteHsmConfiguration -> Text
hsmConfigurationIdentifier} -> Text
hsmConfigurationIdentifier) (\s :: DeleteHsmConfiguration
s@DeleteHsmConfiguration' {} Text
a -> DeleteHsmConfiguration
s {$sel:hsmConfigurationIdentifier:DeleteHsmConfiguration' :: Text
hsmConfigurationIdentifier = Text
a} :: DeleteHsmConfiguration)

instance Core.AWSRequest DeleteHsmConfiguration where
  type
    AWSResponse DeleteHsmConfiguration =
      DeleteHsmConfigurationResponse
  request :: (Service -> Service)
-> DeleteHsmConfiguration -> Request DeleteHsmConfiguration
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteHsmConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteHsmConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteHsmConfigurationResponse
DeleteHsmConfigurationResponse'

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

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

instance Data.ToHeaders DeleteHsmConfiguration where
  toHeaders :: DeleteHsmConfiguration -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteHsmConfiguration where
  toQuery :: DeleteHsmConfiguration -> QueryString
toQuery DeleteHsmConfiguration' {Text
hsmConfigurationIdentifier :: Text
$sel:hsmConfigurationIdentifier:DeleteHsmConfiguration' :: DeleteHsmConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteHsmConfiguration" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"HsmConfigurationIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
hsmConfigurationIdentifier
      ]

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

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

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