{-# 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.Chime.CreateMeetingWithAttendees
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new Amazon Chime SDK meeting in the specified media Region,
-- with attendees. For more information about specifying media Regions, see
-- <https://docs.aws.amazon.com/chime/latest/dg/chime-sdk-meetings-regions.html Amazon Chime SDK Media Regions>
-- in the /Amazon Chime Developer Guide/ . 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.Chime.CreateMeetingWithAttendees
  ( -- * Creating a Request
    CreateMeetingWithAttendees (..),
    newCreateMeetingWithAttendees,

    -- * Request Lenses
    createMeetingWithAttendees_attendees,
    createMeetingWithAttendees_externalMeetingId,
    createMeetingWithAttendees_mediaRegion,
    createMeetingWithAttendees_meetingHostId,
    createMeetingWithAttendees_notificationsConfiguration,
    createMeetingWithAttendees_tags,
    createMeetingWithAttendees_clientRequestToken,

    -- * Destructuring the Response
    CreateMeetingWithAttendeesResponse (..),
    newCreateMeetingWithAttendeesResponse,

    -- * Response Lenses
    createMeetingWithAttendeesResponse_attendees,
    createMeetingWithAttendeesResponse_errors,
    createMeetingWithAttendeesResponse_meeting,
    createMeetingWithAttendeesResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newCreateMeetingWithAttendees' smart constructor.
data CreateMeetingWithAttendees = CreateMeetingWithAttendees'
  { -- | The request containing the attendees to create.
    CreateMeetingWithAttendees
-> Maybe (NonEmpty CreateAttendeeRequestItem)
attendees :: Prelude.Maybe (Prelude.NonEmpty CreateAttendeeRequestItem),
    -- | The external meeting ID.
    CreateMeetingWithAttendees -> Maybe (Sensitive Text)
externalMeetingId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Region in which to create the meeting. Default: @us-east-1@ .
    --
    -- Available values: @af-south-1@ , @ap-northeast-1@ , @ap-northeast-2@ ,
    -- @ap-south-1@ , @ap-southeast-1@ , @ap-southeast-2@ , @ca-central-1@ ,
    -- @eu-central-1@ , @eu-north-1@ , @eu-south-1@ , @eu-west-1@ , @eu-west-2@
    -- , @eu-west-3@ , @sa-east-1@ , @us-east-1@ , @us-east-2@ , @us-west-1@ ,
    -- @us-west-2@ .
    CreateMeetingWithAttendees -> Maybe Text
mediaRegion :: Prelude.Maybe Prelude.Text,
    -- | Reserved.
    CreateMeetingWithAttendees -> Maybe (Sensitive Text)
meetingHostId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    CreateMeetingWithAttendees
-> Maybe MeetingNotificationConfiguration
notificationsConfiguration :: Prelude.Maybe MeetingNotificationConfiguration,
    -- | The tag key-value pairs.
    CreateMeetingWithAttendees -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The unique identifier for the client request. Use a different token for
    -- different meetings.
    CreateMeetingWithAttendees -> Sensitive Text
clientRequestToken :: Data.Sensitive Prelude.Text
  }
  deriving (CreateMeetingWithAttendees -> CreateMeetingWithAttendees -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMeetingWithAttendees -> CreateMeetingWithAttendees -> Bool
$c/= :: CreateMeetingWithAttendees -> CreateMeetingWithAttendees -> Bool
== :: CreateMeetingWithAttendees -> CreateMeetingWithAttendees -> Bool
$c== :: CreateMeetingWithAttendees -> CreateMeetingWithAttendees -> Bool
Prelude.Eq, Int -> CreateMeetingWithAttendees -> ShowS
[CreateMeetingWithAttendees] -> ShowS
CreateMeetingWithAttendees -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMeetingWithAttendees] -> ShowS
$cshowList :: [CreateMeetingWithAttendees] -> ShowS
show :: CreateMeetingWithAttendees -> String
$cshow :: CreateMeetingWithAttendees -> String
showsPrec :: Int -> CreateMeetingWithAttendees -> ShowS
$cshowsPrec :: Int -> CreateMeetingWithAttendees -> ShowS
Prelude.Show, forall x.
Rep CreateMeetingWithAttendees x -> CreateMeetingWithAttendees
forall x.
CreateMeetingWithAttendees -> Rep CreateMeetingWithAttendees x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMeetingWithAttendees x -> CreateMeetingWithAttendees
$cfrom :: forall x.
CreateMeetingWithAttendees -> Rep CreateMeetingWithAttendees x
Prelude.Generic)

-- |
-- Create a value of 'CreateMeetingWithAttendees' 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:
--
-- 'attendees', 'createMeetingWithAttendees_attendees' - The request containing the attendees to create.
--
-- 'externalMeetingId', 'createMeetingWithAttendees_externalMeetingId' - The external meeting ID.
--
-- 'mediaRegion', 'createMeetingWithAttendees_mediaRegion' - The Region in which to create the meeting. Default: @us-east-1@ .
--
-- Available values: @af-south-1@ , @ap-northeast-1@ , @ap-northeast-2@ ,
-- @ap-south-1@ , @ap-southeast-1@ , @ap-southeast-2@ , @ca-central-1@ ,
-- @eu-central-1@ , @eu-north-1@ , @eu-south-1@ , @eu-west-1@ , @eu-west-2@
-- , @eu-west-3@ , @sa-east-1@ , @us-east-1@ , @us-east-2@ , @us-west-1@ ,
-- @us-west-2@ .
--
-- 'meetingHostId', 'createMeetingWithAttendees_meetingHostId' - Reserved.
--
-- 'notificationsConfiguration', 'createMeetingWithAttendees_notificationsConfiguration' - Undocumented member.
--
-- 'tags', 'createMeetingWithAttendees_tags' - The tag key-value pairs.
--
-- 'clientRequestToken', 'createMeetingWithAttendees_clientRequestToken' - The unique identifier for the client request. Use a different token for
-- different meetings.
newCreateMeetingWithAttendees ::
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateMeetingWithAttendees
newCreateMeetingWithAttendees :: Text -> CreateMeetingWithAttendees
newCreateMeetingWithAttendees Text
pClientRequestToken_ =
  CreateMeetingWithAttendees'
    { $sel:attendees:CreateMeetingWithAttendees' :: Maybe (NonEmpty CreateAttendeeRequestItem)
attendees =
        forall a. Maybe a
Prelude.Nothing,
      $sel:externalMeetingId:CreateMeetingWithAttendees' :: Maybe (Sensitive Text)
externalMeetingId = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaRegion:CreateMeetingWithAttendees' :: Maybe Text
mediaRegion = forall a. Maybe a
Prelude.Nothing,
      $sel:meetingHostId:CreateMeetingWithAttendees' :: Maybe (Sensitive Text)
meetingHostId = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationsConfiguration:CreateMeetingWithAttendees' :: Maybe MeetingNotificationConfiguration
notificationsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateMeetingWithAttendees' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:clientRequestToken:CreateMeetingWithAttendees' :: Sensitive Text
clientRequestToken =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientRequestToken_
    }

-- | The request containing the attendees to create.
createMeetingWithAttendees_attendees :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe (Prelude.NonEmpty CreateAttendeeRequestItem))
createMeetingWithAttendees_attendees :: Lens'
  CreateMeetingWithAttendees
  (Maybe (NonEmpty CreateAttendeeRequestItem))
createMeetingWithAttendees_attendees = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe (NonEmpty CreateAttendeeRequestItem)
attendees :: Maybe (NonEmpty CreateAttendeeRequestItem)
$sel:attendees:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe (NonEmpty CreateAttendeeRequestItem)
attendees} -> Maybe (NonEmpty CreateAttendeeRequestItem)
attendees) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe (NonEmpty CreateAttendeeRequestItem)
a -> CreateMeetingWithAttendees
s {$sel:attendees:CreateMeetingWithAttendees' :: Maybe (NonEmpty CreateAttendeeRequestItem)
attendees = Maybe (NonEmpty CreateAttendeeRequestItem)
a} :: CreateMeetingWithAttendees) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The external meeting ID.
createMeetingWithAttendees_externalMeetingId :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe Prelude.Text)
createMeetingWithAttendees_externalMeetingId :: Lens' CreateMeetingWithAttendees (Maybe Text)
createMeetingWithAttendees_externalMeetingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe (Sensitive Text)
externalMeetingId :: Maybe (Sensitive Text)
$sel:externalMeetingId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
externalMeetingId} -> Maybe (Sensitive Text)
externalMeetingId) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe (Sensitive Text)
a -> CreateMeetingWithAttendees
s {$sel:externalMeetingId:CreateMeetingWithAttendees' :: Maybe (Sensitive Text)
externalMeetingId = Maybe (Sensitive Text)
a} :: CreateMeetingWithAttendees) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Region in which to create the meeting. Default: @us-east-1@ .
--
-- Available values: @af-south-1@ , @ap-northeast-1@ , @ap-northeast-2@ ,
-- @ap-south-1@ , @ap-southeast-1@ , @ap-southeast-2@ , @ca-central-1@ ,
-- @eu-central-1@ , @eu-north-1@ , @eu-south-1@ , @eu-west-1@ , @eu-west-2@
-- , @eu-west-3@ , @sa-east-1@ , @us-east-1@ , @us-east-2@ , @us-west-1@ ,
-- @us-west-2@ .
createMeetingWithAttendees_mediaRegion :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe Prelude.Text)
createMeetingWithAttendees_mediaRegion :: Lens' CreateMeetingWithAttendees (Maybe Text)
createMeetingWithAttendees_mediaRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe Text
mediaRegion :: Maybe Text
$sel:mediaRegion:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe Text
mediaRegion} -> Maybe Text
mediaRegion) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe Text
a -> CreateMeetingWithAttendees
s {$sel:mediaRegion:CreateMeetingWithAttendees' :: Maybe Text
mediaRegion = Maybe Text
a} :: CreateMeetingWithAttendees)

-- | Reserved.
createMeetingWithAttendees_meetingHostId :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe Prelude.Text)
createMeetingWithAttendees_meetingHostId :: Lens' CreateMeetingWithAttendees (Maybe Text)
createMeetingWithAttendees_meetingHostId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe (Sensitive Text)
meetingHostId :: Maybe (Sensitive Text)
$sel:meetingHostId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
meetingHostId} -> Maybe (Sensitive Text)
meetingHostId) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe (Sensitive Text)
a -> CreateMeetingWithAttendees
s {$sel:meetingHostId:CreateMeetingWithAttendees' :: Maybe (Sensitive Text)
meetingHostId = Maybe (Sensitive Text)
a} :: CreateMeetingWithAttendees) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Undocumented member.
createMeetingWithAttendees_notificationsConfiguration :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe MeetingNotificationConfiguration)
createMeetingWithAttendees_notificationsConfiguration :: Lens'
  CreateMeetingWithAttendees (Maybe MeetingNotificationConfiguration)
createMeetingWithAttendees_notificationsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe MeetingNotificationConfiguration
notificationsConfiguration :: Maybe MeetingNotificationConfiguration
$sel:notificationsConfiguration:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe MeetingNotificationConfiguration
notificationsConfiguration} -> Maybe MeetingNotificationConfiguration
notificationsConfiguration) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe MeetingNotificationConfiguration
a -> CreateMeetingWithAttendees
s {$sel:notificationsConfiguration:CreateMeetingWithAttendees' :: Maybe MeetingNotificationConfiguration
notificationsConfiguration = Maybe MeetingNotificationConfiguration
a} :: CreateMeetingWithAttendees)

-- | The tag key-value pairs.
createMeetingWithAttendees_tags :: Lens.Lens' CreateMeetingWithAttendees (Prelude.Maybe (Prelude.NonEmpty Tag))
createMeetingWithAttendees_tags :: Lens' CreateMeetingWithAttendees (Maybe (NonEmpty Tag))
createMeetingWithAttendees_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Maybe (NonEmpty Tag)
a -> CreateMeetingWithAttendees
s {$sel:tags:CreateMeetingWithAttendees' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateMeetingWithAttendees) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The unique identifier for the client request. Use a different token for
-- different meetings.
createMeetingWithAttendees_clientRequestToken :: Lens.Lens' CreateMeetingWithAttendees Prelude.Text
createMeetingWithAttendees_clientRequestToken :: Lens' CreateMeetingWithAttendees Text
createMeetingWithAttendees_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendees' {Sensitive Text
clientRequestToken :: Sensitive Text
$sel:clientRequestToken:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Sensitive Text
clientRequestToken} -> Sensitive Text
clientRequestToken) (\s :: CreateMeetingWithAttendees
s@CreateMeetingWithAttendees' {} Sensitive Text
a -> CreateMeetingWithAttendees
s {$sel:clientRequestToken:CreateMeetingWithAttendees' :: Sensitive Text
clientRequestToken = Sensitive Text
a} :: CreateMeetingWithAttendees) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateMeetingWithAttendees where
  type
    AWSResponse CreateMeetingWithAttendees =
      CreateMeetingWithAttendeesResponse
  request :: (Service -> Service)
-> CreateMeetingWithAttendees -> Request CreateMeetingWithAttendees
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateMeetingWithAttendees
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMeetingWithAttendees)))
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 [Attendee]
-> Maybe [CreateAttendeeError]
-> Maybe Meeting
-> Int
-> CreateMeetingWithAttendeesResponse
CreateMeetingWithAttendeesResponse'
            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
"Attendees" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Errors" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Meeting")
            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 CreateMeetingWithAttendees where
  hashWithSalt :: Int -> CreateMeetingWithAttendees -> Int
hashWithSalt Int
_salt CreateMeetingWithAttendees' {Maybe (NonEmpty Tag)
Maybe (NonEmpty CreateAttendeeRequestItem)
Maybe Text
Maybe (Sensitive Text)
Maybe MeetingNotificationConfiguration
Sensitive Text
clientRequestToken :: Sensitive Text
tags :: Maybe (NonEmpty Tag)
notificationsConfiguration :: Maybe MeetingNotificationConfiguration
meetingHostId :: Maybe (Sensitive Text)
mediaRegion :: Maybe Text
externalMeetingId :: Maybe (Sensitive Text)
attendees :: Maybe (NonEmpty CreateAttendeeRequestItem)
$sel:clientRequestToken:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Sensitive Text
$sel:tags:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (NonEmpty Tag)
$sel:notificationsConfiguration:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe MeetingNotificationConfiguration
$sel:meetingHostId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:mediaRegion:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe Text
$sel:externalMeetingId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:attendees:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe (NonEmpty CreateAttendeeRequestItem)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty CreateAttendeeRequestItem)
attendees
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
externalMeetingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mediaRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
meetingHostId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MeetingNotificationConfiguration
notificationsConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientRequestToken

instance Prelude.NFData CreateMeetingWithAttendees where
  rnf :: CreateMeetingWithAttendees -> ()
rnf CreateMeetingWithAttendees' {Maybe (NonEmpty Tag)
Maybe (NonEmpty CreateAttendeeRequestItem)
Maybe Text
Maybe (Sensitive Text)
Maybe MeetingNotificationConfiguration
Sensitive Text
clientRequestToken :: Sensitive Text
tags :: Maybe (NonEmpty Tag)
notificationsConfiguration :: Maybe MeetingNotificationConfiguration
meetingHostId :: Maybe (Sensitive Text)
mediaRegion :: Maybe Text
externalMeetingId :: Maybe (Sensitive Text)
attendees :: Maybe (NonEmpty CreateAttendeeRequestItem)
$sel:clientRequestToken:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Sensitive Text
$sel:tags:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (NonEmpty Tag)
$sel:notificationsConfiguration:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe MeetingNotificationConfiguration
$sel:meetingHostId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:mediaRegion:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe Text
$sel:externalMeetingId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:attendees:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe (NonEmpty CreateAttendeeRequestItem)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty CreateAttendeeRequestItem)
attendees
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
externalMeetingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mediaRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
meetingHostId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MeetingNotificationConfiguration
notificationsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
clientRequestToken

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

instance Data.ToJSON CreateMeetingWithAttendees where
  toJSON :: CreateMeetingWithAttendees -> Value
toJSON CreateMeetingWithAttendees' {Maybe (NonEmpty Tag)
Maybe (NonEmpty CreateAttendeeRequestItem)
Maybe Text
Maybe (Sensitive Text)
Maybe MeetingNotificationConfiguration
Sensitive Text
clientRequestToken :: Sensitive Text
tags :: Maybe (NonEmpty Tag)
notificationsConfiguration :: Maybe MeetingNotificationConfiguration
meetingHostId :: Maybe (Sensitive Text)
mediaRegion :: Maybe Text
externalMeetingId :: Maybe (Sensitive Text)
attendees :: Maybe (NonEmpty CreateAttendeeRequestItem)
$sel:clientRequestToken:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Sensitive Text
$sel:tags:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (NonEmpty Tag)
$sel:notificationsConfiguration:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe MeetingNotificationConfiguration
$sel:meetingHostId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:mediaRegion:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe Text
$sel:externalMeetingId:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees -> Maybe (Sensitive Text)
$sel:attendees:CreateMeetingWithAttendees' :: CreateMeetingWithAttendees
-> Maybe (NonEmpty CreateAttendeeRequestItem)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attendees" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty CreateAttendeeRequestItem)
attendees,
            (Key
"ExternalMeetingId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive Text)
externalMeetingId,
            (Key
"MediaRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
mediaRegion,
            (Key
"MeetingHostId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive Text)
meetingHostId,
            (Key
"NotificationsConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MeetingNotificationConfiguration
notificationsConfiguration,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
clientRequestToken)
          ]
      )

instance Data.ToPath CreateMeetingWithAttendees where
  toPath :: CreateMeetingWithAttendees -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/meetings"

instance Data.ToQuery CreateMeetingWithAttendees where
  toQuery :: CreateMeetingWithAttendees -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"operation=create-attendees"])

-- | /See:/ 'newCreateMeetingWithAttendeesResponse' smart constructor.
data CreateMeetingWithAttendeesResponse = CreateMeetingWithAttendeesResponse'
  { -- | The attendee information, including attendees IDs and join tokens.
    CreateMeetingWithAttendeesResponse -> Maybe [Attendee]
attendees :: Prelude.Maybe [Attendee],
    -- | If the action fails for one or more of the attendees in the request, a
    -- list of the attendees is returned, along with error codes and error
    -- messages.
    CreateMeetingWithAttendeesResponse -> Maybe [CreateAttendeeError]
errors :: Prelude.Maybe [CreateAttendeeError],
    CreateMeetingWithAttendeesResponse -> Maybe Meeting
meeting :: Prelude.Maybe Meeting,
    -- | The response's http status code.
    CreateMeetingWithAttendeesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateMeetingWithAttendeesResponse
-> CreateMeetingWithAttendeesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMeetingWithAttendeesResponse
-> CreateMeetingWithAttendeesResponse -> Bool
$c/= :: CreateMeetingWithAttendeesResponse
-> CreateMeetingWithAttendeesResponse -> Bool
== :: CreateMeetingWithAttendeesResponse
-> CreateMeetingWithAttendeesResponse -> Bool
$c== :: CreateMeetingWithAttendeesResponse
-> CreateMeetingWithAttendeesResponse -> Bool
Prelude.Eq, Int -> CreateMeetingWithAttendeesResponse -> ShowS
[CreateMeetingWithAttendeesResponse] -> ShowS
CreateMeetingWithAttendeesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMeetingWithAttendeesResponse] -> ShowS
$cshowList :: [CreateMeetingWithAttendeesResponse] -> ShowS
show :: CreateMeetingWithAttendeesResponse -> String
$cshow :: CreateMeetingWithAttendeesResponse -> String
showsPrec :: Int -> CreateMeetingWithAttendeesResponse -> ShowS
$cshowsPrec :: Int -> CreateMeetingWithAttendeesResponse -> ShowS
Prelude.Show, forall x.
Rep CreateMeetingWithAttendeesResponse x
-> CreateMeetingWithAttendeesResponse
forall x.
CreateMeetingWithAttendeesResponse
-> Rep CreateMeetingWithAttendeesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMeetingWithAttendeesResponse x
-> CreateMeetingWithAttendeesResponse
$cfrom :: forall x.
CreateMeetingWithAttendeesResponse
-> Rep CreateMeetingWithAttendeesResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMeetingWithAttendeesResponse' 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:
--
-- 'attendees', 'createMeetingWithAttendeesResponse_attendees' - The attendee information, including attendees IDs and join tokens.
--
-- 'errors', 'createMeetingWithAttendeesResponse_errors' - If the action fails for one or more of the attendees in the request, a
-- list of the attendees is returned, along with error codes and error
-- messages.
--
-- 'meeting', 'createMeetingWithAttendeesResponse_meeting' - Undocumented member.
--
-- 'httpStatus', 'createMeetingWithAttendeesResponse_httpStatus' - The response's http status code.
newCreateMeetingWithAttendeesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMeetingWithAttendeesResponse
newCreateMeetingWithAttendeesResponse :: Int -> CreateMeetingWithAttendeesResponse
newCreateMeetingWithAttendeesResponse Int
pHttpStatus_ =
  CreateMeetingWithAttendeesResponse'
    { $sel:attendees:CreateMeetingWithAttendeesResponse' :: Maybe [Attendee]
attendees =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errors:CreateMeetingWithAttendeesResponse' :: Maybe [CreateAttendeeError]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:meeting:CreateMeetingWithAttendeesResponse' :: Maybe Meeting
meeting = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMeetingWithAttendeesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The attendee information, including attendees IDs and join tokens.
createMeetingWithAttendeesResponse_attendees :: Lens.Lens' CreateMeetingWithAttendeesResponse (Prelude.Maybe [Attendee])
createMeetingWithAttendeesResponse_attendees :: Lens' CreateMeetingWithAttendeesResponse (Maybe [Attendee])
createMeetingWithAttendeesResponse_attendees = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendeesResponse' {Maybe [Attendee]
attendees :: Maybe [Attendee]
$sel:attendees:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe [Attendee]
attendees} -> Maybe [Attendee]
attendees) (\s :: CreateMeetingWithAttendeesResponse
s@CreateMeetingWithAttendeesResponse' {} Maybe [Attendee]
a -> CreateMeetingWithAttendeesResponse
s {$sel:attendees:CreateMeetingWithAttendeesResponse' :: Maybe [Attendee]
attendees = Maybe [Attendee]
a} :: CreateMeetingWithAttendeesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | If the action fails for one or more of the attendees in the request, a
-- list of the attendees is returned, along with error codes and error
-- messages.
createMeetingWithAttendeesResponse_errors :: Lens.Lens' CreateMeetingWithAttendeesResponse (Prelude.Maybe [CreateAttendeeError])
createMeetingWithAttendeesResponse_errors :: Lens'
  CreateMeetingWithAttendeesResponse (Maybe [CreateAttendeeError])
createMeetingWithAttendeesResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendeesResponse' {Maybe [CreateAttendeeError]
errors :: Maybe [CreateAttendeeError]
$sel:errors:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe [CreateAttendeeError]
errors} -> Maybe [CreateAttendeeError]
errors) (\s :: CreateMeetingWithAttendeesResponse
s@CreateMeetingWithAttendeesResponse' {} Maybe [CreateAttendeeError]
a -> CreateMeetingWithAttendeesResponse
s {$sel:errors:CreateMeetingWithAttendeesResponse' :: Maybe [CreateAttendeeError]
errors = Maybe [CreateAttendeeError]
a} :: CreateMeetingWithAttendeesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
createMeetingWithAttendeesResponse_meeting :: Lens.Lens' CreateMeetingWithAttendeesResponse (Prelude.Maybe Meeting)
createMeetingWithAttendeesResponse_meeting :: Lens' CreateMeetingWithAttendeesResponse (Maybe Meeting)
createMeetingWithAttendeesResponse_meeting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMeetingWithAttendeesResponse' {Maybe Meeting
meeting :: Maybe Meeting
$sel:meeting:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe Meeting
meeting} -> Maybe Meeting
meeting) (\s :: CreateMeetingWithAttendeesResponse
s@CreateMeetingWithAttendeesResponse' {} Maybe Meeting
a -> CreateMeetingWithAttendeesResponse
s {$sel:meeting:CreateMeetingWithAttendeesResponse' :: Maybe Meeting
meeting = Maybe Meeting
a} :: CreateMeetingWithAttendeesResponse)

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

instance
  Prelude.NFData
    CreateMeetingWithAttendeesResponse
  where
  rnf :: CreateMeetingWithAttendeesResponse -> ()
rnf CreateMeetingWithAttendeesResponse' {Int
Maybe [Attendee]
Maybe [CreateAttendeeError]
Maybe Meeting
httpStatus :: Int
meeting :: Maybe Meeting
errors :: Maybe [CreateAttendeeError]
attendees :: Maybe [Attendee]
$sel:httpStatus:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Int
$sel:meeting:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe Meeting
$sel:errors:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe [CreateAttendeeError]
$sel:attendees:CreateMeetingWithAttendeesResponse' :: CreateMeetingWithAttendeesResponse -> Maybe [Attendee]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attendee]
attendees
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CreateAttendeeError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Meeting
meeting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus