{-# 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.OAM.ListAttachedLinks
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of source account links that are linked to this
-- monitoring account sink.
--
-- To use this operation, provide the sink ARN. To retrieve a list of sink
-- ARNs, use
-- <https://docs.aws.amazon.com/OAM/latest/APIReference/API_ListSinks.html ListSinks>.
--
-- To find a list of links for one source account, use
-- <https://docs.aws.amazon.com/OAM/latest/APIReference/API_ListLinks.html ListLinks>.
--
-- This operation returns paginated results.
module Amazonka.OAM.ListAttachedLinks
  ( -- * Creating a Request
    ListAttachedLinks (..),
    newListAttachedLinks,

    -- * Request Lenses
    listAttachedLinks_maxResults,
    listAttachedLinks_nextToken,
    listAttachedLinks_sinkIdentifier,

    -- * Destructuring the Response
    ListAttachedLinksResponse (..),
    newListAttachedLinksResponse,

    -- * Response Lenses
    listAttachedLinksResponse_nextToken,
    listAttachedLinksResponse_httpStatus,
    listAttachedLinksResponse_items,
  )
where

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

-- | /See:/ 'newListAttachedLinks' smart constructor.
data ListAttachedLinks = ListAttachedLinks'
  { -- | Limits the number of returned links to the specified number.
    ListAttachedLinks -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of items to return. You received this token
    -- from a previous call.
    ListAttachedLinks -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the sink that you want to retrieve links for.
    ListAttachedLinks -> Text
sinkIdentifier :: Prelude.Text
  }
  deriving (ListAttachedLinks -> ListAttachedLinks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAttachedLinks -> ListAttachedLinks -> Bool
$c/= :: ListAttachedLinks -> ListAttachedLinks -> Bool
== :: ListAttachedLinks -> ListAttachedLinks -> Bool
$c== :: ListAttachedLinks -> ListAttachedLinks -> Bool
Prelude.Eq, ReadPrec [ListAttachedLinks]
ReadPrec ListAttachedLinks
Int -> ReadS ListAttachedLinks
ReadS [ListAttachedLinks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAttachedLinks]
$creadListPrec :: ReadPrec [ListAttachedLinks]
readPrec :: ReadPrec ListAttachedLinks
$creadPrec :: ReadPrec ListAttachedLinks
readList :: ReadS [ListAttachedLinks]
$creadList :: ReadS [ListAttachedLinks]
readsPrec :: Int -> ReadS ListAttachedLinks
$creadsPrec :: Int -> ReadS ListAttachedLinks
Prelude.Read, Int -> ListAttachedLinks -> ShowS
[ListAttachedLinks] -> ShowS
ListAttachedLinks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAttachedLinks] -> ShowS
$cshowList :: [ListAttachedLinks] -> ShowS
show :: ListAttachedLinks -> String
$cshow :: ListAttachedLinks -> String
showsPrec :: Int -> ListAttachedLinks -> ShowS
$cshowsPrec :: Int -> ListAttachedLinks -> ShowS
Prelude.Show, forall x. Rep ListAttachedLinks x -> ListAttachedLinks
forall x. ListAttachedLinks -> Rep ListAttachedLinks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAttachedLinks x -> ListAttachedLinks
$cfrom :: forall x. ListAttachedLinks -> Rep ListAttachedLinks x
Prelude.Generic)

-- |
-- Create a value of 'ListAttachedLinks' 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:
--
-- 'maxResults', 'listAttachedLinks_maxResults' - Limits the number of returned links to the specified number.
--
-- 'nextToken', 'listAttachedLinks_nextToken' - The token for the next set of items to return. You received this token
-- from a previous call.
--
-- 'sinkIdentifier', 'listAttachedLinks_sinkIdentifier' - The ARN of the sink that you want to retrieve links for.
newListAttachedLinks ::
  -- | 'sinkIdentifier'
  Prelude.Text ->
  ListAttachedLinks
newListAttachedLinks :: Text -> ListAttachedLinks
newListAttachedLinks Text
pSinkIdentifier_ =
  ListAttachedLinks'
    { $sel:maxResults:ListAttachedLinks' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAttachedLinks' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sinkIdentifier:ListAttachedLinks' :: Text
sinkIdentifier = Text
pSinkIdentifier_
    }

-- | Limits the number of returned links to the specified number.
listAttachedLinks_maxResults :: Lens.Lens' ListAttachedLinks (Prelude.Maybe Prelude.Natural)
listAttachedLinks_maxResults :: Lens' ListAttachedLinks (Maybe Natural)
listAttachedLinks_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedLinks' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListAttachedLinks' :: ListAttachedLinks -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListAttachedLinks
s@ListAttachedLinks' {} Maybe Natural
a -> ListAttachedLinks
s {$sel:maxResults:ListAttachedLinks' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListAttachedLinks)

-- | The token for the next set of items to return. You received this token
-- from a previous call.
listAttachedLinks_nextToken :: Lens.Lens' ListAttachedLinks (Prelude.Maybe Prelude.Text)
listAttachedLinks_nextToken :: Lens' ListAttachedLinks (Maybe Text)
listAttachedLinks_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedLinks' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAttachedLinks' :: ListAttachedLinks -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAttachedLinks
s@ListAttachedLinks' {} Maybe Text
a -> ListAttachedLinks
s {$sel:nextToken:ListAttachedLinks' :: Maybe Text
nextToken = Maybe Text
a} :: ListAttachedLinks)

-- | The ARN of the sink that you want to retrieve links for.
listAttachedLinks_sinkIdentifier :: Lens.Lens' ListAttachedLinks Prelude.Text
listAttachedLinks_sinkIdentifier :: Lens' ListAttachedLinks Text
listAttachedLinks_sinkIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedLinks' {Text
sinkIdentifier :: Text
$sel:sinkIdentifier:ListAttachedLinks' :: ListAttachedLinks -> Text
sinkIdentifier} -> Text
sinkIdentifier) (\s :: ListAttachedLinks
s@ListAttachedLinks' {} Text
a -> ListAttachedLinks
s {$sel:sinkIdentifier:ListAttachedLinks' :: Text
sinkIdentifier = Text
a} :: ListAttachedLinks)

instance Core.AWSPager ListAttachedLinks where
  page :: ListAttachedLinks
-> AWSResponse ListAttachedLinks -> Maybe ListAttachedLinks
page ListAttachedLinks
rq AWSResponse ListAttachedLinks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAttachedLinks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAttachedLinksResponse (Maybe Text)
listAttachedLinksResponse_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 ListAttachedLinks
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListAttachedLinksResponse [ListAttachedLinksItem]
listAttachedLinksResponse_items) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListAttachedLinks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAttachedLinks (Maybe Text)
listAttachedLinks_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAttachedLinks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAttachedLinksResponse (Maybe Text)
listAttachedLinksResponse_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 ListAttachedLinks where
  type
    AWSResponse ListAttachedLinks =
      ListAttachedLinksResponse
  request :: (Service -> Service)
-> ListAttachedLinks -> Request ListAttachedLinks
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 ListAttachedLinks
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListAttachedLinks)))
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 -> [ListAttachedLinksItem] -> ListAttachedLinksResponse
ListAttachedLinksResponse'
            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
"Items" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListAttachedLinks where
  hashWithSalt :: Int -> ListAttachedLinks -> Int
hashWithSalt Int
_salt ListAttachedLinks' {Maybe Natural
Maybe Text
Text
sinkIdentifier :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sinkIdentifier:ListAttachedLinks' :: ListAttachedLinks -> Text
$sel:nextToken:ListAttachedLinks' :: ListAttachedLinks -> Maybe Text
$sel:maxResults:ListAttachedLinks' :: ListAttachedLinks -> Maybe Natural
..} =
    Int
_salt
      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` Text
sinkIdentifier

instance Prelude.NFData ListAttachedLinks where
  rnf :: ListAttachedLinks -> ()
rnf ListAttachedLinks' {Maybe Natural
Maybe Text
Text
sinkIdentifier :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sinkIdentifier:ListAttachedLinks' :: ListAttachedLinks -> Text
$sel:nextToken:ListAttachedLinks' :: ListAttachedLinks -> Maybe Text
$sel:maxResults:ListAttachedLinks' :: ListAttachedLinks -> Maybe Natural
..} =
    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 Text
sinkIdentifier

instance Data.ToHeaders ListAttachedLinks where
  toHeaders :: ListAttachedLinks -> 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.ToJSON ListAttachedLinks where
  toJSON :: ListAttachedLinks -> Value
toJSON ListAttachedLinks' {Maybe Natural
Maybe Text
Text
sinkIdentifier :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:sinkIdentifier:ListAttachedLinks' :: ListAttachedLinks -> Text
$sel:nextToken:ListAttachedLinks' :: ListAttachedLinks -> Maybe Text
$sel:maxResults:ListAttachedLinks' :: ListAttachedLinks -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SinkIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sinkIdentifier)
          ]
      )

instance Data.ToPath ListAttachedLinks where
  toPath :: ListAttachedLinks -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/ListAttachedLinks"

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

-- | /See:/ 'newListAttachedLinksResponse' smart constructor.
data ListAttachedLinksResponse = ListAttachedLinksResponse'
  { -- | The token to use when requesting the next set of links.
    ListAttachedLinksResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAttachedLinksResponse -> Int
httpStatus :: Prelude.Int,
    -- | An array of structures that contain the information about the attached
    -- links.
    ListAttachedLinksResponse -> [ListAttachedLinksItem]
items :: [ListAttachedLinksItem]
  }
  deriving (ListAttachedLinksResponse -> ListAttachedLinksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAttachedLinksResponse -> ListAttachedLinksResponse -> Bool
$c/= :: ListAttachedLinksResponse -> ListAttachedLinksResponse -> Bool
== :: ListAttachedLinksResponse -> ListAttachedLinksResponse -> Bool
$c== :: ListAttachedLinksResponse -> ListAttachedLinksResponse -> Bool
Prelude.Eq, ReadPrec [ListAttachedLinksResponse]
ReadPrec ListAttachedLinksResponse
Int -> ReadS ListAttachedLinksResponse
ReadS [ListAttachedLinksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAttachedLinksResponse]
$creadListPrec :: ReadPrec [ListAttachedLinksResponse]
readPrec :: ReadPrec ListAttachedLinksResponse
$creadPrec :: ReadPrec ListAttachedLinksResponse
readList :: ReadS [ListAttachedLinksResponse]
$creadList :: ReadS [ListAttachedLinksResponse]
readsPrec :: Int -> ReadS ListAttachedLinksResponse
$creadsPrec :: Int -> ReadS ListAttachedLinksResponse
Prelude.Read, Int -> ListAttachedLinksResponse -> ShowS
[ListAttachedLinksResponse] -> ShowS
ListAttachedLinksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAttachedLinksResponse] -> ShowS
$cshowList :: [ListAttachedLinksResponse] -> ShowS
show :: ListAttachedLinksResponse -> String
$cshow :: ListAttachedLinksResponse -> String
showsPrec :: Int -> ListAttachedLinksResponse -> ShowS
$cshowsPrec :: Int -> ListAttachedLinksResponse -> ShowS
Prelude.Show, forall x.
Rep ListAttachedLinksResponse x -> ListAttachedLinksResponse
forall x.
ListAttachedLinksResponse -> Rep ListAttachedLinksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAttachedLinksResponse x -> ListAttachedLinksResponse
$cfrom :: forall x.
ListAttachedLinksResponse -> Rep ListAttachedLinksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAttachedLinksResponse' 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', 'listAttachedLinksResponse_nextToken' - The token to use when requesting the next set of links.
--
-- 'httpStatus', 'listAttachedLinksResponse_httpStatus' - The response's http status code.
--
-- 'items', 'listAttachedLinksResponse_items' - An array of structures that contain the information about the attached
-- links.
newListAttachedLinksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAttachedLinksResponse
newListAttachedLinksResponse :: Int -> ListAttachedLinksResponse
newListAttachedLinksResponse Int
pHttpStatus_ =
  ListAttachedLinksResponse'
    { $sel:nextToken:ListAttachedLinksResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAttachedLinksResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:items:ListAttachedLinksResponse' :: [ListAttachedLinksItem]
items = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token to use when requesting the next set of links.
listAttachedLinksResponse_nextToken :: Lens.Lens' ListAttachedLinksResponse (Prelude.Maybe Prelude.Text)
listAttachedLinksResponse_nextToken :: Lens' ListAttachedLinksResponse (Maybe Text)
listAttachedLinksResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedLinksResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAttachedLinksResponse' :: ListAttachedLinksResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAttachedLinksResponse
s@ListAttachedLinksResponse' {} Maybe Text
a -> ListAttachedLinksResponse
s {$sel:nextToken:ListAttachedLinksResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAttachedLinksResponse)

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

-- | An array of structures that contain the information about the attached
-- links.
listAttachedLinksResponse_items :: Lens.Lens' ListAttachedLinksResponse [ListAttachedLinksItem]
listAttachedLinksResponse_items :: Lens' ListAttachedLinksResponse [ListAttachedLinksItem]
listAttachedLinksResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedLinksResponse' {[ListAttachedLinksItem]
items :: [ListAttachedLinksItem]
$sel:items:ListAttachedLinksResponse' :: ListAttachedLinksResponse -> [ListAttachedLinksItem]
items} -> [ListAttachedLinksItem]
items) (\s :: ListAttachedLinksResponse
s@ListAttachedLinksResponse' {} [ListAttachedLinksItem]
a -> ListAttachedLinksResponse
s {$sel:items:ListAttachedLinksResponse' :: [ListAttachedLinksItem]
items = [ListAttachedLinksItem]
a} :: ListAttachedLinksResponse) 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 ListAttachedLinksResponse where
  rnf :: ListAttachedLinksResponse -> ()
rnf ListAttachedLinksResponse' {Int
[ListAttachedLinksItem]
Maybe Text
items :: [ListAttachedLinksItem]
httpStatus :: Int
nextToken :: Maybe Text
$sel:items:ListAttachedLinksResponse' :: ListAttachedLinksResponse -> [ListAttachedLinksItem]
$sel:httpStatus:ListAttachedLinksResponse' :: ListAttachedLinksResponse -> Int
$sel:nextToken:ListAttachedLinksResponse' :: ListAttachedLinksResponse -> 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 [ListAttachedLinksItem]
items