{-# 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.EC2.CreateVpcEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a VPC endpoint for a specified service. An endpoint enables you
-- to create a private connection between your VPC and the service. The
-- service may be provided by Amazon Web Services, an Amazon Web Services
-- Marketplace Partner, or another Amazon Web Services account. For more
-- information, see the
-- <https://docs.aws.amazon.com/vpc/latest/privatelink/ Amazon Web Services PrivateLink Guide>.
module Amazonka.EC2.CreateVpcEndpoint
  ( -- * Creating a Request
    CreateVpcEndpoint (..),
    newCreateVpcEndpoint,

    -- * Request Lenses
    createVpcEndpoint_clientToken,
    createVpcEndpoint_dnsOptions,
    createVpcEndpoint_dryRun,
    createVpcEndpoint_ipAddressType,
    createVpcEndpoint_policyDocument,
    createVpcEndpoint_privateDnsEnabled,
    createVpcEndpoint_routeTableIds,
    createVpcEndpoint_securityGroupIds,
    createVpcEndpoint_subnetIds,
    createVpcEndpoint_tagSpecifications,
    createVpcEndpoint_vpcEndpointType,
    createVpcEndpoint_vpcId,
    createVpcEndpoint_serviceName,

    -- * Destructuring the Response
    CreateVpcEndpointResponse (..),
    newCreateVpcEndpointResponse,

    -- * Response Lenses
    createVpcEndpointResponse_clientToken,
    createVpcEndpointResponse_vpcEndpoint,
    createVpcEndpointResponse_httpStatus,
  )
where

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

-- | Contains the parameters for CreateVpcEndpoint.
--
-- /See:/ 'newCreateVpcEndpoint' smart constructor.
data CreateVpcEndpoint = CreateVpcEndpoint'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
    CreateVpcEndpoint -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The DNS options for the endpoint.
    CreateVpcEndpoint -> Maybe DnsOptionsSpecification
dnsOptions :: Prelude.Maybe DnsOptionsSpecification,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateVpcEndpoint -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The IP address type for the endpoint.
    CreateVpcEndpoint -> Maybe IpAddressType
ipAddressType :: Prelude.Maybe IpAddressType,
    -- | (Interface and gateway endpoints) A policy to attach to the endpoint
    -- that controls access to the service. The policy must be in valid JSON
    -- format. If this parameter is not specified, we attach a default policy
    -- that allows full access to the service.
    CreateVpcEndpoint -> Maybe Text
policyDocument :: Prelude.Maybe Prelude.Text,
    -- | (Interface endpoint) Indicates whether to associate a private hosted
    -- zone with the specified VPC. The private hosted zone contains a record
    -- set for the default public DNS name for the service for the Region (for
    -- example, @kinesis.us-east-1.amazonaws.com@), which resolves to the
    -- private IP addresses of the endpoint network interfaces in the VPC. This
    -- enables you to make requests to the default public DNS name for the
    -- service instead of the public DNS names that are automatically generated
    -- by the VPC endpoint service.
    --
    -- To use a private hosted zone, you must set the following VPC attributes
    -- to @true@: @enableDnsHostnames@ and @enableDnsSupport@. Use
    -- ModifyVpcAttribute to set the VPC attributes.
    --
    -- Default: @true@
    CreateVpcEndpoint -> Maybe Bool
privateDnsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | (Gateway endpoint) One or more route table IDs.
    CreateVpcEndpoint -> Maybe [Text]
routeTableIds :: Prelude.Maybe [Prelude.Text],
    -- | (Interface endpoint) The ID of one or more security groups to associate
    -- with the endpoint network interface.
    CreateVpcEndpoint -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | (Interface and Gateway Load Balancer endpoints) The ID of one or more
    -- subnets in which to create an endpoint network interface. For a Gateway
    -- Load Balancer endpoint, you can specify one subnet only.
    CreateVpcEndpoint -> Maybe [Text]
subnetIds :: Prelude.Maybe [Prelude.Text],
    -- | The tags to associate with the endpoint.
    CreateVpcEndpoint -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The type of endpoint.
    --
    -- Default: Gateway
    CreateVpcEndpoint -> Maybe VpcEndpointType
vpcEndpointType :: Prelude.Maybe VpcEndpointType,
    -- | The ID of the VPC in which the endpoint will be used.
    CreateVpcEndpoint -> Text
vpcId :: Prelude.Text,
    -- | The service name. To get a list of available services, use the
    -- DescribeVpcEndpointServices request, or get the name from the service
    -- provider.
    CreateVpcEndpoint -> Text
serviceName :: Prelude.Text
  }
  deriving (CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
$c/= :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
== :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
$c== :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateVpcEndpoint]
ReadPrec CreateVpcEndpoint
Int -> ReadS CreateVpcEndpoint
ReadS [CreateVpcEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpcEndpoint]
$creadListPrec :: ReadPrec [CreateVpcEndpoint]
readPrec :: ReadPrec CreateVpcEndpoint
$creadPrec :: ReadPrec CreateVpcEndpoint
readList :: ReadS [CreateVpcEndpoint]
$creadList :: ReadS [CreateVpcEndpoint]
readsPrec :: Int -> ReadS CreateVpcEndpoint
$creadsPrec :: Int -> ReadS CreateVpcEndpoint
Prelude.Read, Int -> CreateVpcEndpoint -> ShowS
[CreateVpcEndpoint] -> ShowS
CreateVpcEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpcEndpoint] -> ShowS
$cshowList :: [CreateVpcEndpoint] -> ShowS
show :: CreateVpcEndpoint -> String
$cshow :: CreateVpcEndpoint -> String
showsPrec :: Int -> CreateVpcEndpoint -> ShowS
$cshowsPrec :: Int -> CreateVpcEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateVpcEndpoint x -> CreateVpcEndpoint
forall x. CreateVpcEndpoint -> Rep CreateVpcEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVpcEndpoint x -> CreateVpcEndpoint
$cfrom :: forall x. CreateVpcEndpoint -> Rep CreateVpcEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpcEndpoint' 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:
--
-- 'clientToken', 'createVpcEndpoint_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
--
-- 'dnsOptions', 'createVpcEndpoint_dnsOptions' - The DNS options for the endpoint.
--
-- 'dryRun', 'createVpcEndpoint_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'ipAddressType', 'createVpcEndpoint_ipAddressType' - The IP address type for the endpoint.
--
-- 'policyDocument', 'createVpcEndpoint_policyDocument' - (Interface and gateway endpoints) A policy to attach to the endpoint
-- that controls access to the service. The policy must be in valid JSON
-- format. If this parameter is not specified, we attach a default policy
-- that allows full access to the service.
--
-- 'privateDnsEnabled', 'createVpcEndpoint_privateDnsEnabled' - (Interface endpoint) Indicates whether to associate a private hosted
-- zone with the specified VPC. The private hosted zone contains a record
-- set for the default public DNS name for the service for the Region (for
-- example, @kinesis.us-east-1.amazonaws.com@), which resolves to the
-- private IP addresses of the endpoint network interfaces in the VPC. This
-- enables you to make requests to the default public DNS name for the
-- service instead of the public DNS names that are automatically generated
-- by the VPC endpoint service.
--
-- To use a private hosted zone, you must set the following VPC attributes
-- to @true@: @enableDnsHostnames@ and @enableDnsSupport@. Use
-- ModifyVpcAttribute to set the VPC attributes.
--
-- Default: @true@
--
-- 'routeTableIds', 'createVpcEndpoint_routeTableIds' - (Gateway endpoint) One or more route table IDs.
--
-- 'securityGroupIds', 'createVpcEndpoint_securityGroupIds' - (Interface endpoint) The ID of one or more security groups to associate
-- with the endpoint network interface.
--
-- 'subnetIds', 'createVpcEndpoint_subnetIds' - (Interface and Gateway Load Balancer endpoints) The ID of one or more
-- subnets in which to create an endpoint network interface. For a Gateway
-- Load Balancer endpoint, you can specify one subnet only.
--
-- 'tagSpecifications', 'createVpcEndpoint_tagSpecifications' - The tags to associate with the endpoint.
--
-- 'vpcEndpointType', 'createVpcEndpoint_vpcEndpointType' - The type of endpoint.
--
-- Default: Gateway
--
-- 'vpcId', 'createVpcEndpoint_vpcId' - The ID of the VPC in which the endpoint will be used.
--
-- 'serviceName', 'createVpcEndpoint_serviceName' - The service name. To get a list of available services, use the
-- DescribeVpcEndpointServices request, or get the name from the service
-- provider.
newCreateVpcEndpoint ::
  -- | 'vpcId'
  Prelude.Text ->
  -- | 'serviceName'
  Prelude.Text ->
  CreateVpcEndpoint
newCreateVpcEndpoint :: Text -> Text -> CreateVpcEndpoint
newCreateVpcEndpoint Text
pVpcId_ Text
pServiceName_ =
  CreateVpcEndpoint'
    { $sel:clientToken:CreateVpcEndpoint' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsOptions:CreateVpcEndpoint' :: Maybe DnsOptionsSpecification
dnsOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateVpcEndpoint' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddressType:CreateVpcEndpoint' :: Maybe IpAddressType
ipAddressType = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDocument:CreateVpcEndpoint' :: Maybe Text
policyDocument = forall a. Maybe a
Prelude.Nothing,
      $sel:privateDnsEnabled:CreateVpcEndpoint' :: Maybe Bool
privateDnsEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:routeTableIds:CreateVpcEndpoint' :: Maybe [Text]
routeTableIds = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupIds:CreateVpcEndpoint' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetIds:CreateVpcEndpoint' :: Maybe [Text]
subnetIds = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateVpcEndpoint' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpointType:CreateVpcEndpoint' :: Maybe VpcEndpointType
vpcEndpointType = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:CreateVpcEndpoint' :: Text
vpcId = Text
pVpcId_,
      $sel:serviceName:CreateVpcEndpoint' :: Text
serviceName = Text
pServiceName_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
createVpcEndpoint_clientToken :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe Prelude.Text)
createVpcEndpoint_clientToken :: Lens' CreateVpcEndpoint (Maybe Text)
createVpcEndpoint_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe Text
a -> CreateVpcEndpoint
s {$sel:clientToken:CreateVpcEndpoint' :: Maybe Text
clientToken = Maybe Text
a} :: CreateVpcEndpoint)

-- | The DNS options for the endpoint.
createVpcEndpoint_dnsOptions :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe DnsOptionsSpecification)
createVpcEndpoint_dnsOptions :: Lens' CreateVpcEndpoint (Maybe DnsOptionsSpecification)
createVpcEndpoint_dnsOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe DnsOptionsSpecification
dnsOptions :: Maybe DnsOptionsSpecification
$sel:dnsOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe DnsOptionsSpecification
dnsOptions} -> Maybe DnsOptionsSpecification
dnsOptions) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe DnsOptionsSpecification
a -> CreateVpcEndpoint
s {$sel:dnsOptions:CreateVpcEndpoint' :: Maybe DnsOptionsSpecification
dnsOptions = Maybe DnsOptionsSpecification
a} :: CreateVpcEndpoint)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createVpcEndpoint_dryRun :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe Prelude.Bool)
createVpcEndpoint_dryRun :: Lens' CreateVpcEndpoint (Maybe Bool)
createVpcEndpoint_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe Bool
a -> CreateVpcEndpoint
s {$sel:dryRun:CreateVpcEndpoint' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateVpcEndpoint)

-- | The IP address type for the endpoint.
createVpcEndpoint_ipAddressType :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe IpAddressType)
createVpcEndpoint_ipAddressType :: Lens' CreateVpcEndpoint (Maybe IpAddressType)
createVpcEndpoint_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe IpAddressType
ipAddressType :: Maybe IpAddressType
$sel:ipAddressType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe IpAddressType
ipAddressType} -> Maybe IpAddressType
ipAddressType) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe IpAddressType
a -> CreateVpcEndpoint
s {$sel:ipAddressType:CreateVpcEndpoint' :: Maybe IpAddressType
ipAddressType = Maybe IpAddressType
a} :: CreateVpcEndpoint)

-- | (Interface and gateway endpoints) A policy to attach to the endpoint
-- that controls access to the service. The policy must be in valid JSON
-- format. If this parameter is not specified, we attach a default policy
-- that allows full access to the service.
createVpcEndpoint_policyDocument :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe Prelude.Text)
createVpcEndpoint_policyDocument :: Lens' CreateVpcEndpoint (Maybe Text)
createVpcEndpoint_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe Text
policyDocument :: Maybe Text
$sel:policyDocument:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
policyDocument} -> Maybe Text
policyDocument) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe Text
a -> CreateVpcEndpoint
s {$sel:policyDocument:CreateVpcEndpoint' :: Maybe Text
policyDocument = Maybe Text
a} :: CreateVpcEndpoint)

-- | (Interface endpoint) Indicates whether to associate a private hosted
-- zone with the specified VPC. The private hosted zone contains a record
-- set for the default public DNS name for the service for the Region (for
-- example, @kinesis.us-east-1.amazonaws.com@), which resolves to the
-- private IP addresses of the endpoint network interfaces in the VPC. This
-- enables you to make requests to the default public DNS name for the
-- service instead of the public DNS names that are automatically generated
-- by the VPC endpoint service.
--
-- To use a private hosted zone, you must set the following VPC attributes
-- to @true@: @enableDnsHostnames@ and @enableDnsSupport@. Use
-- ModifyVpcAttribute to set the VPC attributes.
--
-- Default: @true@
createVpcEndpoint_privateDnsEnabled :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe Prelude.Bool)
createVpcEndpoint_privateDnsEnabled :: Lens' CreateVpcEndpoint (Maybe Bool)
createVpcEndpoint_privateDnsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe Bool
privateDnsEnabled :: Maybe Bool
$sel:privateDnsEnabled:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
privateDnsEnabled} -> Maybe Bool
privateDnsEnabled) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe Bool
a -> CreateVpcEndpoint
s {$sel:privateDnsEnabled:CreateVpcEndpoint' :: Maybe Bool
privateDnsEnabled = Maybe Bool
a} :: CreateVpcEndpoint)

-- | (Gateway endpoint) One or more route table IDs.
createVpcEndpoint_routeTableIds :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe [Prelude.Text])
createVpcEndpoint_routeTableIds :: Lens' CreateVpcEndpoint (Maybe [Text])
createVpcEndpoint_routeTableIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe [Text]
routeTableIds :: Maybe [Text]
$sel:routeTableIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
routeTableIds} -> Maybe [Text]
routeTableIds) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe [Text]
a -> CreateVpcEndpoint
s {$sel:routeTableIds:CreateVpcEndpoint' :: Maybe [Text]
routeTableIds = Maybe [Text]
a} :: CreateVpcEndpoint) 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

-- | (Interface endpoint) The ID of one or more security groups to associate
-- with the endpoint network interface.
createVpcEndpoint_securityGroupIds :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe [Prelude.Text])
createVpcEndpoint_securityGroupIds :: Lens' CreateVpcEndpoint (Maybe [Text])
createVpcEndpoint_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe [Text]
a -> CreateVpcEndpoint
s {$sel:securityGroupIds:CreateVpcEndpoint' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateVpcEndpoint) 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

-- | (Interface and Gateway Load Balancer endpoints) The ID of one or more
-- subnets in which to create an endpoint network interface. For a Gateway
-- Load Balancer endpoint, you can specify one subnet only.
createVpcEndpoint_subnetIds :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe [Prelude.Text])
createVpcEndpoint_subnetIds :: Lens' CreateVpcEndpoint (Maybe [Text])
createVpcEndpoint_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe [Text]
subnetIds :: Maybe [Text]
$sel:subnetIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
subnetIds} -> Maybe [Text]
subnetIds) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe [Text]
a -> CreateVpcEndpoint
s {$sel:subnetIds:CreateVpcEndpoint' :: Maybe [Text]
subnetIds = Maybe [Text]
a} :: CreateVpcEndpoint) 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 tags to associate with the endpoint.
createVpcEndpoint_tagSpecifications :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe [TagSpecification])
createVpcEndpoint_tagSpecifications :: Lens' CreateVpcEndpoint (Maybe [TagSpecification])
createVpcEndpoint_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe [TagSpecification]
a -> CreateVpcEndpoint
s {$sel:tagSpecifications:CreateVpcEndpoint' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVpcEndpoint) 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 type of endpoint.
--
-- Default: Gateway
createVpcEndpoint_vpcEndpointType :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe VpcEndpointType)
createVpcEndpoint_vpcEndpointType :: Lens' CreateVpcEndpoint (Maybe VpcEndpointType)
createVpcEndpoint_vpcEndpointType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe VpcEndpointType
vpcEndpointType :: Maybe VpcEndpointType
$sel:vpcEndpointType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe VpcEndpointType
vpcEndpointType} -> Maybe VpcEndpointType
vpcEndpointType) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe VpcEndpointType
a -> CreateVpcEndpoint
s {$sel:vpcEndpointType:CreateVpcEndpoint' :: Maybe VpcEndpointType
vpcEndpointType = Maybe VpcEndpointType
a} :: CreateVpcEndpoint)

-- | The ID of the VPC in which the endpoint will be used.
createVpcEndpoint_vpcId :: Lens.Lens' CreateVpcEndpoint Prelude.Text
createVpcEndpoint_vpcId :: Lens' CreateVpcEndpoint Text
createVpcEndpoint_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Text
vpcId :: Text
$sel:vpcId:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
vpcId} -> Text
vpcId) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Text
a -> CreateVpcEndpoint
s {$sel:vpcId:CreateVpcEndpoint' :: Text
vpcId = Text
a} :: CreateVpcEndpoint)

-- | The service name. To get a list of available services, use the
-- DescribeVpcEndpointServices request, or get the name from the service
-- provider.
createVpcEndpoint_serviceName :: Lens.Lens' CreateVpcEndpoint Prelude.Text
createVpcEndpoint_serviceName :: Lens' CreateVpcEndpoint Text
createVpcEndpoint_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Text
serviceName :: Text
$sel:serviceName:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
serviceName} -> Text
serviceName) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Text
a -> CreateVpcEndpoint
s {$sel:serviceName:CreateVpcEndpoint' :: Text
serviceName = Text
a} :: CreateVpcEndpoint)

instance Core.AWSRequest CreateVpcEndpoint where
  type
    AWSResponse CreateVpcEndpoint =
      CreateVpcEndpointResponse
  request :: (Service -> Service)
-> CreateVpcEndpoint -> Request CreateVpcEndpoint
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 CreateVpcEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateVpcEndpoint)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Maybe VpcEndpoint -> Int -> CreateVpcEndpointResponse
CreateVpcEndpointResponse'
            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
"clientToken")
            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
"vpcEndpoint")
            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 CreateVpcEndpoint where
  hashWithSalt :: Int -> CreateVpcEndpoint -> Int
hashWithSalt Int
_salt CreateVpcEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe DnsOptionsSpecification
Maybe IpAddressType
Maybe VpcEndpointType
Text
serviceName :: Text
vpcId :: Text
vpcEndpointType :: Maybe VpcEndpointType
tagSpecifications :: Maybe [TagSpecification]
subnetIds :: Maybe [Text]
securityGroupIds :: Maybe [Text]
routeTableIds :: Maybe [Text]
privateDnsEnabled :: Maybe Bool
policyDocument :: Maybe Text
ipAddressType :: Maybe IpAddressType
dryRun :: Maybe Bool
dnsOptions :: Maybe DnsOptionsSpecification
clientToken :: Maybe Text
$sel:serviceName:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcId:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcEndpointType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe VpcEndpointType
$sel:tagSpecifications:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [TagSpecification]
$sel:subnetIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:securityGroupIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:routeTableIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:privateDnsEnabled:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:policyDocument:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
$sel:ipAddressType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe IpAddressType
$sel:dryRun:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:dnsOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe DnsOptionsSpecification
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DnsOptionsSpecification
dnsOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IpAddressType
ipAddressType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policyDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
privateDnsEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
routeTableIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcEndpointType
vpcEndpointType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName

instance Prelude.NFData CreateVpcEndpoint where
  rnf :: CreateVpcEndpoint -> ()
rnf CreateVpcEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe DnsOptionsSpecification
Maybe IpAddressType
Maybe VpcEndpointType
Text
serviceName :: Text
vpcId :: Text
vpcEndpointType :: Maybe VpcEndpointType
tagSpecifications :: Maybe [TagSpecification]
subnetIds :: Maybe [Text]
securityGroupIds :: Maybe [Text]
routeTableIds :: Maybe [Text]
privateDnsEnabled :: Maybe Bool
policyDocument :: Maybe Text
ipAddressType :: Maybe IpAddressType
dryRun :: Maybe Bool
dnsOptions :: Maybe DnsOptionsSpecification
clientToken :: Maybe Text
$sel:serviceName:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcId:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcEndpointType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe VpcEndpointType
$sel:tagSpecifications:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [TagSpecification]
$sel:subnetIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:securityGroupIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:routeTableIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:privateDnsEnabled:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:policyDocument:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
$sel:ipAddressType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe IpAddressType
$sel:dryRun:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:dnsOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe DnsOptionsSpecification
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DnsOptionsSpecification
dnsOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IpAddressType
ipAddressType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
privateDnsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
routeTableIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcEndpointType
vpcEndpointType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceName

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

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

instance Data.ToQuery CreateVpcEndpoint where
  toQuery :: CreateVpcEndpoint -> QueryString
toQuery CreateVpcEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe DnsOptionsSpecification
Maybe IpAddressType
Maybe VpcEndpointType
Text
serviceName :: Text
vpcId :: Text
vpcEndpointType :: Maybe VpcEndpointType
tagSpecifications :: Maybe [TagSpecification]
subnetIds :: Maybe [Text]
securityGroupIds :: Maybe [Text]
routeTableIds :: Maybe [Text]
privateDnsEnabled :: Maybe Bool
policyDocument :: Maybe Text
ipAddressType :: Maybe IpAddressType
dryRun :: Maybe Bool
dnsOptions :: Maybe DnsOptionsSpecification
clientToken :: Maybe Text
$sel:serviceName:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcId:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:vpcEndpointType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe VpcEndpointType
$sel:tagSpecifications:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [TagSpecification]
$sel:subnetIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:securityGroupIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:routeTableIds:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe [Text]
$sel:privateDnsEnabled:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:policyDocument:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
$sel:ipAddressType:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe IpAddressType
$sel:dryRun:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Bool
$sel:dnsOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe DnsOptionsSpecification
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateVpcEndpoint" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DnsOptions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DnsOptionsSpecification
dnsOptions,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"IpAddressType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe IpAddressType
ipAddressType,
        ByteString
"PolicyDocument" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
policyDocument,
        ByteString
"PrivateDnsEnabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
privateDnsEnabled,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"RouteTableId"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
routeTableIds
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"SecurityGroupId"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
securityGroupIds
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"SubnetId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
subnetIds),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"VpcEndpointType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe VpcEndpointType
vpcEndpointType,
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpcId,
        ByteString
"ServiceName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serviceName
      ]

-- | Contains the output of CreateVpcEndpoint.
--
-- /See:/ 'newCreateVpcEndpointResponse' smart constructor.
data CreateVpcEndpointResponse = CreateVpcEndpointResponse'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateVpcEndpointResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the endpoint.
    CreateVpcEndpointResponse -> Maybe VpcEndpoint
vpcEndpoint :: Prelude.Maybe VpcEndpoint,
    -- | The response's http status code.
    CreateVpcEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
$c/= :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
== :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
$c== :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateVpcEndpointResponse]
ReadPrec CreateVpcEndpointResponse
Int -> ReadS CreateVpcEndpointResponse
ReadS [CreateVpcEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpcEndpointResponse]
$creadListPrec :: ReadPrec [CreateVpcEndpointResponse]
readPrec :: ReadPrec CreateVpcEndpointResponse
$creadPrec :: ReadPrec CreateVpcEndpointResponse
readList :: ReadS [CreateVpcEndpointResponse]
$creadList :: ReadS [CreateVpcEndpointResponse]
readsPrec :: Int -> ReadS CreateVpcEndpointResponse
$creadsPrec :: Int -> ReadS CreateVpcEndpointResponse
Prelude.Read, Int -> CreateVpcEndpointResponse -> ShowS
[CreateVpcEndpointResponse] -> ShowS
CreateVpcEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpcEndpointResponse] -> ShowS
$cshowList :: [CreateVpcEndpointResponse] -> ShowS
show :: CreateVpcEndpointResponse -> String
$cshow :: CreateVpcEndpointResponse -> String
showsPrec :: Int -> CreateVpcEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateVpcEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateVpcEndpointResponse x -> CreateVpcEndpointResponse
forall x.
CreateVpcEndpointResponse -> Rep CreateVpcEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVpcEndpointResponse x -> CreateVpcEndpointResponse
$cfrom :: forall x.
CreateVpcEndpointResponse -> Rep CreateVpcEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpcEndpointResponse' 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:
--
-- 'clientToken', 'createVpcEndpointResponse_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'vpcEndpoint', 'createVpcEndpointResponse_vpcEndpoint' - Information about the endpoint.
--
-- 'httpStatus', 'createVpcEndpointResponse_httpStatus' - The response's http status code.
newCreateVpcEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVpcEndpointResponse
newCreateVpcEndpointResponse :: Int -> CreateVpcEndpointResponse
newCreateVpcEndpointResponse Int
pHttpStatus_ =
  CreateVpcEndpointResponse'
    { $sel:clientToken:CreateVpcEndpointResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpoint:CreateVpcEndpointResponse' :: Maybe VpcEndpoint
vpcEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVpcEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createVpcEndpointResponse_clientToken :: Lens.Lens' CreateVpcEndpointResponse (Prelude.Maybe Prelude.Text)
createVpcEndpointResponse_clientToken :: Lens' CreateVpcEndpointResponse (Maybe Text)
createVpcEndpointResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpointResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateVpcEndpointResponse
s@CreateVpcEndpointResponse' {} Maybe Text
a -> CreateVpcEndpointResponse
s {$sel:clientToken:CreateVpcEndpointResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateVpcEndpointResponse)

-- | Information about the endpoint.
createVpcEndpointResponse_vpcEndpoint :: Lens.Lens' CreateVpcEndpointResponse (Prelude.Maybe VpcEndpoint)
createVpcEndpointResponse_vpcEndpoint :: Lens' CreateVpcEndpointResponse (Maybe VpcEndpoint)
createVpcEndpointResponse_vpcEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpointResponse' {Maybe VpcEndpoint
vpcEndpoint :: Maybe VpcEndpoint
$sel:vpcEndpoint:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Maybe VpcEndpoint
vpcEndpoint} -> Maybe VpcEndpoint
vpcEndpoint) (\s :: CreateVpcEndpointResponse
s@CreateVpcEndpointResponse' {} Maybe VpcEndpoint
a -> CreateVpcEndpointResponse
s {$sel:vpcEndpoint:CreateVpcEndpointResponse' :: Maybe VpcEndpoint
vpcEndpoint = Maybe VpcEndpoint
a} :: CreateVpcEndpointResponse)

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

instance Prelude.NFData CreateVpcEndpointResponse where
  rnf :: CreateVpcEndpointResponse -> ()
rnf CreateVpcEndpointResponse' {Int
Maybe Text
Maybe VpcEndpoint
httpStatus :: Int
vpcEndpoint :: Maybe VpcEndpoint
clientToken :: Maybe Text
$sel:httpStatus:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Int
$sel:vpcEndpoint:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Maybe VpcEndpoint
$sel:clientToken:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcEndpoint
vpcEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus