{-# 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.AppConfig.DeleteExtension
-- 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 an AppConfig extension. You must delete all associations to an
-- extension before you delete the extension.
module Amazonka.AppConfig.DeleteExtension
  ( -- * Creating a Request
    DeleteExtension (..),
    newDeleteExtension,

    -- * Request Lenses
    deleteExtension_versionNumber,
    deleteExtension_extensionIdentifier,

    -- * Destructuring the Response
    DeleteExtensionResponse (..),
    newDeleteExtensionResponse,
  )
where

import Amazonka.AppConfig.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:/ 'newDeleteExtension' smart constructor.
data DeleteExtension = DeleteExtension'
  { -- | A specific version of an extension to delete. If omitted, the highest
    -- version is deleted.
    DeleteExtension -> Maybe Int
versionNumber :: Prelude.Maybe Prelude.Int,
    -- | The name, ID, or Amazon Resource Name (ARN) of the extension you want to
    -- delete.
    DeleteExtension -> Text
extensionIdentifier :: Prelude.Text
  }
  deriving (DeleteExtension -> DeleteExtension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteExtension -> DeleteExtension -> Bool
$c/= :: DeleteExtension -> DeleteExtension -> Bool
== :: DeleteExtension -> DeleteExtension -> Bool
$c== :: DeleteExtension -> DeleteExtension -> Bool
Prelude.Eq, ReadPrec [DeleteExtension]
ReadPrec DeleteExtension
Int -> ReadS DeleteExtension
ReadS [DeleteExtension]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteExtension]
$creadListPrec :: ReadPrec [DeleteExtension]
readPrec :: ReadPrec DeleteExtension
$creadPrec :: ReadPrec DeleteExtension
readList :: ReadS [DeleteExtension]
$creadList :: ReadS [DeleteExtension]
readsPrec :: Int -> ReadS DeleteExtension
$creadsPrec :: Int -> ReadS DeleteExtension
Prelude.Read, Int -> DeleteExtension -> ShowS
[DeleteExtension] -> ShowS
DeleteExtension -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteExtension] -> ShowS
$cshowList :: [DeleteExtension] -> ShowS
show :: DeleteExtension -> String
$cshow :: DeleteExtension -> String
showsPrec :: Int -> DeleteExtension -> ShowS
$cshowsPrec :: Int -> DeleteExtension -> ShowS
Prelude.Show, forall x. Rep DeleteExtension x -> DeleteExtension
forall x. DeleteExtension -> Rep DeleteExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteExtension x -> DeleteExtension
$cfrom :: forall x. DeleteExtension -> Rep DeleteExtension x
Prelude.Generic)

-- |
-- Create a value of 'DeleteExtension' 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:
--
-- 'versionNumber', 'deleteExtension_versionNumber' - A specific version of an extension to delete. If omitted, the highest
-- version is deleted.
--
-- 'extensionIdentifier', 'deleteExtension_extensionIdentifier' - The name, ID, or Amazon Resource Name (ARN) of the extension you want to
-- delete.
newDeleteExtension ::
  -- | 'extensionIdentifier'
  Prelude.Text ->
  DeleteExtension
newDeleteExtension :: Text -> DeleteExtension
newDeleteExtension Text
pExtensionIdentifier_ =
  DeleteExtension'
    { $sel:versionNumber:DeleteExtension' :: Maybe Int
versionNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:extensionIdentifier:DeleteExtension' :: Text
extensionIdentifier = Text
pExtensionIdentifier_
    }

-- | A specific version of an extension to delete. If omitted, the highest
-- version is deleted.
deleteExtension_versionNumber :: Lens.Lens' DeleteExtension (Prelude.Maybe Prelude.Int)
deleteExtension_versionNumber :: Lens' DeleteExtension (Maybe Int)
deleteExtension_versionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteExtension' {Maybe Int
versionNumber :: Maybe Int
$sel:versionNumber:DeleteExtension' :: DeleteExtension -> Maybe Int
versionNumber} -> Maybe Int
versionNumber) (\s :: DeleteExtension
s@DeleteExtension' {} Maybe Int
a -> DeleteExtension
s {$sel:versionNumber:DeleteExtension' :: Maybe Int
versionNumber = Maybe Int
a} :: DeleteExtension)

-- | The name, ID, or Amazon Resource Name (ARN) of the extension you want to
-- delete.
deleteExtension_extensionIdentifier :: Lens.Lens' DeleteExtension Prelude.Text
deleteExtension_extensionIdentifier :: Lens' DeleteExtension Text
deleteExtension_extensionIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteExtension' {Text
extensionIdentifier :: Text
$sel:extensionIdentifier:DeleteExtension' :: DeleteExtension -> Text
extensionIdentifier} -> Text
extensionIdentifier) (\s :: DeleteExtension
s@DeleteExtension' {} Text
a -> DeleteExtension
s {$sel:extensionIdentifier:DeleteExtension' :: Text
extensionIdentifier = Text
a} :: DeleteExtension)

instance Core.AWSRequest DeleteExtension where
  type
    AWSResponse DeleteExtension =
      DeleteExtensionResponse
  request :: (Service -> Service) -> DeleteExtension -> Request DeleteExtension
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 DeleteExtension
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteExtension)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteExtensionResponse
DeleteExtensionResponse'

instance Prelude.Hashable DeleteExtension where
  hashWithSalt :: Int -> DeleteExtension -> Int
hashWithSalt Int
_salt DeleteExtension' {Maybe Int
Text
extensionIdentifier :: Text
versionNumber :: Maybe Int
$sel:extensionIdentifier:DeleteExtension' :: DeleteExtension -> Text
$sel:versionNumber:DeleteExtension' :: DeleteExtension -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
versionNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
extensionIdentifier

instance Prelude.NFData DeleteExtension where
  rnf :: DeleteExtension -> ()
rnf DeleteExtension' {Maybe Int
Text
extensionIdentifier :: Text
versionNumber :: Maybe Int
$sel:extensionIdentifier:DeleteExtension' :: DeleteExtension -> Text
$sel:versionNumber:DeleteExtension' :: DeleteExtension -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
versionNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
extensionIdentifier

instance Data.ToHeaders DeleteExtension where
  toHeaders :: DeleteExtension -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteExtension where
  toPath :: DeleteExtension -> ByteString
toPath DeleteExtension' {Maybe Int
Text
extensionIdentifier :: Text
versionNumber :: Maybe Int
$sel:extensionIdentifier:DeleteExtension' :: DeleteExtension -> Text
$sel:versionNumber:DeleteExtension' :: DeleteExtension -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/extensions/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
extensionIdentifier]

instance Data.ToQuery DeleteExtension where
  toQuery :: DeleteExtension -> QueryString
toQuery DeleteExtension' {Maybe Int
Text
extensionIdentifier :: Text
versionNumber :: Maybe Int
$sel:extensionIdentifier:DeleteExtension' :: DeleteExtension -> Text
$sel:versionNumber:DeleteExtension' :: DeleteExtension -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"version" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
versionNumber]

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

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

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