{-# 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.CreateThing
-- 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 thing record in the registry. If this call is made multiple
-- times using the same thing name and configuration, the call will
-- succeed. If this call is made with the same thing name but different
-- configuration a @ResourceAlreadyExistsException@ is thrown.
--
-- 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 CreateThing>
-- action.
module Amazonka.IoT.CreateThing
  ( -- * Creating a Request
    CreateThing (..),
    newCreateThing,

    -- * Request Lenses
    createThing_attributePayload,
    createThing_billingGroupName,
    createThing_thingTypeName,
    createThing_thingName,

    -- * Destructuring the Response
    CreateThingResponse (..),
    newCreateThingResponse,

    -- * Response Lenses
    createThingResponse_thingArn,
    createThingResponse_thingId,
    createThingResponse_thingName,
    createThingResponse_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

-- | The input for the CreateThing operation.
--
-- /See:/ 'newCreateThing' smart constructor.
data CreateThing = CreateThing'
  { -- | The attribute payload, which consists of up to three name\/value pairs
    -- in a JSON document. For example:
    --
    -- @{\\\"attributes\\\":{\\\"string1\\\":\\\"string2\\\"}}@
    CreateThing -> Maybe AttributePayload
attributePayload :: Prelude.Maybe AttributePayload,
    -- | The name of the billing group the thing will be added to.
    CreateThing -> Maybe Text
billingGroupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing type associated with the new thing.
    CreateThing -> Maybe Text
thingTypeName :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing to create.
    --
    -- You can\'t change a thing\'s name after you create it. To change a
    -- thing\'s name, you must create a new thing, give it the new name, and
    -- then delete the old thing.
    CreateThing -> Text
thingName :: Prelude.Text
  }
  deriving (CreateThing -> CreateThing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateThing -> CreateThing -> Bool
$c/= :: CreateThing -> CreateThing -> Bool
== :: CreateThing -> CreateThing -> Bool
$c== :: CreateThing -> CreateThing -> Bool
Prelude.Eq, ReadPrec [CreateThing]
ReadPrec CreateThing
Int -> ReadS CreateThing
ReadS [CreateThing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateThing]
$creadListPrec :: ReadPrec [CreateThing]
readPrec :: ReadPrec CreateThing
$creadPrec :: ReadPrec CreateThing
readList :: ReadS [CreateThing]
$creadList :: ReadS [CreateThing]
readsPrec :: Int -> ReadS CreateThing
$creadsPrec :: Int -> ReadS CreateThing
Prelude.Read, Int -> CreateThing -> ShowS
[CreateThing] -> ShowS
CreateThing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateThing] -> ShowS
$cshowList :: [CreateThing] -> ShowS
show :: CreateThing -> String
$cshow :: CreateThing -> String
showsPrec :: Int -> CreateThing -> ShowS
$cshowsPrec :: Int -> CreateThing -> ShowS
Prelude.Show, forall x. Rep CreateThing x -> CreateThing
forall x. CreateThing -> Rep CreateThing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateThing x -> CreateThing
$cfrom :: forall x. CreateThing -> Rep CreateThing x
Prelude.Generic)

-- |
-- Create a value of 'CreateThing' 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:
--
-- 'attributePayload', 'createThing_attributePayload' - The attribute payload, which consists of up to three name\/value pairs
-- in a JSON document. For example:
--
-- @{\\\"attributes\\\":{\\\"string1\\\":\\\"string2\\\"}}@
--
-- 'billingGroupName', 'createThing_billingGroupName' - The name of the billing group the thing will be added to.
--
-- 'thingTypeName', 'createThing_thingTypeName' - The name of the thing type associated with the new thing.
--
-- 'thingName', 'createThing_thingName' - The name of the thing to create.
--
-- You can\'t change a thing\'s name after you create it. To change a
-- thing\'s name, you must create a new thing, give it the new name, and
-- then delete the old thing.
newCreateThing ::
  -- | 'thingName'
  Prelude.Text ->
  CreateThing
newCreateThing :: Text -> CreateThing
newCreateThing Text
pThingName_ =
  CreateThing'
    { $sel:attributePayload:CreateThing' :: Maybe AttributePayload
attributePayload = forall a. Maybe a
Prelude.Nothing,
      $sel:billingGroupName:CreateThing' :: Maybe Text
billingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingTypeName:CreateThing' :: Maybe Text
thingTypeName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:CreateThing' :: Text
thingName = Text
pThingName_
    }

-- | The attribute payload, which consists of up to three name\/value pairs
-- in a JSON document. For example:
--
-- @{\\\"attributes\\\":{\\\"string1\\\":\\\"string2\\\"}}@
createThing_attributePayload :: Lens.Lens' CreateThing (Prelude.Maybe AttributePayload)
createThing_attributePayload :: Lens' CreateThing (Maybe AttributePayload)
createThing_attributePayload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThing' {Maybe AttributePayload
attributePayload :: Maybe AttributePayload
$sel:attributePayload:CreateThing' :: CreateThing -> Maybe AttributePayload
attributePayload} -> Maybe AttributePayload
attributePayload) (\s :: CreateThing
s@CreateThing' {} Maybe AttributePayload
a -> CreateThing
s {$sel:attributePayload:CreateThing' :: Maybe AttributePayload
attributePayload = Maybe AttributePayload
a} :: CreateThing)

-- | The name of the billing group the thing will be added to.
createThing_billingGroupName :: Lens.Lens' CreateThing (Prelude.Maybe Prelude.Text)
createThing_billingGroupName :: Lens' CreateThing (Maybe Text)
createThing_billingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThing' {Maybe Text
billingGroupName :: Maybe Text
$sel:billingGroupName:CreateThing' :: CreateThing -> Maybe Text
billingGroupName} -> Maybe Text
billingGroupName) (\s :: CreateThing
s@CreateThing' {} Maybe Text
a -> CreateThing
s {$sel:billingGroupName:CreateThing' :: Maybe Text
billingGroupName = Maybe Text
a} :: CreateThing)

-- | The name of the thing type associated with the new thing.
createThing_thingTypeName :: Lens.Lens' CreateThing (Prelude.Maybe Prelude.Text)
createThing_thingTypeName :: Lens' CreateThing (Maybe Text)
createThing_thingTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThing' {Maybe Text
thingTypeName :: Maybe Text
$sel:thingTypeName:CreateThing' :: CreateThing -> Maybe Text
thingTypeName} -> Maybe Text
thingTypeName) (\s :: CreateThing
s@CreateThing' {} Maybe Text
a -> CreateThing
s {$sel:thingTypeName:CreateThing' :: Maybe Text
thingTypeName = Maybe Text
a} :: CreateThing)

-- | The name of the thing to create.
--
-- You can\'t change a thing\'s name after you create it. To change a
-- thing\'s name, you must create a new thing, give it the new name, and
-- then delete the old thing.
createThing_thingName :: Lens.Lens' CreateThing Prelude.Text
createThing_thingName :: Lens' CreateThing Text
createThing_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThing' {Text
thingName :: Text
$sel:thingName:CreateThing' :: CreateThing -> Text
thingName} -> Text
thingName) (\s :: CreateThing
s@CreateThing' {} Text
a -> CreateThing
s {$sel:thingName:CreateThing' :: Text
thingName = Text
a} :: CreateThing)

instance Core.AWSRequest CreateThing where
  type AWSResponse CreateThing = CreateThingResponse
  request :: (Service -> Service) -> CreateThing -> Request CreateThing
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 CreateThing
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateThing)))
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 -> CreateThingResponse
CreateThingResponse'
            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
"thingArn")
            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
"thingId")
            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
"thingName")
            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 CreateThing where
  hashWithSalt :: Int -> CreateThing -> Int
hashWithSalt Int
_salt CreateThing' {Maybe Text
Maybe AttributePayload
Text
thingName :: Text
thingTypeName :: Maybe Text
billingGroupName :: Maybe Text
attributePayload :: Maybe AttributePayload
$sel:thingName:CreateThing' :: CreateThing -> Text
$sel:thingTypeName:CreateThing' :: CreateThing -> Maybe Text
$sel:billingGroupName:CreateThing' :: CreateThing -> Maybe Text
$sel:attributePayload:CreateThing' :: CreateThing -> Maybe AttributePayload
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributePayload
attributePayload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
billingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName

instance Prelude.NFData CreateThing where
  rnf :: CreateThing -> ()
rnf CreateThing' {Maybe Text
Maybe AttributePayload
Text
thingName :: Text
thingTypeName :: Maybe Text
billingGroupName :: Maybe Text
attributePayload :: Maybe AttributePayload
$sel:thingName:CreateThing' :: CreateThing -> Text
$sel:thingTypeName:CreateThing' :: CreateThing -> Maybe Text
$sel:billingGroupName:CreateThing' :: CreateThing -> Maybe Text
$sel:attributePayload:CreateThing' :: CreateThing -> Maybe AttributePayload
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributePayload
attributePayload
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingName

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

instance Data.ToJSON CreateThing where
  toJSON :: CreateThing -> Value
toJSON CreateThing' {Maybe Text
Maybe AttributePayload
Text
thingName :: Text
thingTypeName :: Maybe Text
billingGroupName :: Maybe Text
attributePayload :: Maybe AttributePayload
$sel:thingName:CreateThing' :: CreateThing -> Text
$sel:thingTypeName:CreateThing' :: CreateThing -> Maybe Text
$sel:billingGroupName:CreateThing' :: CreateThing -> Maybe Text
$sel:attributePayload:CreateThing' :: CreateThing -> Maybe AttributePayload
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"attributePayload" 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 AttributePayload
attributePayload,
            (Key
"billingGroupName" 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
billingGroupName,
            (Key
"thingTypeName" 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
thingTypeName
          ]
      )

instance Data.ToPath CreateThing where
  toPath :: CreateThing -> ByteString
toPath CreateThing' {Maybe Text
Maybe AttributePayload
Text
thingName :: Text
thingTypeName :: Maybe Text
billingGroupName :: Maybe Text
attributePayload :: Maybe AttributePayload
$sel:thingName:CreateThing' :: CreateThing -> Text
$sel:thingTypeName:CreateThing' :: CreateThing -> Maybe Text
$sel:billingGroupName:CreateThing' :: CreateThing -> Maybe Text
$sel:attributePayload:CreateThing' :: CreateThing -> Maybe AttributePayload
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/things/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingName]

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

-- | The output of the CreateThing operation.
--
-- /See:/ 'newCreateThingResponse' smart constructor.
data CreateThingResponse = CreateThingResponse'
  { -- | The ARN of the new thing.
    CreateThingResponse -> Maybe Text
thingArn :: Prelude.Maybe Prelude.Text,
    -- | The thing ID.
    CreateThingResponse -> Maybe Text
thingId :: Prelude.Maybe Prelude.Text,
    -- | The name of the new thing.
    CreateThingResponse -> Maybe Text
thingName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateThingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateThingResponse -> CreateThingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateThingResponse -> CreateThingResponse -> Bool
$c/= :: CreateThingResponse -> CreateThingResponse -> Bool
== :: CreateThingResponse -> CreateThingResponse -> Bool
$c== :: CreateThingResponse -> CreateThingResponse -> Bool
Prelude.Eq, ReadPrec [CreateThingResponse]
ReadPrec CreateThingResponse
Int -> ReadS CreateThingResponse
ReadS [CreateThingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateThingResponse]
$creadListPrec :: ReadPrec [CreateThingResponse]
readPrec :: ReadPrec CreateThingResponse
$creadPrec :: ReadPrec CreateThingResponse
readList :: ReadS [CreateThingResponse]
$creadList :: ReadS [CreateThingResponse]
readsPrec :: Int -> ReadS CreateThingResponse
$creadsPrec :: Int -> ReadS CreateThingResponse
Prelude.Read, Int -> CreateThingResponse -> ShowS
[CreateThingResponse] -> ShowS
CreateThingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateThingResponse] -> ShowS
$cshowList :: [CreateThingResponse] -> ShowS
show :: CreateThingResponse -> String
$cshow :: CreateThingResponse -> String
showsPrec :: Int -> CreateThingResponse -> ShowS
$cshowsPrec :: Int -> CreateThingResponse -> ShowS
Prelude.Show, forall x. Rep CreateThingResponse x -> CreateThingResponse
forall x. CreateThingResponse -> Rep CreateThingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateThingResponse x -> CreateThingResponse
$cfrom :: forall x. CreateThingResponse -> Rep CreateThingResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateThingResponse' 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:
--
-- 'thingArn', 'createThingResponse_thingArn' - The ARN of the new thing.
--
-- 'thingId', 'createThingResponse_thingId' - The thing ID.
--
-- 'thingName', 'createThingResponse_thingName' - The name of the new thing.
--
-- 'httpStatus', 'createThingResponse_httpStatus' - The response's http status code.
newCreateThingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateThingResponse
newCreateThingResponse :: Int -> CreateThingResponse
newCreateThingResponse Int
pHttpStatus_ =
  CreateThingResponse'
    { $sel:thingArn:CreateThingResponse' :: Maybe Text
thingArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingId:CreateThingResponse' :: Maybe Text
thingId = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:CreateThingResponse' :: Maybe Text
thingName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateThingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the new thing.
createThingResponse_thingArn :: Lens.Lens' CreateThingResponse (Prelude.Maybe Prelude.Text)
createThingResponse_thingArn :: Lens' CreateThingResponse (Maybe Text)
createThingResponse_thingArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingResponse' {Maybe Text
thingArn :: Maybe Text
$sel:thingArn:CreateThingResponse' :: CreateThingResponse -> Maybe Text
thingArn} -> Maybe Text
thingArn) (\s :: CreateThingResponse
s@CreateThingResponse' {} Maybe Text
a -> CreateThingResponse
s {$sel:thingArn:CreateThingResponse' :: Maybe Text
thingArn = Maybe Text
a} :: CreateThingResponse)

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

-- | The name of the new thing.
createThingResponse_thingName :: Lens.Lens' CreateThingResponse (Prelude.Maybe Prelude.Text)
createThingResponse_thingName :: Lens' CreateThingResponse (Maybe Text)
createThingResponse_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThingResponse' {Maybe Text
thingName :: Maybe Text
$sel:thingName:CreateThingResponse' :: CreateThingResponse -> Maybe Text
thingName} -> Maybe Text
thingName) (\s :: CreateThingResponse
s@CreateThingResponse' {} Maybe Text
a -> CreateThingResponse
s {$sel:thingName:CreateThingResponse' :: Maybe Text
thingName = Maybe Text
a} :: CreateThingResponse)

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

instance Prelude.NFData CreateThingResponse where
  rnf :: CreateThingResponse -> ()
rnf CreateThingResponse' {Int
Maybe Text
httpStatus :: Int
thingName :: Maybe Text
thingId :: Maybe Text
thingArn :: Maybe Text
$sel:httpStatus:CreateThingResponse' :: CreateThingResponse -> Int
$sel:thingName:CreateThingResponse' :: CreateThingResponse -> Maybe Text
$sel:thingId:CreateThingResponse' :: CreateThingResponse -> Maybe Text
$sel:thingArn:CreateThingResponse' :: CreateThingResponse -> Maybe Text
..} =
    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
thingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus