{-# 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.NetworkManager.GetLinkAssociations
-- 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 the link associations for a device or a link. Either the device ID
-- or the link ID must be specified.
--
-- This operation returns paginated results.
module Amazonka.NetworkManager.GetLinkAssociations
  ( -- * Creating a Request
    GetLinkAssociations (..),
    newGetLinkAssociations,

    -- * Request Lenses
    getLinkAssociations_deviceId,
    getLinkAssociations_linkId,
    getLinkAssociations_maxResults,
    getLinkAssociations_nextToken,
    getLinkAssociations_globalNetworkId,

    -- * Destructuring the Response
    GetLinkAssociationsResponse (..),
    newGetLinkAssociationsResponse,

    -- * Response Lenses
    getLinkAssociationsResponse_linkAssociations,
    getLinkAssociationsResponse_nextToken,
    getLinkAssociationsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetLinkAssociations' smart constructor.
data GetLinkAssociations = GetLinkAssociations'
  { -- | The ID of the device.
    GetLinkAssociations -> Maybe Text
deviceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the link.
    GetLinkAssociations -> Maybe Text
linkId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to return.
    GetLinkAssociations -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next page of results.
    GetLinkAssociations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    GetLinkAssociations -> Text
globalNetworkId :: Prelude.Text
  }
  deriving (GetLinkAssociations -> GetLinkAssociations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLinkAssociations -> GetLinkAssociations -> Bool
$c/= :: GetLinkAssociations -> GetLinkAssociations -> Bool
== :: GetLinkAssociations -> GetLinkAssociations -> Bool
$c== :: GetLinkAssociations -> GetLinkAssociations -> Bool
Prelude.Eq, ReadPrec [GetLinkAssociations]
ReadPrec GetLinkAssociations
Int -> ReadS GetLinkAssociations
ReadS [GetLinkAssociations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLinkAssociations]
$creadListPrec :: ReadPrec [GetLinkAssociations]
readPrec :: ReadPrec GetLinkAssociations
$creadPrec :: ReadPrec GetLinkAssociations
readList :: ReadS [GetLinkAssociations]
$creadList :: ReadS [GetLinkAssociations]
readsPrec :: Int -> ReadS GetLinkAssociations
$creadsPrec :: Int -> ReadS GetLinkAssociations
Prelude.Read, Int -> GetLinkAssociations -> ShowS
[GetLinkAssociations] -> ShowS
GetLinkAssociations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLinkAssociations] -> ShowS
$cshowList :: [GetLinkAssociations] -> ShowS
show :: GetLinkAssociations -> String
$cshow :: GetLinkAssociations -> String
showsPrec :: Int -> GetLinkAssociations -> ShowS
$cshowsPrec :: Int -> GetLinkAssociations -> ShowS
Prelude.Show, forall x. Rep GetLinkAssociations x -> GetLinkAssociations
forall x. GetLinkAssociations -> Rep GetLinkAssociations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLinkAssociations x -> GetLinkAssociations
$cfrom :: forall x. GetLinkAssociations -> Rep GetLinkAssociations x
Prelude.Generic)

-- |
-- Create a value of 'GetLinkAssociations' 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:
--
-- 'deviceId', 'getLinkAssociations_deviceId' - The ID of the device.
--
-- 'linkId', 'getLinkAssociations_linkId' - The ID of the link.
--
-- 'maxResults', 'getLinkAssociations_maxResults' - The maximum number of results to return.
--
-- 'nextToken', 'getLinkAssociations_nextToken' - The token for the next page of results.
--
-- 'globalNetworkId', 'getLinkAssociations_globalNetworkId' - The ID of the global network.
newGetLinkAssociations ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  GetLinkAssociations
newGetLinkAssociations :: Text -> GetLinkAssociations
newGetLinkAssociations Text
pGlobalNetworkId_ =
  GetLinkAssociations'
    { $sel:deviceId:GetLinkAssociations' :: Maybe Text
deviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:linkId:GetLinkAssociations' :: Maybe Text
linkId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetLinkAssociations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetLinkAssociations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:GetLinkAssociations' :: Text
globalNetworkId = Text
pGlobalNetworkId_
    }

-- | The ID of the device.
getLinkAssociations_deviceId :: Lens.Lens' GetLinkAssociations (Prelude.Maybe Prelude.Text)
getLinkAssociations_deviceId :: Lens' GetLinkAssociations (Maybe Text)
getLinkAssociations_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociations' {Maybe Text
deviceId :: Maybe Text
$sel:deviceId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
deviceId} -> Maybe Text
deviceId) (\s :: GetLinkAssociations
s@GetLinkAssociations' {} Maybe Text
a -> GetLinkAssociations
s {$sel:deviceId:GetLinkAssociations' :: Maybe Text
deviceId = Maybe Text
a} :: GetLinkAssociations)

-- | The ID of the link.
getLinkAssociations_linkId :: Lens.Lens' GetLinkAssociations (Prelude.Maybe Prelude.Text)
getLinkAssociations_linkId :: Lens' GetLinkAssociations (Maybe Text)
getLinkAssociations_linkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociations' {Maybe Text
linkId :: Maybe Text
$sel:linkId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
linkId} -> Maybe Text
linkId) (\s :: GetLinkAssociations
s@GetLinkAssociations' {} Maybe Text
a -> GetLinkAssociations
s {$sel:linkId:GetLinkAssociations' :: Maybe Text
linkId = Maybe Text
a} :: GetLinkAssociations)

-- | The maximum number of results to return.
getLinkAssociations_maxResults :: Lens.Lens' GetLinkAssociations (Prelude.Maybe Prelude.Natural)
getLinkAssociations_maxResults :: Lens' GetLinkAssociations (Maybe Natural)
getLinkAssociations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociations' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetLinkAssociations' :: GetLinkAssociations -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetLinkAssociations
s@GetLinkAssociations' {} Maybe Natural
a -> GetLinkAssociations
s {$sel:maxResults:GetLinkAssociations' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetLinkAssociations)

-- | The token for the next page of results.
getLinkAssociations_nextToken :: Lens.Lens' GetLinkAssociations (Prelude.Maybe Prelude.Text)
getLinkAssociations_nextToken :: Lens' GetLinkAssociations (Maybe Text)
getLinkAssociations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetLinkAssociations
s@GetLinkAssociations' {} Maybe Text
a -> GetLinkAssociations
s {$sel:nextToken:GetLinkAssociations' :: Maybe Text
nextToken = Maybe Text
a} :: GetLinkAssociations)

-- | The ID of the global network.
getLinkAssociations_globalNetworkId :: Lens.Lens' GetLinkAssociations Prelude.Text
getLinkAssociations_globalNetworkId :: Lens' GetLinkAssociations Text
getLinkAssociations_globalNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociations' {Text
globalNetworkId :: Text
$sel:globalNetworkId:GetLinkAssociations' :: GetLinkAssociations -> Text
globalNetworkId} -> Text
globalNetworkId) (\s :: GetLinkAssociations
s@GetLinkAssociations' {} Text
a -> GetLinkAssociations
s {$sel:globalNetworkId:GetLinkAssociations' :: Text
globalNetworkId = Text
a} :: GetLinkAssociations)

instance Core.AWSPager GetLinkAssociations where
  page :: GetLinkAssociations
-> AWSResponse GetLinkAssociations -> Maybe GetLinkAssociations
page GetLinkAssociations
rq AWSResponse GetLinkAssociations
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetLinkAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetLinkAssociationsResponse (Maybe Text)
getLinkAssociationsResponse_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 GetLinkAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetLinkAssociationsResponse (Maybe [LinkAssociation])
getLinkAssociationsResponse_linkAssociations
            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
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetLinkAssociations
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetLinkAssociations (Maybe Text)
getLinkAssociations_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetLinkAssociations
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetLinkAssociationsResponse (Maybe Text)
getLinkAssociationsResponse_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 GetLinkAssociations where
  type
    AWSResponse GetLinkAssociations =
      GetLinkAssociationsResponse
  request :: (Service -> Service)
-> GetLinkAssociations -> Request GetLinkAssociations
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 GetLinkAssociations
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetLinkAssociations)))
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 [LinkAssociation]
-> Maybe Text -> Int -> GetLinkAssociationsResponse
GetLinkAssociationsResponse'
            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
"LinkAssociations"
                            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
"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))
      )

instance Prelude.Hashable GetLinkAssociations where
  hashWithSalt :: Int -> GetLinkAssociations -> Int
hashWithSalt Int
_salt GetLinkAssociations' {Maybe Natural
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
linkId :: Maybe Text
deviceId :: Maybe Text
$sel:globalNetworkId:GetLinkAssociations' :: GetLinkAssociations -> Text
$sel:nextToken:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:maxResults:GetLinkAssociations' :: GetLinkAssociations -> Maybe Natural
$sel:linkId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:deviceId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
linkId
      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
globalNetworkId

instance Prelude.NFData GetLinkAssociations where
  rnf :: GetLinkAssociations -> ()
rnf GetLinkAssociations' {Maybe Natural
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
linkId :: Maybe Text
deviceId :: Maybe Text
$sel:globalNetworkId:GetLinkAssociations' :: GetLinkAssociations -> Text
$sel:nextToken:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:maxResults:GetLinkAssociations' :: GetLinkAssociations -> Maybe Natural
$sel:linkId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:deviceId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
linkId
      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 Text
globalNetworkId

instance Data.ToHeaders GetLinkAssociations where
  toHeaders :: GetLinkAssociations -> 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 GetLinkAssociations where
  toPath :: GetLinkAssociations -> ByteString
toPath GetLinkAssociations' {Maybe Natural
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
linkId :: Maybe Text
deviceId :: Maybe Text
$sel:globalNetworkId:GetLinkAssociations' :: GetLinkAssociations -> Text
$sel:nextToken:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:maxResults:GetLinkAssociations' :: GetLinkAssociations -> Maybe Natural
$sel:linkId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:deviceId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/link-associations"
      ]

instance Data.ToQuery GetLinkAssociations where
  toQuery :: GetLinkAssociations -> QueryString
toQuery GetLinkAssociations' {Maybe Natural
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
linkId :: Maybe Text
deviceId :: Maybe Text
$sel:globalNetworkId:GetLinkAssociations' :: GetLinkAssociations -> Text
$sel:nextToken:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:maxResults:GetLinkAssociations' :: GetLinkAssociations -> Maybe Natural
$sel:linkId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
$sel:deviceId:GetLinkAssociations' :: GetLinkAssociations -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"deviceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
deviceId,
        ByteString
"linkId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
linkId,
        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
      ]

-- | /See:/ 'newGetLinkAssociationsResponse' smart constructor.
data GetLinkAssociationsResponse = GetLinkAssociationsResponse'
  { -- | The link associations.
    GetLinkAssociationsResponse -> Maybe [LinkAssociation]
linkAssociations :: Prelude.Maybe [LinkAssociation],
    -- | The token for the next page of results.
    GetLinkAssociationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetLinkAssociationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLinkAssociationsResponse -> GetLinkAssociationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLinkAssociationsResponse -> GetLinkAssociationsResponse -> Bool
$c/= :: GetLinkAssociationsResponse -> GetLinkAssociationsResponse -> Bool
== :: GetLinkAssociationsResponse -> GetLinkAssociationsResponse -> Bool
$c== :: GetLinkAssociationsResponse -> GetLinkAssociationsResponse -> Bool
Prelude.Eq, ReadPrec [GetLinkAssociationsResponse]
ReadPrec GetLinkAssociationsResponse
Int -> ReadS GetLinkAssociationsResponse
ReadS [GetLinkAssociationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLinkAssociationsResponse]
$creadListPrec :: ReadPrec [GetLinkAssociationsResponse]
readPrec :: ReadPrec GetLinkAssociationsResponse
$creadPrec :: ReadPrec GetLinkAssociationsResponse
readList :: ReadS [GetLinkAssociationsResponse]
$creadList :: ReadS [GetLinkAssociationsResponse]
readsPrec :: Int -> ReadS GetLinkAssociationsResponse
$creadsPrec :: Int -> ReadS GetLinkAssociationsResponse
Prelude.Read, Int -> GetLinkAssociationsResponse -> ShowS
[GetLinkAssociationsResponse] -> ShowS
GetLinkAssociationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLinkAssociationsResponse] -> ShowS
$cshowList :: [GetLinkAssociationsResponse] -> ShowS
show :: GetLinkAssociationsResponse -> String
$cshow :: GetLinkAssociationsResponse -> String
showsPrec :: Int -> GetLinkAssociationsResponse -> ShowS
$cshowsPrec :: Int -> GetLinkAssociationsResponse -> ShowS
Prelude.Show, forall x.
Rep GetLinkAssociationsResponse x -> GetLinkAssociationsResponse
forall x.
GetLinkAssociationsResponse -> Rep GetLinkAssociationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetLinkAssociationsResponse x -> GetLinkAssociationsResponse
$cfrom :: forall x.
GetLinkAssociationsResponse -> Rep GetLinkAssociationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLinkAssociationsResponse' 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:
--
-- 'linkAssociations', 'getLinkAssociationsResponse_linkAssociations' - The link associations.
--
-- 'nextToken', 'getLinkAssociationsResponse_nextToken' - The token for the next page of results.
--
-- 'httpStatus', 'getLinkAssociationsResponse_httpStatus' - The response's http status code.
newGetLinkAssociationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLinkAssociationsResponse
newGetLinkAssociationsResponse :: Int -> GetLinkAssociationsResponse
newGetLinkAssociationsResponse Int
pHttpStatus_ =
  GetLinkAssociationsResponse'
    { $sel:linkAssociations:GetLinkAssociationsResponse' :: Maybe [LinkAssociation]
linkAssociations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetLinkAssociationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLinkAssociationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The link associations.
getLinkAssociationsResponse_linkAssociations :: Lens.Lens' GetLinkAssociationsResponse (Prelude.Maybe [LinkAssociation])
getLinkAssociationsResponse_linkAssociations :: Lens' GetLinkAssociationsResponse (Maybe [LinkAssociation])
getLinkAssociationsResponse_linkAssociations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociationsResponse' {Maybe [LinkAssociation]
linkAssociations :: Maybe [LinkAssociation]
$sel:linkAssociations:GetLinkAssociationsResponse' :: GetLinkAssociationsResponse -> Maybe [LinkAssociation]
linkAssociations} -> Maybe [LinkAssociation]
linkAssociations) (\s :: GetLinkAssociationsResponse
s@GetLinkAssociationsResponse' {} Maybe [LinkAssociation]
a -> GetLinkAssociationsResponse
s {$sel:linkAssociations:GetLinkAssociationsResponse' :: Maybe [LinkAssociation]
linkAssociations = Maybe [LinkAssociation]
a} :: GetLinkAssociationsResponse) 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 token for the next page of results.
getLinkAssociationsResponse_nextToken :: Lens.Lens' GetLinkAssociationsResponse (Prelude.Maybe Prelude.Text)
getLinkAssociationsResponse_nextToken :: Lens' GetLinkAssociationsResponse (Maybe Text)
getLinkAssociationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAssociationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetLinkAssociationsResponse' :: GetLinkAssociationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetLinkAssociationsResponse
s@GetLinkAssociationsResponse' {} Maybe Text
a -> GetLinkAssociationsResponse
s {$sel:nextToken:GetLinkAssociationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetLinkAssociationsResponse)

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

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