{-# 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.IoTWireless.CreateMulticastGroup
-- 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 multicast group.
module Amazonka.IoTWireless.CreateMulticastGroup
  ( -- * Creating a Request
    CreateMulticastGroup (..),
    newCreateMulticastGroup,

    -- * Request Lenses
    createMulticastGroup_clientRequestToken,
    createMulticastGroup_description,
    createMulticastGroup_name,
    createMulticastGroup_tags,
    createMulticastGroup_loRaWAN,

    -- * Destructuring the Response
    CreateMulticastGroupResponse (..),
    newCreateMulticastGroupResponse,

    -- * Response Lenses
    createMulticastGroupResponse_arn,
    createMulticastGroupResponse_id,
    createMulticastGroupResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTWireless.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateMulticastGroup' smart constructor.
data CreateMulticastGroup = CreateMulticastGroup'
  { -- | Each resource must have a unique client request token. If you try to
    -- create a new resource with the same token as a resource that already
    -- exists, an exception occurs. If you omit this value, AWS SDKs will
    -- automatically generate a unique client request.
    CreateMulticastGroup -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The description of the multicast group.
    CreateMulticastGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    CreateMulticastGroup -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    CreateMulticastGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    CreateMulticastGroup -> LoRaWANMulticast
loRaWAN :: LoRaWANMulticast
  }
  deriving (CreateMulticastGroup -> CreateMulticastGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMulticastGroup -> CreateMulticastGroup -> Bool
$c/= :: CreateMulticastGroup -> CreateMulticastGroup -> Bool
== :: CreateMulticastGroup -> CreateMulticastGroup -> Bool
$c== :: CreateMulticastGroup -> CreateMulticastGroup -> Bool
Prelude.Eq, ReadPrec [CreateMulticastGroup]
ReadPrec CreateMulticastGroup
Int -> ReadS CreateMulticastGroup
ReadS [CreateMulticastGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMulticastGroup]
$creadListPrec :: ReadPrec [CreateMulticastGroup]
readPrec :: ReadPrec CreateMulticastGroup
$creadPrec :: ReadPrec CreateMulticastGroup
readList :: ReadS [CreateMulticastGroup]
$creadList :: ReadS [CreateMulticastGroup]
readsPrec :: Int -> ReadS CreateMulticastGroup
$creadsPrec :: Int -> ReadS CreateMulticastGroup
Prelude.Read, Int -> CreateMulticastGroup -> ShowS
[CreateMulticastGroup] -> ShowS
CreateMulticastGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMulticastGroup] -> ShowS
$cshowList :: [CreateMulticastGroup] -> ShowS
show :: CreateMulticastGroup -> String
$cshow :: CreateMulticastGroup -> String
showsPrec :: Int -> CreateMulticastGroup -> ShowS
$cshowsPrec :: Int -> CreateMulticastGroup -> ShowS
Prelude.Show, forall x. Rep CreateMulticastGroup x -> CreateMulticastGroup
forall x. CreateMulticastGroup -> Rep CreateMulticastGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMulticastGroup x -> CreateMulticastGroup
$cfrom :: forall x. CreateMulticastGroup -> Rep CreateMulticastGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateMulticastGroup' 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:
--
-- 'clientRequestToken', 'createMulticastGroup_clientRequestToken' - Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
--
-- 'description', 'createMulticastGroup_description' - The description of the multicast group.
--
-- 'name', 'createMulticastGroup_name' - Undocumented member.
--
-- 'tags', 'createMulticastGroup_tags' - Undocumented member.
--
-- 'loRaWAN', 'createMulticastGroup_loRaWAN' - Undocumented member.
newCreateMulticastGroup ::
  -- | 'loRaWAN'
  LoRaWANMulticast ->
  CreateMulticastGroup
newCreateMulticastGroup :: LoRaWANMulticast -> CreateMulticastGroup
newCreateMulticastGroup LoRaWANMulticast
pLoRaWAN_ =
  CreateMulticastGroup'
    { $sel:clientRequestToken:CreateMulticastGroup' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateMulticastGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateMulticastGroup' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateMulticastGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:loRaWAN:CreateMulticastGroup' :: LoRaWANMulticast
loRaWAN = LoRaWANMulticast
pLoRaWAN_
    }

-- | Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
createMulticastGroup_clientRequestToken :: Lens.Lens' CreateMulticastGroup (Prelude.Maybe Prelude.Text)
createMulticastGroup_clientRequestToken :: Lens' CreateMulticastGroup (Maybe Text)
createMulticastGroup_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroup' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateMulticastGroup
s@CreateMulticastGroup' {} Maybe Text
a -> CreateMulticastGroup
s {$sel:clientRequestToken:CreateMulticastGroup' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateMulticastGroup)

-- | The description of the multicast group.
createMulticastGroup_description :: Lens.Lens' CreateMulticastGroup (Prelude.Maybe Prelude.Text)
createMulticastGroup_description :: Lens' CreateMulticastGroup (Maybe Text)
createMulticastGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroup' {Maybe Text
description :: Maybe Text
$sel:description:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateMulticastGroup
s@CreateMulticastGroup' {} Maybe Text
a -> CreateMulticastGroup
s {$sel:description:CreateMulticastGroup' :: Maybe Text
description = Maybe Text
a} :: CreateMulticastGroup)

-- | Undocumented member.
createMulticastGroup_name :: Lens.Lens' CreateMulticastGroup (Prelude.Maybe Prelude.Text)
createMulticastGroup_name :: Lens' CreateMulticastGroup (Maybe Text)
createMulticastGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroup' {Maybe Text
name :: Maybe Text
$sel:name:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateMulticastGroup
s@CreateMulticastGroup' {} Maybe Text
a -> CreateMulticastGroup
s {$sel:name:CreateMulticastGroup' :: Maybe Text
name = Maybe Text
a} :: CreateMulticastGroup)

-- | Undocumented member.
createMulticastGroup_tags :: Lens.Lens' CreateMulticastGroup (Prelude.Maybe [Tag])
createMulticastGroup_tags :: Lens' CreateMulticastGroup (Maybe [Tag])
createMulticastGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateMulticastGroup
s@CreateMulticastGroup' {} Maybe [Tag]
a -> CreateMulticastGroup
s {$sel:tags:CreateMulticastGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateMulticastGroup) 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.
createMulticastGroup_loRaWAN :: Lens.Lens' CreateMulticastGroup LoRaWANMulticast
createMulticastGroup_loRaWAN :: Lens' CreateMulticastGroup LoRaWANMulticast
createMulticastGroup_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroup' {LoRaWANMulticast
loRaWAN :: LoRaWANMulticast
$sel:loRaWAN:CreateMulticastGroup' :: CreateMulticastGroup -> LoRaWANMulticast
loRaWAN} -> LoRaWANMulticast
loRaWAN) (\s :: CreateMulticastGroup
s@CreateMulticastGroup' {} LoRaWANMulticast
a -> CreateMulticastGroup
s {$sel:loRaWAN:CreateMulticastGroup' :: LoRaWANMulticast
loRaWAN = LoRaWANMulticast
a} :: CreateMulticastGroup)

instance Core.AWSRequest CreateMulticastGroup where
  type
    AWSResponse CreateMulticastGroup =
      CreateMulticastGroupResponse
  request :: (Service -> Service)
-> CreateMulticastGroup -> Request CreateMulticastGroup
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 CreateMulticastGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMulticastGroup)))
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 Text -> Int -> CreateMulticastGroupResponse
CreateMulticastGroupResponse'
            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
"Arn")
            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
"Id")
            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 CreateMulticastGroup where
  hashWithSalt :: Int -> CreateMulticastGroup -> Int
hashWithSalt Int
_salt CreateMulticastGroup' {Maybe [Tag]
Maybe Text
LoRaWANMulticast
loRaWAN :: LoRaWANMulticast
tags :: Maybe [Tag]
name :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:loRaWAN:CreateMulticastGroup' :: CreateMulticastGroup -> LoRaWANMulticast
$sel:tags:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe [Tag]
$sel:name:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:description:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:clientRequestToken:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LoRaWANMulticast
loRaWAN

instance Prelude.NFData CreateMulticastGroup where
  rnf :: CreateMulticastGroup -> ()
rnf CreateMulticastGroup' {Maybe [Tag]
Maybe Text
LoRaWANMulticast
loRaWAN :: LoRaWANMulticast
tags :: Maybe [Tag]
name :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:loRaWAN:CreateMulticastGroup' :: CreateMulticastGroup -> LoRaWANMulticast
$sel:tags:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe [Tag]
$sel:name:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:description:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:clientRequestToken:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LoRaWANMulticast
loRaWAN

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

instance Data.ToJSON CreateMulticastGroup where
  toJSON :: CreateMulticastGroup -> Value
toJSON CreateMulticastGroup' {Maybe [Tag]
Maybe Text
LoRaWANMulticast
loRaWAN :: LoRaWANMulticast
tags :: Maybe [Tag]
name :: Maybe Text
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:loRaWAN:CreateMulticastGroup' :: CreateMulticastGroup -> LoRaWANMulticast
$sel:tags:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe [Tag]
$sel:name:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:description:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
$sel:clientRequestToken:CreateMulticastGroup' :: CreateMulticastGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"Description" 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
description,
            (Key
"Name" 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
name,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"LoRaWAN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LoRaWANMulticast
loRaWAN)
          ]
      )

instance Data.ToPath CreateMulticastGroup where
  toPath :: CreateMulticastGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/multicast-groups"

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

-- | /See:/ 'newCreateMulticastGroupResponse' smart constructor.
data CreateMulticastGroupResponse = CreateMulticastGroupResponse'
  { CreateMulticastGroupResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    CreateMulticastGroupResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateMulticastGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateMulticastGroupResponse
-> CreateMulticastGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMulticastGroupResponse
-> CreateMulticastGroupResponse -> Bool
$c/= :: CreateMulticastGroupResponse
-> CreateMulticastGroupResponse -> Bool
== :: CreateMulticastGroupResponse
-> CreateMulticastGroupResponse -> Bool
$c== :: CreateMulticastGroupResponse
-> CreateMulticastGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateMulticastGroupResponse]
ReadPrec CreateMulticastGroupResponse
Int -> ReadS CreateMulticastGroupResponse
ReadS [CreateMulticastGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMulticastGroupResponse]
$creadListPrec :: ReadPrec [CreateMulticastGroupResponse]
readPrec :: ReadPrec CreateMulticastGroupResponse
$creadPrec :: ReadPrec CreateMulticastGroupResponse
readList :: ReadS [CreateMulticastGroupResponse]
$creadList :: ReadS [CreateMulticastGroupResponse]
readsPrec :: Int -> ReadS CreateMulticastGroupResponse
$creadsPrec :: Int -> ReadS CreateMulticastGroupResponse
Prelude.Read, Int -> CreateMulticastGroupResponse -> ShowS
[CreateMulticastGroupResponse] -> ShowS
CreateMulticastGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMulticastGroupResponse] -> ShowS
$cshowList :: [CreateMulticastGroupResponse] -> ShowS
show :: CreateMulticastGroupResponse -> String
$cshow :: CreateMulticastGroupResponse -> String
showsPrec :: Int -> CreateMulticastGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateMulticastGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreateMulticastGroupResponse x -> CreateMulticastGroupResponse
forall x.
CreateMulticastGroupResponse -> Rep CreateMulticastGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMulticastGroupResponse x -> CreateMulticastGroupResponse
$cfrom :: forall x.
CreateMulticastGroupResponse -> Rep CreateMulticastGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMulticastGroupResponse' 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:
--
-- 'arn', 'createMulticastGroupResponse_arn' - Undocumented member.
--
-- 'id', 'createMulticastGroupResponse_id' - Undocumented member.
--
-- 'httpStatus', 'createMulticastGroupResponse_httpStatus' - The response's http status code.
newCreateMulticastGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMulticastGroupResponse
newCreateMulticastGroupResponse :: Int -> CreateMulticastGroupResponse
newCreateMulticastGroupResponse Int
pHttpStatus_ =
  CreateMulticastGroupResponse'
    { $sel:arn:CreateMulticastGroupResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateMulticastGroupResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMulticastGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createMulticastGroupResponse_arn :: Lens.Lens' CreateMulticastGroupResponse (Prelude.Maybe Prelude.Text)
createMulticastGroupResponse_arn :: Lens' CreateMulticastGroupResponse (Maybe Text)
createMulticastGroupResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroupResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateMulticastGroupResponse' :: CreateMulticastGroupResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateMulticastGroupResponse
s@CreateMulticastGroupResponse' {} Maybe Text
a -> CreateMulticastGroupResponse
s {$sel:arn:CreateMulticastGroupResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateMulticastGroupResponse)

-- | Undocumented member.
createMulticastGroupResponse_id :: Lens.Lens' CreateMulticastGroupResponse (Prelude.Maybe Prelude.Text)
createMulticastGroupResponse_id :: Lens' CreateMulticastGroupResponse (Maybe Text)
createMulticastGroupResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMulticastGroupResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateMulticastGroupResponse' :: CreateMulticastGroupResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateMulticastGroupResponse
s@CreateMulticastGroupResponse' {} Maybe Text
a -> CreateMulticastGroupResponse
s {$sel:id:CreateMulticastGroupResponse' :: Maybe Text
id = Maybe Text
a} :: CreateMulticastGroupResponse)

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

instance Prelude.NFData CreateMulticastGroupResponse where
  rnf :: CreateMulticastGroupResponse -> ()
rnf CreateMulticastGroupResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateMulticastGroupResponse' :: CreateMulticastGroupResponse -> Int
$sel:id:CreateMulticastGroupResponse' :: CreateMulticastGroupResponse -> Maybe Text
$sel:arn:CreateMulticastGroupResponse' :: CreateMulticastGroupResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus