{-# 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.OpenSearchServerless.ListVpcEndpoints
-- 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 the OpenSearch Serverless-managed interface VPC endpoints
-- associated with the current account. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/serverless-vpc.html Access Amazon OpenSearch Serverless using an interface endpoint>.
module Amazonka.OpenSearchServerless.ListVpcEndpoints
  ( -- * Creating a Request
    ListVpcEndpoints (..),
    newListVpcEndpoints,

    -- * Request Lenses
    listVpcEndpoints_maxResults,
    listVpcEndpoints_nextToken,
    listVpcEndpoints_vpcEndpointFilters,

    -- * Destructuring the Response
    ListVpcEndpointsResponse (..),
    newListVpcEndpointsResponse,

    -- * Response Lenses
    listVpcEndpointsResponse_nextToken,
    listVpcEndpointsResponse_vpcEndpointSummaries,
    listVpcEndpointsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListVpcEndpoints' smart constructor.
data ListVpcEndpoints = ListVpcEndpoints'
  { -- | An optional parameter that specifies the maximum number of results to
    -- return. You can use @nextToken@ to get the next page of results. The
    -- default is 20.
    ListVpcEndpoints -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If your initial @ListVpcEndpoints@ operation returns a @nextToken@, you
    -- can include the returned @nextToken@ in subsequent @ListVpcEndpoints@
    -- operations, which returns results in the next page.
    ListVpcEndpoints -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Filter the results according to the current status of the VPC endpoint.
    -- Possible statuses are @CREATING@, @DELETING@, @UPDATING@, @ACTIVE@, and
    -- @FAILED@.
    ListVpcEndpoints -> Maybe VpcEndpointFilters
vpcEndpointFilters :: Prelude.Maybe VpcEndpointFilters
  }
  deriving (ListVpcEndpoints -> ListVpcEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVpcEndpoints -> ListVpcEndpoints -> Bool
$c/= :: ListVpcEndpoints -> ListVpcEndpoints -> Bool
== :: ListVpcEndpoints -> ListVpcEndpoints -> Bool
$c== :: ListVpcEndpoints -> ListVpcEndpoints -> Bool
Prelude.Eq, ReadPrec [ListVpcEndpoints]
ReadPrec ListVpcEndpoints
Int -> ReadS ListVpcEndpoints
ReadS [ListVpcEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVpcEndpoints]
$creadListPrec :: ReadPrec [ListVpcEndpoints]
readPrec :: ReadPrec ListVpcEndpoints
$creadPrec :: ReadPrec ListVpcEndpoints
readList :: ReadS [ListVpcEndpoints]
$creadList :: ReadS [ListVpcEndpoints]
readsPrec :: Int -> ReadS ListVpcEndpoints
$creadsPrec :: Int -> ReadS ListVpcEndpoints
Prelude.Read, Int -> ListVpcEndpoints -> ShowS
[ListVpcEndpoints] -> ShowS
ListVpcEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVpcEndpoints] -> ShowS
$cshowList :: [ListVpcEndpoints] -> ShowS
show :: ListVpcEndpoints -> String
$cshow :: ListVpcEndpoints -> String
showsPrec :: Int -> ListVpcEndpoints -> ShowS
$cshowsPrec :: Int -> ListVpcEndpoints -> ShowS
Prelude.Show, forall x. Rep ListVpcEndpoints x -> ListVpcEndpoints
forall x. ListVpcEndpoints -> Rep ListVpcEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListVpcEndpoints x -> ListVpcEndpoints
$cfrom :: forall x. ListVpcEndpoints -> Rep ListVpcEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'ListVpcEndpoints' 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', 'listVpcEndpoints_maxResults' - An optional parameter that specifies the maximum number of results to
-- return. You can use @nextToken@ to get the next page of results. The
-- default is 20.
--
-- 'nextToken', 'listVpcEndpoints_nextToken' - If your initial @ListVpcEndpoints@ operation returns a @nextToken@, you
-- can include the returned @nextToken@ in subsequent @ListVpcEndpoints@
-- operations, which returns results in the next page.
--
-- 'vpcEndpointFilters', 'listVpcEndpoints_vpcEndpointFilters' - Filter the results according to the current status of the VPC endpoint.
-- Possible statuses are @CREATING@, @DELETING@, @UPDATING@, @ACTIVE@, and
-- @FAILED@.
newListVpcEndpoints ::
  ListVpcEndpoints
newListVpcEndpoints :: ListVpcEndpoints
newListVpcEndpoints =
  ListVpcEndpoints'
    { $sel:maxResults:ListVpcEndpoints' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListVpcEndpoints' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpointFilters:ListVpcEndpoints' :: Maybe VpcEndpointFilters
vpcEndpointFilters = forall a. Maybe a
Prelude.Nothing
    }

-- | An optional parameter that specifies the maximum number of results to
-- return. You can use @nextToken@ to get the next page of results. The
-- default is 20.
listVpcEndpoints_maxResults :: Lens.Lens' ListVpcEndpoints (Prelude.Maybe Prelude.Natural)
listVpcEndpoints_maxResults :: Lens' ListVpcEndpoints (Maybe Natural)
listVpcEndpoints_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpoints' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListVpcEndpoints
s@ListVpcEndpoints' {} Maybe Natural
a -> ListVpcEndpoints
s {$sel:maxResults:ListVpcEndpoints' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListVpcEndpoints)

-- | If your initial @ListVpcEndpoints@ operation returns a @nextToken@, you
-- can include the returned @nextToken@ in subsequent @ListVpcEndpoints@
-- operations, which returns results in the next page.
listVpcEndpoints_nextToken :: Lens.Lens' ListVpcEndpoints (Prelude.Maybe Prelude.Text)
listVpcEndpoints_nextToken :: Lens' ListVpcEndpoints (Maybe Text)
listVpcEndpoints_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpoints' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVpcEndpoints
s@ListVpcEndpoints' {} Maybe Text
a -> ListVpcEndpoints
s {$sel:nextToken:ListVpcEndpoints' :: Maybe Text
nextToken = Maybe Text
a} :: ListVpcEndpoints)

-- | Filter the results according to the current status of the VPC endpoint.
-- Possible statuses are @CREATING@, @DELETING@, @UPDATING@, @ACTIVE@, and
-- @FAILED@.
listVpcEndpoints_vpcEndpointFilters :: Lens.Lens' ListVpcEndpoints (Prelude.Maybe VpcEndpointFilters)
listVpcEndpoints_vpcEndpointFilters :: Lens' ListVpcEndpoints (Maybe VpcEndpointFilters)
listVpcEndpoints_vpcEndpointFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpoints' {Maybe VpcEndpointFilters
vpcEndpointFilters :: Maybe VpcEndpointFilters
$sel:vpcEndpointFilters:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe VpcEndpointFilters
vpcEndpointFilters} -> Maybe VpcEndpointFilters
vpcEndpointFilters) (\s :: ListVpcEndpoints
s@ListVpcEndpoints' {} Maybe VpcEndpointFilters
a -> ListVpcEndpoints
s {$sel:vpcEndpointFilters:ListVpcEndpoints' :: Maybe VpcEndpointFilters
vpcEndpointFilters = Maybe VpcEndpointFilters
a} :: ListVpcEndpoints)

instance Core.AWSRequest ListVpcEndpoints where
  type
    AWSResponse ListVpcEndpoints =
      ListVpcEndpointsResponse
  request :: (Service -> Service)
-> ListVpcEndpoints -> Request ListVpcEndpoints
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 ListVpcEndpoints
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListVpcEndpoints)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [VpcEndpointSummary] -> Int -> ListVpcEndpointsResponse
ListVpcEndpointsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"vpcEndpointSummaries"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListVpcEndpoints where
  hashWithSalt :: Int -> ListVpcEndpoints -> Int
hashWithSalt Int
_salt ListVpcEndpoints' {Maybe Natural
Maybe Text
Maybe VpcEndpointFilters
vpcEndpointFilters :: Maybe VpcEndpointFilters
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:vpcEndpointFilters:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe VpcEndpointFilters
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
$sel:maxResults:ListVpcEndpoints' :: ListVpcEndpoints -> 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` Maybe VpcEndpointFilters
vpcEndpointFilters

instance Prelude.NFData ListVpcEndpoints where
  rnf :: ListVpcEndpoints -> ()
rnf ListVpcEndpoints' {Maybe Natural
Maybe Text
Maybe VpcEndpointFilters
vpcEndpointFilters :: Maybe VpcEndpointFilters
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:vpcEndpointFilters:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe VpcEndpointFilters
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
$sel:maxResults:ListVpcEndpoints' :: ListVpcEndpoints -> 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 Maybe VpcEndpointFilters
vpcEndpointFilters

instance Data.ToHeaders ListVpcEndpoints where
  toHeaders :: ListVpcEndpoints -> 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
"OpenSearchServerless.ListVpcEndpoints" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListVpcEndpoints where
  toJSON :: ListVpcEndpoints -> Value
toJSON ListVpcEndpoints' {Maybe Natural
Maybe Text
Maybe VpcEndpointFilters
vpcEndpointFilters :: Maybe VpcEndpointFilters
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:vpcEndpointFilters:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe VpcEndpointFilters
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
$sel:maxResults:ListVpcEndpoints' :: ListVpcEndpoints -> 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,
            (Key
"vpcEndpointFilters" 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 VpcEndpointFilters
vpcEndpointFilters
          ]
      )

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

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

-- | /See:/ 'newListVpcEndpointsResponse' smart constructor.
data ListVpcEndpointsResponse = ListVpcEndpointsResponse'
  { -- | When @nextToken@ is returned, there are more results available. The
    -- value of @nextToken@ is a unique pagination token for each page. Make
    -- the call again using the returned token to retrieve the next page.
    ListVpcEndpointsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Details about each VPC endpoint, including the name and current status.
    ListVpcEndpointsResponse -> Maybe [VpcEndpointSummary]
vpcEndpointSummaries :: Prelude.Maybe [VpcEndpointSummary],
    -- | The response's http status code.
    ListVpcEndpointsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListVpcEndpointsResponse -> ListVpcEndpointsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVpcEndpointsResponse -> ListVpcEndpointsResponse -> Bool
$c/= :: ListVpcEndpointsResponse -> ListVpcEndpointsResponse -> Bool
== :: ListVpcEndpointsResponse -> ListVpcEndpointsResponse -> Bool
$c== :: ListVpcEndpointsResponse -> ListVpcEndpointsResponse -> Bool
Prelude.Eq, ReadPrec [ListVpcEndpointsResponse]
ReadPrec ListVpcEndpointsResponse
Int -> ReadS ListVpcEndpointsResponse
ReadS [ListVpcEndpointsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVpcEndpointsResponse]
$creadListPrec :: ReadPrec [ListVpcEndpointsResponse]
readPrec :: ReadPrec ListVpcEndpointsResponse
$creadPrec :: ReadPrec ListVpcEndpointsResponse
readList :: ReadS [ListVpcEndpointsResponse]
$creadList :: ReadS [ListVpcEndpointsResponse]
readsPrec :: Int -> ReadS ListVpcEndpointsResponse
$creadsPrec :: Int -> ReadS ListVpcEndpointsResponse
Prelude.Read, Int -> ListVpcEndpointsResponse -> ShowS
[ListVpcEndpointsResponse] -> ShowS
ListVpcEndpointsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVpcEndpointsResponse] -> ShowS
$cshowList :: [ListVpcEndpointsResponse] -> ShowS
show :: ListVpcEndpointsResponse -> String
$cshow :: ListVpcEndpointsResponse -> String
showsPrec :: Int -> ListVpcEndpointsResponse -> ShowS
$cshowsPrec :: Int -> ListVpcEndpointsResponse -> ShowS
Prelude.Show, forall x.
Rep ListVpcEndpointsResponse x -> ListVpcEndpointsResponse
forall x.
ListVpcEndpointsResponse -> Rep ListVpcEndpointsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListVpcEndpointsResponse x -> ListVpcEndpointsResponse
$cfrom :: forall x.
ListVpcEndpointsResponse -> Rep ListVpcEndpointsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListVpcEndpointsResponse' 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', 'listVpcEndpointsResponse_nextToken' - When @nextToken@ is returned, there are more results available. The
-- value of @nextToken@ is a unique pagination token for each page. Make
-- the call again using the returned token to retrieve the next page.
--
-- 'vpcEndpointSummaries', 'listVpcEndpointsResponse_vpcEndpointSummaries' - Details about each VPC endpoint, including the name and current status.
--
-- 'httpStatus', 'listVpcEndpointsResponse_httpStatus' - The response's http status code.
newListVpcEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListVpcEndpointsResponse
newListVpcEndpointsResponse :: Int -> ListVpcEndpointsResponse
newListVpcEndpointsResponse Int
pHttpStatus_ =
  ListVpcEndpointsResponse'
    { $sel:nextToken:ListVpcEndpointsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpointSummaries:ListVpcEndpointsResponse' :: Maybe [VpcEndpointSummary]
vpcEndpointSummaries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListVpcEndpointsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | When @nextToken@ is returned, there are more results available. The
-- value of @nextToken@ is a unique pagination token for each page. Make
-- the call again using the returned token to retrieve the next page.
listVpcEndpointsResponse_nextToken :: Lens.Lens' ListVpcEndpointsResponse (Prelude.Maybe Prelude.Text)
listVpcEndpointsResponse_nextToken :: Lens' ListVpcEndpointsResponse (Maybe Text)
listVpcEndpointsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpointsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListVpcEndpointsResponse
s@ListVpcEndpointsResponse' {} Maybe Text
a -> ListVpcEndpointsResponse
s {$sel:nextToken:ListVpcEndpointsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListVpcEndpointsResponse)

-- | Details about each VPC endpoint, including the name and current status.
listVpcEndpointsResponse_vpcEndpointSummaries :: Lens.Lens' ListVpcEndpointsResponse (Prelude.Maybe [VpcEndpointSummary])
listVpcEndpointsResponse_vpcEndpointSummaries :: Lens' ListVpcEndpointsResponse (Maybe [VpcEndpointSummary])
listVpcEndpointsResponse_vpcEndpointSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpointsResponse' {Maybe [VpcEndpointSummary]
vpcEndpointSummaries :: Maybe [VpcEndpointSummary]
$sel:vpcEndpointSummaries:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Maybe [VpcEndpointSummary]
vpcEndpointSummaries} -> Maybe [VpcEndpointSummary]
vpcEndpointSummaries) (\s :: ListVpcEndpointsResponse
s@ListVpcEndpointsResponse' {} Maybe [VpcEndpointSummary]
a -> ListVpcEndpointsResponse
s {$sel:vpcEndpointSummaries:ListVpcEndpointsResponse' :: Maybe [VpcEndpointSummary]
vpcEndpointSummaries = Maybe [VpcEndpointSummary]
a} :: ListVpcEndpointsResponse) 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 response's http status code.
listVpcEndpointsResponse_httpStatus :: Lens.Lens' ListVpcEndpointsResponse Prelude.Int
listVpcEndpointsResponse_httpStatus :: Lens' ListVpcEndpointsResponse Int
listVpcEndpointsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpointsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListVpcEndpointsResponse
s@ListVpcEndpointsResponse' {} Int
a -> ListVpcEndpointsResponse
s {$sel:httpStatus:ListVpcEndpointsResponse' :: Int
httpStatus = Int
a} :: ListVpcEndpointsResponse)

instance Prelude.NFData ListVpcEndpointsResponse where
  rnf :: ListVpcEndpointsResponse -> ()
rnf ListVpcEndpointsResponse' {Int
Maybe [VpcEndpointSummary]
Maybe Text
httpStatus :: Int
vpcEndpointSummaries :: Maybe [VpcEndpointSummary]
nextToken :: Maybe Text
$sel:httpStatus:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Int
$sel:vpcEndpointSummaries:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Maybe [VpcEndpointSummary]
$sel:nextToken:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> 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 Maybe [VpcEndpointSummary]
vpcEndpointSummaries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus