{-# 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.SNS.ListEndpointsByPlatformApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the endpoints and endpoint attributes for devices in a supported
-- push notification service, such as GCM (Firebase Cloud Messaging) and
-- APNS. The results for @ListEndpointsByPlatformApplication@ are paginated
-- and return a limited list of endpoints, up to 100. If additional records
-- are available after the first page results, then a NextToken string will
-- be returned. To receive the next page, you call
-- @ListEndpointsByPlatformApplication@ again using the NextToken string
-- received from the previous call. When there are no more records to
-- return, NextToken will be null. For more information, see
-- <https://docs.aws.amazon.com/sns/latest/dg/SNSMobilePush.html Using Amazon SNS Mobile Push Notifications>.
--
-- This action is throttled at 30 transactions per second (TPS).
--
-- This operation returns paginated results.
module Amazonka.SNS.ListEndpointsByPlatformApplication
  ( -- * Creating a Request
    ListEndpointsByPlatformApplication (..),
    newListEndpointsByPlatformApplication,

    -- * Request Lenses
    listEndpointsByPlatformApplication_nextToken,
    listEndpointsByPlatformApplication_platformApplicationArn,

    -- * Destructuring the Response
    ListEndpointsByPlatformApplicationResponse (..),
    newListEndpointsByPlatformApplicationResponse,

    -- * Response Lenses
    listEndpointsByPlatformApplicationResponse_endpoints,
    listEndpointsByPlatformApplicationResponse_nextToken,
    listEndpointsByPlatformApplicationResponse_httpStatus,
  )
where

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

-- | Input for ListEndpointsByPlatformApplication action.
--
-- /See:/ 'newListEndpointsByPlatformApplication' smart constructor.
data ListEndpointsByPlatformApplication = ListEndpointsByPlatformApplication'
  { -- | NextToken string is used when calling ListEndpointsByPlatformApplication
    -- action to retrieve additional records that are available after the first
    -- page results.
    ListEndpointsByPlatformApplication -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | PlatformApplicationArn for ListEndpointsByPlatformApplicationInput
    -- action.
    ListEndpointsByPlatformApplication -> Text
platformApplicationArn :: Prelude.Text
  }
  deriving (ListEndpointsByPlatformApplication
-> ListEndpointsByPlatformApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEndpointsByPlatformApplication
-> ListEndpointsByPlatformApplication -> Bool
$c/= :: ListEndpointsByPlatformApplication
-> ListEndpointsByPlatformApplication -> Bool
== :: ListEndpointsByPlatformApplication
-> ListEndpointsByPlatformApplication -> Bool
$c== :: ListEndpointsByPlatformApplication
-> ListEndpointsByPlatformApplication -> Bool
Prelude.Eq, ReadPrec [ListEndpointsByPlatformApplication]
ReadPrec ListEndpointsByPlatformApplication
Int -> ReadS ListEndpointsByPlatformApplication
ReadS [ListEndpointsByPlatformApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEndpointsByPlatformApplication]
$creadListPrec :: ReadPrec [ListEndpointsByPlatformApplication]
readPrec :: ReadPrec ListEndpointsByPlatformApplication
$creadPrec :: ReadPrec ListEndpointsByPlatformApplication
readList :: ReadS [ListEndpointsByPlatformApplication]
$creadList :: ReadS [ListEndpointsByPlatformApplication]
readsPrec :: Int -> ReadS ListEndpointsByPlatformApplication
$creadsPrec :: Int -> ReadS ListEndpointsByPlatformApplication
Prelude.Read, Int -> ListEndpointsByPlatformApplication -> ShowS
[ListEndpointsByPlatformApplication] -> ShowS
ListEndpointsByPlatformApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEndpointsByPlatformApplication] -> ShowS
$cshowList :: [ListEndpointsByPlatformApplication] -> ShowS
show :: ListEndpointsByPlatformApplication -> String
$cshow :: ListEndpointsByPlatformApplication -> String
showsPrec :: Int -> ListEndpointsByPlatformApplication -> ShowS
$cshowsPrec :: Int -> ListEndpointsByPlatformApplication -> ShowS
Prelude.Show, forall x.
Rep ListEndpointsByPlatformApplication x
-> ListEndpointsByPlatformApplication
forall x.
ListEndpointsByPlatformApplication
-> Rep ListEndpointsByPlatformApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListEndpointsByPlatformApplication x
-> ListEndpointsByPlatformApplication
$cfrom :: forall x.
ListEndpointsByPlatformApplication
-> Rep ListEndpointsByPlatformApplication x
Prelude.Generic)

-- |
-- Create a value of 'ListEndpointsByPlatformApplication' 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', 'listEndpointsByPlatformApplication_nextToken' - NextToken string is used when calling ListEndpointsByPlatformApplication
-- action to retrieve additional records that are available after the first
-- page results.
--
-- 'platformApplicationArn', 'listEndpointsByPlatformApplication_platformApplicationArn' - PlatformApplicationArn for ListEndpointsByPlatformApplicationInput
-- action.
newListEndpointsByPlatformApplication ::
  -- | 'platformApplicationArn'
  Prelude.Text ->
  ListEndpointsByPlatformApplication
newListEndpointsByPlatformApplication :: Text -> ListEndpointsByPlatformApplication
newListEndpointsByPlatformApplication
  Text
pPlatformApplicationArn_ =
    ListEndpointsByPlatformApplication'
      { $sel:nextToken:ListEndpointsByPlatformApplication' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: Text
platformApplicationArn =
          Text
pPlatformApplicationArn_
      }

-- | NextToken string is used when calling ListEndpointsByPlatformApplication
-- action to retrieve additional records that are available after the first
-- page results.
listEndpointsByPlatformApplication_nextToken :: Lens.Lens' ListEndpointsByPlatformApplication (Prelude.Maybe Prelude.Text)
listEndpointsByPlatformApplication_nextToken :: Lens' ListEndpointsByPlatformApplication (Maybe Text)
listEndpointsByPlatformApplication_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointsByPlatformApplication' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEndpointsByPlatformApplication
s@ListEndpointsByPlatformApplication' {} Maybe Text
a -> ListEndpointsByPlatformApplication
s {$sel:nextToken:ListEndpointsByPlatformApplication' :: Maybe Text
nextToken = Maybe Text
a} :: ListEndpointsByPlatformApplication)

-- | PlatformApplicationArn for ListEndpointsByPlatformApplicationInput
-- action.
listEndpointsByPlatformApplication_platformApplicationArn :: Lens.Lens' ListEndpointsByPlatformApplication Prelude.Text
listEndpointsByPlatformApplication_platformApplicationArn :: Lens' ListEndpointsByPlatformApplication Text
listEndpointsByPlatformApplication_platformApplicationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointsByPlatformApplication' {Text
platformApplicationArn :: Text
$sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Text
platformApplicationArn} -> Text
platformApplicationArn) (\s :: ListEndpointsByPlatformApplication
s@ListEndpointsByPlatformApplication' {} Text
a -> ListEndpointsByPlatformApplication
s {$sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: Text
platformApplicationArn = Text
a} :: ListEndpointsByPlatformApplication)

instance
  Core.AWSPager
    ListEndpointsByPlatformApplication
  where
  page :: ListEndpointsByPlatformApplication
-> AWSResponse ListEndpointsByPlatformApplication
-> Maybe ListEndpointsByPlatformApplication
page ListEndpointsByPlatformApplication
rq AWSResponse ListEndpointsByPlatformApplication
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListEndpointsByPlatformApplication
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointsByPlatformApplicationResponse (Maybe Text)
listEndpointsByPlatformApplicationResponse_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 ListEndpointsByPlatformApplication
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointsByPlatformApplicationResponse (Maybe [Endpoint])
listEndpointsByPlatformApplicationResponse_endpoints
            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.$ ListEndpointsByPlatformApplication
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListEndpointsByPlatformApplication (Maybe Text)
listEndpointsByPlatformApplication_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListEndpointsByPlatformApplication
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointsByPlatformApplicationResponse (Maybe Text)
listEndpointsByPlatformApplicationResponse_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
    ListEndpointsByPlatformApplication
  where
  type
    AWSResponse ListEndpointsByPlatformApplication =
      ListEndpointsByPlatformApplicationResponse
  request :: (Service -> Service)
-> ListEndpointsByPlatformApplication
-> Request ListEndpointsByPlatformApplication
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListEndpointsByPlatformApplication
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ListEndpointsByPlatformApplication)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ListEndpointsByPlatformApplicationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Endpoint]
-> Maybe Text -> Int -> ListEndpointsByPlatformApplicationResponse
ListEndpointsByPlatformApplicationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Endpoints"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"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
    ListEndpointsByPlatformApplication
  where
  hashWithSalt :: Int -> ListEndpointsByPlatformApplication -> Int
hashWithSalt
    Int
_salt
    ListEndpointsByPlatformApplication' {Maybe Text
Text
platformApplicationArn :: Text
nextToken :: Maybe Text
$sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Text
$sel:nextToken:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
platformApplicationArn

instance
  Prelude.NFData
    ListEndpointsByPlatformApplication
  where
  rnf :: ListEndpointsByPlatformApplication -> ()
rnf ListEndpointsByPlatformApplication' {Maybe Text
Text
platformApplicationArn :: Text
nextToken :: Maybe Text
$sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Text
$sel:nextToken:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> 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 Text
platformApplicationArn

instance
  Data.ToHeaders
    ListEndpointsByPlatformApplication
  where
  toHeaders :: ListEndpointsByPlatformApplication -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance
  Data.ToQuery
    ListEndpointsByPlatformApplication
  where
  toQuery :: ListEndpointsByPlatformApplication -> QueryString
toQuery ListEndpointsByPlatformApplication' {Maybe Text
Text
platformApplicationArn :: Text
nextToken :: Maybe Text
$sel:platformApplicationArn:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Text
$sel:nextToken:ListEndpointsByPlatformApplication' :: ListEndpointsByPlatformApplication -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ListEndpointsByPlatformApplication" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"PlatformApplicationArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
platformApplicationArn
      ]

-- | Response for ListEndpointsByPlatformApplication action.
--
-- /See:/ 'newListEndpointsByPlatformApplicationResponse' smart constructor.
data ListEndpointsByPlatformApplicationResponse = ListEndpointsByPlatformApplicationResponse'
  { -- | Endpoints returned for ListEndpointsByPlatformApplication action.
    ListEndpointsByPlatformApplicationResponse -> Maybe [Endpoint]
endpoints :: Prelude.Maybe [Endpoint],
    -- | NextToken string is returned when calling
    -- ListEndpointsByPlatformApplication action if additional records are
    -- available after the first page results.
    ListEndpointsByPlatformApplicationResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListEndpointsByPlatformApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListEndpointsByPlatformApplicationResponse
-> ListEndpointsByPlatformApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEndpointsByPlatformApplicationResponse
-> ListEndpointsByPlatformApplicationResponse -> Bool
$c/= :: ListEndpointsByPlatformApplicationResponse
-> ListEndpointsByPlatformApplicationResponse -> Bool
== :: ListEndpointsByPlatformApplicationResponse
-> ListEndpointsByPlatformApplicationResponse -> Bool
$c== :: ListEndpointsByPlatformApplicationResponse
-> ListEndpointsByPlatformApplicationResponse -> Bool
Prelude.Eq, ReadPrec [ListEndpointsByPlatformApplicationResponse]
ReadPrec ListEndpointsByPlatformApplicationResponse
Int -> ReadS ListEndpointsByPlatformApplicationResponse
ReadS [ListEndpointsByPlatformApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEndpointsByPlatformApplicationResponse]
$creadListPrec :: ReadPrec [ListEndpointsByPlatformApplicationResponse]
readPrec :: ReadPrec ListEndpointsByPlatformApplicationResponse
$creadPrec :: ReadPrec ListEndpointsByPlatformApplicationResponse
readList :: ReadS [ListEndpointsByPlatformApplicationResponse]
$creadList :: ReadS [ListEndpointsByPlatformApplicationResponse]
readsPrec :: Int -> ReadS ListEndpointsByPlatformApplicationResponse
$creadsPrec :: Int -> ReadS ListEndpointsByPlatformApplicationResponse
Prelude.Read, Int -> ListEndpointsByPlatformApplicationResponse -> ShowS
[ListEndpointsByPlatformApplicationResponse] -> ShowS
ListEndpointsByPlatformApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEndpointsByPlatformApplicationResponse] -> ShowS
$cshowList :: [ListEndpointsByPlatformApplicationResponse] -> ShowS
show :: ListEndpointsByPlatformApplicationResponse -> String
$cshow :: ListEndpointsByPlatformApplicationResponse -> String
showsPrec :: Int -> ListEndpointsByPlatformApplicationResponse -> ShowS
$cshowsPrec :: Int -> ListEndpointsByPlatformApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep ListEndpointsByPlatformApplicationResponse x
-> ListEndpointsByPlatformApplicationResponse
forall x.
ListEndpointsByPlatformApplicationResponse
-> Rep ListEndpointsByPlatformApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListEndpointsByPlatformApplicationResponse x
-> ListEndpointsByPlatformApplicationResponse
$cfrom :: forall x.
ListEndpointsByPlatformApplicationResponse
-> Rep ListEndpointsByPlatformApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListEndpointsByPlatformApplicationResponse' 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:
--
-- 'endpoints', 'listEndpointsByPlatformApplicationResponse_endpoints' - Endpoints returned for ListEndpointsByPlatformApplication action.
--
-- 'nextToken', 'listEndpointsByPlatformApplicationResponse_nextToken' - NextToken string is returned when calling
-- ListEndpointsByPlatformApplication action if additional records are
-- available after the first page results.
--
-- 'httpStatus', 'listEndpointsByPlatformApplicationResponse_httpStatus' - The response's http status code.
newListEndpointsByPlatformApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListEndpointsByPlatformApplicationResponse
newListEndpointsByPlatformApplicationResponse :: Int -> ListEndpointsByPlatformApplicationResponse
newListEndpointsByPlatformApplicationResponse
  Int
pHttpStatus_ =
    ListEndpointsByPlatformApplicationResponse'
      { $sel:endpoints:ListEndpointsByPlatformApplicationResponse' :: Maybe [Endpoint]
endpoints =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListEndpointsByPlatformApplicationResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListEndpointsByPlatformApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Endpoints returned for ListEndpointsByPlatformApplication action.
listEndpointsByPlatformApplicationResponse_endpoints :: Lens.Lens' ListEndpointsByPlatformApplicationResponse (Prelude.Maybe [Endpoint])
listEndpointsByPlatformApplicationResponse_endpoints :: Lens' ListEndpointsByPlatformApplicationResponse (Maybe [Endpoint])
listEndpointsByPlatformApplicationResponse_endpoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointsByPlatformApplicationResponse' {Maybe [Endpoint]
endpoints :: Maybe [Endpoint]
$sel:endpoints:ListEndpointsByPlatformApplicationResponse' :: ListEndpointsByPlatformApplicationResponse -> Maybe [Endpoint]
endpoints} -> Maybe [Endpoint]
endpoints) (\s :: ListEndpointsByPlatformApplicationResponse
s@ListEndpointsByPlatformApplicationResponse' {} Maybe [Endpoint]
a -> ListEndpointsByPlatformApplicationResponse
s {$sel:endpoints:ListEndpointsByPlatformApplicationResponse' :: Maybe [Endpoint]
endpoints = Maybe [Endpoint]
a} :: ListEndpointsByPlatformApplicationResponse) 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

-- | NextToken string is returned when calling
-- ListEndpointsByPlatformApplication action if additional records are
-- available after the first page results.
listEndpointsByPlatformApplicationResponse_nextToken :: Lens.Lens' ListEndpointsByPlatformApplicationResponse (Prelude.Maybe Prelude.Text)
listEndpointsByPlatformApplicationResponse_nextToken :: Lens' ListEndpointsByPlatformApplicationResponse (Maybe Text)
listEndpointsByPlatformApplicationResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointsByPlatformApplicationResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEndpointsByPlatformApplicationResponse' :: ListEndpointsByPlatformApplicationResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEndpointsByPlatformApplicationResponse
s@ListEndpointsByPlatformApplicationResponse' {} Maybe Text
a -> ListEndpointsByPlatformApplicationResponse
s {$sel:nextToken:ListEndpointsByPlatformApplicationResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListEndpointsByPlatformApplicationResponse)

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

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