{-# 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.GetConnectPeerAssociations
-- 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 information about a core network Connect peer associations.
--
-- This operation returns paginated results.
module Amazonka.NetworkManager.GetConnectPeerAssociations
  ( -- * Creating a Request
    GetConnectPeerAssociations (..),
    newGetConnectPeerAssociations,

    -- * Request Lenses
    getConnectPeerAssociations_connectPeerIds,
    getConnectPeerAssociations_maxResults,
    getConnectPeerAssociations_nextToken,
    getConnectPeerAssociations_globalNetworkId,

    -- * Destructuring the Response
    GetConnectPeerAssociationsResponse (..),
    newGetConnectPeerAssociationsResponse,

    -- * Response Lenses
    getConnectPeerAssociationsResponse_connectPeerAssociations,
    getConnectPeerAssociationsResponse_nextToken,
    getConnectPeerAssociationsResponse_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:/ 'newGetConnectPeerAssociations' smart constructor.
data GetConnectPeerAssociations = GetConnectPeerAssociations'
  { -- | The IDs of the Connect peers.
    GetConnectPeerAssociations -> Maybe [Text]
connectPeerIds :: Prelude.Maybe [Prelude.Text],
    -- | The maximum number of results to return.
    GetConnectPeerAssociations -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next page of results.
    GetConnectPeerAssociations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    GetConnectPeerAssociations -> Text
globalNetworkId :: Prelude.Text
  }
  deriving (GetConnectPeerAssociations -> GetConnectPeerAssociations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConnectPeerAssociations -> GetConnectPeerAssociations -> Bool
$c/= :: GetConnectPeerAssociations -> GetConnectPeerAssociations -> Bool
== :: GetConnectPeerAssociations -> GetConnectPeerAssociations -> Bool
$c== :: GetConnectPeerAssociations -> GetConnectPeerAssociations -> Bool
Prelude.Eq, ReadPrec [GetConnectPeerAssociations]
ReadPrec GetConnectPeerAssociations
Int -> ReadS GetConnectPeerAssociations
ReadS [GetConnectPeerAssociations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetConnectPeerAssociations]
$creadListPrec :: ReadPrec [GetConnectPeerAssociations]
readPrec :: ReadPrec GetConnectPeerAssociations
$creadPrec :: ReadPrec GetConnectPeerAssociations
readList :: ReadS [GetConnectPeerAssociations]
$creadList :: ReadS [GetConnectPeerAssociations]
readsPrec :: Int -> ReadS GetConnectPeerAssociations
$creadsPrec :: Int -> ReadS GetConnectPeerAssociations
Prelude.Read, Int -> GetConnectPeerAssociations -> ShowS
[GetConnectPeerAssociations] -> ShowS
GetConnectPeerAssociations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConnectPeerAssociations] -> ShowS
$cshowList :: [GetConnectPeerAssociations] -> ShowS
show :: GetConnectPeerAssociations -> String
$cshow :: GetConnectPeerAssociations -> String
showsPrec :: Int -> GetConnectPeerAssociations -> ShowS
$cshowsPrec :: Int -> GetConnectPeerAssociations -> ShowS
Prelude.Show, forall x.
Rep GetConnectPeerAssociations x -> GetConnectPeerAssociations
forall x.
GetConnectPeerAssociations -> Rep GetConnectPeerAssociations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetConnectPeerAssociations x -> GetConnectPeerAssociations
$cfrom :: forall x.
GetConnectPeerAssociations -> Rep GetConnectPeerAssociations x
Prelude.Generic)

-- |
-- Create a value of 'GetConnectPeerAssociations' 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:
--
-- 'connectPeerIds', 'getConnectPeerAssociations_connectPeerIds' - The IDs of the Connect peers.
--
-- 'maxResults', 'getConnectPeerAssociations_maxResults' - The maximum number of results to return.
--
-- 'nextToken', 'getConnectPeerAssociations_nextToken' - The token for the next page of results.
--
-- 'globalNetworkId', 'getConnectPeerAssociations_globalNetworkId' - The ID of the global network.
newGetConnectPeerAssociations ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  GetConnectPeerAssociations
newGetConnectPeerAssociations :: Text -> GetConnectPeerAssociations
newGetConnectPeerAssociations Text
pGlobalNetworkId_ =
  GetConnectPeerAssociations'
    { $sel:connectPeerIds:GetConnectPeerAssociations' :: Maybe [Text]
connectPeerIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetConnectPeerAssociations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetConnectPeerAssociations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:GetConnectPeerAssociations' :: Text
globalNetworkId = Text
pGlobalNetworkId_
    }

-- | The IDs of the Connect peers.
getConnectPeerAssociations_connectPeerIds :: Lens.Lens' GetConnectPeerAssociations (Prelude.Maybe [Prelude.Text])
getConnectPeerAssociations_connectPeerIds :: Lens' GetConnectPeerAssociations (Maybe [Text])
getConnectPeerAssociations_connectPeerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConnectPeerAssociations' {Maybe [Text]
connectPeerIds :: Maybe [Text]
$sel:connectPeerIds:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe [Text]
connectPeerIds} -> Maybe [Text]
connectPeerIds) (\s :: GetConnectPeerAssociations
s@GetConnectPeerAssociations' {} Maybe [Text]
a -> GetConnectPeerAssociations
s {$sel:connectPeerIds:GetConnectPeerAssociations' :: Maybe [Text]
connectPeerIds = Maybe [Text]
a} :: GetConnectPeerAssociations) 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 maximum number of results to return.
getConnectPeerAssociations_maxResults :: Lens.Lens' GetConnectPeerAssociations (Prelude.Maybe Prelude.Natural)
getConnectPeerAssociations_maxResults :: Lens' GetConnectPeerAssociations (Maybe Natural)
getConnectPeerAssociations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConnectPeerAssociations' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetConnectPeerAssociations
s@GetConnectPeerAssociations' {} Maybe Natural
a -> GetConnectPeerAssociations
s {$sel:maxResults:GetConnectPeerAssociations' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetConnectPeerAssociations)

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

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

instance Core.AWSPager GetConnectPeerAssociations where
  page :: GetConnectPeerAssociations
-> AWSResponse GetConnectPeerAssociations
-> Maybe GetConnectPeerAssociations
page GetConnectPeerAssociations
rq AWSResponse GetConnectPeerAssociations
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetConnectPeerAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetConnectPeerAssociationsResponse (Maybe Text)
getConnectPeerAssociationsResponse_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 GetConnectPeerAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetConnectPeerAssociationsResponse (Maybe [ConnectPeerAssociation])
getConnectPeerAssociationsResponse_connectPeerAssociations
            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.$ GetConnectPeerAssociations
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetConnectPeerAssociations (Maybe Text)
getConnectPeerAssociations_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetConnectPeerAssociations
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetConnectPeerAssociationsResponse (Maybe Text)
getConnectPeerAssociationsResponse_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 GetConnectPeerAssociations where
  type
    AWSResponse GetConnectPeerAssociations =
      GetConnectPeerAssociationsResponse
  request :: (Service -> Service)
-> GetConnectPeerAssociations -> Request GetConnectPeerAssociations
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 GetConnectPeerAssociations
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetConnectPeerAssociations)))
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 [ConnectPeerAssociation]
-> Maybe Text -> Int -> GetConnectPeerAssociationsResponse
GetConnectPeerAssociationsResponse'
            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
"ConnectPeerAssociations"
                            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 GetConnectPeerAssociations where
  hashWithSalt :: Int -> GetConnectPeerAssociations -> Int
hashWithSalt Int
_salt GetConnectPeerAssociations' {Maybe Natural
Maybe [Text]
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
connectPeerIds :: Maybe [Text]
$sel:globalNetworkId:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Text
$sel:nextToken:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Text
$sel:maxResults:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Natural
$sel:connectPeerIds:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
connectPeerIds
      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 GetConnectPeerAssociations where
  rnf :: GetConnectPeerAssociations -> ()
rnf GetConnectPeerAssociations' {Maybe Natural
Maybe [Text]
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
connectPeerIds :: Maybe [Text]
$sel:globalNetworkId:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Text
$sel:nextToken:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Text
$sel:maxResults:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Natural
$sel:connectPeerIds:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
connectPeerIds
      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 GetConnectPeerAssociations where
  toHeaders :: GetConnectPeerAssociations -> 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 GetConnectPeerAssociations where
  toPath :: GetConnectPeerAssociations -> ByteString
toPath GetConnectPeerAssociations' {Maybe Natural
Maybe [Text]
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
connectPeerIds :: Maybe [Text]
$sel:globalNetworkId:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Text
$sel:nextToken:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Text
$sel:maxResults:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Natural
$sel:connectPeerIds:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/connect-peer-associations"
      ]

instance Data.ToQuery GetConnectPeerAssociations where
  toQuery :: GetConnectPeerAssociations -> QueryString
toQuery GetConnectPeerAssociations' {Maybe Natural
Maybe [Text]
Maybe Text
Text
globalNetworkId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
connectPeerIds :: Maybe [Text]
$sel:globalNetworkId:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Text
$sel:nextToken:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Text
$sel:maxResults:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe Natural
$sel:connectPeerIds:GetConnectPeerAssociations' :: GetConnectPeerAssociations -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"connectPeerIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
connectPeerIds
            ),
        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:/ 'newGetConnectPeerAssociationsResponse' smart constructor.
data GetConnectPeerAssociationsResponse = GetConnectPeerAssociationsResponse'
  { -- | Displays a list of Connect peer associations.
    GetConnectPeerAssociationsResponse
-> Maybe [ConnectPeerAssociation]
connectPeerAssociations :: Prelude.Maybe [ConnectPeerAssociation],
    -- | The token for the next page of results.
    GetConnectPeerAssociationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetConnectPeerAssociationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetConnectPeerAssociationsResponse
-> GetConnectPeerAssociationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConnectPeerAssociationsResponse
-> GetConnectPeerAssociationsResponse -> Bool
$c/= :: GetConnectPeerAssociationsResponse
-> GetConnectPeerAssociationsResponse -> Bool
== :: GetConnectPeerAssociationsResponse
-> GetConnectPeerAssociationsResponse -> Bool
$c== :: GetConnectPeerAssociationsResponse
-> GetConnectPeerAssociationsResponse -> Bool
Prelude.Eq, ReadPrec [GetConnectPeerAssociationsResponse]
ReadPrec GetConnectPeerAssociationsResponse
Int -> ReadS GetConnectPeerAssociationsResponse
ReadS [GetConnectPeerAssociationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetConnectPeerAssociationsResponse]
$creadListPrec :: ReadPrec [GetConnectPeerAssociationsResponse]
readPrec :: ReadPrec GetConnectPeerAssociationsResponse
$creadPrec :: ReadPrec GetConnectPeerAssociationsResponse
readList :: ReadS [GetConnectPeerAssociationsResponse]
$creadList :: ReadS [GetConnectPeerAssociationsResponse]
readsPrec :: Int -> ReadS GetConnectPeerAssociationsResponse
$creadsPrec :: Int -> ReadS GetConnectPeerAssociationsResponse
Prelude.Read, Int -> GetConnectPeerAssociationsResponse -> ShowS
[GetConnectPeerAssociationsResponse] -> ShowS
GetConnectPeerAssociationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConnectPeerAssociationsResponse] -> ShowS
$cshowList :: [GetConnectPeerAssociationsResponse] -> ShowS
show :: GetConnectPeerAssociationsResponse -> String
$cshow :: GetConnectPeerAssociationsResponse -> String
showsPrec :: Int -> GetConnectPeerAssociationsResponse -> ShowS
$cshowsPrec :: Int -> GetConnectPeerAssociationsResponse -> ShowS
Prelude.Show, forall x.
Rep GetConnectPeerAssociationsResponse x
-> GetConnectPeerAssociationsResponse
forall x.
GetConnectPeerAssociationsResponse
-> Rep GetConnectPeerAssociationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetConnectPeerAssociationsResponse x
-> GetConnectPeerAssociationsResponse
$cfrom :: forall x.
GetConnectPeerAssociationsResponse
-> Rep GetConnectPeerAssociationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetConnectPeerAssociationsResponse' 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:
--
-- 'connectPeerAssociations', 'getConnectPeerAssociationsResponse_connectPeerAssociations' - Displays a list of Connect peer associations.
--
-- 'nextToken', 'getConnectPeerAssociationsResponse_nextToken' - The token for the next page of results.
--
-- 'httpStatus', 'getConnectPeerAssociationsResponse_httpStatus' - The response's http status code.
newGetConnectPeerAssociationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetConnectPeerAssociationsResponse
newGetConnectPeerAssociationsResponse :: Int -> GetConnectPeerAssociationsResponse
newGetConnectPeerAssociationsResponse Int
pHttpStatus_ =
  GetConnectPeerAssociationsResponse'
    { $sel:connectPeerAssociations:GetConnectPeerAssociationsResponse' :: Maybe [ConnectPeerAssociation]
connectPeerAssociations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetConnectPeerAssociationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetConnectPeerAssociationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Displays a list of Connect peer associations.
getConnectPeerAssociationsResponse_connectPeerAssociations :: Lens.Lens' GetConnectPeerAssociationsResponse (Prelude.Maybe [ConnectPeerAssociation])
getConnectPeerAssociationsResponse_connectPeerAssociations :: Lens'
  GetConnectPeerAssociationsResponse (Maybe [ConnectPeerAssociation])
getConnectPeerAssociationsResponse_connectPeerAssociations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConnectPeerAssociationsResponse' {Maybe [ConnectPeerAssociation]
connectPeerAssociations :: Maybe [ConnectPeerAssociation]
$sel:connectPeerAssociations:GetConnectPeerAssociationsResponse' :: GetConnectPeerAssociationsResponse
-> Maybe [ConnectPeerAssociation]
connectPeerAssociations} -> Maybe [ConnectPeerAssociation]
connectPeerAssociations) (\s :: GetConnectPeerAssociationsResponse
s@GetConnectPeerAssociationsResponse' {} Maybe [ConnectPeerAssociation]
a -> GetConnectPeerAssociationsResponse
s {$sel:connectPeerAssociations:GetConnectPeerAssociationsResponse' :: Maybe [ConnectPeerAssociation]
connectPeerAssociations = Maybe [ConnectPeerAssociation]
a} :: GetConnectPeerAssociationsResponse) 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.
getConnectPeerAssociationsResponse_nextToken :: Lens.Lens' GetConnectPeerAssociationsResponse (Prelude.Maybe Prelude.Text)
getConnectPeerAssociationsResponse_nextToken :: Lens' GetConnectPeerAssociationsResponse (Maybe Text)
getConnectPeerAssociationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConnectPeerAssociationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetConnectPeerAssociationsResponse' :: GetConnectPeerAssociationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetConnectPeerAssociationsResponse
s@GetConnectPeerAssociationsResponse' {} Maybe Text
a -> GetConnectPeerAssociationsResponse
s {$sel:nextToken:GetConnectPeerAssociationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetConnectPeerAssociationsResponse)

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

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