{-# 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.CreateChannelModerator
-- 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 @ChannelModerator@. A channel moderator can:
--
-- -   Add and remove other members of the channel.
--
-- -   Add and remove other moderators of the channel.
--
-- -   Add and remove user bans for the channel.
--
-- -   Redact messages in the channel.
--
-- -   List messages in the channel.
--
-- The @x-amz-chime-bearer@ request header is mandatory. Use the
-- @AppInstanceUserArn@ of the user that makes the API call as the value in
-- the header.
module Amazonka.Chime.CreateChannelModerator
  ( -- * Creating a Request
    CreateChannelModerator (..),
    newCreateChannelModerator,

    -- * Request Lenses
    createChannelModerator_chimeBearer,
    createChannelModerator_channelArn,
    createChannelModerator_channelModeratorArn,

    -- * Destructuring the Response
    CreateChannelModeratorResponse (..),
    newCreateChannelModeratorResponse,

    -- * Response Lenses
    createChannelModeratorResponse_channelArn,
    createChannelModeratorResponse_channelModerator,
    createChannelModeratorResponse_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:/ 'newCreateChannelModerator' smart constructor.
data CreateChannelModerator = CreateChannelModerator'
  { -- | The @AppInstanceUserArn@ of the user that makes the API call.
    CreateChannelModerator -> Maybe Text
chimeBearer :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the channel.
    CreateChannelModerator -> Text
channelArn :: Prelude.Text,
    -- | The ARN of the moderator.
    CreateChannelModerator -> Text
channelModeratorArn :: Prelude.Text
  }
  deriving (CreateChannelModerator -> CreateChannelModerator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChannelModerator -> CreateChannelModerator -> Bool
$c/= :: CreateChannelModerator -> CreateChannelModerator -> Bool
== :: CreateChannelModerator -> CreateChannelModerator -> Bool
$c== :: CreateChannelModerator -> CreateChannelModerator -> Bool
Prelude.Eq, ReadPrec [CreateChannelModerator]
ReadPrec CreateChannelModerator
Int -> ReadS CreateChannelModerator
ReadS [CreateChannelModerator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateChannelModerator]
$creadListPrec :: ReadPrec [CreateChannelModerator]
readPrec :: ReadPrec CreateChannelModerator
$creadPrec :: ReadPrec CreateChannelModerator
readList :: ReadS [CreateChannelModerator]
$creadList :: ReadS [CreateChannelModerator]
readsPrec :: Int -> ReadS CreateChannelModerator
$creadsPrec :: Int -> ReadS CreateChannelModerator
Prelude.Read, Int -> CreateChannelModerator -> ShowS
[CreateChannelModerator] -> ShowS
CreateChannelModerator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChannelModerator] -> ShowS
$cshowList :: [CreateChannelModerator] -> ShowS
show :: CreateChannelModerator -> String
$cshow :: CreateChannelModerator -> String
showsPrec :: Int -> CreateChannelModerator -> ShowS
$cshowsPrec :: Int -> CreateChannelModerator -> ShowS
Prelude.Show, forall x. Rep CreateChannelModerator x -> CreateChannelModerator
forall x. CreateChannelModerator -> Rep CreateChannelModerator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateChannelModerator x -> CreateChannelModerator
$cfrom :: forall x. CreateChannelModerator -> Rep CreateChannelModerator x
Prelude.Generic)

-- |
-- Create a value of 'CreateChannelModerator' 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:
--
-- 'chimeBearer', 'createChannelModerator_chimeBearer' - The @AppInstanceUserArn@ of the user that makes the API call.
--
-- 'channelArn', 'createChannelModerator_channelArn' - The ARN of the channel.
--
-- 'channelModeratorArn', 'createChannelModerator_channelModeratorArn' - The ARN of the moderator.
newCreateChannelModerator ::
  -- | 'channelArn'
  Prelude.Text ->
  -- | 'channelModeratorArn'
  Prelude.Text ->
  CreateChannelModerator
newCreateChannelModerator :: Text -> Text -> CreateChannelModerator
newCreateChannelModerator
  Text
pChannelArn_
  Text
pChannelModeratorArn_ =
    CreateChannelModerator'
      { $sel:chimeBearer:CreateChannelModerator' :: Maybe Text
chimeBearer =
          forall a. Maybe a
Prelude.Nothing,
        $sel:channelArn:CreateChannelModerator' :: Text
channelArn = Text
pChannelArn_,
        $sel:channelModeratorArn:CreateChannelModerator' :: Text
channelModeratorArn = Text
pChannelModeratorArn_
      }

-- | The @AppInstanceUserArn@ of the user that makes the API call.
createChannelModerator_chimeBearer :: Lens.Lens' CreateChannelModerator (Prelude.Maybe Prelude.Text)
createChannelModerator_chimeBearer :: Lens' CreateChannelModerator (Maybe Text)
createChannelModerator_chimeBearer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelModerator' {Maybe Text
chimeBearer :: Maybe Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
chimeBearer} -> Maybe Text
chimeBearer) (\s :: CreateChannelModerator
s@CreateChannelModerator' {} Maybe Text
a -> CreateChannelModerator
s {$sel:chimeBearer:CreateChannelModerator' :: Maybe Text
chimeBearer = Maybe Text
a} :: CreateChannelModerator)

-- | The ARN of the channel.
createChannelModerator_channelArn :: Lens.Lens' CreateChannelModerator Prelude.Text
createChannelModerator_channelArn :: Lens' CreateChannelModerator Text
createChannelModerator_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelModerator' {Text
channelArn :: Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
channelArn} -> Text
channelArn) (\s :: CreateChannelModerator
s@CreateChannelModerator' {} Text
a -> CreateChannelModerator
s {$sel:channelArn:CreateChannelModerator' :: Text
channelArn = Text
a} :: CreateChannelModerator)

-- | The ARN of the moderator.
createChannelModerator_channelModeratorArn :: Lens.Lens' CreateChannelModerator Prelude.Text
createChannelModerator_channelModeratorArn :: Lens' CreateChannelModerator Text
createChannelModerator_channelModeratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelModerator' {Text
channelModeratorArn :: Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
channelModeratorArn} -> Text
channelModeratorArn) (\s :: CreateChannelModerator
s@CreateChannelModerator' {} Text
a -> CreateChannelModerator
s {$sel:channelModeratorArn:CreateChannelModerator' :: Text
channelModeratorArn = Text
a} :: CreateChannelModerator)

instance Core.AWSRequest CreateChannelModerator where
  type
    AWSResponse CreateChannelModerator =
      CreateChannelModeratorResponse
  request :: (Service -> Service)
-> CreateChannelModerator -> Request CreateChannelModerator
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 CreateChannelModerator
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateChannelModerator)))
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 Text
-> Maybe Identity -> Int -> CreateChannelModeratorResponse
CreateChannelModeratorResponse'
            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
"ChannelArn")
            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
"ChannelModerator")
            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 CreateChannelModerator where
  hashWithSalt :: Int -> CreateChannelModerator -> Int
hashWithSalt Int
_salt CreateChannelModerator' {Maybe Text
Text
channelModeratorArn :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
chimeBearer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelModeratorArn

instance Prelude.NFData CreateChannelModerator where
  rnf :: CreateChannelModerator -> ()
rnf CreateChannelModerator' {Maybe Text
Text
channelModeratorArn :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
chimeBearer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelModeratorArn

instance Data.ToHeaders CreateChannelModerator where
  toHeaders :: CreateChannelModerator -> ResponseHeaders
toHeaders CreateChannelModerator' {Maybe Text
Text
channelModeratorArn :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-chime-bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
chimeBearer]

instance Data.ToJSON CreateChannelModerator where
  toJSON :: CreateChannelModerator -> Value
toJSON CreateChannelModerator' {Maybe Text
Text
channelModeratorArn :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ChannelModeratorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelModeratorArn)
          ]
      )

instance Data.ToPath CreateChannelModerator where
  toPath :: CreateChannelModerator -> ByteString
toPath CreateChannelModerator' {Maybe Text
Text
channelModeratorArn :: Text
channelArn :: Text
chimeBearer :: Maybe Text
$sel:channelModeratorArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:channelArn:CreateChannelModerator' :: CreateChannelModerator -> Text
$sel:chimeBearer:CreateChannelModerator' :: CreateChannelModerator -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/channels/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelArn, ByteString
"/moderators"]

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

-- | /See:/ 'newCreateChannelModeratorResponse' smart constructor.
data CreateChannelModeratorResponse = CreateChannelModeratorResponse'
  { -- | The ARN of the channel.
    CreateChannelModeratorResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the channel and the moderator.
    CreateChannelModeratorResponse -> Maybe Identity
channelModerator :: Prelude.Maybe Identity,
    -- | The response's http status code.
    CreateChannelModeratorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateChannelModeratorResponse
-> CreateChannelModeratorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateChannelModeratorResponse
-> CreateChannelModeratorResponse -> Bool
$c/= :: CreateChannelModeratorResponse
-> CreateChannelModeratorResponse -> Bool
== :: CreateChannelModeratorResponse
-> CreateChannelModeratorResponse -> Bool
$c== :: CreateChannelModeratorResponse
-> CreateChannelModeratorResponse -> Bool
Prelude.Eq, Int -> CreateChannelModeratorResponse -> ShowS
[CreateChannelModeratorResponse] -> ShowS
CreateChannelModeratorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChannelModeratorResponse] -> ShowS
$cshowList :: [CreateChannelModeratorResponse] -> ShowS
show :: CreateChannelModeratorResponse -> String
$cshow :: CreateChannelModeratorResponse -> String
showsPrec :: Int -> CreateChannelModeratorResponse -> ShowS
$cshowsPrec :: Int -> CreateChannelModeratorResponse -> ShowS
Prelude.Show, forall x.
Rep CreateChannelModeratorResponse x
-> CreateChannelModeratorResponse
forall x.
CreateChannelModeratorResponse
-> Rep CreateChannelModeratorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateChannelModeratorResponse x
-> CreateChannelModeratorResponse
$cfrom :: forall x.
CreateChannelModeratorResponse
-> Rep CreateChannelModeratorResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateChannelModeratorResponse' 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:
--
-- 'channelArn', 'createChannelModeratorResponse_channelArn' - The ARN of the channel.
--
-- 'channelModerator', 'createChannelModeratorResponse_channelModerator' - The ARNs of the channel and the moderator.
--
-- 'httpStatus', 'createChannelModeratorResponse_httpStatus' - The response's http status code.
newCreateChannelModeratorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateChannelModeratorResponse
newCreateChannelModeratorResponse :: Int -> CreateChannelModeratorResponse
newCreateChannelModeratorResponse Int
pHttpStatus_ =
  CreateChannelModeratorResponse'
    { $sel:channelArn:CreateChannelModeratorResponse' :: Maybe Text
channelArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:channelModerator:CreateChannelModeratorResponse' :: Maybe Identity
channelModerator = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateChannelModeratorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the channel.
createChannelModeratorResponse_channelArn :: Lens.Lens' CreateChannelModeratorResponse (Prelude.Maybe Prelude.Text)
createChannelModeratorResponse_channelArn :: Lens' CreateChannelModeratorResponse (Maybe Text)
createChannelModeratorResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelModeratorResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:CreateChannelModeratorResponse' :: CreateChannelModeratorResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: CreateChannelModeratorResponse
s@CreateChannelModeratorResponse' {} Maybe Text
a -> CreateChannelModeratorResponse
s {$sel:channelArn:CreateChannelModeratorResponse' :: Maybe Text
channelArn = Maybe Text
a} :: CreateChannelModeratorResponse)

-- | The ARNs of the channel and the moderator.
createChannelModeratorResponse_channelModerator :: Lens.Lens' CreateChannelModeratorResponse (Prelude.Maybe Identity)
createChannelModeratorResponse_channelModerator :: Lens' CreateChannelModeratorResponse (Maybe Identity)
createChannelModeratorResponse_channelModerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateChannelModeratorResponse' {Maybe Identity
channelModerator :: Maybe Identity
$sel:channelModerator:CreateChannelModeratorResponse' :: CreateChannelModeratorResponse -> Maybe Identity
channelModerator} -> Maybe Identity
channelModerator) (\s :: CreateChannelModeratorResponse
s@CreateChannelModeratorResponse' {} Maybe Identity
a -> CreateChannelModeratorResponse
s {$sel:channelModerator:CreateChannelModeratorResponse' :: Maybe Identity
channelModerator = Maybe Identity
a} :: CreateChannelModeratorResponse)

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

instance
  Prelude.NFData
    CreateChannelModeratorResponse
  where
  rnf :: CreateChannelModeratorResponse -> ()
rnf CreateChannelModeratorResponse' {Int
Maybe Text
Maybe Identity
httpStatus :: Int
channelModerator :: Maybe Identity
channelArn :: Maybe Text
$sel:httpStatus:CreateChannelModeratorResponse' :: CreateChannelModeratorResponse -> Int
$sel:channelModerator:CreateChannelModeratorResponse' :: CreateChannelModeratorResponse -> Maybe Identity
$sel:channelArn:CreateChannelModeratorResponse' :: CreateChannelModeratorResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Identity
channelModerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus