{-# 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.DescribeThing
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about the specified thing.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DescribeThing>
-- action.
module Amazonka.IoT.DescribeThing
  ( -- * Creating a Request
    DescribeThing (..),
    newDescribeThing,

    -- * Request Lenses
    describeThing_thingName,

    -- * Destructuring the Response
    DescribeThingResponse (..),
    newDescribeThingResponse,

    -- * Response Lenses
    describeThingResponse_attributes,
    describeThingResponse_billingGroupName,
    describeThingResponse_defaultClientId,
    describeThingResponse_thingArn,
    describeThingResponse_thingId,
    describeThingResponse_thingName,
    describeThingResponse_thingTypeName,
    describeThingResponse_version,
    describeThingResponse_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 DescribeThing operation.
--
-- /See:/ 'newDescribeThing' smart constructor.
data DescribeThing = DescribeThing'
  { -- | The name of the thing.
    DescribeThing -> Text
thingName :: Prelude.Text
  }
  deriving (DescribeThing -> DescribeThing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeThing -> DescribeThing -> Bool
$c/= :: DescribeThing -> DescribeThing -> Bool
== :: DescribeThing -> DescribeThing -> Bool
$c== :: DescribeThing -> DescribeThing -> Bool
Prelude.Eq, ReadPrec [DescribeThing]
ReadPrec DescribeThing
Int -> ReadS DescribeThing
ReadS [DescribeThing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeThing]
$creadListPrec :: ReadPrec [DescribeThing]
readPrec :: ReadPrec DescribeThing
$creadPrec :: ReadPrec DescribeThing
readList :: ReadS [DescribeThing]
$creadList :: ReadS [DescribeThing]
readsPrec :: Int -> ReadS DescribeThing
$creadsPrec :: Int -> ReadS DescribeThing
Prelude.Read, Int -> DescribeThing -> ShowS
[DescribeThing] -> ShowS
DescribeThing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeThing] -> ShowS
$cshowList :: [DescribeThing] -> ShowS
show :: DescribeThing -> String
$cshow :: DescribeThing -> String
showsPrec :: Int -> DescribeThing -> ShowS
$cshowsPrec :: Int -> DescribeThing -> ShowS
Prelude.Show, forall x. Rep DescribeThing x -> DescribeThing
forall x. DescribeThing -> Rep DescribeThing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeThing x -> DescribeThing
$cfrom :: forall x. DescribeThing -> Rep DescribeThing x
Prelude.Generic)

-- |
-- Create a value of 'DescribeThing' 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:
--
-- 'thingName', 'describeThing_thingName' - The name of the thing.
newDescribeThing ::
  -- | 'thingName'
  Prelude.Text ->
  DescribeThing
newDescribeThing :: Text -> DescribeThing
newDescribeThing Text
pThingName_ =
  DescribeThing' {$sel:thingName:DescribeThing' :: Text
thingName = Text
pThingName_}

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

instance Core.AWSRequest DescribeThing where
  type
    AWSResponse DescribeThing =
      DescribeThingResponse
  request :: (Service -> Service) -> DescribeThing -> Request DescribeThing
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeThing
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeThing)))
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 (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Int
-> DescribeThingResponse
DescribeThingResponse'
            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
"attributes" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"billingGroupName")
            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
"defaultClientId")
            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
"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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"thingTypeName")
            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
"version")
            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 DescribeThing where
  hashWithSalt :: Int -> DescribeThing -> Int
hashWithSalt Int
_salt DescribeThing' {Text
thingName :: Text
$sel:thingName:DescribeThing' :: DescribeThing -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName

instance Prelude.NFData DescribeThing where
  rnf :: DescribeThing -> ()
rnf DescribeThing' {Text
thingName :: Text
$sel:thingName:DescribeThing' :: DescribeThing -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
thingName

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

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

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

-- | The output from the DescribeThing operation.
--
-- /See:/ 'newDescribeThingResponse' smart constructor.
data DescribeThingResponse = DescribeThingResponse'
  { -- | The thing attributes.
    DescribeThingResponse -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the billing group the thing belongs to.
    DescribeThingResponse -> Maybe Text
billingGroupName :: Prelude.Maybe Prelude.Text,
    -- | The default MQTT client ID. For a typical device, the thing name is also
    -- used as the default MQTT client ID. Although we don’t require a mapping
    -- between a thing\'s registry name and its use of MQTT client IDs,
    -- certificates, or shadow state, we recommend that you choose a thing name
    -- and use it as the MQTT client ID for the registry and the Device Shadow
    -- service.
    --
    -- This lets you better organize your IoT fleet without removing the
    -- flexibility of the underlying device certificate model or shadows.
    DescribeThingResponse -> Maybe Text
defaultClientId :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the thing to describe.
    DescribeThingResponse -> Maybe Text
thingArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the thing to describe.
    DescribeThingResponse -> Maybe Text
thingId :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing.
    DescribeThingResponse -> Maybe Text
thingName :: Prelude.Maybe Prelude.Text,
    -- | The thing type name.
    DescribeThingResponse -> Maybe Text
thingTypeName :: Prelude.Maybe Prelude.Text,
    -- | The current version of the thing record in the registry.
    --
    -- To avoid unintentional changes to the information in the registry, you
    -- can pass the version information in the @expectedVersion@ parameter of
    -- the @UpdateThing@ and @DeleteThing@ calls.
    DescribeThingResponse -> Maybe Integer
version :: Prelude.Maybe Prelude.Integer,
    -- | The response's http status code.
    DescribeThingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeThingResponse -> DescribeThingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeThingResponse -> DescribeThingResponse -> Bool
$c/= :: DescribeThingResponse -> DescribeThingResponse -> Bool
== :: DescribeThingResponse -> DescribeThingResponse -> Bool
$c== :: DescribeThingResponse -> DescribeThingResponse -> Bool
Prelude.Eq, ReadPrec [DescribeThingResponse]
ReadPrec DescribeThingResponse
Int -> ReadS DescribeThingResponse
ReadS [DescribeThingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeThingResponse]
$creadListPrec :: ReadPrec [DescribeThingResponse]
readPrec :: ReadPrec DescribeThingResponse
$creadPrec :: ReadPrec DescribeThingResponse
readList :: ReadS [DescribeThingResponse]
$creadList :: ReadS [DescribeThingResponse]
readsPrec :: Int -> ReadS DescribeThingResponse
$creadsPrec :: Int -> ReadS DescribeThingResponse
Prelude.Read, Int -> DescribeThingResponse -> ShowS
[DescribeThingResponse] -> ShowS
DescribeThingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeThingResponse] -> ShowS
$cshowList :: [DescribeThingResponse] -> ShowS
show :: DescribeThingResponse -> String
$cshow :: DescribeThingResponse -> String
showsPrec :: Int -> DescribeThingResponse -> ShowS
$cshowsPrec :: Int -> DescribeThingResponse -> ShowS
Prelude.Show, forall x. Rep DescribeThingResponse x -> DescribeThingResponse
forall x. DescribeThingResponse -> Rep DescribeThingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeThingResponse x -> DescribeThingResponse
$cfrom :: forall x. DescribeThingResponse -> Rep DescribeThingResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeThingResponse' 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:
--
-- 'attributes', 'describeThingResponse_attributes' - The thing attributes.
--
-- 'billingGroupName', 'describeThingResponse_billingGroupName' - The name of the billing group the thing belongs to.
--
-- 'defaultClientId', 'describeThingResponse_defaultClientId' - The default MQTT client ID. For a typical device, the thing name is also
-- used as the default MQTT client ID. Although we don’t require a mapping
-- between a thing\'s registry name and its use of MQTT client IDs,
-- certificates, or shadow state, we recommend that you choose a thing name
-- and use it as the MQTT client ID for the registry and the Device Shadow
-- service.
--
-- This lets you better organize your IoT fleet without removing the
-- flexibility of the underlying device certificate model or shadows.
--
-- 'thingArn', 'describeThingResponse_thingArn' - The ARN of the thing to describe.
--
-- 'thingId', 'describeThingResponse_thingId' - The ID of the thing to describe.
--
-- 'thingName', 'describeThingResponse_thingName' - The name of the thing.
--
-- 'thingTypeName', 'describeThingResponse_thingTypeName' - The thing type name.
--
-- 'version', 'describeThingResponse_version' - The current version of the thing record in the registry.
--
-- To avoid unintentional changes to the information in the registry, you
-- can pass the version information in the @expectedVersion@ parameter of
-- the @UpdateThing@ and @DeleteThing@ calls.
--
-- 'httpStatus', 'describeThingResponse_httpStatus' - The response's http status code.
newDescribeThingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeThingResponse
newDescribeThingResponse :: Int -> DescribeThingResponse
newDescribeThingResponse Int
pHttpStatus_ =
  DescribeThingResponse'
    { $sel:attributes:DescribeThingResponse' :: Maybe (HashMap Text Text)
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:billingGroupName:DescribeThingResponse' :: Maybe Text
billingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultClientId:DescribeThingResponse' :: Maybe Text
defaultClientId = forall a. Maybe a
Prelude.Nothing,
      $sel:thingArn:DescribeThingResponse' :: Maybe Text
thingArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingId:DescribeThingResponse' :: Maybe Text
thingId = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:DescribeThingResponse' :: Maybe Text
thingName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingTypeName:DescribeThingResponse' :: Maybe Text
thingTypeName = forall a. Maybe a
Prelude.Nothing,
      $sel:version:DescribeThingResponse' :: Maybe Integer
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeThingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The thing attributes.
describeThingResponse_attributes :: Lens.Lens' DescribeThingResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeThingResponse_attributes :: Lens' DescribeThingResponse (Maybe (HashMap Text Text))
describeThingResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:DescribeThingResponse' :: DescribeThingResponse -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe (HashMap Text Text)
a -> DescribeThingResponse
s {$sel:attributes:DescribeThingResponse' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: DescribeThingResponse) 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 name of the billing group the thing belongs to.
describeThingResponse_billingGroupName :: Lens.Lens' DescribeThingResponse (Prelude.Maybe Prelude.Text)
describeThingResponse_billingGroupName :: Lens' DescribeThingResponse (Maybe Text)
describeThingResponse_billingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe Text
billingGroupName :: Maybe Text
$sel:billingGroupName:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
billingGroupName} -> Maybe Text
billingGroupName) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe Text
a -> DescribeThingResponse
s {$sel:billingGroupName:DescribeThingResponse' :: Maybe Text
billingGroupName = Maybe Text
a} :: DescribeThingResponse)

-- | The default MQTT client ID. For a typical device, the thing name is also
-- used as the default MQTT client ID. Although we don’t require a mapping
-- between a thing\'s registry name and its use of MQTT client IDs,
-- certificates, or shadow state, we recommend that you choose a thing name
-- and use it as the MQTT client ID for the registry and the Device Shadow
-- service.
--
-- This lets you better organize your IoT fleet without removing the
-- flexibility of the underlying device certificate model or shadows.
describeThingResponse_defaultClientId :: Lens.Lens' DescribeThingResponse (Prelude.Maybe Prelude.Text)
describeThingResponse_defaultClientId :: Lens' DescribeThingResponse (Maybe Text)
describeThingResponse_defaultClientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe Text
defaultClientId :: Maybe Text
$sel:defaultClientId:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
defaultClientId} -> Maybe Text
defaultClientId) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe Text
a -> DescribeThingResponse
s {$sel:defaultClientId:DescribeThingResponse' :: Maybe Text
defaultClientId = Maybe Text
a} :: DescribeThingResponse)

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

-- | The ID of the thing to describe.
describeThingResponse_thingId :: Lens.Lens' DescribeThingResponse (Prelude.Maybe Prelude.Text)
describeThingResponse_thingId :: Lens' DescribeThingResponse (Maybe Text)
describeThingResponse_thingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe Text
thingId :: Maybe Text
$sel:thingId:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
thingId} -> Maybe Text
thingId) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe Text
a -> DescribeThingResponse
s {$sel:thingId:DescribeThingResponse' :: Maybe Text
thingId = Maybe Text
a} :: DescribeThingResponse)

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

-- | The thing type name.
describeThingResponse_thingTypeName :: Lens.Lens' DescribeThingResponse (Prelude.Maybe Prelude.Text)
describeThingResponse_thingTypeName :: Lens' DescribeThingResponse (Maybe Text)
describeThingResponse_thingTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe Text
thingTypeName :: Maybe Text
$sel:thingTypeName:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
thingTypeName} -> Maybe Text
thingTypeName) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe Text
a -> DescribeThingResponse
s {$sel:thingTypeName:DescribeThingResponse' :: Maybe Text
thingTypeName = Maybe Text
a} :: DescribeThingResponse)

-- | The current version of the thing record in the registry.
--
-- To avoid unintentional changes to the information in the registry, you
-- can pass the version information in the @expectedVersion@ parameter of
-- the @UpdateThing@ and @DeleteThing@ calls.
describeThingResponse_version :: Lens.Lens' DescribeThingResponse (Prelude.Maybe Prelude.Integer)
describeThingResponse_version :: Lens' DescribeThingResponse (Maybe Integer)
describeThingResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeThingResponse' {Maybe Integer
version :: Maybe Integer
$sel:version:DescribeThingResponse' :: DescribeThingResponse -> Maybe Integer
version} -> Maybe Integer
version) (\s :: DescribeThingResponse
s@DescribeThingResponse' {} Maybe Integer
a -> DescribeThingResponse
s {$sel:version:DescribeThingResponse' :: Maybe Integer
version = Maybe Integer
a} :: DescribeThingResponse)

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

instance Prelude.NFData DescribeThingResponse where
  rnf :: DescribeThingResponse -> ()
rnf DescribeThingResponse' {Int
Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
version :: Maybe Integer
thingTypeName :: Maybe Text
thingName :: Maybe Text
thingId :: Maybe Text
thingArn :: Maybe Text
defaultClientId :: Maybe Text
billingGroupName :: Maybe Text
attributes :: Maybe (HashMap Text Text)
$sel:httpStatus:DescribeThingResponse' :: DescribeThingResponse -> Int
$sel:version:DescribeThingResponse' :: DescribeThingResponse -> Maybe Integer
$sel:thingTypeName:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:thingName:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:thingId:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:thingArn:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:defaultClientId:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:billingGroupName:DescribeThingResponse' :: DescribeThingResponse -> Maybe Text
$sel:attributes:DescribeThingResponse' :: DescribeThingResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      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
defaultClientId
      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
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 Maybe Text
thingTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus