{-# 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.ServiceCatalogAppRegistry.DeleteAttributeGroup
-- 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 attribute group, specified either by its attribute group ID
-- or name.
module Amazonka.ServiceCatalogAppRegistry.DeleteAttributeGroup
  ( -- * Creating a Request
    DeleteAttributeGroup (..),
    newDeleteAttributeGroup,

    -- * Request Lenses
    deleteAttributeGroup_attributeGroup,

    -- * Destructuring the Response
    DeleteAttributeGroupResponse (..),
    newDeleteAttributeGroupResponse,

    -- * Response Lenses
    deleteAttributeGroupResponse_attributeGroup,
    deleteAttributeGroupResponse_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.ServiceCatalogAppRegistry.Types

-- | /See:/ 'newDeleteAttributeGroup' smart constructor.
data DeleteAttributeGroup = DeleteAttributeGroup'
  { -- | The name or ID of the attribute group that holds the attributes to
    -- describe the application.
    DeleteAttributeGroup -> Text
attributeGroup :: Prelude.Text
  }
  deriving (DeleteAttributeGroup -> DeleteAttributeGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAttributeGroup -> DeleteAttributeGroup -> Bool
$c/= :: DeleteAttributeGroup -> DeleteAttributeGroup -> Bool
== :: DeleteAttributeGroup -> DeleteAttributeGroup -> Bool
$c== :: DeleteAttributeGroup -> DeleteAttributeGroup -> Bool
Prelude.Eq, ReadPrec [DeleteAttributeGroup]
ReadPrec DeleteAttributeGroup
Int -> ReadS DeleteAttributeGroup
ReadS [DeleteAttributeGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAttributeGroup]
$creadListPrec :: ReadPrec [DeleteAttributeGroup]
readPrec :: ReadPrec DeleteAttributeGroup
$creadPrec :: ReadPrec DeleteAttributeGroup
readList :: ReadS [DeleteAttributeGroup]
$creadList :: ReadS [DeleteAttributeGroup]
readsPrec :: Int -> ReadS DeleteAttributeGroup
$creadsPrec :: Int -> ReadS DeleteAttributeGroup
Prelude.Read, Int -> DeleteAttributeGroup -> ShowS
[DeleteAttributeGroup] -> ShowS
DeleteAttributeGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAttributeGroup] -> ShowS
$cshowList :: [DeleteAttributeGroup] -> ShowS
show :: DeleteAttributeGroup -> String
$cshow :: DeleteAttributeGroup -> String
showsPrec :: Int -> DeleteAttributeGroup -> ShowS
$cshowsPrec :: Int -> DeleteAttributeGroup -> ShowS
Prelude.Show, forall x. Rep DeleteAttributeGroup x -> DeleteAttributeGroup
forall x. DeleteAttributeGroup -> Rep DeleteAttributeGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAttributeGroup x -> DeleteAttributeGroup
$cfrom :: forall x. DeleteAttributeGroup -> Rep DeleteAttributeGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAttributeGroup' 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:
--
-- 'attributeGroup', 'deleteAttributeGroup_attributeGroup' - The name or ID of the attribute group that holds the attributes to
-- describe the application.
newDeleteAttributeGroup ::
  -- | 'attributeGroup'
  Prelude.Text ->
  DeleteAttributeGroup
newDeleteAttributeGroup :: Text -> DeleteAttributeGroup
newDeleteAttributeGroup Text
pAttributeGroup_ =
  DeleteAttributeGroup'
    { $sel:attributeGroup:DeleteAttributeGroup' :: Text
attributeGroup =
        Text
pAttributeGroup_
    }

-- | The name or ID of the attribute group that holds the attributes to
-- describe the application.
deleteAttributeGroup_attributeGroup :: Lens.Lens' DeleteAttributeGroup Prelude.Text
deleteAttributeGroup_attributeGroup :: Lens' DeleteAttributeGroup Text
deleteAttributeGroup_attributeGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributeGroup' {Text
attributeGroup :: Text
$sel:attributeGroup:DeleteAttributeGroup' :: DeleteAttributeGroup -> Text
attributeGroup} -> Text
attributeGroup) (\s :: DeleteAttributeGroup
s@DeleteAttributeGroup' {} Text
a -> DeleteAttributeGroup
s {$sel:attributeGroup:DeleteAttributeGroup' :: Text
attributeGroup = Text
a} :: DeleteAttributeGroup)

instance Core.AWSRequest DeleteAttributeGroup where
  type
    AWSResponse DeleteAttributeGroup =
      DeleteAttributeGroupResponse
  request :: (Service -> Service)
-> DeleteAttributeGroup -> Request DeleteAttributeGroup
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 DeleteAttributeGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteAttributeGroup)))
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 ->
          Maybe AttributeGroupSummary -> Int -> DeleteAttributeGroupResponse
DeleteAttributeGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"attributeGroup")
            forall (f :: * -> *) a b. Applicative f => 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 DeleteAttributeGroup where
  hashWithSalt :: Int -> DeleteAttributeGroup -> Int
hashWithSalt Int
_salt DeleteAttributeGroup' {Text
attributeGroup :: Text
$sel:attributeGroup:DeleteAttributeGroup' :: DeleteAttributeGroup -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeGroup

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

instance Data.ToHeaders DeleteAttributeGroup where
  toHeaders :: DeleteAttributeGroup -> 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 DeleteAttributeGroup where
  toPath :: DeleteAttributeGroup -> ByteString
toPath DeleteAttributeGroup' {Text
attributeGroup :: Text
$sel:attributeGroup:DeleteAttributeGroup' :: DeleteAttributeGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/attribute-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
attributeGroup]

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

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

-- |
-- Create a value of 'DeleteAttributeGroupResponse' 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:
--
-- 'attributeGroup', 'deleteAttributeGroupResponse_attributeGroup' - Information about the deleted attribute group.
--
-- 'httpStatus', 'deleteAttributeGroupResponse_httpStatus' - The response's http status code.
newDeleteAttributeGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteAttributeGroupResponse
newDeleteAttributeGroupResponse :: Int -> DeleteAttributeGroupResponse
newDeleteAttributeGroupResponse Int
pHttpStatus_ =
  DeleteAttributeGroupResponse'
    { $sel:attributeGroup:DeleteAttributeGroupResponse' :: Maybe AttributeGroupSummary
attributeGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteAttributeGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the deleted attribute group.
deleteAttributeGroupResponse_attributeGroup :: Lens.Lens' DeleteAttributeGroupResponse (Prelude.Maybe AttributeGroupSummary)
deleteAttributeGroupResponse_attributeGroup :: Lens' DeleteAttributeGroupResponse (Maybe AttributeGroupSummary)
deleteAttributeGroupResponse_attributeGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributeGroupResponse' {Maybe AttributeGroupSummary
attributeGroup :: Maybe AttributeGroupSummary
$sel:attributeGroup:DeleteAttributeGroupResponse' :: DeleteAttributeGroupResponse -> Maybe AttributeGroupSummary
attributeGroup} -> Maybe AttributeGroupSummary
attributeGroup) (\s :: DeleteAttributeGroupResponse
s@DeleteAttributeGroupResponse' {} Maybe AttributeGroupSummary
a -> DeleteAttributeGroupResponse
s {$sel:attributeGroup:DeleteAttributeGroupResponse' :: Maybe AttributeGroupSummary
attributeGroup = Maybe AttributeGroupSummary
a} :: DeleteAttributeGroupResponse)

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

instance Prelude.NFData DeleteAttributeGroupResponse where
  rnf :: DeleteAttributeGroupResponse -> ()
rnf DeleteAttributeGroupResponse' {Int
Maybe AttributeGroupSummary
httpStatus :: Int
attributeGroup :: Maybe AttributeGroupSummary
$sel:httpStatus:DeleteAttributeGroupResponse' :: DeleteAttributeGroupResponse -> Int
$sel:attributeGroup:DeleteAttributeGroupResponse' :: DeleteAttributeGroupResponse -> Maybe AttributeGroupSummary
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeGroupSummary
attributeGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus