{-# 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.ElasticSearch.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)
--
-- Retrieves all Amazon OpenSearch Service-managed VPC endpoints in the
-- current account and Region.
module Amazonka.ElasticSearch.ListVpcEndpoints
  ( -- * Creating a Request
    ListVpcEndpoints (..),
    newListVpcEndpoints,

    -- * Request Lenses
    listVpcEndpoints_nextToken,

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

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

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

-- | Container for request parameters to the @ListVpcEndpoints@ operation.
--
-- /See:/ 'newListVpcEndpoints' smart constructor.
data ListVpcEndpoints = ListVpcEndpoints'
  { -- | Identifier to allow retrieval of paginated results.
    ListVpcEndpoints -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  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:
--
-- 'nextToken', 'listVpcEndpoints_nextToken' - Identifier to allow retrieval of paginated results.
newListVpcEndpoints ::
  ListVpcEndpoints
newListVpcEndpoints :: ListVpcEndpoints
newListVpcEndpoints =
  ListVpcEndpoints' {$sel:nextToken:ListVpcEndpoints' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | Identifier to allow retrieval of paginated results.
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)

instance Core.AWSRequest ListVpcEndpoints where
  type
    AWSResponse ListVpcEndpoints =
      ListVpcEndpointsResponse
  request :: (Service -> Service)
-> ListVpcEndpoints -> Request ListVpcEndpoints
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 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 ->
          Int -> [VpcEndpointSummary] -> Text -> ListVpcEndpointsResponse
ListVpcEndpointsResponse'
            forall (f :: * -> *) a b. Functor 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))
            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
"VpcEndpointSummaryList"
                            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 a
Data..:> Key
"NextToken")
      )

instance Prelude.Hashable ListVpcEndpoints where
  hashWithSalt :: Int -> ListVpcEndpoints -> Int
hashWithSalt Int
_salt ListVpcEndpoints' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListVpcEndpoints where
  rnf :: ListVpcEndpoints -> ()
rnf ListVpcEndpoints' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

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

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

instance Data.ToQuery ListVpcEndpoints where
  toQuery :: ListVpcEndpoints -> QueryString
toQuery ListVpcEndpoints' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListVpcEndpoints' :: ListVpcEndpoints -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken]

-- | Container for response parameters to the @ListVpcEndpoints@ operation.
-- Returns a list containing summarized details of the VPC endpoints.
--
-- /See:/ 'newListVpcEndpointsResponse' smart constructor.
data ListVpcEndpointsResponse = ListVpcEndpointsResponse'
  { -- | The response's http status code.
    ListVpcEndpointsResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about each endpoint.
    ListVpcEndpointsResponse -> [VpcEndpointSummary]
vpcEndpointSummaryList :: [VpcEndpointSummary],
    -- | Provides an identifier to allow retrieval of paginated results.
    ListVpcEndpointsResponse -> Text
nextToken :: Prelude.Text
  }
  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:
--
-- 'httpStatus', 'listVpcEndpointsResponse_httpStatus' - The response's http status code.
--
-- 'vpcEndpointSummaryList', 'listVpcEndpointsResponse_vpcEndpointSummaryList' - Information about each endpoint.
--
-- 'nextToken', 'listVpcEndpointsResponse_nextToken' - Provides an identifier to allow retrieval of paginated results.
newListVpcEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'nextToken'
  Prelude.Text ->
  ListVpcEndpointsResponse
newListVpcEndpointsResponse :: Int -> Text -> ListVpcEndpointsResponse
newListVpcEndpointsResponse Int
pHttpStatus_ Text
pNextToken_ =
  ListVpcEndpointsResponse'
    { $sel:httpStatus:ListVpcEndpointsResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:vpcEndpointSummaryList:ListVpcEndpointsResponse' :: [VpcEndpointSummary]
vpcEndpointSummaryList = forall a. Monoid a => a
Prelude.mempty,
      $sel:nextToken:ListVpcEndpointsResponse' :: Text
nextToken = Text
pNextToken_
    }

-- | 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)

-- | Information about each endpoint.
listVpcEndpointsResponse_vpcEndpointSummaryList :: Lens.Lens' ListVpcEndpointsResponse [VpcEndpointSummary]
listVpcEndpointsResponse_vpcEndpointSummaryList :: Lens' ListVpcEndpointsResponse [VpcEndpointSummary]
listVpcEndpointsResponse_vpcEndpointSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpointsResponse' {[VpcEndpointSummary]
vpcEndpointSummaryList :: [VpcEndpointSummary]
$sel:vpcEndpointSummaryList:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> [VpcEndpointSummary]
vpcEndpointSummaryList} -> [VpcEndpointSummary]
vpcEndpointSummaryList) (\s :: ListVpcEndpointsResponse
s@ListVpcEndpointsResponse' {} [VpcEndpointSummary]
a -> ListVpcEndpointsResponse
s {$sel:vpcEndpointSummaryList:ListVpcEndpointsResponse' :: [VpcEndpointSummary]
vpcEndpointSummaryList = [VpcEndpointSummary]
a} :: ListVpcEndpointsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Provides an identifier to allow retrieval of paginated results.
listVpcEndpointsResponse_nextToken :: Lens.Lens' ListVpcEndpointsResponse Prelude.Text
listVpcEndpointsResponse_nextToken :: Lens' ListVpcEndpointsResponse Text
listVpcEndpointsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVpcEndpointsResponse' {Text
nextToken :: Text
$sel:nextToken:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Text
nextToken} -> Text
nextToken) (\s :: ListVpcEndpointsResponse
s@ListVpcEndpointsResponse' {} Text
a -> ListVpcEndpointsResponse
s {$sel:nextToken:ListVpcEndpointsResponse' :: Text
nextToken = Text
a} :: ListVpcEndpointsResponse)

instance Prelude.NFData ListVpcEndpointsResponse where
  rnf :: ListVpcEndpointsResponse -> ()
rnf ListVpcEndpointsResponse' {Int
[VpcEndpointSummary]
Text
nextToken :: Text
vpcEndpointSummaryList :: [VpcEndpointSummary]
httpStatus :: Int
$sel:nextToken:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Text
$sel:vpcEndpointSummaryList:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> [VpcEndpointSummary]
$sel:httpStatus:ListVpcEndpointsResponse' :: ListVpcEndpointsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [VpcEndpointSummary]
vpcEndpointSummaryList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
nextToken