{-# 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.IoTWireless.DeleteMulticastGroup
-- 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 multicast group if it is not in use by a fuota task.
module Amazonka.IoTWireless.DeleteMulticastGroup
  ( -- * Creating a Request
    DeleteMulticastGroup (..),
    newDeleteMulticastGroup,

    -- * Request Lenses
    deleteMulticastGroup_id,

    -- * Destructuring the Response
    DeleteMulticastGroupResponse (..),
    newDeleteMulticastGroupResponse,

    -- * Response Lenses
    deleteMulticastGroupResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTWireless.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

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

-- |
-- Create a value of 'DeleteMulticastGroup' 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:
--
-- 'id', 'deleteMulticastGroup_id' - Undocumented member.
newDeleteMulticastGroup ::
  -- | 'id'
  Prelude.Text ->
  DeleteMulticastGroup
newDeleteMulticastGroup :: Text -> DeleteMulticastGroup
newDeleteMulticastGroup Text
pId_ =
  DeleteMulticastGroup' {$sel:id:DeleteMulticastGroup' :: Text
id = Text
pId_}

-- | Undocumented member.
deleteMulticastGroup_id :: Lens.Lens' DeleteMulticastGroup Prelude.Text
deleteMulticastGroup_id :: Lens' DeleteMulticastGroup Text
deleteMulticastGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMulticastGroup' {Text
id :: Text
$sel:id:DeleteMulticastGroup' :: DeleteMulticastGroup -> Text
id} -> Text
id) (\s :: DeleteMulticastGroup
s@DeleteMulticastGroup' {} Text
a -> DeleteMulticastGroup
s {$sel:id:DeleteMulticastGroup' :: Text
id = Text
a} :: DeleteMulticastGroup)

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

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

instance Data.ToHeaders DeleteMulticastGroup where
  toHeaders :: DeleteMulticastGroup -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

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

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