{-# 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.CloudHSM.DeleteHsm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This is documentation for __AWS CloudHSM Classic__. For more
-- information, see
-- <http://aws.amazon.com/cloudhsm/faqs-classic/ AWS CloudHSM Classic FAQs>,
-- the
-- <https://docs.aws.amazon.com/cloudhsm/classic/userguide/ AWS CloudHSM Classic User Guide>,
-- and the
-- <https://docs.aws.amazon.com/cloudhsm/classic/APIReference/ AWS CloudHSM Classic API Reference>.
--
-- __For information about the current version of AWS CloudHSM__, see
-- <http://aws.amazon.com/cloudhsm/ AWS CloudHSM>, the
-- <https://docs.aws.amazon.com/cloudhsm/latest/userguide/ AWS CloudHSM User Guide>,
-- and the
-- <https://docs.aws.amazon.com/cloudhsm/latest/APIReference/ AWS CloudHSM API Reference>.
--
-- Deletes an HSM. After completion, this operation cannot be undone and
-- your key material cannot be recovered.
module Amazonka.CloudHSM.DeleteHsm
  ( -- * Creating a Request
    DeleteHsm (..),
    newDeleteHsm,

    -- * Request Lenses
    deleteHsm_hsmArn,

    -- * Destructuring the Response
    DeleteHsmResponse (..),
    newDeleteHsmResponse,

    -- * Response Lenses
    deleteHsmResponse_httpStatus,
    deleteHsmResponse_status,
  )
where

import Amazonka.CloudHSM.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the inputs for the DeleteHsm operation.
--
-- /See:/ 'newDeleteHsm' smart constructor.
data DeleteHsm = DeleteHsm'
  { -- | The ARN of the HSM to delete.
    DeleteHsm -> Text
hsmArn :: Prelude.Text
  }
  deriving (DeleteHsm -> DeleteHsm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteHsm -> DeleteHsm -> Bool
$c/= :: DeleteHsm -> DeleteHsm -> Bool
== :: DeleteHsm -> DeleteHsm -> Bool
$c== :: DeleteHsm -> DeleteHsm -> Bool
Prelude.Eq, ReadPrec [DeleteHsm]
ReadPrec DeleteHsm
Int -> ReadS DeleteHsm
ReadS [DeleteHsm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteHsm]
$creadListPrec :: ReadPrec [DeleteHsm]
readPrec :: ReadPrec DeleteHsm
$creadPrec :: ReadPrec DeleteHsm
readList :: ReadS [DeleteHsm]
$creadList :: ReadS [DeleteHsm]
readsPrec :: Int -> ReadS DeleteHsm
$creadsPrec :: Int -> ReadS DeleteHsm
Prelude.Read, Int -> DeleteHsm -> ShowS
[DeleteHsm] -> ShowS
DeleteHsm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteHsm] -> ShowS
$cshowList :: [DeleteHsm] -> ShowS
show :: DeleteHsm -> String
$cshow :: DeleteHsm -> String
showsPrec :: Int -> DeleteHsm -> ShowS
$cshowsPrec :: Int -> DeleteHsm -> ShowS
Prelude.Show, forall x. Rep DeleteHsm x -> DeleteHsm
forall x. DeleteHsm -> Rep DeleteHsm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteHsm x -> DeleteHsm
$cfrom :: forall x. DeleteHsm -> Rep DeleteHsm x
Prelude.Generic)

-- |
-- Create a value of 'DeleteHsm' 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:
--
-- 'hsmArn', 'deleteHsm_hsmArn' - The ARN of the HSM to delete.
newDeleteHsm ::
  -- | 'hsmArn'
  Prelude.Text ->
  DeleteHsm
newDeleteHsm :: Text -> DeleteHsm
newDeleteHsm Text
pHsmArn_ = DeleteHsm' {$sel:hsmArn:DeleteHsm' :: Text
hsmArn = Text
pHsmArn_}

-- | The ARN of the HSM to delete.
deleteHsm_hsmArn :: Lens.Lens' DeleteHsm Prelude.Text
deleteHsm_hsmArn :: Lens' DeleteHsm Text
deleteHsm_hsmArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHsm' {Text
hsmArn :: Text
$sel:hsmArn:DeleteHsm' :: DeleteHsm -> Text
hsmArn} -> Text
hsmArn) (\s :: DeleteHsm
s@DeleteHsm' {} Text
a -> DeleteHsm
s {$sel:hsmArn:DeleteHsm' :: Text
hsmArn = Text
a} :: DeleteHsm)

instance Core.AWSRequest DeleteHsm where
  type AWSResponse DeleteHsm = DeleteHsmResponse
  request :: (Service -> Service) -> DeleteHsm -> Request DeleteHsm
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 DeleteHsm
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteHsm)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> DeleteHsmResponse
DeleteHsmResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Status")
      )

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

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

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

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

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

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

-- |
-- Create a value of 'DeleteHsmResponse' 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', 'deleteHsmResponse_httpStatus' - The response's http status code.
--
-- 'status', 'deleteHsmResponse_status' - The status of the operation.
newDeleteHsmResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'status'
  Prelude.Text ->
  DeleteHsmResponse
newDeleteHsmResponse :: Int -> Text -> DeleteHsmResponse
newDeleteHsmResponse Int
pHttpStatus_ Text
pStatus_ =
  DeleteHsmResponse'
    { $sel:httpStatus:DeleteHsmResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:status:DeleteHsmResponse' :: Text
status = Text
pStatus_
    }

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

-- | The status of the operation.
deleteHsmResponse_status :: Lens.Lens' DeleteHsmResponse Prelude.Text
deleteHsmResponse_status :: Lens' DeleteHsmResponse Text
deleteHsmResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHsmResponse' {Text
status :: Text
$sel:status:DeleteHsmResponse' :: DeleteHsmResponse -> Text
status} -> Text
status) (\s :: DeleteHsmResponse
s@DeleteHsmResponse' {} Text
a -> DeleteHsmResponse
s {$sel:status:DeleteHsmResponse' :: Text
status = Text
a} :: DeleteHsmResponse)

instance Prelude.NFData DeleteHsmResponse where
  rnf :: DeleteHsmResponse -> ()
rnf DeleteHsmResponse' {Int
Text
status :: Text
httpStatus :: Int
$sel:status:DeleteHsmResponse' :: DeleteHsmResponse -> Text
$sel:httpStatus:DeleteHsmResponse' :: DeleteHsmResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
status