{-# 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.ChimeSdkMeetings.DeleteAttendee
-- 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 attendee from the specified Amazon Chime SDK meeting and
-- deletes their @JoinToken@. Attendees are automatically deleted when a
-- Amazon Chime SDK meeting is deleted. For more information about the
-- Amazon Chime SDK, see
-- <https://docs.aws.amazon.com/chime/latest/dg/meetings-sdk.html Using the Amazon Chime SDK>
-- in the /Amazon Chime Developer Guide/.
module Amazonka.ChimeSdkMeetings.DeleteAttendee
  ( -- * Creating a Request
    DeleteAttendee (..),
    newDeleteAttendee,

    -- * Request Lenses
    deleteAttendee_meetingId,
    deleteAttendee_attendeeId,

    -- * Destructuring the Response
    DeleteAttendeeResponse (..),
    newDeleteAttendeeResponse,
  )
where

import Amazonka.ChimeSdkMeetings.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:/ 'newDeleteAttendee' smart constructor.
data DeleteAttendee = DeleteAttendee'
  { -- | The Amazon Chime SDK meeting ID.
    DeleteAttendee -> Text
meetingId :: Prelude.Text,
    -- | The Amazon Chime SDK attendee ID.
    DeleteAttendee -> Text
attendeeId :: Prelude.Text
  }
  deriving (DeleteAttendee -> DeleteAttendee -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAttendee -> DeleteAttendee -> Bool
$c/= :: DeleteAttendee -> DeleteAttendee -> Bool
== :: DeleteAttendee -> DeleteAttendee -> Bool
$c== :: DeleteAttendee -> DeleteAttendee -> Bool
Prelude.Eq, ReadPrec [DeleteAttendee]
ReadPrec DeleteAttendee
Int -> ReadS DeleteAttendee
ReadS [DeleteAttendee]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAttendee]
$creadListPrec :: ReadPrec [DeleteAttendee]
readPrec :: ReadPrec DeleteAttendee
$creadPrec :: ReadPrec DeleteAttendee
readList :: ReadS [DeleteAttendee]
$creadList :: ReadS [DeleteAttendee]
readsPrec :: Int -> ReadS DeleteAttendee
$creadsPrec :: Int -> ReadS DeleteAttendee
Prelude.Read, Int -> DeleteAttendee -> ShowS
[DeleteAttendee] -> ShowS
DeleteAttendee -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAttendee] -> ShowS
$cshowList :: [DeleteAttendee] -> ShowS
show :: DeleteAttendee -> String
$cshow :: DeleteAttendee -> String
showsPrec :: Int -> DeleteAttendee -> ShowS
$cshowsPrec :: Int -> DeleteAttendee -> ShowS
Prelude.Show, forall x. Rep DeleteAttendee x -> DeleteAttendee
forall x. DeleteAttendee -> Rep DeleteAttendee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAttendee x -> DeleteAttendee
$cfrom :: forall x. DeleteAttendee -> Rep DeleteAttendee x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAttendee' 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:
--
-- 'meetingId', 'deleteAttendee_meetingId' - The Amazon Chime SDK meeting ID.
--
-- 'attendeeId', 'deleteAttendee_attendeeId' - The Amazon Chime SDK attendee ID.
newDeleteAttendee ::
  -- | 'meetingId'
  Prelude.Text ->
  -- | 'attendeeId'
  Prelude.Text ->
  DeleteAttendee
newDeleteAttendee :: Text -> Text -> DeleteAttendee
newDeleteAttendee Text
pMeetingId_ Text
pAttendeeId_ =
  DeleteAttendee'
    { $sel:meetingId:DeleteAttendee' :: Text
meetingId = Text
pMeetingId_,
      $sel:attendeeId:DeleteAttendee' :: Text
attendeeId = Text
pAttendeeId_
    }

-- | The Amazon Chime SDK meeting ID.
deleteAttendee_meetingId :: Lens.Lens' DeleteAttendee Prelude.Text
deleteAttendee_meetingId :: Lens' DeleteAttendee Text
deleteAttendee_meetingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttendee' {Text
meetingId :: Text
$sel:meetingId:DeleteAttendee' :: DeleteAttendee -> Text
meetingId} -> Text
meetingId) (\s :: DeleteAttendee
s@DeleteAttendee' {} Text
a -> DeleteAttendee
s {$sel:meetingId:DeleteAttendee' :: Text
meetingId = Text
a} :: DeleteAttendee)

-- | The Amazon Chime SDK attendee ID.
deleteAttendee_attendeeId :: Lens.Lens' DeleteAttendee Prelude.Text
deleteAttendee_attendeeId :: Lens' DeleteAttendee Text
deleteAttendee_attendeeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttendee' {Text
attendeeId :: Text
$sel:attendeeId:DeleteAttendee' :: DeleteAttendee -> Text
attendeeId} -> Text
attendeeId) (\s :: DeleteAttendee
s@DeleteAttendee' {} Text
a -> DeleteAttendee
s {$sel:attendeeId:DeleteAttendee' :: Text
attendeeId = Text
a} :: DeleteAttendee)

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

instance Prelude.Hashable DeleteAttendee where
  hashWithSalt :: Int -> DeleteAttendee -> Int
hashWithSalt Int
_salt DeleteAttendee' {Text
attendeeId :: Text
meetingId :: Text
$sel:attendeeId:DeleteAttendee' :: DeleteAttendee -> Text
$sel:meetingId:DeleteAttendee' :: DeleteAttendee -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
meetingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attendeeId

instance Prelude.NFData DeleteAttendee where
  rnf :: DeleteAttendee -> ()
rnf DeleteAttendee' {Text
attendeeId :: Text
meetingId :: Text
$sel:attendeeId:DeleteAttendee' :: DeleteAttendee -> Text
$sel:meetingId:DeleteAttendee' :: DeleteAttendee -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
meetingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attendeeId

instance Data.ToHeaders DeleteAttendee where
  toHeaders :: DeleteAttendee -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteAttendee where
  toPath :: DeleteAttendee -> ByteString
toPath DeleteAttendee' {Text
attendeeId :: Text
meetingId :: Text
$sel:attendeeId:DeleteAttendee' :: DeleteAttendee -> Text
$sel:meetingId:DeleteAttendee' :: DeleteAttendee -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/meetings/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
meetingId,
        ByteString
"/attendees/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
attendeeId
      ]

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

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

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

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