{-# 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.IoTSiteWise.DescribeAsset
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about an asset.
module Amazonka.IoTSiteWise.DescribeAsset
  ( -- * Creating a Request
    DescribeAsset (..),
    newDescribeAsset,

    -- * Request Lenses
    describeAsset_excludeProperties,
    describeAsset_assetId,

    -- * Destructuring the Response
    DescribeAssetResponse (..),
    newDescribeAssetResponse,

    -- * Response Lenses
    describeAssetResponse_assetCompositeModels,
    describeAssetResponse_assetDescription,
    describeAssetResponse_httpStatus,
    describeAssetResponse_assetId,
    describeAssetResponse_assetArn,
    describeAssetResponse_assetName,
    describeAssetResponse_assetModelId,
    describeAssetResponse_assetProperties,
    describeAssetResponse_assetHierarchies,
    describeAssetResponse_assetCreationDate,
    describeAssetResponse_assetLastUpdateDate,
    describeAssetResponse_assetStatus,
  )
where

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

-- | /See:/ 'newDescribeAsset' smart constructor.
data DescribeAsset = DescribeAsset'
  { -- | Whether or not to exclude asset properties from the response.
    DescribeAsset -> Maybe Bool
excludeProperties :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the asset.
    DescribeAsset -> Text
assetId :: Prelude.Text
  }
  deriving (DescribeAsset -> DescribeAsset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAsset -> DescribeAsset -> Bool
$c/= :: DescribeAsset -> DescribeAsset -> Bool
== :: DescribeAsset -> DescribeAsset -> Bool
$c== :: DescribeAsset -> DescribeAsset -> Bool
Prelude.Eq, ReadPrec [DescribeAsset]
ReadPrec DescribeAsset
Int -> ReadS DescribeAsset
ReadS [DescribeAsset]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAsset]
$creadListPrec :: ReadPrec [DescribeAsset]
readPrec :: ReadPrec DescribeAsset
$creadPrec :: ReadPrec DescribeAsset
readList :: ReadS [DescribeAsset]
$creadList :: ReadS [DescribeAsset]
readsPrec :: Int -> ReadS DescribeAsset
$creadsPrec :: Int -> ReadS DescribeAsset
Prelude.Read, Int -> DescribeAsset -> ShowS
[DescribeAsset] -> ShowS
DescribeAsset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAsset] -> ShowS
$cshowList :: [DescribeAsset] -> ShowS
show :: DescribeAsset -> String
$cshow :: DescribeAsset -> String
showsPrec :: Int -> DescribeAsset -> ShowS
$cshowsPrec :: Int -> DescribeAsset -> ShowS
Prelude.Show, forall x. Rep DescribeAsset x -> DescribeAsset
forall x. DescribeAsset -> Rep DescribeAsset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAsset x -> DescribeAsset
$cfrom :: forall x. DescribeAsset -> Rep DescribeAsset x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAsset' 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:
--
-- 'excludeProperties', 'describeAsset_excludeProperties' - Whether or not to exclude asset properties from the response.
--
-- 'assetId', 'describeAsset_assetId' - The ID of the asset.
newDescribeAsset ::
  -- | 'assetId'
  Prelude.Text ->
  DescribeAsset
newDescribeAsset :: Text -> DescribeAsset
newDescribeAsset Text
pAssetId_ =
  DescribeAsset'
    { $sel:excludeProperties:DescribeAsset' :: Maybe Bool
excludeProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:assetId:DescribeAsset' :: Text
assetId = Text
pAssetId_
    }

-- | Whether or not to exclude asset properties from the response.
describeAsset_excludeProperties :: Lens.Lens' DescribeAsset (Prelude.Maybe Prelude.Bool)
describeAsset_excludeProperties :: Lens' DescribeAsset (Maybe Bool)
describeAsset_excludeProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAsset' {Maybe Bool
excludeProperties :: Maybe Bool
$sel:excludeProperties:DescribeAsset' :: DescribeAsset -> Maybe Bool
excludeProperties} -> Maybe Bool
excludeProperties) (\s :: DescribeAsset
s@DescribeAsset' {} Maybe Bool
a -> DescribeAsset
s {$sel:excludeProperties:DescribeAsset' :: Maybe Bool
excludeProperties = Maybe Bool
a} :: DescribeAsset)

-- | The ID of the asset.
describeAsset_assetId :: Lens.Lens' DescribeAsset Prelude.Text
describeAsset_assetId :: Lens' DescribeAsset Text
describeAsset_assetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAsset' {Text
assetId :: Text
$sel:assetId:DescribeAsset' :: DescribeAsset -> Text
assetId} -> Text
assetId) (\s :: DescribeAsset
s@DescribeAsset' {} Text
a -> DescribeAsset
s {$sel:assetId:DescribeAsset' :: Text
assetId = Text
a} :: DescribeAsset)

instance Core.AWSRequest DescribeAsset where
  type
    AWSResponse DescribeAsset =
      DescribeAssetResponse
  request :: (Service -> Service) -> DescribeAsset -> Request DescribeAsset
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 DescribeAsset
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeAsset)))
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 [AssetCompositeModel]
-> Maybe Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> [AssetProperty]
-> [AssetHierarchy]
-> POSIX
-> POSIX
-> AssetStatus
-> DescribeAssetResponse
DescribeAssetResponse'
            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
"assetCompositeModels"
                            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
"assetDescription")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetModelId")
            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
"assetProperties"
                            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
"assetHierarchies"
                            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 a
Data..:> Key
"assetCreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetLastUpdateDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"assetStatus")
      )

instance Prelude.Hashable DescribeAsset where
  hashWithSalt :: Int -> DescribeAsset -> Int
hashWithSalt Int
_salt DescribeAsset' {Maybe Bool
Text
assetId :: Text
excludeProperties :: Maybe Bool
$sel:assetId:DescribeAsset' :: DescribeAsset -> Text
$sel:excludeProperties:DescribeAsset' :: DescribeAsset -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
excludeProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assetId

instance Prelude.NFData DescribeAsset where
  rnf :: DescribeAsset -> ()
rnf DescribeAsset' {Maybe Bool
Text
assetId :: Text
excludeProperties :: Maybe Bool
$sel:assetId:DescribeAsset' :: DescribeAsset -> Text
$sel:excludeProperties:DescribeAsset' :: DescribeAsset -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
excludeProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetId

instance Data.ToHeaders DescribeAsset where
  toHeaders :: DescribeAsset -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DescribeAsset where
  toPath :: DescribeAsset -> ByteString
toPath DescribeAsset' {Maybe Bool
Text
assetId :: Text
excludeProperties :: Maybe Bool
$sel:assetId:DescribeAsset' :: DescribeAsset -> Text
$sel:excludeProperties:DescribeAsset' :: DescribeAsset -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/assets/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
assetId]

instance Data.ToQuery DescribeAsset where
  toQuery :: DescribeAsset -> QueryString
toQuery DescribeAsset' {Maybe Bool
Text
assetId :: Text
excludeProperties :: Maybe Bool
$sel:assetId:DescribeAsset' :: DescribeAsset -> Text
$sel:excludeProperties:DescribeAsset' :: DescribeAsset -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"excludeProperties" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
excludeProperties]

-- | /See:/ 'newDescribeAssetResponse' smart constructor.
data DescribeAssetResponse = DescribeAssetResponse'
  { -- | The composite models for the asset.
    DescribeAssetResponse -> Maybe [AssetCompositeModel]
assetCompositeModels :: Prelude.Maybe [AssetCompositeModel],
    -- | A description for the asset.
    DescribeAssetResponse -> Maybe Text
assetDescription :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeAssetResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the asset.
    DescribeAssetResponse -> Text
assetId :: Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the asset, which has the following format.
    --
    -- @arn:${Partition}:iotsitewise:${Region}:${Account}:asset\/${AssetId}@
    DescribeAssetResponse -> Text
assetArn :: Prelude.Text,
    -- | The name of the asset.
    DescribeAssetResponse -> Text
assetName :: Prelude.Text,
    -- | The ID of the asset model that was used to create the asset.
    DescribeAssetResponse -> Text
assetModelId :: Prelude.Text,
    -- | The list of asset properties for the asset.
    --
    -- This object doesn\'t include properties that you define in composite
    -- models. You can find composite model properties in the
    -- @assetCompositeModels@ object.
    DescribeAssetResponse -> [AssetProperty]
assetProperties :: [AssetProperty],
    -- | A list of asset hierarchies that each contain a @hierarchyId@. A
    -- hierarchy specifies allowed parent\/child asset relationships.
    DescribeAssetResponse -> [AssetHierarchy]
assetHierarchies :: [AssetHierarchy],
    -- | The date the asset was created, in Unix epoch time.
    DescribeAssetResponse -> POSIX
assetCreationDate :: Data.POSIX,
    -- | The date the asset was last updated, in Unix epoch time.
    DescribeAssetResponse -> POSIX
assetLastUpdateDate :: Data.POSIX,
    -- | The current status of the asset, which contains a state and any error
    -- message.
    DescribeAssetResponse -> AssetStatus
assetStatus :: AssetStatus
  }
  deriving (DescribeAssetResponse -> DescribeAssetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAssetResponse -> DescribeAssetResponse -> Bool
$c/= :: DescribeAssetResponse -> DescribeAssetResponse -> Bool
== :: DescribeAssetResponse -> DescribeAssetResponse -> Bool
$c== :: DescribeAssetResponse -> DescribeAssetResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAssetResponse]
ReadPrec DescribeAssetResponse
Int -> ReadS DescribeAssetResponse
ReadS [DescribeAssetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAssetResponse]
$creadListPrec :: ReadPrec [DescribeAssetResponse]
readPrec :: ReadPrec DescribeAssetResponse
$creadPrec :: ReadPrec DescribeAssetResponse
readList :: ReadS [DescribeAssetResponse]
$creadList :: ReadS [DescribeAssetResponse]
readsPrec :: Int -> ReadS DescribeAssetResponse
$creadsPrec :: Int -> ReadS DescribeAssetResponse
Prelude.Read, Int -> DescribeAssetResponse -> ShowS
[DescribeAssetResponse] -> ShowS
DescribeAssetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAssetResponse] -> ShowS
$cshowList :: [DescribeAssetResponse] -> ShowS
show :: DescribeAssetResponse -> String
$cshow :: DescribeAssetResponse -> String
showsPrec :: Int -> DescribeAssetResponse -> ShowS
$cshowsPrec :: Int -> DescribeAssetResponse -> ShowS
Prelude.Show, forall x. Rep DescribeAssetResponse x -> DescribeAssetResponse
forall x. DescribeAssetResponse -> Rep DescribeAssetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAssetResponse x -> DescribeAssetResponse
$cfrom :: forall x. DescribeAssetResponse -> Rep DescribeAssetResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAssetResponse' 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:
--
-- 'assetCompositeModels', 'describeAssetResponse_assetCompositeModels' - The composite models for the asset.
--
-- 'assetDescription', 'describeAssetResponse_assetDescription' - A description for the asset.
--
-- 'httpStatus', 'describeAssetResponse_httpStatus' - The response's http status code.
--
-- 'assetId', 'describeAssetResponse_assetId' - The ID of the asset.
--
-- 'assetArn', 'describeAssetResponse_assetArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the asset, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:asset\/${AssetId}@
--
-- 'assetName', 'describeAssetResponse_assetName' - The name of the asset.
--
-- 'assetModelId', 'describeAssetResponse_assetModelId' - The ID of the asset model that was used to create the asset.
--
-- 'assetProperties', 'describeAssetResponse_assetProperties' - The list of asset properties for the asset.
--
-- This object doesn\'t include properties that you define in composite
-- models. You can find composite model properties in the
-- @assetCompositeModels@ object.
--
-- 'assetHierarchies', 'describeAssetResponse_assetHierarchies' - A list of asset hierarchies that each contain a @hierarchyId@. A
-- hierarchy specifies allowed parent\/child asset relationships.
--
-- 'assetCreationDate', 'describeAssetResponse_assetCreationDate' - The date the asset was created, in Unix epoch time.
--
-- 'assetLastUpdateDate', 'describeAssetResponse_assetLastUpdateDate' - The date the asset was last updated, in Unix epoch time.
--
-- 'assetStatus', 'describeAssetResponse_assetStatus' - The current status of the asset, which contains a state and any error
-- message.
newDescribeAssetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'assetId'
  Prelude.Text ->
  -- | 'assetArn'
  Prelude.Text ->
  -- | 'assetName'
  Prelude.Text ->
  -- | 'assetModelId'
  Prelude.Text ->
  -- | 'assetCreationDate'
  Prelude.UTCTime ->
  -- | 'assetLastUpdateDate'
  Prelude.UTCTime ->
  -- | 'assetStatus'
  AssetStatus ->
  DescribeAssetResponse
newDescribeAssetResponse :: Int
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> UTCTime
-> AssetStatus
-> DescribeAssetResponse
newDescribeAssetResponse
  Int
pHttpStatus_
  Text
pAssetId_
  Text
pAssetArn_
  Text
pAssetName_
  Text
pAssetModelId_
  UTCTime
pAssetCreationDate_
  UTCTime
pAssetLastUpdateDate_
  AssetStatus
pAssetStatus_ =
    DescribeAssetResponse'
      { $sel:assetCompositeModels:DescribeAssetResponse' :: Maybe [AssetCompositeModel]
assetCompositeModels =
          forall a. Maybe a
Prelude.Nothing,
        $sel:assetDescription:DescribeAssetResponse' :: Maybe Text
assetDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeAssetResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:assetId:DescribeAssetResponse' :: Text
assetId = Text
pAssetId_,
        $sel:assetArn:DescribeAssetResponse' :: Text
assetArn = Text
pAssetArn_,
        $sel:assetName:DescribeAssetResponse' :: Text
assetName = Text
pAssetName_,
        $sel:assetModelId:DescribeAssetResponse' :: Text
assetModelId = Text
pAssetModelId_,
        $sel:assetProperties:DescribeAssetResponse' :: [AssetProperty]
assetProperties = forall a. Monoid a => a
Prelude.mempty,
        $sel:assetHierarchies:DescribeAssetResponse' :: [AssetHierarchy]
assetHierarchies = forall a. Monoid a => a
Prelude.mempty,
        $sel:assetCreationDate:DescribeAssetResponse' :: POSIX
assetCreationDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pAssetCreationDate_,
        $sel:assetLastUpdateDate:DescribeAssetResponse' :: POSIX
assetLastUpdateDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pAssetLastUpdateDate_,
        $sel:assetStatus:DescribeAssetResponse' :: AssetStatus
assetStatus = AssetStatus
pAssetStatus_
      }

-- | The composite models for the asset.
describeAssetResponse_assetCompositeModels :: Lens.Lens' DescribeAssetResponse (Prelude.Maybe [AssetCompositeModel])
describeAssetResponse_assetCompositeModels :: Lens' DescribeAssetResponse (Maybe [AssetCompositeModel])
describeAssetResponse_assetCompositeModels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Maybe [AssetCompositeModel]
assetCompositeModels :: Maybe [AssetCompositeModel]
$sel:assetCompositeModels:DescribeAssetResponse' :: DescribeAssetResponse -> Maybe [AssetCompositeModel]
assetCompositeModels} -> Maybe [AssetCompositeModel]
assetCompositeModels) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Maybe [AssetCompositeModel]
a -> DescribeAssetResponse
s {$sel:assetCompositeModels:DescribeAssetResponse' :: Maybe [AssetCompositeModel]
assetCompositeModels = Maybe [AssetCompositeModel]
a} :: DescribeAssetResponse) 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

-- | A description for the asset.
describeAssetResponse_assetDescription :: Lens.Lens' DescribeAssetResponse (Prelude.Maybe Prelude.Text)
describeAssetResponse_assetDescription :: Lens' DescribeAssetResponse (Maybe Text)
describeAssetResponse_assetDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Maybe Text
assetDescription :: Maybe Text
$sel:assetDescription:DescribeAssetResponse' :: DescribeAssetResponse -> Maybe Text
assetDescription} -> Maybe Text
assetDescription) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Maybe Text
a -> DescribeAssetResponse
s {$sel:assetDescription:DescribeAssetResponse' :: Maybe Text
assetDescription = Maybe Text
a} :: DescribeAssetResponse)

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

-- | The ID of the asset.
describeAssetResponse_assetId :: Lens.Lens' DescribeAssetResponse Prelude.Text
describeAssetResponse_assetId :: Lens' DescribeAssetResponse Text
describeAssetResponse_assetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Text
assetId :: Text
$sel:assetId:DescribeAssetResponse' :: DescribeAssetResponse -> Text
assetId} -> Text
assetId) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Text
a -> DescribeAssetResponse
s {$sel:assetId:DescribeAssetResponse' :: Text
assetId = Text
a} :: DescribeAssetResponse)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the asset, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:asset\/${AssetId}@
describeAssetResponse_assetArn :: Lens.Lens' DescribeAssetResponse Prelude.Text
describeAssetResponse_assetArn :: Lens' DescribeAssetResponse Text
describeAssetResponse_assetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Text
assetArn :: Text
$sel:assetArn:DescribeAssetResponse' :: DescribeAssetResponse -> Text
assetArn} -> Text
assetArn) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Text
a -> DescribeAssetResponse
s {$sel:assetArn:DescribeAssetResponse' :: Text
assetArn = Text
a} :: DescribeAssetResponse)

-- | The name of the asset.
describeAssetResponse_assetName :: Lens.Lens' DescribeAssetResponse Prelude.Text
describeAssetResponse_assetName :: Lens' DescribeAssetResponse Text
describeAssetResponse_assetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Text
assetName :: Text
$sel:assetName:DescribeAssetResponse' :: DescribeAssetResponse -> Text
assetName} -> Text
assetName) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Text
a -> DescribeAssetResponse
s {$sel:assetName:DescribeAssetResponse' :: Text
assetName = Text
a} :: DescribeAssetResponse)

-- | The ID of the asset model that was used to create the asset.
describeAssetResponse_assetModelId :: Lens.Lens' DescribeAssetResponse Prelude.Text
describeAssetResponse_assetModelId :: Lens' DescribeAssetResponse Text
describeAssetResponse_assetModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {Text
assetModelId :: Text
$sel:assetModelId:DescribeAssetResponse' :: DescribeAssetResponse -> Text
assetModelId} -> Text
assetModelId) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} Text
a -> DescribeAssetResponse
s {$sel:assetModelId:DescribeAssetResponse' :: Text
assetModelId = Text
a} :: DescribeAssetResponse)

-- | The list of asset properties for the asset.
--
-- This object doesn\'t include properties that you define in composite
-- models. You can find composite model properties in the
-- @assetCompositeModels@ object.
describeAssetResponse_assetProperties :: Lens.Lens' DescribeAssetResponse [AssetProperty]
describeAssetResponse_assetProperties :: Lens' DescribeAssetResponse [AssetProperty]
describeAssetResponse_assetProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {[AssetProperty]
assetProperties :: [AssetProperty]
$sel:assetProperties:DescribeAssetResponse' :: DescribeAssetResponse -> [AssetProperty]
assetProperties} -> [AssetProperty]
assetProperties) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} [AssetProperty]
a -> DescribeAssetResponse
s {$sel:assetProperties:DescribeAssetResponse' :: [AssetProperty]
assetProperties = [AssetProperty]
a} :: DescribeAssetResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of asset hierarchies that each contain a @hierarchyId@. A
-- hierarchy specifies allowed parent\/child asset relationships.
describeAssetResponse_assetHierarchies :: Lens.Lens' DescribeAssetResponse [AssetHierarchy]
describeAssetResponse_assetHierarchies :: Lens' DescribeAssetResponse [AssetHierarchy]
describeAssetResponse_assetHierarchies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {[AssetHierarchy]
assetHierarchies :: [AssetHierarchy]
$sel:assetHierarchies:DescribeAssetResponse' :: DescribeAssetResponse -> [AssetHierarchy]
assetHierarchies} -> [AssetHierarchy]
assetHierarchies) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} [AssetHierarchy]
a -> DescribeAssetResponse
s {$sel:assetHierarchies:DescribeAssetResponse' :: [AssetHierarchy]
assetHierarchies = [AssetHierarchy]
a} :: DescribeAssetResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date the asset was created, in Unix epoch time.
describeAssetResponse_assetCreationDate :: Lens.Lens' DescribeAssetResponse Prelude.UTCTime
describeAssetResponse_assetCreationDate :: Lens' DescribeAssetResponse UTCTime
describeAssetResponse_assetCreationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {POSIX
assetCreationDate :: POSIX
$sel:assetCreationDate:DescribeAssetResponse' :: DescribeAssetResponse -> POSIX
assetCreationDate} -> POSIX
assetCreationDate) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} POSIX
a -> DescribeAssetResponse
s {$sel:assetCreationDate:DescribeAssetResponse' :: POSIX
assetCreationDate = POSIX
a} :: DescribeAssetResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date the asset was last updated, in Unix epoch time.
describeAssetResponse_assetLastUpdateDate :: Lens.Lens' DescribeAssetResponse Prelude.UTCTime
describeAssetResponse_assetLastUpdateDate :: Lens' DescribeAssetResponse UTCTime
describeAssetResponse_assetLastUpdateDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {POSIX
assetLastUpdateDate :: POSIX
$sel:assetLastUpdateDate:DescribeAssetResponse' :: DescribeAssetResponse -> POSIX
assetLastUpdateDate} -> POSIX
assetLastUpdateDate) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} POSIX
a -> DescribeAssetResponse
s {$sel:assetLastUpdateDate:DescribeAssetResponse' :: POSIX
assetLastUpdateDate = POSIX
a} :: DescribeAssetResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current status of the asset, which contains a state and any error
-- message.
describeAssetResponse_assetStatus :: Lens.Lens' DescribeAssetResponse AssetStatus
describeAssetResponse_assetStatus :: Lens' DescribeAssetResponse AssetStatus
describeAssetResponse_assetStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAssetResponse' {AssetStatus
assetStatus :: AssetStatus
$sel:assetStatus:DescribeAssetResponse' :: DescribeAssetResponse -> AssetStatus
assetStatus} -> AssetStatus
assetStatus) (\s :: DescribeAssetResponse
s@DescribeAssetResponse' {} AssetStatus
a -> DescribeAssetResponse
s {$sel:assetStatus:DescribeAssetResponse' :: AssetStatus
assetStatus = AssetStatus
a} :: DescribeAssetResponse)

instance Prelude.NFData DescribeAssetResponse where
  rnf :: DescribeAssetResponse -> ()
rnf DescribeAssetResponse' {Int
[AssetHierarchy]
[AssetProperty]
Maybe [AssetCompositeModel]
Maybe Text
Text
POSIX
AssetStatus
assetStatus :: AssetStatus
assetLastUpdateDate :: POSIX
assetCreationDate :: POSIX
assetHierarchies :: [AssetHierarchy]
assetProperties :: [AssetProperty]
assetModelId :: Text
assetName :: Text
assetArn :: Text
assetId :: Text
httpStatus :: Int
assetDescription :: Maybe Text
assetCompositeModels :: Maybe [AssetCompositeModel]
$sel:assetStatus:DescribeAssetResponse' :: DescribeAssetResponse -> AssetStatus
$sel:assetLastUpdateDate:DescribeAssetResponse' :: DescribeAssetResponse -> POSIX
$sel:assetCreationDate:DescribeAssetResponse' :: DescribeAssetResponse -> POSIX
$sel:assetHierarchies:DescribeAssetResponse' :: DescribeAssetResponse -> [AssetHierarchy]
$sel:assetProperties:DescribeAssetResponse' :: DescribeAssetResponse -> [AssetProperty]
$sel:assetModelId:DescribeAssetResponse' :: DescribeAssetResponse -> Text
$sel:assetName:DescribeAssetResponse' :: DescribeAssetResponse -> Text
$sel:assetArn:DescribeAssetResponse' :: DescribeAssetResponse -> Text
$sel:assetId:DescribeAssetResponse' :: DescribeAssetResponse -> Text
$sel:httpStatus:DescribeAssetResponse' :: DescribeAssetResponse -> Int
$sel:assetDescription:DescribeAssetResponse' :: DescribeAssetResponse -> Maybe Text
$sel:assetCompositeModels:DescribeAssetResponse' :: DescribeAssetResponse -> Maybe [AssetCompositeModel]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AssetCompositeModel]
assetCompositeModels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
assetDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetModelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AssetProperty]
assetProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AssetHierarchy]
assetHierarchies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
assetCreationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
assetLastUpdateDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AssetStatus
assetStatus