{-# 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.GlobalAccelerator.ListCustomRoutingPortMappingsByDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List the port mappings for a specific EC2 instance (destination) in a
-- VPC subnet endpoint. The response is the mappings for one destination IP
-- address. This is useful when your subnet endpoint has mappings that span
-- multiple custom routing accelerators in your account, or for scenarios
-- where you only want to list the port mappings for a specific destination
-- instance.
--
-- This operation returns paginated results.
module Amazonka.GlobalAccelerator.ListCustomRoutingPortMappingsByDestination
  ( -- * Creating a Request
    ListCustomRoutingPortMappingsByDestination (..),
    newListCustomRoutingPortMappingsByDestination,

    -- * Request Lenses
    listCustomRoutingPortMappingsByDestination_maxResults,
    listCustomRoutingPortMappingsByDestination_nextToken,
    listCustomRoutingPortMappingsByDestination_endpointId,
    listCustomRoutingPortMappingsByDestination_destinationAddress,

    -- * Destructuring the Response
    ListCustomRoutingPortMappingsByDestinationResponse (..),
    newListCustomRoutingPortMappingsByDestinationResponse,

    -- * Response Lenses
    listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings,
    listCustomRoutingPortMappingsByDestinationResponse_nextToken,
    listCustomRoutingPortMappingsByDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCustomRoutingPortMappingsByDestination' smart constructor.
data ListCustomRoutingPortMappingsByDestination = ListCustomRoutingPortMappingsByDestination'
  { -- | The number of destination port mappings that you want to return with
    -- this call. The default value is 10.
    ListCustomRoutingPortMappingsByDestination -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of results. You receive this token from a
    -- previous call.
    ListCustomRoutingPortMappingsByDestination -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID for the virtual private cloud (VPC) subnet.
    ListCustomRoutingPortMappingsByDestination -> Text
endpointId :: Prelude.Text,
    -- | The endpoint IP address in a virtual private cloud (VPC) subnet for
    -- which you want to receive back port mappings.
    ListCustomRoutingPortMappingsByDestination -> Text
destinationAddress :: Prelude.Text
  }
  deriving (ListCustomRoutingPortMappingsByDestination
-> ListCustomRoutingPortMappingsByDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomRoutingPortMappingsByDestination
-> ListCustomRoutingPortMappingsByDestination -> Bool
$c/= :: ListCustomRoutingPortMappingsByDestination
-> ListCustomRoutingPortMappingsByDestination -> Bool
== :: ListCustomRoutingPortMappingsByDestination
-> ListCustomRoutingPortMappingsByDestination -> Bool
$c== :: ListCustomRoutingPortMappingsByDestination
-> ListCustomRoutingPortMappingsByDestination -> Bool
Prelude.Eq, ReadPrec [ListCustomRoutingPortMappingsByDestination]
ReadPrec ListCustomRoutingPortMappingsByDestination
Int -> ReadS ListCustomRoutingPortMappingsByDestination
ReadS [ListCustomRoutingPortMappingsByDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomRoutingPortMappingsByDestination]
$creadListPrec :: ReadPrec [ListCustomRoutingPortMappingsByDestination]
readPrec :: ReadPrec ListCustomRoutingPortMappingsByDestination
$creadPrec :: ReadPrec ListCustomRoutingPortMappingsByDestination
readList :: ReadS [ListCustomRoutingPortMappingsByDestination]
$creadList :: ReadS [ListCustomRoutingPortMappingsByDestination]
readsPrec :: Int -> ReadS ListCustomRoutingPortMappingsByDestination
$creadsPrec :: Int -> ReadS ListCustomRoutingPortMappingsByDestination
Prelude.Read, Int -> ListCustomRoutingPortMappingsByDestination -> ShowS
[ListCustomRoutingPortMappingsByDestination] -> ShowS
ListCustomRoutingPortMappingsByDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomRoutingPortMappingsByDestination] -> ShowS
$cshowList :: [ListCustomRoutingPortMappingsByDestination] -> ShowS
show :: ListCustomRoutingPortMappingsByDestination -> String
$cshow :: ListCustomRoutingPortMappingsByDestination -> String
showsPrec :: Int -> ListCustomRoutingPortMappingsByDestination -> ShowS
$cshowsPrec :: Int -> ListCustomRoutingPortMappingsByDestination -> ShowS
Prelude.Show, forall x.
Rep ListCustomRoutingPortMappingsByDestination x
-> ListCustomRoutingPortMappingsByDestination
forall x.
ListCustomRoutingPortMappingsByDestination
-> Rep ListCustomRoutingPortMappingsByDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomRoutingPortMappingsByDestination x
-> ListCustomRoutingPortMappingsByDestination
$cfrom :: forall x.
ListCustomRoutingPortMappingsByDestination
-> Rep ListCustomRoutingPortMappingsByDestination x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomRoutingPortMappingsByDestination' 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', 'listCustomRoutingPortMappingsByDestination_maxResults' - The number of destination port mappings that you want to return with
-- this call. The default value is 10.
--
-- 'nextToken', 'listCustomRoutingPortMappingsByDestination_nextToken' - The token for the next set of results. You receive this token from a
-- previous call.
--
-- 'endpointId', 'listCustomRoutingPortMappingsByDestination_endpointId' - The ID for the virtual private cloud (VPC) subnet.
--
-- 'destinationAddress', 'listCustomRoutingPortMappingsByDestination_destinationAddress' - The endpoint IP address in a virtual private cloud (VPC) subnet for
-- which you want to receive back port mappings.
newListCustomRoutingPortMappingsByDestination ::
  -- | 'endpointId'
  Prelude.Text ->
  -- | 'destinationAddress'
  Prelude.Text ->
  ListCustomRoutingPortMappingsByDestination
newListCustomRoutingPortMappingsByDestination :: Text -> Text -> ListCustomRoutingPortMappingsByDestination
newListCustomRoutingPortMappingsByDestination
  Text
pEndpointId_
  Text
pDestinationAddress_ =
    ListCustomRoutingPortMappingsByDestination'
      { $sel:maxResults:ListCustomRoutingPortMappingsByDestination' :: Maybe Natural
maxResults =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListCustomRoutingPortMappingsByDestination' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointId:ListCustomRoutingPortMappingsByDestination' :: Text
endpointId = Text
pEndpointId_,
        $sel:destinationAddress:ListCustomRoutingPortMappingsByDestination' :: Text
destinationAddress =
          Text
pDestinationAddress_
      }

-- | The number of destination port mappings that you want to return with
-- this call. The default value is 10.
listCustomRoutingPortMappingsByDestination_maxResults :: Lens.Lens' ListCustomRoutingPortMappingsByDestination (Prelude.Maybe Prelude.Natural)
listCustomRoutingPortMappingsByDestination_maxResults :: Lens' ListCustomRoutingPortMappingsByDestination (Maybe Natural)
listCustomRoutingPortMappingsByDestination_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestination' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCustomRoutingPortMappingsByDestination
s@ListCustomRoutingPortMappingsByDestination' {} Maybe Natural
a -> ListCustomRoutingPortMappingsByDestination
s {$sel:maxResults:ListCustomRoutingPortMappingsByDestination' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCustomRoutingPortMappingsByDestination)

-- | The token for the next set of results. You receive this token from a
-- previous call.
listCustomRoutingPortMappingsByDestination_nextToken :: Lens.Lens' ListCustomRoutingPortMappingsByDestination (Prelude.Maybe Prelude.Text)
listCustomRoutingPortMappingsByDestination_nextToken :: Lens' ListCustomRoutingPortMappingsByDestination (Maybe Text)
listCustomRoutingPortMappingsByDestination_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestination' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomRoutingPortMappingsByDestination
s@ListCustomRoutingPortMappingsByDestination' {} Maybe Text
a -> ListCustomRoutingPortMappingsByDestination
s {$sel:nextToken:ListCustomRoutingPortMappingsByDestination' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomRoutingPortMappingsByDestination)

-- | The ID for the virtual private cloud (VPC) subnet.
listCustomRoutingPortMappingsByDestination_endpointId :: Lens.Lens' ListCustomRoutingPortMappingsByDestination Prelude.Text
listCustomRoutingPortMappingsByDestination_endpointId :: Lens' ListCustomRoutingPortMappingsByDestination Text
listCustomRoutingPortMappingsByDestination_endpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestination' {Text
endpointId :: Text
$sel:endpointId:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
endpointId} -> Text
endpointId) (\s :: ListCustomRoutingPortMappingsByDestination
s@ListCustomRoutingPortMappingsByDestination' {} Text
a -> ListCustomRoutingPortMappingsByDestination
s {$sel:endpointId:ListCustomRoutingPortMappingsByDestination' :: Text
endpointId = Text
a} :: ListCustomRoutingPortMappingsByDestination)

-- | The endpoint IP address in a virtual private cloud (VPC) subnet for
-- which you want to receive back port mappings.
listCustomRoutingPortMappingsByDestination_destinationAddress :: Lens.Lens' ListCustomRoutingPortMappingsByDestination Prelude.Text
listCustomRoutingPortMappingsByDestination_destinationAddress :: Lens' ListCustomRoutingPortMappingsByDestination Text
listCustomRoutingPortMappingsByDestination_destinationAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestination' {Text
destinationAddress :: Text
$sel:destinationAddress:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
destinationAddress} -> Text
destinationAddress) (\s :: ListCustomRoutingPortMappingsByDestination
s@ListCustomRoutingPortMappingsByDestination' {} Text
a -> ListCustomRoutingPortMappingsByDestination
s {$sel:destinationAddress:ListCustomRoutingPortMappingsByDestination' :: Text
destinationAddress = Text
a} :: ListCustomRoutingPortMappingsByDestination)

instance
  Core.AWSPager
    ListCustomRoutingPortMappingsByDestination
  where
  page :: ListCustomRoutingPortMappingsByDestination
-> AWSResponse ListCustomRoutingPortMappingsByDestination
-> Maybe ListCustomRoutingPortMappingsByDestination
page ListCustomRoutingPortMappingsByDestination
rq AWSResponse ListCustomRoutingPortMappingsByDestination
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCustomRoutingPortMappingsByDestination
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCustomRoutingPortMappingsByDestinationResponse (Maybe Text)
listCustomRoutingPortMappingsByDestinationResponse_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 ListCustomRoutingPortMappingsByDestination
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCustomRoutingPortMappingsByDestinationResponse
  (Maybe [DestinationPortMapping])
listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings
            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.$ ListCustomRoutingPortMappingsByDestination
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCustomRoutingPortMappingsByDestination (Maybe Text)
listCustomRoutingPortMappingsByDestination_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCustomRoutingPortMappingsByDestination
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCustomRoutingPortMappingsByDestinationResponse (Maybe Text)
listCustomRoutingPortMappingsByDestinationResponse_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
    ListCustomRoutingPortMappingsByDestination
  where
  type
    AWSResponse
      ListCustomRoutingPortMappingsByDestination =
      ListCustomRoutingPortMappingsByDestinationResponse
  request :: (Service -> Service)
-> ListCustomRoutingPortMappingsByDestination
-> Request ListCustomRoutingPortMappingsByDestination
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 ListCustomRoutingPortMappingsByDestination
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse ListCustomRoutingPortMappingsByDestination)))
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 [DestinationPortMapping]
-> Maybe Text
-> Int
-> ListCustomRoutingPortMappingsByDestinationResponse
ListCustomRoutingPortMappingsByDestinationResponse'
            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
"DestinationPortMappings"
                            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
    ListCustomRoutingPortMappingsByDestination
  where
  hashWithSalt :: Int -> ListCustomRoutingPortMappingsByDestination -> Int
hashWithSalt
    Int
_salt
    ListCustomRoutingPortMappingsByDestination' {Maybe Natural
Maybe Text
Text
destinationAddress :: Text
endpointId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:destinationAddress:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
$sel:endpointId:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
$sel:nextToken:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Maybe Text
$sel:maxResults:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> 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
endpointId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationAddress

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

instance
  Data.ToHeaders
    ListCustomRoutingPortMappingsByDestination
  where
  toHeaders :: ListCustomRoutingPortMappingsByDestination -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"GlobalAccelerator_V20180706.ListCustomRoutingPortMappingsByDestination" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    ListCustomRoutingPortMappingsByDestination
  where
  toJSON :: ListCustomRoutingPortMappingsByDestination -> Value
toJSON
    ListCustomRoutingPortMappingsByDestination' {Maybe Natural
Maybe Text
Text
destinationAddress :: Text
endpointId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:destinationAddress:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
$sel:endpointId:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Text
$sel:nextToken:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> Maybe Text
$sel:maxResults:ListCustomRoutingPortMappingsByDestination' :: ListCustomRoutingPortMappingsByDestination -> 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
"EndpointId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointId),
              forall a. a -> Maybe a
Prelude.Just
                (Key
"DestinationAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationAddress)
            ]
        )

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

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

-- | /See:/ 'newListCustomRoutingPortMappingsByDestinationResponse' smart constructor.
data ListCustomRoutingPortMappingsByDestinationResponse = ListCustomRoutingPortMappingsByDestinationResponse'
  { -- | The port mappings for the endpoint IP address that you specified in the
    -- request.
    ListCustomRoutingPortMappingsByDestinationResponse
-> Maybe [DestinationPortMapping]
destinationPortMappings :: Prelude.Maybe [DestinationPortMapping],
    -- | The token for the next set of results. You receive this token from a
    -- previous call.
    ListCustomRoutingPortMappingsByDestinationResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCustomRoutingPortMappingsByDestinationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCustomRoutingPortMappingsByDestinationResponse
-> ListCustomRoutingPortMappingsByDestinationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomRoutingPortMappingsByDestinationResponse
-> ListCustomRoutingPortMappingsByDestinationResponse -> Bool
$c/= :: ListCustomRoutingPortMappingsByDestinationResponse
-> ListCustomRoutingPortMappingsByDestinationResponse -> Bool
== :: ListCustomRoutingPortMappingsByDestinationResponse
-> ListCustomRoutingPortMappingsByDestinationResponse -> Bool
$c== :: ListCustomRoutingPortMappingsByDestinationResponse
-> ListCustomRoutingPortMappingsByDestinationResponse -> Bool
Prelude.Eq, ReadPrec [ListCustomRoutingPortMappingsByDestinationResponse]
ReadPrec ListCustomRoutingPortMappingsByDestinationResponse
Int -> ReadS ListCustomRoutingPortMappingsByDestinationResponse
ReadS [ListCustomRoutingPortMappingsByDestinationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomRoutingPortMappingsByDestinationResponse]
$creadListPrec :: ReadPrec [ListCustomRoutingPortMappingsByDestinationResponse]
readPrec :: ReadPrec ListCustomRoutingPortMappingsByDestinationResponse
$creadPrec :: ReadPrec ListCustomRoutingPortMappingsByDestinationResponse
readList :: ReadS [ListCustomRoutingPortMappingsByDestinationResponse]
$creadList :: ReadS [ListCustomRoutingPortMappingsByDestinationResponse]
readsPrec :: Int -> ReadS ListCustomRoutingPortMappingsByDestinationResponse
$creadsPrec :: Int -> ReadS ListCustomRoutingPortMappingsByDestinationResponse
Prelude.Read, Int -> ListCustomRoutingPortMappingsByDestinationResponse -> ShowS
[ListCustomRoutingPortMappingsByDestinationResponse] -> ShowS
ListCustomRoutingPortMappingsByDestinationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomRoutingPortMappingsByDestinationResponse] -> ShowS
$cshowList :: [ListCustomRoutingPortMappingsByDestinationResponse] -> ShowS
show :: ListCustomRoutingPortMappingsByDestinationResponse -> String
$cshow :: ListCustomRoutingPortMappingsByDestinationResponse -> String
showsPrec :: Int -> ListCustomRoutingPortMappingsByDestinationResponse -> ShowS
$cshowsPrec :: Int -> ListCustomRoutingPortMappingsByDestinationResponse -> ShowS
Prelude.Show, forall x.
Rep ListCustomRoutingPortMappingsByDestinationResponse x
-> ListCustomRoutingPortMappingsByDestinationResponse
forall x.
ListCustomRoutingPortMappingsByDestinationResponse
-> Rep ListCustomRoutingPortMappingsByDestinationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomRoutingPortMappingsByDestinationResponse x
-> ListCustomRoutingPortMappingsByDestinationResponse
$cfrom :: forall x.
ListCustomRoutingPortMappingsByDestinationResponse
-> Rep ListCustomRoutingPortMappingsByDestinationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomRoutingPortMappingsByDestinationResponse' 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:
--
-- 'destinationPortMappings', 'listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings' - The port mappings for the endpoint IP address that you specified in the
-- request.
--
-- 'nextToken', 'listCustomRoutingPortMappingsByDestinationResponse_nextToken' - The token for the next set of results. You receive this token from a
-- previous call.
--
-- 'httpStatus', 'listCustomRoutingPortMappingsByDestinationResponse_httpStatus' - The response's http status code.
newListCustomRoutingPortMappingsByDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCustomRoutingPortMappingsByDestinationResponse
newListCustomRoutingPortMappingsByDestinationResponse :: Int -> ListCustomRoutingPortMappingsByDestinationResponse
newListCustomRoutingPortMappingsByDestinationResponse
  Int
pHttpStatus_ =
    ListCustomRoutingPortMappingsByDestinationResponse'
      { $sel:destinationPortMappings:ListCustomRoutingPortMappingsByDestinationResponse' :: Maybe [DestinationPortMapping]
destinationPortMappings =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListCustomRoutingPortMappingsByDestinationResponse' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListCustomRoutingPortMappingsByDestinationResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | The port mappings for the endpoint IP address that you specified in the
-- request.
listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings :: Lens.Lens' ListCustomRoutingPortMappingsByDestinationResponse (Prelude.Maybe [DestinationPortMapping])
listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings :: Lens'
  ListCustomRoutingPortMappingsByDestinationResponse
  (Maybe [DestinationPortMapping])
listCustomRoutingPortMappingsByDestinationResponse_destinationPortMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestinationResponse' {Maybe [DestinationPortMapping]
destinationPortMappings :: Maybe [DestinationPortMapping]
$sel:destinationPortMappings:ListCustomRoutingPortMappingsByDestinationResponse' :: ListCustomRoutingPortMappingsByDestinationResponse
-> Maybe [DestinationPortMapping]
destinationPortMappings} -> Maybe [DestinationPortMapping]
destinationPortMappings) (\s :: ListCustomRoutingPortMappingsByDestinationResponse
s@ListCustomRoutingPortMappingsByDestinationResponse' {} Maybe [DestinationPortMapping]
a -> ListCustomRoutingPortMappingsByDestinationResponse
s {$sel:destinationPortMappings:ListCustomRoutingPortMappingsByDestinationResponse' :: Maybe [DestinationPortMapping]
destinationPortMappings = Maybe [DestinationPortMapping]
a} :: ListCustomRoutingPortMappingsByDestinationResponse) 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 set of results. You receive this token from a
-- previous call.
listCustomRoutingPortMappingsByDestinationResponse_nextToken :: Lens.Lens' ListCustomRoutingPortMappingsByDestinationResponse (Prelude.Maybe Prelude.Text)
listCustomRoutingPortMappingsByDestinationResponse_nextToken :: Lens'
  ListCustomRoutingPortMappingsByDestinationResponse (Maybe Text)
listCustomRoutingPortMappingsByDestinationResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingPortMappingsByDestinationResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomRoutingPortMappingsByDestinationResponse' :: ListCustomRoutingPortMappingsByDestinationResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomRoutingPortMappingsByDestinationResponse
s@ListCustomRoutingPortMappingsByDestinationResponse' {} Maybe Text
a -> ListCustomRoutingPortMappingsByDestinationResponse
s {$sel:nextToken:ListCustomRoutingPortMappingsByDestinationResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomRoutingPortMappingsByDestinationResponse)

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

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