{-# 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.AddThingToThingGroup
-- 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 thing to a thing group.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions AddThingToThingGroup>
-- action.
module Amazonka.IoT.AddThingToThingGroup
  ( -- * Creating a Request
    AddThingToThingGroup (..),
    newAddThingToThingGroup,

    -- * Request Lenses
    addThingToThingGroup_overrideDynamicGroups,
    addThingToThingGroup_thingArn,
    addThingToThingGroup_thingGroupArn,
    addThingToThingGroup_thingGroupName,
    addThingToThingGroup_thingName,

    -- * Destructuring the Response
    AddThingToThingGroupResponse (..),
    newAddThingToThingGroupResponse,

    -- * Response Lenses
    addThingToThingGroupResponse_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:/ 'newAddThingToThingGroup' smart constructor.
data AddThingToThingGroup = AddThingToThingGroup'
  { -- | Override dynamic thing groups with static thing groups when 10-group
    -- limit is reached. If a thing belongs to 10 thing groups, and one or more
    -- of those groups are dynamic thing groups, adding a thing to a static
    -- group removes the thing from the last dynamic group.
    AddThingToThingGroup -> Maybe Bool
overrideDynamicGroups :: Prelude.Maybe Prelude.Bool,
    -- | The ARN of the thing to add to a group.
    AddThingToThingGroup -> Maybe Text
thingArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the group to which you are adding a thing.
    AddThingToThingGroup -> Maybe Text
thingGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the group to which you are adding a thing.
    AddThingToThingGroup -> Maybe Text
thingGroupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing to add to a group.
    AddThingToThingGroup -> Maybe Text
thingName :: Prelude.Maybe Prelude.Text
  }
  deriving (AddThingToThingGroup -> AddThingToThingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddThingToThingGroup -> AddThingToThingGroup -> Bool
$c/= :: AddThingToThingGroup -> AddThingToThingGroup -> Bool
== :: AddThingToThingGroup -> AddThingToThingGroup -> Bool
$c== :: AddThingToThingGroup -> AddThingToThingGroup -> Bool
Prelude.Eq, ReadPrec [AddThingToThingGroup]
ReadPrec AddThingToThingGroup
Int -> ReadS AddThingToThingGroup
ReadS [AddThingToThingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddThingToThingGroup]
$creadListPrec :: ReadPrec [AddThingToThingGroup]
readPrec :: ReadPrec AddThingToThingGroup
$creadPrec :: ReadPrec AddThingToThingGroup
readList :: ReadS [AddThingToThingGroup]
$creadList :: ReadS [AddThingToThingGroup]
readsPrec :: Int -> ReadS AddThingToThingGroup
$creadsPrec :: Int -> ReadS AddThingToThingGroup
Prelude.Read, Int -> AddThingToThingGroup -> ShowS
[AddThingToThingGroup] -> ShowS
AddThingToThingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddThingToThingGroup] -> ShowS
$cshowList :: [AddThingToThingGroup] -> ShowS
show :: AddThingToThingGroup -> String
$cshow :: AddThingToThingGroup -> String
showsPrec :: Int -> AddThingToThingGroup -> ShowS
$cshowsPrec :: Int -> AddThingToThingGroup -> ShowS
Prelude.Show, forall x. Rep AddThingToThingGroup x -> AddThingToThingGroup
forall x. AddThingToThingGroup -> Rep AddThingToThingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddThingToThingGroup x -> AddThingToThingGroup
$cfrom :: forall x. AddThingToThingGroup -> Rep AddThingToThingGroup x
Prelude.Generic)

-- |
-- Create a value of 'AddThingToThingGroup' 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:
--
-- 'overrideDynamicGroups', 'addThingToThingGroup_overrideDynamicGroups' - Override dynamic thing groups with static thing groups when 10-group
-- limit is reached. If a thing belongs to 10 thing groups, and one or more
-- of those groups are dynamic thing groups, adding a thing to a static
-- group removes the thing from the last dynamic group.
--
-- 'thingArn', 'addThingToThingGroup_thingArn' - The ARN of the thing to add to a group.
--
-- 'thingGroupArn', 'addThingToThingGroup_thingGroupArn' - The ARN of the group to which you are adding a thing.
--
-- 'thingGroupName', 'addThingToThingGroup_thingGroupName' - The name of the group to which you are adding a thing.
--
-- 'thingName', 'addThingToThingGroup_thingName' - The name of the thing to add to a group.
newAddThingToThingGroup ::
  AddThingToThingGroup
newAddThingToThingGroup :: AddThingToThingGroup
newAddThingToThingGroup =
  AddThingToThingGroup'
    { $sel:overrideDynamicGroups:AddThingToThingGroup' :: Maybe Bool
overrideDynamicGroups =
        forall a. Maybe a
Prelude.Nothing,
      $sel:thingArn:AddThingToThingGroup' :: Maybe Text
thingArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupArn:AddThingToThingGroup' :: Maybe Text
thingGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupName:AddThingToThingGroup' :: Maybe Text
thingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:AddThingToThingGroup' :: Maybe Text
thingName = forall a. Maybe a
Prelude.Nothing
    }

-- | Override dynamic thing groups with static thing groups when 10-group
-- limit is reached. If a thing belongs to 10 thing groups, and one or more
-- of those groups are dynamic thing groups, adding a thing to a static
-- group removes the thing from the last dynamic group.
addThingToThingGroup_overrideDynamicGroups :: Lens.Lens' AddThingToThingGroup (Prelude.Maybe Prelude.Bool)
addThingToThingGroup_overrideDynamicGroups :: Lens' AddThingToThingGroup (Maybe Bool)
addThingToThingGroup_overrideDynamicGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddThingToThingGroup' {Maybe Bool
overrideDynamicGroups :: Maybe Bool
$sel:overrideDynamicGroups:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Bool
overrideDynamicGroups} -> Maybe Bool
overrideDynamicGroups) (\s :: AddThingToThingGroup
s@AddThingToThingGroup' {} Maybe Bool
a -> AddThingToThingGroup
s {$sel:overrideDynamicGroups:AddThingToThingGroup' :: Maybe Bool
overrideDynamicGroups = Maybe Bool
a} :: AddThingToThingGroup)

-- | The ARN of the thing to add to a group.
addThingToThingGroup_thingArn :: Lens.Lens' AddThingToThingGroup (Prelude.Maybe Prelude.Text)
addThingToThingGroup_thingArn :: Lens' AddThingToThingGroup (Maybe Text)
addThingToThingGroup_thingArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddThingToThingGroup' {Maybe Text
thingArn :: Maybe Text
$sel:thingArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
thingArn} -> Maybe Text
thingArn) (\s :: AddThingToThingGroup
s@AddThingToThingGroup' {} Maybe Text
a -> AddThingToThingGroup
s {$sel:thingArn:AddThingToThingGroup' :: Maybe Text
thingArn = Maybe Text
a} :: AddThingToThingGroup)

-- | The ARN of the group to which you are adding a thing.
addThingToThingGroup_thingGroupArn :: Lens.Lens' AddThingToThingGroup (Prelude.Maybe Prelude.Text)
addThingToThingGroup_thingGroupArn :: Lens' AddThingToThingGroup (Maybe Text)
addThingToThingGroup_thingGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddThingToThingGroup' {Maybe Text
thingGroupArn :: Maybe Text
$sel:thingGroupArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
thingGroupArn} -> Maybe Text
thingGroupArn) (\s :: AddThingToThingGroup
s@AddThingToThingGroup' {} Maybe Text
a -> AddThingToThingGroup
s {$sel:thingGroupArn:AddThingToThingGroup' :: Maybe Text
thingGroupArn = Maybe Text
a} :: AddThingToThingGroup)

-- | The name of the group to which you are adding a thing.
addThingToThingGroup_thingGroupName :: Lens.Lens' AddThingToThingGroup (Prelude.Maybe Prelude.Text)
addThingToThingGroup_thingGroupName :: Lens' AddThingToThingGroup (Maybe Text)
addThingToThingGroup_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddThingToThingGroup' {Maybe Text
thingGroupName :: Maybe Text
$sel:thingGroupName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
thingGroupName} -> Maybe Text
thingGroupName) (\s :: AddThingToThingGroup
s@AddThingToThingGroup' {} Maybe Text
a -> AddThingToThingGroup
s {$sel:thingGroupName:AddThingToThingGroup' :: Maybe Text
thingGroupName = Maybe Text
a} :: AddThingToThingGroup)

-- | The name of the thing to add to a group.
addThingToThingGroup_thingName :: Lens.Lens' AddThingToThingGroup (Prelude.Maybe Prelude.Text)
addThingToThingGroup_thingName :: Lens' AddThingToThingGroup (Maybe Text)
addThingToThingGroup_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddThingToThingGroup' {Maybe Text
thingName :: Maybe Text
$sel:thingName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
thingName} -> Maybe Text
thingName) (\s :: AddThingToThingGroup
s@AddThingToThingGroup' {} Maybe Text
a -> AddThingToThingGroup
s {$sel:thingName:AddThingToThingGroup' :: Maybe Text
thingName = Maybe Text
a} :: AddThingToThingGroup)

instance Core.AWSRequest AddThingToThingGroup where
  type
    AWSResponse AddThingToThingGroup =
      AddThingToThingGroupResponse
  request :: (Service -> Service)
-> AddThingToThingGroup -> Request AddThingToThingGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AddThingToThingGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddThingToThingGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AddThingToThingGroupResponse
AddThingToThingGroupResponse'
            forall (f :: * -> *) a b. Functor 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 AddThingToThingGroup where
  hashWithSalt :: Int -> AddThingToThingGroup -> Int
hashWithSalt Int
_salt AddThingToThingGroup' {Maybe Bool
Maybe Text
thingName :: Maybe Text
thingGroupName :: Maybe Text
thingGroupArn :: Maybe Text
thingArn :: Maybe Text
overrideDynamicGroups :: Maybe Bool
$sel:thingName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:overrideDynamicGroups:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
overrideDynamicGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingName

instance Prelude.NFData AddThingToThingGroup where
  rnf :: AddThingToThingGroup -> ()
rnf AddThingToThingGroup' {Maybe Bool
Maybe Text
thingName :: Maybe Text
thingGroupName :: Maybe Text
thingGroupArn :: Maybe Text
thingArn :: Maybe Text
overrideDynamicGroups :: Maybe Bool
$sel:thingName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:overrideDynamicGroups:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
overrideDynamicGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
thingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingName

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

instance Data.ToJSON AddThingToThingGroup where
  toJSON :: AddThingToThingGroup -> Value
toJSON AddThingToThingGroup' {Maybe Bool
Maybe Text
thingName :: Maybe Text
thingGroupName :: Maybe Text
thingGroupArn :: Maybe Text
thingArn :: Maybe Text
overrideDynamicGroups :: Maybe Bool
$sel:thingName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupName:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingGroupArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:thingArn:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Text
$sel:overrideDynamicGroups:AddThingToThingGroup' :: AddThingToThingGroup -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"overrideDynamicGroups" 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 Bool
overrideDynamicGroups,
            (Key
"thingArn" 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
thingArn,
            (Key
"thingGroupArn" 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
thingGroupArn,
            (Key
"thingGroupName" 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
thingGroupName,
            (Key
"thingName" 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
thingName
          ]
      )

instance Data.ToPath AddThingToThingGroup where
  toPath :: AddThingToThingGroup -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/thing-groups/addThingToThingGroup"

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

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

-- |
-- Create a value of 'AddThingToThingGroupResponse' 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:
--
-- 'httpStatus', 'addThingToThingGroupResponse_httpStatus' - The response's http status code.
newAddThingToThingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddThingToThingGroupResponse
newAddThingToThingGroupResponse :: Int -> AddThingToThingGroupResponse
newAddThingToThingGroupResponse Int
pHttpStatus_ =
  AddThingToThingGroupResponse'
    { $sel:httpStatus:AddThingToThingGroupResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData AddThingToThingGroupResponse where
  rnf :: AddThingToThingGroupResponse -> ()
rnf AddThingToThingGroupResponse' {Int
httpStatus :: Int
$sel:httpStatus:AddThingToThingGroupResponse' :: AddThingToThingGroupResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus