{-# 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.ListAssociatedAssets
-- 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 a paginated list of associated assets.
--
-- You can use this operation to do the following:
--
-- -   List child assets associated to a parent asset by a hierarchy that
--     you specify.
--
-- -   List an asset\'s parent asset.
--
-- This operation returns paginated results.
module Amazonka.IoTSiteWise.ListAssociatedAssets
  ( -- * Creating a Request
    ListAssociatedAssets (..),
    newListAssociatedAssets,

    -- * Request Lenses
    listAssociatedAssets_hierarchyId,
    listAssociatedAssets_maxResults,
    listAssociatedAssets_nextToken,
    listAssociatedAssets_traversalDirection,
    listAssociatedAssets_assetId,

    -- * Destructuring the Response
    ListAssociatedAssetsResponse (..),
    newListAssociatedAssetsResponse,

    -- * Response Lenses
    listAssociatedAssetsResponse_nextToken,
    listAssociatedAssetsResponse_httpStatus,
    listAssociatedAssetsResponse_assetSummaries,
  )
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:/ 'newListAssociatedAssets' smart constructor.
data ListAssociatedAssets = ListAssociatedAssets'
  { -- | The ID of the hierarchy by which child assets are associated to the
    -- asset. To find a hierarchy ID, use the
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAsset.html DescribeAsset>
    -- or
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAssetModel.html DescribeAssetModel>
    -- operations. This parameter is required if you choose @CHILD@ for
    -- @traversalDirection@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/asset-hierarchies.html Asset hierarchies>
    -- in the /IoT SiteWise User Guide/.
    ListAssociatedAssets -> Maybe Text
hierarchyId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to return for each paginated request.
    --
    -- Default: 50
    ListAssociatedAssets -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to be used for the next set of paginated results.
    ListAssociatedAssets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The direction to list associated assets. Choose one of the following
    -- options:
    --
    -- -   @CHILD@ – The list includes all child assets associated to the
    --     asset. The @hierarchyId@ parameter is required if you choose
    --     @CHILD@.
    --
    -- -   @PARENT@ – The list includes the asset\'s parent asset.
    --
    -- Default: @CHILD@
    ListAssociatedAssets -> Maybe TraversalDirection
traversalDirection :: Prelude.Maybe TraversalDirection,
    -- | The ID of the asset to query.
    ListAssociatedAssets -> Text
assetId :: Prelude.Text
  }
  deriving (ListAssociatedAssets -> ListAssociatedAssets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAssociatedAssets -> ListAssociatedAssets -> Bool
$c/= :: ListAssociatedAssets -> ListAssociatedAssets -> Bool
== :: ListAssociatedAssets -> ListAssociatedAssets -> Bool
$c== :: ListAssociatedAssets -> ListAssociatedAssets -> Bool
Prelude.Eq, ReadPrec [ListAssociatedAssets]
ReadPrec ListAssociatedAssets
Int -> ReadS ListAssociatedAssets
ReadS [ListAssociatedAssets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAssociatedAssets]
$creadListPrec :: ReadPrec [ListAssociatedAssets]
readPrec :: ReadPrec ListAssociatedAssets
$creadPrec :: ReadPrec ListAssociatedAssets
readList :: ReadS [ListAssociatedAssets]
$creadList :: ReadS [ListAssociatedAssets]
readsPrec :: Int -> ReadS ListAssociatedAssets
$creadsPrec :: Int -> ReadS ListAssociatedAssets
Prelude.Read, Int -> ListAssociatedAssets -> ShowS
[ListAssociatedAssets] -> ShowS
ListAssociatedAssets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAssociatedAssets] -> ShowS
$cshowList :: [ListAssociatedAssets] -> ShowS
show :: ListAssociatedAssets -> String
$cshow :: ListAssociatedAssets -> String
showsPrec :: Int -> ListAssociatedAssets -> ShowS
$cshowsPrec :: Int -> ListAssociatedAssets -> ShowS
Prelude.Show, forall x. Rep ListAssociatedAssets x -> ListAssociatedAssets
forall x. ListAssociatedAssets -> Rep ListAssociatedAssets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAssociatedAssets x -> ListAssociatedAssets
$cfrom :: forall x. ListAssociatedAssets -> Rep ListAssociatedAssets x
Prelude.Generic)

-- |
-- Create a value of 'ListAssociatedAssets' 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:
--
-- 'hierarchyId', 'listAssociatedAssets_hierarchyId' - The ID of the hierarchy by which child assets are associated to the
-- asset. To find a hierarchy ID, use the
-- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAsset.html DescribeAsset>
-- or
-- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAssetModel.html DescribeAssetModel>
-- operations. This parameter is required if you choose @CHILD@ for
-- @traversalDirection@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/asset-hierarchies.html Asset hierarchies>
-- in the /IoT SiteWise User Guide/.
--
-- 'maxResults', 'listAssociatedAssets_maxResults' - The maximum number of results to return for each paginated request.
--
-- Default: 50
--
-- 'nextToken', 'listAssociatedAssets_nextToken' - The token to be used for the next set of paginated results.
--
-- 'traversalDirection', 'listAssociatedAssets_traversalDirection' - The direction to list associated assets. Choose one of the following
-- options:
--
-- -   @CHILD@ – The list includes all child assets associated to the
--     asset. The @hierarchyId@ parameter is required if you choose
--     @CHILD@.
--
-- -   @PARENT@ – The list includes the asset\'s parent asset.
--
-- Default: @CHILD@
--
-- 'assetId', 'listAssociatedAssets_assetId' - The ID of the asset to query.
newListAssociatedAssets ::
  -- | 'assetId'
  Prelude.Text ->
  ListAssociatedAssets
newListAssociatedAssets :: Text -> ListAssociatedAssets
newListAssociatedAssets Text
pAssetId_ =
  ListAssociatedAssets'
    { $sel:hierarchyId:ListAssociatedAssets' :: Maybe Text
hierarchyId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListAssociatedAssets' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAssociatedAssets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:traversalDirection:ListAssociatedAssets' :: Maybe TraversalDirection
traversalDirection = forall a. Maybe a
Prelude.Nothing,
      $sel:assetId:ListAssociatedAssets' :: Text
assetId = Text
pAssetId_
    }

-- | The ID of the hierarchy by which child assets are associated to the
-- asset. To find a hierarchy ID, use the
-- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAsset.html DescribeAsset>
-- or
-- <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_DescribeAssetModel.html DescribeAssetModel>
-- operations. This parameter is required if you choose @CHILD@ for
-- @traversalDirection@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/asset-hierarchies.html Asset hierarchies>
-- in the /IoT SiteWise User Guide/.
listAssociatedAssets_hierarchyId :: Lens.Lens' ListAssociatedAssets (Prelude.Maybe Prelude.Text)
listAssociatedAssets_hierarchyId :: Lens' ListAssociatedAssets (Maybe Text)
listAssociatedAssets_hierarchyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssets' {Maybe Text
hierarchyId :: Maybe Text
$sel:hierarchyId:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
hierarchyId} -> Maybe Text
hierarchyId) (\s :: ListAssociatedAssets
s@ListAssociatedAssets' {} Maybe Text
a -> ListAssociatedAssets
s {$sel:hierarchyId:ListAssociatedAssets' :: Maybe Text
hierarchyId = Maybe Text
a} :: ListAssociatedAssets)

-- | The maximum number of results to return for each paginated request.
--
-- Default: 50
listAssociatedAssets_maxResults :: Lens.Lens' ListAssociatedAssets (Prelude.Maybe Prelude.Natural)
listAssociatedAssets_maxResults :: Lens' ListAssociatedAssets (Maybe Natural)
listAssociatedAssets_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssets' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListAssociatedAssets
s@ListAssociatedAssets' {} Maybe Natural
a -> ListAssociatedAssets
s {$sel:maxResults:ListAssociatedAssets' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListAssociatedAssets)

-- | The token to be used for the next set of paginated results.
listAssociatedAssets_nextToken :: Lens.Lens' ListAssociatedAssets (Prelude.Maybe Prelude.Text)
listAssociatedAssets_nextToken :: Lens' ListAssociatedAssets (Maybe Text)
listAssociatedAssets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAssociatedAssets
s@ListAssociatedAssets' {} Maybe Text
a -> ListAssociatedAssets
s {$sel:nextToken:ListAssociatedAssets' :: Maybe Text
nextToken = Maybe Text
a} :: ListAssociatedAssets)

-- | The direction to list associated assets. Choose one of the following
-- options:
--
-- -   @CHILD@ – The list includes all child assets associated to the
--     asset. The @hierarchyId@ parameter is required if you choose
--     @CHILD@.
--
-- -   @PARENT@ – The list includes the asset\'s parent asset.
--
-- Default: @CHILD@
listAssociatedAssets_traversalDirection :: Lens.Lens' ListAssociatedAssets (Prelude.Maybe TraversalDirection)
listAssociatedAssets_traversalDirection :: Lens' ListAssociatedAssets (Maybe TraversalDirection)
listAssociatedAssets_traversalDirection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssets' {Maybe TraversalDirection
traversalDirection :: Maybe TraversalDirection
$sel:traversalDirection:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe TraversalDirection
traversalDirection} -> Maybe TraversalDirection
traversalDirection) (\s :: ListAssociatedAssets
s@ListAssociatedAssets' {} Maybe TraversalDirection
a -> ListAssociatedAssets
s {$sel:traversalDirection:ListAssociatedAssets' :: Maybe TraversalDirection
traversalDirection = Maybe TraversalDirection
a} :: ListAssociatedAssets)

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

instance Core.AWSPager ListAssociatedAssets where
  page :: ListAssociatedAssets
-> AWSResponse ListAssociatedAssets -> Maybe ListAssociatedAssets
page ListAssociatedAssets
rq AWSResponse ListAssociatedAssets
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAssociatedAssets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAssociatedAssetsResponse (Maybe Text)
listAssociatedAssetsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAssociatedAssets
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListAssociatedAssetsResponse [AssociatedAssetsSummary]
listAssociatedAssetsResponse_assetSummaries
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListAssociatedAssets
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAssociatedAssets (Maybe Text)
listAssociatedAssets_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAssociatedAssets
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAssociatedAssetsResponse (Maybe Text)
listAssociatedAssetsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListAssociatedAssets where
  type
    AWSResponse ListAssociatedAssets =
      ListAssociatedAssetsResponse
  request :: (Service -> Service)
-> ListAssociatedAssets -> Request ListAssociatedAssets
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 ListAssociatedAssets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListAssociatedAssets)))
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
-> Int -> [AssociatedAssetsSummary] -> ListAssociatedAssetsResponse
ListAssociatedAssetsResponse'
            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
"nextToken")
            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 (Maybe a)
Data..?> Key
"assetSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListAssociatedAssets where
  hashWithSalt :: Int -> ListAssociatedAssets -> Int
hashWithSalt Int
_salt ListAssociatedAssets' {Maybe Natural
Maybe Text
Maybe TraversalDirection
Text
assetId :: Text
traversalDirection :: Maybe TraversalDirection
nextToken :: Maybe Text
maxResults :: Maybe Natural
hierarchyId :: Maybe Text
$sel:assetId:ListAssociatedAssets' :: ListAssociatedAssets -> Text
$sel:traversalDirection:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe TraversalDirection
$sel:nextToken:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
$sel:maxResults:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Natural
$sel:hierarchyId:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hierarchyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TraversalDirection
traversalDirection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assetId

instance Prelude.NFData ListAssociatedAssets where
  rnf :: ListAssociatedAssets -> ()
rnf ListAssociatedAssets' {Maybe Natural
Maybe Text
Maybe TraversalDirection
Text
assetId :: Text
traversalDirection :: Maybe TraversalDirection
nextToken :: Maybe Text
maxResults :: Maybe Natural
hierarchyId :: Maybe Text
$sel:assetId:ListAssociatedAssets' :: ListAssociatedAssets -> Text
$sel:traversalDirection:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe TraversalDirection
$sel:nextToken:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
$sel:maxResults:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Natural
$sel:hierarchyId:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hierarchyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TraversalDirection
traversalDirection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetId

instance Data.ToHeaders ListAssociatedAssets where
  toHeaders :: ListAssociatedAssets -> 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 ListAssociatedAssets where
  toPath :: ListAssociatedAssets -> ByteString
toPath ListAssociatedAssets' {Maybe Natural
Maybe Text
Maybe TraversalDirection
Text
assetId :: Text
traversalDirection :: Maybe TraversalDirection
nextToken :: Maybe Text
maxResults :: Maybe Natural
hierarchyId :: Maybe Text
$sel:assetId:ListAssociatedAssets' :: ListAssociatedAssets -> Text
$sel:traversalDirection:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe TraversalDirection
$sel:nextToken:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
$sel:maxResults:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Natural
$sel:hierarchyId:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/assets/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
assetId, ByteString
"/hierarchies"]

instance Data.ToQuery ListAssociatedAssets where
  toQuery :: ListAssociatedAssets -> QueryString
toQuery ListAssociatedAssets' {Maybe Natural
Maybe Text
Maybe TraversalDirection
Text
assetId :: Text
traversalDirection :: Maybe TraversalDirection
nextToken :: Maybe Text
maxResults :: Maybe Natural
hierarchyId :: Maybe Text
$sel:assetId:ListAssociatedAssets' :: ListAssociatedAssets -> Text
$sel:traversalDirection:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe TraversalDirection
$sel:nextToken:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
$sel:maxResults:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Natural
$sel:hierarchyId:ListAssociatedAssets' :: ListAssociatedAssets -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"hierarchyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hierarchyId,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"traversalDirection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TraversalDirection
traversalDirection
      ]

-- | /See:/ 'newListAssociatedAssetsResponse' smart constructor.
data ListAssociatedAssetsResponse = ListAssociatedAssetsResponse'
  { -- | The token for the next set of results, or null if there are no
    -- additional results.
    ListAssociatedAssetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAssociatedAssetsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list that summarizes the associated assets.
    ListAssociatedAssetsResponse -> [AssociatedAssetsSummary]
assetSummaries :: [AssociatedAssetsSummary]
  }
  deriving (ListAssociatedAssetsResponse
-> ListAssociatedAssetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAssociatedAssetsResponse
-> ListAssociatedAssetsResponse -> Bool
$c/= :: ListAssociatedAssetsResponse
-> ListAssociatedAssetsResponse -> Bool
== :: ListAssociatedAssetsResponse
-> ListAssociatedAssetsResponse -> Bool
$c== :: ListAssociatedAssetsResponse
-> ListAssociatedAssetsResponse -> Bool
Prelude.Eq, ReadPrec [ListAssociatedAssetsResponse]
ReadPrec ListAssociatedAssetsResponse
Int -> ReadS ListAssociatedAssetsResponse
ReadS [ListAssociatedAssetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAssociatedAssetsResponse]
$creadListPrec :: ReadPrec [ListAssociatedAssetsResponse]
readPrec :: ReadPrec ListAssociatedAssetsResponse
$creadPrec :: ReadPrec ListAssociatedAssetsResponse
readList :: ReadS [ListAssociatedAssetsResponse]
$creadList :: ReadS [ListAssociatedAssetsResponse]
readsPrec :: Int -> ReadS ListAssociatedAssetsResponse
$creadsPrec :: Int -> ReadS ListAssociatedAssetsResponse
Prelude.Read, Int -> ListAssociatedAssetsResponse -> ShowS
[ListAssociatedAssetsResponse] -> ShowS
ListAssociatedAssetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAssociatedAssetsResponse] -> ShowS
$cshowList :: [ListAssociatedAssetsResponse] -> ShowS
show :: ListAssociatedAssetsResponse -> String
$cshow :: ListAssociatedAssetsResponse -> String
showsPrec :: Int -> ListAssociatedAssetsResponse -> ShowS
$cshowsPrec :: Int -> ListAssociatedAssetsResponse -> ShowS
Prelude.Show, forall x.
Rep ListAssociatedAssetsResponse x -> ListAssociatedAssetsResponse
forall x.
ListAssociatedAssetsResponse -> Rep ListAssociatedAssetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAssociatedAssetsResponse x -> ListAssociatedAssetsResponse
$cfrom :: forall x.
ListAssociatedAssetsResponse -> Rep ListAssociatedAssetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAssociatedAssetsResponse' 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:
--
-- 'nextToken', 'listAssociatedAssetsResponse_nextToken' - The token for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'listAssociatedAssetsResponse_httpStatus' - The response's http status code.
--
-- 'assetSummaries', 'listAssociatedAssetsResponse_assetSummaries' - A list that summarizes the associated assets.
newListAssociatedAssetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAssociatedAssetsResponse
newListAssociatedAssetsResponse :: Int -> ListAssociatedAssetsResponse
newListAssociatedAssetsResponse Int
pHttpStatus_ =
  ListAssociatedAssetsResponse'
    { $sel:nextToken:ListAssociatedAssetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAssociatedAssetsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:assetSummaries:ListAssociatedAssetsResponse' :: [AssociatedAssetsSummary]
assetSummaries = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token for the next set of results, or null if there are no
-- additional results.
listAssociatedAssetsResponse_nextToken :: Lens.Lens' ListAssociatedAssetsResponse (Prelude.Maybe Prelude.Text)
listAssociatedAssetsResponse_nextToken :: Lens' ListAssociatedAssetsResponse (Maybe Text)
listAssociatedAssetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAssociatedAssetsResponse' :: ListAssociatedAssetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAssociatedAssetsResponse
s@ListAssociatedAssetsResponse' {} Maybe Text
a -> ListAssociatedAssetsResponse
s {$sel:nextToken:ListAssociatedAssetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAssociatedAssetsResponse)

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

-- | A list that summarizes the associated assets.
listAssociatedAssetsResponse_assetSummaries :: Lens.Lens' ListAssociatedAssetsResponse [AssociatedAssetsSummary]
listAssociatedAssetsResponse_assetSummaries :: Lens' ListAssociatedAssetsResponse [AssociatedAssetsSummary]
listAssociatedAssetsResponse_assetSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAssociatedAssetsResponse' {[AssociatedAssetsSummary]
assetSummaries :: [AssociatedAssetsSummary]
$sel:assetSummaries:ListAssociatedAssetsResponse' :: ListAssociatedAssetsResponse -> [AssociatedAssetsSummary]
assetSummaries} -> [AssociatedAssetsSummary]
assetSummaries) (\s :: ListAssociatedAssetsResponse
s@ListAssociatedAssetsResponse' {} [AssociatedAssetsSummary]
a -> ListAssociatedAssetsResponse
s {$sel:assetSummaries:ListAssociatedAssetsResponse' :: [AssociatedAssetsSummary]
assetSummaries = [AssociatedAssetsSummary]
a} :: ListAssociatedAssetsResponse) 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

instance Prelude.NFData ListAssociatedAssetsResponse where
  rnf :: ListAssociatedAssetsResponse -> ()
rnf ListAssociatedAssetsResponse' {Int
[AssociatedAssetsSummary]
Maybe Text
assetSummaries :: [AssociatedAssetsSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:assetSummaries:ListAssociatedAssetsResponse' :: ListAssociatedAssetsResponse -> [AssociatedAssetsSummary]
$sel:httpStatus:ListAssociatedAssetsResponse' :: ListAssociatedAssetsResponse -> Int
$sel:nextToken:ListAssociatedAssetsResponse' :: ListAssociatedAssetsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      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 [AssociatedAssetsSummary]
assetSummaries