{-# 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.DeleteLunaClient
-- 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 a client.
module Amazonka.CloudHSM.DeleteLunaClient
  ( -- * Creating a Request
    DeleteLunaClient (..),
    newDeleteLunaClient,

    -- * Request Lenses
    deleteLunaClient_clientArn,

    -- * Destructuring the Response
    DeleteLunaClientResponse (..),
    newDeleteLunaClientResponse,

    -- * Response Lenses
    deleteLunaClientResponse_httpStatus,
    deleteLunaClientResponse_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

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

-- |
-- Create a value of 'DeleteLunaClient' 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:
--
-- 'clientArn', 'deleteLunaClient_clientArn' - The ARN of the client to delete.
newDeleteLunaClient ::
  -- | 'clientArn'
  Prelude.Text ->
  DeleteLunaClient
newDeleteLunaClient :: Text -> DeleteLunaClient
newDeleteLunaClient Text
pClientArn_ =
  DeleteLunaClient' {$sel:clientArn:DeleteLunaClient' :: Text
clientArn = Text
pClientArn_}

-- | The ARN of the client to delete.
deleteLunaClient_clientArn :: Lens.Lens' DeleteLunaClient Prelude.Text
deleteLunaClient_clientArn :: Lens' DeleteLunaClient Text
deleteLunaClient_clientArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLunaClient' {Text
clientArn :: Text
$sel:clientArn:DeleteLunaClient' :: DeleteLunaClient -> Text
clientArn} -> Text
clientArn) (\s :: DeleteLunaClient
s@DeleteLunaClient' {} Text
a -> DeleteLunaClient
s {$sel:clientArn:DeleteLunaClient' :: Text
clientArn = Text
a} :: DeleteLunaClient)

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

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

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

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

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

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

-- |
-- Create a value of 'DeleteLunaClientResponse' 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', 'deleteLunaClientResponse_httpStatus' - The response's http status code.
--
-- 'status', 'deleteLunaClientResponse_status' - The status of the action.
newDeleteLunaClientResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'status'
  Prelude.Text ->
  DeleteLunaClientResponse
newDeleteLunaClientResponse :: Int -> Text -> DeleteLunaClientResponse
newDeleteLunaClientResponse Int
pHttpStatus_ Text
pStatus_ =
  DeleteLunaClientResponse'
    { $sel:httpStatus:DeleteLunaClientResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:status:DeleteLunaClientResponse' :: Text
status = Text
pStatus_
    }

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

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

instance Prelude.NFData DeleteLunaClientResponse where
  rnf :: DeleteLunaClientResponse -> ()
rnf DeleteLunaClientResponse' {Int
Text
status :: Text
httpStatus :: Int
$sel:status:DeleteLunaClientResponse' :: DeleteLunaClientResponse -> Text
$sel:httpStatus:DeleteLunaClientResponse' :: DeleteLunaClientResponse -> 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