{-# 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.Route53RecoveryControlConfig.DeleteControlPanel
-- 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 control panel.
module Amazonka.Route53RecoveryControlConfig.DeleteControlPanel
  ( -- * Creating a Request
    DeleteControlPanel (..),
    newDeleteControlPanel,

    -- * Request Lenses
    deleteControlPanel_controlPanelArn,

    -- * Destructuring the Response
    DeleteControlPanelResponse (..),
    newDeleteControlPanelResponse,

    -- * Response Lenses
    deleteControlPanelResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53RecoveryControlConfig.Types

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

-- |
-- Create a value of 'DeleteControlPanel' 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:
--
-- 'controlPanelArn', 'deleteControlPanel_controlPanelArn' - The Amazon Resource Name (ARN) of the control panel.
newDeleteControlPanel ::
  -- | 'controlPanelArn'
  Prelude.Text ->
  DeleteControlPanel
newDeleteControlPanel :: Text -> DeleteControlPanel
newDeleteControlPanel Text
pControlPanelArn_ =
  DeleteControlPanel'
    { $sel:controlPanelArn:DeleteControlPanel' :: Text
controlPanelArn =
        Text
pControlPanelArn_
    }

-- | The Amazon Resource Name (ARN) of the control panel.
deleteControlPanel_controlPanelArn :: Lens.Lens' DeleteControlPanel Prelude.Text
deleteControlPanel_controlPanelArn :: Lens' DeleteControlPanel Text
deleteControlPanel_controlPanelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteControlPanel' {Text
controlPanelArn :: Text
$sel:controlPanelArn:DeleteControlPanel' :: DeleteControlPanel -> Text
controlPanelArn} -> Text
controlPanelArn) (\s :: DeleteControlPanel
s@DeleteControlPanel' {} Text
a -> DeleteControlPanel
s {$sel:controlPanelArn:DeleteControlPanel' :: Text
controlPanelArn = Text
a} :: DeleteControlPanel)

instance Core.AWSRequest DeleteControlPanel where
  type
    AWSResponse DeleteControlPanel =
      DeleteControlPanelResponse
  request :: (Service -> Service)
-> DeleteControlPanel -> Request DeleteControlPanel
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteControlPanel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteControlPanel)))
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 -> DeleteControlPanelResponse
DeleteControlPanelResponse'
            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 DeleteControlPanel where
  hashWithSalt :: Int -> DeleteControlPanel -> Int
hashWithSalt Int
_salt DeleteControlPanel' {Text
controlPanelArn :: Text
$sel:controlPanelArn:DeleteControlPanel' :: DeleteControlPanel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
controlPanelArn

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

instance Data.ToHeaders DeleteControlPanel where
  toHeaders :: DeleteControlPanel -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteControlPanel where
  toPath :: DeleteControlPanel -> ByteString
toPath DeleteControlPanel' {Text
controlPanelArn :: Text
$sel:controlPanelArn:DeleteControlPanel' :: DeleteControlPanel -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/controlpanel/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
controlPanelArn]

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

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

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

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

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