{-# 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.CreateAttendee
-- 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 attendee for an active Amazon Chime SDK meeting. 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.CreateAttendee
  ( -- * Creating a Request
    CreateAttendee (..),
    newCreateAttendee,

    -- * Request Lenses
    createAttendee_tags,
    createAttendee_meetingId,
    createAttendee_externalUserId,

    -- * Destructuring the Response
    CreateAttendeeResponse (..),
    newCreateAttendeeResponse,

    -- * Response Lenses
    createAttendeeResponse_attendee,
    createAttendeeResponse_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:/ 'newCreateAttendee' smart constructor.
data CreateAttendee = CreateAttendee'
  { -- | The tag key-value pairs.
    CreateAttendee -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The Amazon Chime SDK meeting ID.
    CreateAttendee -> Text
meetingId :: Prelude.Text,
    -- | The Amazon Chime SDK external user ID. An idempotency token. Links the
    -- attendee to an identity managed by a builder application.
    CreateAttendee -> Sensitive Text
externalUserId :: Data.Sensitive Prelude.Text
  }
  deriving (CreateAttendee -> CreateAttendee -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAttendee -> CreateAttendee -> Bool
$c/= :: CreateAttendee -> CreateAttendee -> Bool
== :: CreateAttendee -> CreateAttendee -> Bool
$c== :: CreateAttendee -> CreateAttendee -> Bool
Prelude.Eq, Int -> CreateAttendee -> ShowS
[CreateAttendee] -> ShowS
CreateAttendee -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAttendee] -> ShowS
$cshowList :: [CreateAttendee] -> ShowS
show :: CreateAttendee -> String
$cshow :: CreateAttendee -> String
showsPrec :: Int -> CreateAttendee -> ShowS
$cshowsPrec :: Int -> CreateAttendee -> ShowS
Prelude.Show, forall x. Rep CreateAttendee x -> CreateAttendee
forall x. CreateAttendee -> Rep CreateAttendee x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAttendee x -> CreateAttendee
$cfrom :: forall x. CreateAttendee -> Rep CreateAttendee x
Prelude.Generic)

-- |
-- Create a value of 'CreateAttendee' 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:
--
-- 'tags', 'createAttendee_tags' - The tag key-value pairs.
--
-- 'meetingId', 'createAttendee_meetingId' - The Amazon Chime SDK meeting ID.
--
-- 'externalUserId', 'createAttendee_externalUserId' - The Amazon Chime SDK external user ID. An idempotency token. Links the
-- attendee to an identity managed by a builder application.
newCreateAttendee ::
  -- | 'meetingId'
  Prelude.Text ->
  -- | 'externalUserId'
  Prelude.Text ->
  CreateAttendee
newCreateAttendee :: Text -> Text -> CreateAttendee
newCreateAttendee Text
pMeetingId_ Text
pExternalUserId_ =
  CreateAttendee'
    { $sel:tags:CreateAttendee' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:meetingId:CreateAttendee' :: Text
meetingId = Text
pMeetingId_,
      $sel:externalUserId:CreateAttendee' :: Sensitive Text
externalUserId =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pExternalUserId_
    }

-- | The tag key-value pairs.
createAttendee_tags :: Lens.Lens' CreateAttendee (Prelude.Maybe (Prelude.NonEmpty Tag))
createAttendee_tags :: Lens' CreateAttendee (Maybe (NonEmpty Tag))
createAttendee_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttendee' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateAttendee' :: CreateAttendee -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateAttendee
s@CreateAttendee' {} Maybe (NonEmpty Tag)
a -> CreateAttendee
s {$sel:tags:CreateAttendee' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateAttendee) 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 Amazon Chime SDK meeting ID.
createAttendee_meetingId :: Lens.Lens' CreateAttendee Prelude.Text
createAttendee_meetingId :: Lens' CreateAttendee Text
createAttendee_meetingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttendee' {Text
meetingId :: Text
$sel:meetingId:CreateAttendee' :: CreateAttendee -> Text
meetingId} -> Text
meetingId) (\s :: CreateAttendee
s@CreateAttendee' {} Text
a -> CreateAttendee
s {$sel:meetingId:CreateAttendee' :: Text
meetingId = Text
a} :: CreateAttendee)

-- | The Amazon Chime SDK external user ID. An idempotency token. Links the
-- attendee to an identity managed by a builder application.
createAttendee_externalUserId :: Lens.Lens' CreateAttendee Prelude.Text
createAttendee_externalUserId :: Lens' CreateAttendee Text
createAttendee_externalUserId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttendee' {Sensitive Text
externalUserId :: Sensitive Text
$sel:externalUserId:CreateAttendee' :: CreateAttendee -> Sensitive Text
externalUserId} -> Sensitive Text
externalUserId) (\s :: CreateAttendee
s@CreateAttendee' {} Sensitive Text
a -> CreateAttendee
s {$sel:externalUserId:CreateAttendee' :: Sensitive Text
externalUserId = Sensitive Text
a} :: CreateAttendee) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateAttendee where
  type
    AWSResponse CreateAttendee =
      CreateAttendeeResponse
  request :: (Service -> Service) -> CreateAttendee -> Request CreateAttendee
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 CreateAttendee
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAttendee)))
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 -> Int -> CreateAttendeeResponse
CreateAttendeeResponse'
            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
"Attendee")
            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 CreateAttendee where
  hashWithSalt :: Int -> CreateAttendee -> Int
hashWithSalt Int
_salt CreateAttendee' {Maybe (NonEmpty Tag)
Text
Sensitive Text
externalUserId :: Sensitive Text
meetingId :: Text
tags :: Maybe (NonEmpty Tag)
$sel:externalUserId:CreateAttendee' :: CreateAttendee -> Sensitive Text
$sel:meetingId:CreateAttendee' :: CreateAttendee -> Text
$sel:tags:CreateAttendee' :: CreateAttendee -> Maybe (NonEmpty Tag)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
meetingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
externalUserId

instance Prelude.NFData CreateAttendee where
  rnf :: CreateAttendee -> ()
rnf CreateAttendee' {Maybe (NonEmpty Tag)
Text
Sensitive Text
externalUserId :: Sensitive Text
meetingId :: Text
tags :: Maybe (NonEmpty Tag)
$sel:externalUserId:CreateAttendee' :: CreateAttendee -> Sensitive Text
$sel:meetingId:CreateAttendee' :: CreateAttendee -> Text
$sel:tags:CreateAttendee' :: CreateAttendee -> Maybe (NonEmpty Tag)
..} =
    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 Text
meetingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
externalUserId

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

instance Data.ToJSON CreateAttendee where
  toJSON :: CreateAttendee -> Value
toJSON CreateAttendee' {Maybe (NonEmpty Tag)
Text
Sensitive Text
externalUserId :: Sensitive Text
meetingId :: Text
tags :: Maybe (NonEmpty Tag)
$sel:externalUserId:CreateAttendee' :: CreateAttendee -> Sensitive Text
$sel:meetingId:CreateAttendee' :: CreateAttendee -> Text
$sel:tags:CreateAttendee' :: CreateAttendee -> Maybe (NonEmpty Tag)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"ExternalUserId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
externalUserId)
          ]
      )

instance Data.ToPath CreateAttendee where
  toPath :: CreateAttendee -> ByteString
toPath CreateAttendee' {Maybe (NonEmpty Tag)
Text
Sensitive Text
externalUserId :: Sensitive Text
meetingId :: Text
tags :: Maybe (NonEmpty Tag)
$sel:externalUserId:CreateAttendee' :: CreateAttendee -> Sensitive Text
$sel:meetingId:CreateAttendee' :: CreateAttendee -> Text
$sel:tags:CreateAttendee' :: CreateAttendee -> Maybe (NonEmpty Tag)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/meetings/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
meetingId, ByteString
"/attendees"]

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

-- | /See:/ 'newCreateAttendeeResponse' smart constructor.
data CreateAttendeeResponse = CreateAttendeeResponse'
  { -- | The attendee information, including attendee ID and join token.
    CreateAttendeeResponse -> Maybe Attendee
attendee :: Prelude.Maybe Attendee,
    -- | The response's http status code.
    CreateAttendeeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateAttendeeResponse -> CreateAttendeeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAttendeeResponse -> CreateAttendeeResponse -> Bool
$c/= :: CreateAttendeeResponse -> CreateAttendeeResponse -> Bool
== :: CreateAttendeeResponse -> CreateAttendeeResponse -> Bool
$c== :: CreateAttendeeResponse -> CreateAttendeeResponse -> Bool
Prelude.Eq, Int -> CreateAttendeeResponse -> ShowS
[CreateAttendeeResponse] -> ShowS
CreateAttendeeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAttendeeResponse] -> ShowS
$cshowList :: [CreateAttendeeResponse] -> ShowS
show :: CreateAttendeeResponse -> String
$cshow :: CreateAttendeeResponse -> String
showsPrec :: Int -> CreateAttendeeResponse -> ShowS
$cshowsPrec :: Int -> CreateAttendeeResponse -> ShowS
Prelude.Show, forall x. Rep CreateAttendeeResponse x -> CreateAttendeeResponse
forall x. CreateAttendeeResponse -> Rep CreateAttendeeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAttendeeResponse x -> CreateAttendeeResponse
$cfrom :: forall x. CreateAttendeeResponse -> Rep CreateAttendeeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAttendeeResponse' 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:
--
-- 'attendee', 'createAttendeeResponse_attendee' - The attendee information, including attendee ID and join token.
--
-- 'httpStatus', 'createAttendeeResponse_httpStatus' - The response's http status code.
newCreateAttendeeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAttendeeResponse
newCreateAttendeeResponse :: Int -> CreateAttendeeResponse
newCreateAttendeeResponse Int
pHttpStatus_ =
  CreateAttendeeResponse'
    { $sel:attendee:CreateAttendeeResponse' :: Maybe Attendee
attendee = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAttendeeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The attendee information, including attendee ID and join token.
createAttendeeResponse_attendee :: Lens.Lens' CreateAttendeeResponse (Prelude.Maybe Attendee)
createAttendeeResponse_attendee :: Lens' CreateAttendeeResponse (Maybe Attendee)
createAttendeeResponse_attendee = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttendeeResponse' {Maybe Attendee
attendee :: Maybe Attendee
$sel:attendee:CreateAttendeeResponse' :: CreateAttendeeResponse -> Maybe Attendee
attendee} -> Maybe Attendee
attendee) (\s :: CreateAttendeeResponse
s@CreateAttendeeResponse' {} Maybe Attendee
a -> CreateAttendeeResponse
s {$sel:attendee:CreateAttendeeResponse' :: Maybe Attendee
attendee = Maybe Attendee
a} :: CreateAttendeeResponse)

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

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