{-# 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.IoT.CreateThingGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a thing group.
--
-- This is a control plane operation. See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/iot-authorization.html Authorization>
-- for information about authorizing control plane actions.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateThingGroup>
-- action.
module Amazonka.IoT.CreateThingGroup
  ( -- * Creating a Request
    CreateThingGroup (..),
    newCreateThingGroup,

    -- * Request Lenses
    createThingGroup_parentGroupName,
    createThingGroup_tags,
    createThingGroup_thingGroupProperties,
    createThingGroup_thingGroupName,

    -- * Destructuring the Response
    CreateThingGroupResponse (..),
    newCreateThingGroupResponse,

    -- * Response Lenses
    createThingGroupResponse_thingGroupArn,
    createThingGroupResponse_thingGroupId,
    createThingGroupResponse_thingGroupName,
    createThingGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateThingGroup' smart constructor.
data CreateThingGroup = CreateThingGroup'
  { -- | The name of the parent thing group.
    CreateThingGroup -> Maybe Text
parentGroupName :: Prelude.Maybe Prelude.Text,
    -- | Metadata which can be used to manage the thing group.
    CreateThingGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The thing group properties.
    CreateThingGroup -> Maybe ThingGroupProperties
thingGroupProperties :: Prelude.Maybe ThingGroupProperties,
    -- | The thing group name to create.
    CreateThingGroup -> Text
thingGroupName :: Prelude.Text
  }
  deriving (CreateThingGroup -> CreateThingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateThingGroup -> CreateThingGroup -> Bool
$c/= :: CreateThingGroup -> CreateThingGroup -> Bool
== :: CreateThingGroup -> CreateThingGroup -> Bool
$c== :: CreateThingGroup -> CreateThingGroup -> Bool
Prelude.Eq, ReadPrec [CreateThingGroup]
ReadPrec CreateThingGroup
Int -> ReadS CreateThingGroup
ReadS [CreateThingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateThingGroup]
$creadListPrec :: ReadPrec [CreateThingGroup]
readPrec :: ReadPrec CreateThingGroup
$creadPrec :: ReadPrec CreateThingGroup
readList :: ReadS [CreateThingGroup]
$creadList :: ReadS [CreateThingGroup]
readsPrec :: Int -> ReadS CreateThingGroup
$creadsPrec :: Int -> ReadS CreateThingGroup
Prelude.Read, Int -> CreateThingGroup -> ShowS
[CreateThingGroup] -> ShowS
CreateThingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateThingGroup] -> ShowS
$cshowList :: [CreateThingGroup] -> ShowS
show :: CreateThingGroup -> String
$cshow :: CreateThingGroup -> String
showsPrec :: Int -> CreateThingGroup -> ShowS
$cshowsPrec :: Int -> CreateThingGroup -> ShowS
Prelude.Show, forall x. Rep CreateThingGroup x -> CreateThingGroup
forall x. CreateThingGroup -> Rep CreateThingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateThingGroup x -> CreateThingGroup
$cfrom :: forall x. CreateThingGroup -> Rep CreateThingGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateThingGroup' 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:
--
-- 'parentGroupName', 'createThingGroup_parentGroupName' - The name of the parent thing group.
--
-- 'tags', 'createThingGroup_tags' - Metadata which can be used to manage the thing group.
--
-- 'thingGroupProperties', 'createThingGroup_thingGroupProperties' - The thing group properties.
--
-- 'thingGroupName', 'createThingGroup_thingGroupName' - The thing group name to create.
newCreateThingGroup ::
  -- | 'thingGroupName'
  Prelude.Text ->
  CreateThingGroup
newCreateThingGroup :: Text -> CreateThingGroup
newCreateThingGroup Text
pThingGroupName_ =
  CreateThingGroup'
    { $sel:parentGroupName:CreateThingGroup' :: Maybe Text
parentGroupName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateThingGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupProperties:CreateThingGroup' :: Maybe ThingGroupProperties
thingGroupProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupName:CreateThingGroup' :: Text
thingGroupName = Text
pThingGroupName_
    }

-- | The name of the parent thing group.
createThingGroup_parentGroupName :: Lens.Lens' CreateThingGroup (Prelude.Maybe Prelude.Text)
createThingGroup_parentGroupName :: Lens' CreateThingGroup (Maybe Text)
createThingGroup_parentGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroup' {Maybe Text
parentGroupName :: Maybe Text
$sel:parentGroupName:CreateThingGroup' :: CreateThingGroup -> Maybe Text
parentGroupName} -> Maybe Text
parentGroupName) (\s :: CreateThingGroup
s@CreateThingGroup' {} Maybe Text
a -> CreateThingGroup
s {$sel:parentGroupName:CreateThingGroup' :: Maybe Text
parentGroupName = Maybe Text
a} :: CreateThingGroup)

-- | Metadata which can be used to manage the thing group.
createThingGroup_tags :: Lens.Lens' CreateThingGroup (Prelude.Maybe [Tag])
createThingGroup_tags :: Lens' CreateThingGroup (Maybe [Tag])
createThingGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateThingGroup' :: CreateThingGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateThingGroup
s@CreateThingGroup' {} Maybe [Tag]
a -> CreateThingGroup
s {$sel:tags:CreateThingGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateThingGroup) 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 thing group properties.
createThingGroup_thingGroupProperties :: Lens.Lens' CreateThingGroup (Prelude.Maybe ThingGroupProperties)
createThingGroup_thingGroupProperties :: Lens' CreateThingGroup (Maybe ThingGroupProperties)
createThingGroup_thingGroupProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroup' {Maybe ThingGroupProperties
thingGroupProperties :: Maybe ThingGroupProperties
$sel:thingGroupProperties:CreateThingGroup' :: CreateThingGroup -> Maybe ThingGroupProperties
thingGroupProperties} -> Maybe ThingGroupProperties
thingGroupProperties) (\s :: CreateThingGroup
s@CreateThingGroup' {} Maybe ThingGroupProperties
a -> CreateThingGroup
s {$sel:thingGroupProperties:CreateThingGroup' :: Maybe ThingGroupProperties
thingGroupProperties = Maybe ThingGroupProperties
a} :: CreateThingGroup)

-- | The thing group name to create.
createThingGroup_thingGroupName :: Lens.Lens' CreateThingGroup Prelude.Text
createThingGroup_thingGroupName :: Lens' CreateThingGroup Text
createThingGroup_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroup' {Text
thingGroupName :: Text
$sel:thingGroupName:CreateThingGroup' :: CreateThingGroup -> Text
thingGroupName} -> Text
thingGroupName) (\s :: CreateThingGroup
s@CreateThingGroup' {} Text
a -> CreateThingGroup
s {$sel:thingGroupName:CreateThingGroup' :: Text
thingGroupName = Text
a} :: CreateThingGroup)

instance Core.AWSRequest CreateThingGroup where
  type
    AWSResponse CreateThingGroup =
      CreateThingGroupResponse
  request :: (Service -> Service)
-> CreateThingGroup -> Request CreateThingGroup
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 CreateThingGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateThingGroup)))
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 -> Maybe Text -> Int -> CreateThingGroupResponse
CreateThingGroupResponse'
            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
"thingGroupArn")
            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
"thingGroupId")
            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
"thingGroupName")
            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 CreateThingGroup where
  hashWithSalt :: Int -> CreateThingGroup -> Int
hashWithSalt Int
_salt CreateThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
parentGroupName :: Maybe Text
$sel:thingGroupName:CreateThingGroup' :: CreateThingGroup -> Text
$sel:thingGroupProperties:CreateThingGroup' :: CreateThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateThingGroup' :: CreateThingGroup -> Maybe [Tag]
$sel:parentGroupName:CreateThingGroup' :: CreateThingGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThingGroupProperties
thingGroupProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingGroupName

instance Prelude.NFData CreateThingGroup where
  rnf :: CreateThingGroup -> ()
rnf CreateThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
parentGroupName :: Maybe Text
$sel:thingGroupName:CreateThingGroup' :: CreateThingGroup -> Text
$sel:thingGroupProperties:CreateThingGroup' :: CreateThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateThingGroup' :: CreateThingGroup -> Maybe [Tag]
$sel:parentGroupName:CreateThingGroup' :: CreateThingGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentGroupName
      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 Maybe ThingGroupProperties
thingGroupProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingGroupName

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

instance Data.ToJSON CreateThingGroup where
  toJSON :: CreateThingGroup -> Value
toJSON CreateThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
parentGroupName :: Maybe Text
$sel:thingGroupName:CreateThingGroup' :: CreateThingGroup -> Text
$sel:thingGroupProperties:CreateThingGroup' :: CreateThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateThingGroup' :: CreateThingGroup -> Maybe [Tag]
$sel:parentGroupName:CreateThingGroup' :: CreateThingGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"parentGroupName" 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
parentGroupName,
            (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,
            (Key
"thingGroupProperties" 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 ThingGroupProperties
thingGroupProperties
          ]
      )

instance Data.ToPath CreateThingGroup where
  toPath :: CreateThingGroup -> ByteString
toPath CreateThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
parentGroupName :: Maybe Text
$sel:thingGroupName:CreateThingGroup' :: CreateThingGroup -> Text
$sel:thingGroupProperties:CreateThingGroup' :: CreateThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateThingGroup' :: CreateThingGroup -> Maybe [Tag]
$sel:parentGroupName:CreateThingGroup' :: CreateThingGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/thing-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingGroupName]

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

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

-- |
-- Create a value of 'CreateThingGroupResponse' 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:
--
-- 'thingGroupArn', 'createThingGroupResponse_thingGroupArn' - The thing group ARN.
--
-- 'thingGroupId', 'createThingGroupResponse_thingGroupId' - The thing group ID.
--
-- 'thingGroupName', 'createThingGroupResponse_thingGroupName' - The thing group name.
--
-- 'httpStatus', 'createThingGroupResponse_httpStatus' - The response's http status code.
newCreateThingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateThingGroupResponse
newCreateThingGroupResponse :: Int -> CreateThingGroupResponse
newCreateThingGroupResponse Int
pHttpStatus_ =
  CreateThingGroupResponse'
    { $sel:thingGroupArn:CreateThingGroupResponse' :: Maybe Text
thingGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupId:CreateThingGroupResponse' :: Maybe Text
thingGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupName:CreateThingGroupResponse' :: Maybe Text
thingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateThingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The thing group ARN.
createThingGroupResponse_thingGroupArn :: Lens.Lens' CreateThingGroupResponse (Prelude.Maybe Prelude.Text)
createThingGroupResponse_thingGroupArn :: Lens' CreateThingGroupResponse (Maybe Text)
createThingGroupResponse_thingGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroupResponse' {Maybe Text
thingGroupArn :: Maybe Text
$sel:thingGroupArn:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
thingGroupArn} -> Maybe Text
thingGroupArn) (\s :: CreateThingGroupResponse
s@CreateThingGroupResponse' {} Maybe Text
a -> CreateThingGroupResponse
s {$sel:thingGroupArn:CreateThingGroupResponse' :: Maybe Text
thingGroupArn = Maybe Text
a} :: CreateThingGroupResponse)

-- | The thing group ID.
createThingGroupResponse_thingGroupId :: Lens.Lens' CreateThingGroupResponse (Prelude.Maybe Prelude.Text)
createThingGroupResponse_thingGroupId :: Lens' CreateThingGroupResponse (Maybe Text)
createThingGroupResponse_thingGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroupResponse' {Maybe Text
thingGroupId :: Maybe Text
$sel:thingGroupId:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
thingGroupId} -> Maybe Text
thingGroupId) (\s :: CreateThingGroupResponse
s@CreateThingGroupResponse' {} Maybe Text
a -> CreateThingGroupResponse
s {$sel:thingGroupId:CreateThingGroupResponse' :: Maybe Text
thingGroupId = Maybe Text
a} :: CreateThingGroupResponse)

-- | The thing group name.
createThingGroupResponse_thingGroupName :: Lens.Lens' CreateThingGroupResponse (Prelude.Maybe Prelude.Text)
createThingGroupResponse_thingGroupName :: Lens' CreateThingGroupResponse (Maybe Text)
createThingGroupResponse_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingGroupResponse' {Maybe Text
thingGroupName :: Maybe Text
$sel:thingGroupName:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
thingGroupName} -> Maybe Text
thingGroupName) (\s :: CreateThingGroupResponse
s@CreateThingGroupResponse' {} Maybe Text
a -> CreateThingGroupResponse
s {$sel:thingGroupName:CreateThingGroupResponse' :: Maybe Text
thingGroupName = Maybe Text
a} :: CreateThingGroupResponse)

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

instance Prelude.NFData CreateThingGroupResponse where
  rnf :: CreateThingGroupResponse -> ()
rnf CreateThingGroupResponse' {Int
Maybe Text
httpStatus :: Int
thingGroupName :: Maybe Text
thingGroupId :: Maybe Text
thingGroupArn :: Maybe Text
$sel:httpStatus:CreateThingGroupResponse' :: CreateThingGroupResponse -> Int
$sel:thingGroupName:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
$sel:thingGroupId:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
$sel:thingGroupArn:CreateThingGroupResponse' :: CreateThingGroupResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus