{-# 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.BatchCreateChannelMembership
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a specified number of users to a channel.
module Amazonka.Chime.BatchCreateChannelMembership
  ( -- * Creating a Request
    BatchCreateChannelMembership (..),
    newBatchCreateChannelMembership,

    -- * Request Lenses
    batchCreateChannelMembership_chimeBearer,
    batchCreateChannelMembership_type,
    batchCreateChannelMembership_channelArn,
    batchCreateChannelMembership_memberArns,

    -- * Destructuring the Response
    BatchCreateChannelMembershipResponse (..),
    newBatchCreateChannelMembershipResponse,

    -- * Response Lenses
    batchCreateChannelMembershipResponse_batchChannelMemberships,
    batchCreateChannelMembershipResponse_errors,
    batchCreateChannelMembershipResponse_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:/ 'newBatchCreateChannelMembership' smart constructor.
data BatchCreateChannelMembership = BatchCreateChannelMembership'
  { -- | The @AppInstanceUserArn@ of the user that makes the API call.
    BatchCreateChannelMembership -> Maybe Text
chimeBearer :: Prelude.Maybe Prelude.Text,
    -- | The membership type of a user, @DEFAULT@ or @HIDDEN@. Default members
    -- are always returned as part of @ListChannelMemberships@. Hidden members
    -- are only returned if the type filter in @ListChannelMemberships@ equals
    -- @HIDDEN@. Otherwise hidden members are not returned. This is only
    -- supported by moderators.
    BatchCreateChannelMembership -> Maybe ChannelMembershipType
type' :: Prelude.Maybe ChannelMembershipType,
    -- | The ARN of the channel to which you\'re adding users.
    BatchCreateChannelMembership -> Text
channelArn :: Prelude.Text,
    -- | The ARNs of the members you want to add to the channel.
    BatchCreateChannelMembership -> NonEmpty Text
memberArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchCreateChannelMembership
-> BatchCreateChannelMembership -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchCreateChannelMembership
-> BatchCreateChannelMembership -> Bool
$c/= :: BatchCreateChannelMembership
-> BatchCreateChannelMembership -> Bool
== :: BatchCreateChannelMembership
-> BatchCreateChannelMembership -> Bool
$c== :: BatchCreateChannelMembership
-> BatchCreateChannelMembership -> Bool
Prelude.Eq, ReadPrec [BatchCreateChannelMembership]
ReadPrec BatchCreateChannelMembership
Int -> ReadS BatchCreateChannelMembership
ReadS [BatchCreateChannelMembership]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchCreateChannelMembership]
$creadListPrec :: ReadPrec [BatchCreateChannelMembership]
readPrec :: ReadPrec BatchCreateChannelMembership
$creadPrec :: ReadPrec BatchCreateChannelMembership
readList :: ReadS [BatchCreateChannelMembership]
$creadList :: ReadS [BatchCreateChannelMembership]
readsPrec :: Int -> ReadS BatchCreateChannelMembership
$creadsPrec :: Int -> ReadS BatchCreateChannelMembership
Prelude.Read, Int -> BatchCreateChannelMembership -> ShowS
[BatchCreateChannelMembership] -> ShowS
BatchCreateChannelMembership -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchCreateChannelMembership] -> ShowS
$cshowList :: [BatchCreateChannelMembership] -> ShowS
show :: BatchCreateChannelMembership -> String
$cshow :: BatchCreateChannelMembership -> String
showsPrec :: Int -> BatchCreateChannelMembership -> ShowS
$cshowsPrec :: Int -> BatchCreateChannelMembership -> ShowS
Prelude.Show, forall x.
Rep BatchCreateChannelMembership x -> BatchCreateChannelMembership
forall x.
BatchCreateChannelMembership -> Rep BatchCreateChannelMembership x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchCreateChannelMembership x -> BatchCreateChannelMembership
$cfrom :: forall x.
BatchCreateChannelMembership -> Rep BatchCreateChannelMembership x
Prelude.Generic)

-- |
-- Create a value of 'BatchCreateChannelMembership' 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', 'batchCreateChannelMembership_chimeBearer' - The @AppInstanceUserArn@ of the user that makes the API call.
--
-- 'type'', 'batchCreateChannelMembership_type' - The membership type of a user, @DEFAULT@ or @HIDDEN@. Default members
-- are always returned as part of @ListChannelMemberships@. Hidden members
-- are only returned if the type filter in @ListChannelMemberships@ equals
-- @HIDDEN@. Otherwise hidden members are not returned. This is only
-- supported by moderators.
--
-- 'channelArn', 'batchCreateChannelMembership_channelArn' - The ARN of the channel to which you\'re adding users.
--
-- 'memberArns', 'batchCreateChannelMembership_memberArns' - The ARNs of the members you want to add to the channel.
newBatchCreateChannelMembership ::
  -- | 'channelArn'
  Prelude.Text ->
  -- | 'memberArns'
  Prelude.NonEmpty Prelude.Text ->
  BatchCreateChannelMembership
newBatchCreateChannelMembership :: Text -> NonEmpty Text -> BatchCreateChannelMembership
newBatchCreateChannelMembership
  Text
pChannelArn_
  NonEmpty Text
pMemberArns_ =
    BatchCreateChannelMembership'
      { $sel:chimeBearer:BatchCreateChannelMembership' :: Maybe Text
chimeBearer =
          forall a. Maybe a
Prelude.Nothing,
        $sel:type':BatchCreateChannelMembership' :: Maybe ChannelMembershipType
type' = forall a. Maybe a
Prelude.Nothing,
        $sel:channelArn:BatchCreateChannelMembership' :: Text
channelArn = Text
pChannelArn_,
        $sel:memberArns:BatchCreateChannelMembership' :: NonEmpty Text
memberArns = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pMemberArns_
      }

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

-- | The membership type of a user, @DEFAULT@ or @HIDDEN@. Default members
-- are always returned as part of @ListChannelMemberships@. Hidden members
-- are only returned if the type filter in @ListChannelMemberships@ equals
-- @HIDDEN@. Otherwise hidden members are not returned. This is only
-- supported by moderators.
batchCreateChannelMembership_type :: Lens.Lens' BatchCreateChannelMembership (Prelude.Maybe ChannelMembershipType)
batchCreateChannelMembership_type :: Lens' BatchCreateChannelMembership (Maybe ChannelMembershipType)
batchCreateChannelMembership_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembership' {Maybe ChannelMembershipType
type' :: Maybe ChannelMembershipType
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
type'} -> Maybe ChannelMembershipType
type') (\s :: BatchCreateChannelMembership
s@BatchCreateChannelMembership' {} Maybe ChannelMembershipType
a -> BatchCreateChannelMembership
s {$sel:type':BatchCreateChannelMembership' :: Maybe ChannelMembershipType
type' = Maybe ChannelMembershipType
a} :: BatchCreateChannelMembership)

-- | The ARN of the channel to which you\'re adding users.
batchCreateChannelMembership_channelArn :: Lens.Lens' BatchCreateChannelMembership Prelude.Text
batchCreateChannelMembership_channelArn :: Lens' BatchCreateChannelMembership Text
batchCreateChannelMembership_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembership' {Text
channelArn :: Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
channelArn} -> Text
channelArn) (\s :: BatchCreateChannelMembership
s@BatchCreateChannelMembership' {} Text
a -> BatchCreateChannelMembership
s {$sel:channelArn:BatchCreateChannelMembership' :: Text
channelArn = Text
a} :: BatchCreateChannelMembership)

-- | The ARNs of the members you want to add to the channel.
batchCreateChannelMembership_memberArns :: Lens.Lens' BatchCreateChannelMembership (Prelude.NonEmpty Prelude.Text)
batchCreateChannelMembership_memberArns :: Lens' BatchCreateChannelMembership (NonEmpty Text)
batchCreateChannelMembership_memberArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembership' {NonEmpty Text
memberArns :: NonEmpty Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
memberArns} -> NonEmpty Text
memberArns) (\s :: BatchCreateChannelMembership
s@BatchCreateChannelMembership' {} NonEmpty Text
a -> BatchCreateChannelMembership
s {$sel:memberArns:BatchCreateChannelMembership' :: NonEmpty Text
memberArns = NonEmpty Text
a} :: BatchCreateChannelMembership) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchCreateChannelMembership where
  type
    AWSResponse BatchCreateChannelMembership =
      BatchCreateChannelMembershipResponse
  request :: (Service -> Service)
-> BatchCreateChannelMembership
-> Request BatchCreateChannelMembership
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 BatchCreateChannelMembership
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchCreateChannelMembership)))
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 BatchChannelMemberships
-> Maybe [BatchCreateChannelMembershipError]
-> Int
-> BatchCreateChannelMembershipResponse
BatchCreateChannelMembershipResponse'
            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
"BatchChannelMemberships")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    BatchCreateChannelMembership
  where
  hashWithSalt :: Int -> BatchCreateChannelMembership -> Int
hashWithSalt Int
_salt BatchCreateChannelMembership' {Maybe Text
Maybe ChannelMembershipType
NonEmpty Text
Text
memberArns :: NonEmpty Text
channelArn :: Text
type' :: Maybe ChannelMembershipType
chimeBearer :: Maybe Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
$sel:chimeBearer:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> 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` Maybe ChannelMembershipType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
memberArns

instance Prelude.NFData BatchCreateChannelMembership where
  rnf :: BatchCreateChannelMembership -> ()
rnf BatchCreateChannelMembership' {Maybe Text
Maybe ChannelMembershipType
NonEmpty Text
Text
memberArns :: NonEmpty Text
channelArn :: Text
type' :: Maybe ChannelMembershipType
chimeBearer :: Maybe Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
$sel:chimeBearer:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> 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 Maybe ChannelMembershipType
type'
      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 NonEmpty Text
memberArns

instance Data.ToHeaders BatchCreateChannelMembership where
  toHeaders :: BatchCreateChannelMembership -> ResponseHeaders
toHeaders BatchCreateChannelMembership' {Maybe Text
Maybe ChannelMembershipType
NonEmpty Text
Text
memberArns :: NonEmpty Text
channelArn :: Text
type' :: Maybe ChannelMembershipType
chimeBearer :: Maybe Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
$sel:chimeBearer:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> 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 BatchCreateChannelMembership where
  toJSON :: BatchCreateChannelMembership -> Value
toJSON BatchCreateChannelMembership' {Maybe Text
Maybe ChannelMembershipType
NonEmpty Text
Text
memberArns :: NonEmpty Text
channelArn :: Text
type' :: Maybe ChannelMembershipType
chimeBearer :: Maybe Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
$sel:chimeBearer:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Type" 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 ChannelMembershipType
type',
            forall a. a -> Maybe a
Prelude.Just (Key
"MemberArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
memberArns)
          ]
      )

instance Data.ToPath BatchCreateChannelMembership where
  toPath :: BatchCreateChannelMembership -> ByteString
toPath BatchCreateChannelMembership' {Maybe Text
Maybe ChannelMembershipType
NonEmpty Text
Text
memberArns :: NonEmpty Text
channelArn :: Text
type' :: Maybe ChannelMembershipType
chimeBearer :: Maybe Text
$sel:memberArns:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> NonEmpty Text
$sel:channelArn:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Text
$sel:type':BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe ChannelMembershipType
$sel:chimeBearer:BatchCreateChannelMembership' :: BatchCreateChannelMembership -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/channels/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelArn, ByteString
"/memberships"]

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

-- | /See:/ 'newBatchCreateChannelMembershipResponse' smart constructor.
data BatchCreateChannelMembershipResponse = BatchCreateChannelMembershipResponse'
  { -- | The list of channel memberships in the response.
    BatchCreateChannelMembershipResponse
-> Maybe BatchChannelMemberships
batchChannelMemberships :: Prelude.Maybe BatchChannelMemberships,
    -- | If the action fails for one or more of the memberships in the request, a
    -- list of the memberships is returned, along with error codes and error
    -- messages.
    BatchCreateChannelMembershipResponse
-> Maybe [BatchCreateChannelMembershipError]
errors :: Prelude.Maybe [BatchCreateChannelMembershipError],
    -- | The response's http status code.
    BatchCreateChannelMembershipResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchCreateChannelMembershipResponse
-> BatchCreateChannelMembershipResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchCreateChannelMembershipResponse
-> BatchCreateChannelMembershipResponse -> Bool
$c/= :: BatchCreateChannelMembershipResponse
-> BatchCreateChannelMembershipResponse -> Bool
== :: BatchCreateChannelMembershipResponse
-> BatchCreateChannelMembershipResponse -> Bool
$c== :: BatchCreateChannelMembershipResponse
-> BatchCreateChannelMembershipResponse -> Bool
Prelude.Eq, Int -> BatchCreateChannelMembershipResponse -> ShowS
[BatchCreateChannelMembershipResponse] -> ShowS
BatchCreateChannelMembershipResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchCreateChannelMembershipResponse] -> ShowS
$cshowList :: [BatchCreateChannelMembershipResponse] -> ShowS
show :: BatchCreateChannelMembershipResponse -> String
$cshow :: BatchCreateChannelMembershipResponse -> String
showsPrec :: Int -> BatchCreateChannelMembershipResponse -> ShowS
$cshowsPrec :: Int -> BatchCreateChannelMembershipResponse -> ShowS
Prelude.Show, forall x.
Rep BatchCreateChannelMembershipResponse x
-> BatchCreateChannelMembershipResponse
forall x.
BatchCreateChannelMembershipResponse
-> Rep BatchCreateChannelMembershipResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchCreateChannelMembershipResponse x
-> BatchCreateChannelMembershipResponse
$cfrom :: forall x.
BatchCreateChannelMembershipResponse
-> Rep BatchCreateChannelMembershipResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchCreateChannelMembershipResponse' 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:
--
-- 'batchChannelMemberships', 'batchCreateChannelMembershipResponse_batchChannelMemberships' - The list of channel memberships in the response.
--
-- 'errors', 'batchCreateChannelMembershipResponse_errors' - If the action fails for one or more of the memberships in the request, a
-- list of the memberships is returned, along with error codes and error
-- messages.
--
-- 'httpStatus', 'batchCreateChannelMembershipResponse_httpStatus' - The response's http status code.
newBatchCreateChannelMembershipResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchCreateChannelMembershipResponse
newBatchCreateChannelMembershipResponse :: Int -> BatchCreateChannelMembershipResponse
newBatchCreateChannelMembershipResponse Int
pHttpStatus_ =
  BatchCreateChannelMembershipResponse'
    { $sel:batchChannelMemberships:BatchCreateChannelMembershipResponse' :: Maybe BatchChannelMemberships
batchChannelMemberships =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errors:BatchCreateChannelMembershipResponse' :: Maybe [BatchCreateChannelMembershipError]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchCreateChannelMembershipResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of channel memberships in the response.
batchCreateChannelMembershipResponse_batchChannelMemberships :: Lens.Lens' BatchCreateChannelMembershipResponse (Prelude.Maybe BatchChannelMemberships)
batchCreateChannelMembershipResponse_batchChannelMemberships :: Lens'
  BatchCreateChannelMembershipResponse
  (Maybe BatchChannelMemberships)
batchCreateChannelMembershipResponse_batchChannelMemberships = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembershipResponse' {Maybe BatchChannelMemberships
batchChannelMemberships :: Maybe BatchChannelMemberships
$sel:batchChannelMemberships:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse
-> Maybe BatchChannelMemberships
batchChannelMemberships} -> Maybe BatchChannelMemberships
batchChannelMemberships) (\s :: BatchCreateChannelMembershipResponse
s@BatchCreateChannelMembershipResponse' {} Maybe BatchChannelMemberships
a -> BatchCreateChannelMembershipResponse
s {$sel:batchChannelMemberships:BatchCreateChannelMembershipResponse' :: Maybe BatchChannelMemberships
batchChannelMemberships = Maybe BatchChannelMemberships
a} :: BatchCreateChannelMembershipResponse)

-- | If the action fails for one or more of the memberships in the request, a
-- list of the memberships is returned, along with error codes and error
-- messages.
batchCreateChannelMembershipResponse_errors :: Lens.Lens' BatchCreateChannelMembershipResponse (Prelude.Maybe [BatchCreateChannelMembershipError])
batchCreateChannelMembershipResponse_errors :: Lens'
  BatchCreateChannelMembershipResponse
  (Maybe [BatchCreateChannelMembershipError])
batchCreateChannelMembershipResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembershipResponse' {Maybe [BatchCreateChannelMembershipError]
errors :: Maybe [BatchCreateChannelMembershipError]
$sel:errors:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse
-> Maybe [BatchCreateChannelMembershipError]
errors} -> Maybe [BatchCreateChannelMembershipError]
errors) (\s :: BatchCreateChannelMembershipResponse
s@BatchCreateChannelMembershipResponse' {} Maybe [BatchCreateChannelMembershipError]
a -> BatchCreateChannelMembershipResponse
s {$sel:errors:BatchCreateChannelMembershipResponse' :: Maybe [BatchCreateChannelMembershipError]
errors = Maybe [BatchCreateChannelMembershipError]
a} :: BatchCreateChannelMembershipResponse) 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 response's http status code.
batchCreateChannelMembershipResponse_httpStatus :: Lens.Lens' BatchCreateChannelMembershipResponse Prelude.Int
batchCreateChannelMembershipResponse_httpStatus :: Lens' BatchCreateChannelMembershipResponse Int
batchCreateChannelMembershipResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchCreateChannelMembershipResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchCreateChannelMembershipResponse
s@BatchCreateChannelMembershipResponse' {} Int
a -> BatchCreateChannelMembershipResponse
s {$sel:httpStatus:BatchCreateChannelMembershipResponse' :: Int
httpStatus = Int
a} :: BatchCreateChannelMembershipResponse)

instance
  Prelude.NFData
    BatchCreateChannelMembershipResponse
  where
  rnf :: BatchCreateChannelMembershipResponse -> ()
rnf BatchCreateChannelMembershipResponse' {Int
Maybe [BatchCreateChannelMembershipError]
Maybe BatchChannelMemberships
httpStatus :: Int
errors :: Maybe [BatchCreateChannelMembershipError]
batchChannelMemberships :: Maybe BatchChannelMemberships
$sel:httpStatus:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse -> Int
$sel:errors:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse
-> Maybe [BatchCreateChannelMembershipError]
$sel:batchChannelMemberships:BatchCreateChannelMembershipResponse' :: BatchCreateChannelMembershipResponse
-> Maybe BatchChannelMemberships
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchChannelMemberships
batchChannelMemberships
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BatchCreateChannelMembershipError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus