{-# 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.CreateClientVpnEndpoint
-- 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 Client VPN endpoint. A Client VPN endpoint is the resource you
-- create and configure to enable and manage client VPN sessions. It is the
-- destination endpoint at which all client VPN sessions are terminated.
module Amazonka.EC2.CreateClientVpnEndpoint
  ( -- * Creating a Request
    CreateClientVpnEndpoint (..),
    newCreateClientVpnEndpoint,

    -- * Request Lenses
    createClientVpnEndpoint_clientConnectOptions,
    createClientVpnEndpoint_clientLoginBannerOptions,
    createClientVpnEndpoint_clientToken,
    createClientVpnEndpoint_description,
    createClientVpnEndpoint_dnsServers,
    createClientVpnEndpoint_dryRun,
    createClientVpnEndpoint_securityGroupIds,
    createClientVpnEndpoint_selfServicePortal,
    createClientVpnEndpoint_sessionTimeoutHours,
    createClientVpnEndpoint_splitTunnel,
    createClientVpnEndpoint_tagSpecifications,
    createClientVpnEndpoint_transportProtocol,
    createClientVpnEndpoint_vpcId,
    createClientVpnEndpoint_vpnPort,
    createClientVpnEndpoint_clientCidrBlock,
    createClientVpnEndpoint_serverCertificateArn,
    createClientVpnEndpoint_authenticationOptions,
    createClientVpnEndpoint_connectionLogOptions,

    -- * Destructuring the Response
    CreateClientVpnEndpointResponse (..),
    newCreateClientVpnEndpointResponse,

    -- * Response Lenses
    createClientVpnEndpointResponse_clientVpnEndpointId,
    createClientVpnEndpointResponse_dnsName,
    createClientVpnEndpointResponse_status,
    createClientVpnEndpointResponse_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

-- | /See:/ 'newCreateClientVpnEndpoint' smart constructor.
data CreateClientVpnEndpoint = CreateClientVpnEndpoint'
  { -- | The options for managing connection authorization for new client
    -- connections.
    CreateClientVpnEndpoint -> Maybe ClientConnectOptions
clientConnectOptions :: Prelude.Maybe ClientConnectOptions,
    -- | Options for enabling a customizable text banner that will be displayed
    -- on Amazon Web Services provided clients when a VPN session is
    -- established.
    CreateClientVpnEndpoint -> Maybe ClientLoginBannerOptions
clientLoginBannerOptions :: Prelude.Maybe ClientLoginBannerOptions,
    -- | 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>.
    CreateClientVpnEndpoint -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A brief description of the Client VPN endpoint.
    CreateClientVpnEndpoint -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Information about the DNS servers to be used for DNS resolution. A
    -- Client VPN endpoint can have up to two DNS servers. If no DNS server is
    -- specified, the DNS address configured on the device is used for the DNS
    -- server.
    CreateClientVpnEndpoint -> Maybe [Text]
dnsServers :: Prelude.Maybe [Prelude.Text],
    -- | 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@.
    CreateClientVpnEndpoint -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The IDs of one or more security groups to apply to the target network.
    -- You must also specify the ID of the VPC that contains the security
    -- groups.
    CreateClientVpnEndpoint -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | Specify whether to enable the self-service portal for the Client VPN
    -- endpoint.
    --
    -- Default Value: @enabled@
    CreateClientVpnEndpoint -> Maybe SelfServicePortal
selfServicePortal :: Prelude.Maybe SelfServicePortal,
    -- | The maximum VPN session duration time in hours.
    --
    -- Valid values: @8 | 10 | 12 | 24@
    --
    -- Default value: @24@
    CreateClientVpnEndpoint -> Maybe Int
sessionTimeoutHours :: Prelude.Maybe Prelude.Int,
    -- | Indicates whether split-tunnel is enabled on the Client VPN endpoint.
    --
    -- By default, split-tunnel on a VPN endpoint is disabled.
    --
    -- For information about split-tunnel VPN endpoints, see
    -- <https://docs.aws.amazon.com/vpn/latest/clientvpn-admin/split-tunnel-vpn.html Split-tunnel Client VPN endpoint>
    -- in the /Client VPN Administrator Guide/.
    CreateClientVpnEndpoint -> Maybe Bool
splitTunnel :: Prelude.Maybe Prelude.Bool,
    -- | The tags to apply to the Client VPN endpoint during creation.
    CreateClientVpnEndpoint -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The transport protocol to be used by the VPN session.
    --
    -- Default value: @udp@
    CreateClientVpnEndpoint -> Maybe TransportProtocol
transportProtocol :: Prelude.Maybe TransportProtocol,
    -- | The ID of the VPC to associate with the Client VPN endpoint. If no
    -- security group IDs are specified in the request, the default security
    -- group for the VPC is applied.
    CreateClientVpnEndpoint -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text,
    -- | The port number to assign to the Client VPN endpoint for TCP and UDP
    -- traffic.
    --
    -- Valid Values: @443@ | @1194@
    --
    -- Default Value: @443@
    CreateClientVpnEndpoint -> Maybe Int
vpnPort :: Prelude.Maybe Prelude.Int,
    -- | The IPv4 address range, in CIDR notation, from which to assign client IP
    -- addresses. The address range cannot overlap with the local CIDR of the
    -- VPC in which the associated subnet is located, or the routes that you
    -- add manually. The address range cannot be changed after the Client VPN
    -- endpoint has been created. The CIDR block should be \/22 or greater.
    CreateClientVpnEndpoint -> Text
clientCidrBlock :: Prelude.Text,
    -- | The ARN of the server certificate. For more information, see the
    -- <https://docs.aws.amazon.com/acm/latest/userguide/ Certificate Manager User Guide>.
    CreateClientVpnEndpoint -> Text
serverCertificateArn :: Prelude.Text,
    -- | Information about the authentication method to be used to authenticate
    -- clients.
    CreateClientVpnEndpoint -> [ClientVpnAuthenticationRequest]
authenticationOptions :: [ClientVpnAuthenticationRequest],
    -- | Information about the client connection logging options.
    --
    -- If you enable client connection logging, data about client connections
    -- is sent to a Cloudwatch Logs log stream. The following information is
    -- logged:
    --
    -- -   Client connection requests
    --
    -- -   Client connection results (successful and unsuccessful)
    --
    -- -   Reasons for unsuccessful client connection requests
    --
    -- -   Client connection termination time
    CreateClientVpnEndpoint -> ConnectionLogOptions
connectionLogOptions :: ConnectionLogOptions
  }
  deriving (CreateClientVpnEndpoint -> CreateClientVpnEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateClientVpnEndpoint -> CreateClientVpnEndpoint -> Bool
$c/= :: CreateClientVpnEndpoint -> CreateClientVpnEndpoint -> Bool
== :: CreateClientVpnEndpoint -> CreateClientVpnEndpoint -> Bool
$c== :: CreateClientVpnEndpoint -> CreateClientVpnEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateClientVpnEndpoint]
ReadPrec CreateClientVpnEndpoint
Int -> ReadS CreateClientVpnEndpoint
ReadS [CreateClientVpnEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateClientVpnEndpoint]
$creadListPrec :: ReadPrec [CreateClientVpnEndpoint]
readPrec :: ReadPrec CreateClientVpnEndpoint
$creadPrec :: ReadPrec CreateClientVpnEndpoint
readList :: ReadS [CreateClientVpnEndpoint]
$creadList :: ReadS [CreateClientVpnEndpoint]
readsPrec :: Int -> ReadS CreateClientVpnEndpoint
$creadsPrec :: Int -> ReadS CreateClientVpnEndpoint
Prelude.Read, Int -> CreateClientVpnEndpoint -> ShowS
[CreateClientVpnEndpoint] -> ShowS
CreateClientVpnEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateClientVpnEndpoint] -> ShowS
$cshowList :: [CreateClientVpnEndpoint] -> ShowS
show :: CreateClientVpnEndpoint -> String
$cshow :: CreateClientVpnEndpoint -> String
showsPrec :: Int -> CreateClientVpnEndpoint -> ShowS
$cshowsPrec :: Int -> CreateClientVpnEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateClientVpnEndpoint x -> CreateClientVpnEndpoint
forall x. CreateClientVpnEndpoint -> Rep CreateClientVpnEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateClientVpnEndpoint x -> CreateClientVpnEndpoint
$cfrom :: forall x. CreateClientVpnEndpoint -> Rep CreateClientVpnEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateClientVpnEndpoint' 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:
--
-- 'clientConnectOptions', 'createClientVpnEndpoint_clientConnectOptions' - The options for managing connection authorization for new client
-- connections.
--
-- 'clientLoginBannerOptions', 'createClientVpnEndpoint_clientLoginBannerOptions' - Options for enabling a customizable text banner that will be displayed
-- on Amazon Web Services provided clients when a VPN session is
-- established.
--
-- 'clientToken', 'createClientVpnEndpoint_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>.
--
-- 'description', 'createClientVpnEndpoint_description' - A brief description of the Client VPN endpoint.
--
-- 'dnsServers', 'createClientVpnEndpoint_dnsServers' - Information about the DNS servers to be used for DNS resolution. A
-- Client VPN endpoint can have up to two DNS servers. If no DNS server is
-- specified, the DNS address configured on the device is used for the DNS
-- server.
--
-- 'dryRun', 'createClientVpnEndpoint_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@.
--
-- 'securityGroupIds', 'createClientVpnEndpoint_securityGroupIds' - The IDs of one or more security groups to apply to the target network.
-- You must also specify the ID of the VPC that contains the security
-- groups.
--
-- 'selfServicePortal', 'createClientVpnEndpoint_selfServicePortal' - Specify whether to enable the self-service portal for the Client VPN
-- endpoint.
--
-- Default Value: @enabled@
--
-- 'sessionTimeoutHours', 'createClientVpnEndpoint_sessionTimeoutHours' - The maximum VPN session duration time in hours.
--
-- Valid values: @8 | 10 | 12 | 24@
--
-- Default value: @24@
--
-- 'splitTunnel', 'createClientVpnEndpoint_splitTunnel' - Indicates whether split-tunnel is enabled on the Client VPN endpoint.
--
-- By default, split-tunnel on a VPN endpoint is disabled.
--
-- For information about split-tunnel VPN endpoints, see
-- <https://docs.aws.amazon.com/vpn/latest/clientvpn-admin/split-tunnel-vpn.html Split-tunnel Client VPN endpoint>
-- in the /Client VPN Administrator Guide/.
--
-- 'tagSpecifications', 'createClientVpnEndpoint_tagSpecifications' - The tags to apply to the Client VPN endpoint during creation.
--
-- 'transportProtocol', 'createClientVpnEndpoint_transportProtocol' - The transport protocol to be used by the VPN session.
--
-- Default value: @udp@
--
-- 'vpcId', 'createClientVpnEndpoint_vpcId' - The ID of the VPC to associate with the Client VPN endpoint. If no
-- security group IDs are specified in the request, the default security
-- group for the VPC is applied.
--
-- 'vpnPort', 'createClientVpnEndpoint_vpnPort' - The port number to assign to the Client VPN endpoint for TCP and UDP
-- traffic.
--
-- Valid Values: @443@ | @1194@
--
-- Default Value: @443@
--
-- 'clientCidrBlock', 'createClientVpnEndpoint_clientCidrBlock' - The IPv4 address range, in CIDR notation, from which to assign client IP
-- addresses. The address range cannot overlap with the local CIDR of the
-- VPC in which the associated subnet is located, or the routes that you
-- add manually. The address range cannot be changed after the Client VPN
-- endpoint has been created. The CIDR block should be \/22 or greater.
--
-- 'serverCertificateArn', 'createClientVpnEndpoint_serverCertificateArn' - The ARN of the server certificate. For more information, see the
-- <https://docs.aws.amazon.com/acm/latest/userguide/ Certificate Manager User Guide>.
--
-- 'authenticationOptions', 'createClientVpnEndpoint_authenticationOptions' - Information about the authentication method to be used to authenticate
-- clients.
--
-- 'connectionLogOptions', 'createClientVpnEndpoint_connectionLogOptions' - Information about the client connection logging options.
--
-- If you enable client connection logging, data about client connections
-- is sent to a Cloudwatch Logs log stream. The following information is
-- logged:
--
-- -   Client connection requests
--
-- -   Client connection results (successful and unsuccessful)
--
-- -   Reasons for unsuccessful client connection requests
--
-- -   Client connection termination time
newCreateClientVpnEndpoint ::
  -- | 'clientCidrBlock'
  Prelude.Text ->
  -- | 'serverCertificateArn'
  Prelude.Text ->
  -- | 'connectionLogOptions'
  ConnectionLogOptions ->
  CreateClientVpnEndpoint
newCreateClientVpnEndpoint :: Text -> Text -> ConnectionLogOptions -> CreateClientVpnEndpoint
newCreateClientVpnEndpoint
  Text
pClientCidrBlock_
  Text
pServerCertificateArn_
  ConnectionLogOptions
pConnectionLogOptions_ =
    CreateClientVpnEndpoint'
      { $sel:clientConnectOptions:CreateClientVpnEndpoint' :: Maybe ClientConnectOptions
clientConnectOptions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: Maybe ClientLoginBannerOptions
clientLoginBannerOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:CreateClientVpnEndpoint' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateClientVpnEndpoint' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:dnsServers:CreateClientVpnEndpoint' :: Maybe [Text]
dnsServers = forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:CreateClientVpnEndpoint' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateClientVpnEndpoint' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:selfServicePortal:CreateClientVpnEndpoint' :: Maybe SelfServicePortal
selfServicePortal = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: Maybe Int
sessionTimeoutHours = forall a. Maybe a
Prelude.Nothing,
        $sel:splitTunnel:CreateClientVpnEndpoint' :: Maybe Bool
splitTunnel = forall a. Maybe a
Prelude.Nothing,
        $sel:tagSpecifications:CreateClientVpnEndpoint' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:transportProtocol:CreateClientVpnEndpoint' :: Maybe TransportProtocol
transportProtocol = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcId:CreateClientVpnEndpoint' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing,
        $sel:vpnPort:CreateClientVpnEndpoint' :: Maybe Int
vpnPort = forall a. Maybe a
Prelude.Nothing,
        $sel:clientCidrBlock:CreateClientVpnEndpoint' :: Text
clientCidrBlock = Text
pClientCidrBlock_,
        $sel:serverCertificateArn:CreateClientVpnEndpoint' :: Text
serverCertificateArn = Text
pServerCertificateArn_,
        $sel:authenticationOptions:CreateClientVpnEndpoint' :: [ClientVpnAuthenticationRequest]
authenticationOptions = forall a. Monoid a => a
Prelude.mempty,
        $sel:connectionLogOptions:CreateClientVpnEndpoint' :: ConnectionLogOptions
connectionLogOptions = ConnectionLogOptions
pConnectionLogOptions_
      }

-- | The options for managing connection authorization for new client
-- connections.
createClientVpnEndpoint_clientConnectOptions :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe ClientConnectOptions)
createClientVpnEndpoint_clientConnectOptions :: Lens' CreateClientVpnEndpoint (Maybe ClientConnectOptions)
createClientVpnEndpoint_clientConnectOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe ClientConnectOptions
clientConnectOptions :: Maybe ClientConnectOptions
$sel:clientConnectOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientConnectOptions
clientConnectOptions} -> Maybe ClientConnectOptions
clientConnectOptions) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe ClientConnectOptions
a -> CreateClientVpnEndpoint
s {$sel:clientConnectOptions:CreateClientVpnEndpoint' :: Maybe ClientConnectOptions
clientConnectOptions = Maybe ClientConnectOptions
a} :: CreateClientVpnEndpoint)

-- | Options for enabling a customizable text banner that will be displayed
-- on Amazon Web Services provided clients when a VPN session is
-- established.
createClientVpnEndpoint_clientLoginBannerOptions :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe ClientLoginBannerOptions)
createClientVpnEndpoint_clientLoginBannerOptions :: Lens' CreateClientVpnEndpoint (Maybe ClientLoginBannerOptions)
createClientVpnEndpoint_clientLoginBannerOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe ClientLoginBannerOptions
clientLoginBannerOptions :: Maybe ClientLoginBannerOptions
$sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientLoginBannerOptions
clientLoginBannerOptions} -> Maybe ClientLoginBannerOptions
clientLoginBannerOptions) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe ClientLoginBannerOptions
a -> CreateClientVpnEndpoint
s {$sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: Maybe ClientLoginBannerOptions
clientLoginBannerOptions = Maybe ClientLoginBannerOptions
a} :: CreateClientVpnEndpoint)

-- | 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>.
createClientVpnEndpoint_clientToken :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Text)
createClientVpnEndpoint_clientToken :: Lens' CreateClientVpnEndpoint (Maybe Text)
createClientVpnEndpoint_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Text
a -> CreateClientVpnEndpoint
s {$sel:clientToken:CreateClientVpnEndpoint' :: Maybe Text
clientToken = Maybe Text
a} :: CreateClientVpnEndpoint)

-- | A brief description of the Client VPN endpoint.
createClientVpnEndpoint_description :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Text)
createClientVpnEndpoint_description :: Lens' CreateClientVpnEndpoint (Maybe Text)
createClientVpnEndpoint_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Text
description :: Maybe Text
$sel:description:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Text
a -> CreateClientVpnEndpoint
s {$sel:description:CreateClientVpnEndpoint' :: Maybe Text
description = Maybe Text
a} :: CreateClientVpnEndpoint)

-- | Information about the DNS servers to be used for DNS resolution. A
-- Client VPN endpoint can have up to two DNS servers. If no DNS server is
-- specified, the DNS address configured on the device is used for the DNS
-- server.
createClientVpnEndpoint_dnsServers :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe [Prelude.Text])
createClientVpnEndpoint_dnsServers :: Lens' CreateClientVpnEndpoint (Maybe [Text])
createClientVpnEndpoint_dnsServers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe [Text]
dnsServers :: Maybe [Text]
$sel:dnsServers:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
dnsServers} -> Maybe [Text]
dnsServers) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe [Text]
a -> CreateClientVpnEndpoint
s {$sel:dnsServers:CreateClientVpnEndpoint' :: Maybe [Text]
dnsServers = Maybe [Text]
a} :: CreateClientVpnEndpoint) 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

-- | 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@.
createClientVpnEndpoint_dryRun :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Bool)
createClientVpnEndpoint_dryRun :: Lens' CreateClientVpnEndpoint (Maybe Bool)
createClientVpnEndpoint_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Bool
a -> CreateClientVpnEndpoint
s {$sel:dryRun:CreateClientVpnEndpoint' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateClientVpnEndpoint)

-- | The IDs of one or more security groups to apply to the target network.
-- You must also specify the ID of the VPC that contains the security
-- groups.
createClientVpnEndpoint_securityGroupIds :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe [Prelude.Text])
createClientVpnEndpoint_securityGroupIds :: Lens' CreateClientVpnEndpoint (Maybe [Text])
createClientVpnEndpoint_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe [Text]
a -> CreateClientVpnEndpoint
s {$sel:securityGroupIds:CreateClientVpnEndpoint' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateClientVpnEndpoint) 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

-- | Specify whether to enable the self-service portal for the Client VPN
-- endpoint.
--
-- Default Value: @enabled@
createClientVpnEndpoint_selfServicePortal :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe SelfServicePortal)
createClientVpnEndpoint_selfServicePortal :: Lens' CreateClientVpnEndpoint (Maybe SelfServicePortal)
createClientVpnEndpoint_selfServicePortal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe SelfServicePortal
selfServicePortal :: Maybe SelfServicePortal
$sel:selfServicePortal:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe SelfServicePortal
selfServicePortal} -> Maybe SelfServicePortal
selfServicePortal) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe SelfServicePortal
a -> CreateClientVpnEndpoint
s {$sel:selfServicePortal:CreateClientVpnEndpoint' :: Maybe SelfServicePortal
selfServicePortal = Maybe SelfServicePortal
a} :: CreateClientVpnEndpoint)

-- | The maximum VPN session duration time in hours.
--
-- Valid values: @8 | 10 | 12 | 24@
--
-- Default value: @24@
createClientVpnEndpoint_sessionTimeoutHours :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Int)
createClientVpnEndpoint_sessionTimeoutHours :: Lens' CreateClientVpnEndpoint (Maybe Int)
createClientVpnEndpoint_sessionTimeoutHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Int
sessionTimeoutHours :: Maybe Int
$sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
sessionTimeoutHours} -> Maybe Int
sessionTimeoutHours) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Int
a -> CreateClientVpnEndpoint
s {$sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: Maybe Int
sessionTimeoutHours = Maybe Int
a} :: CreateClientVpnEndpoint)

-- | Indicates whether split-tunnel is enabled on the Client VPN endpoint.
--
-- By default, split-tunnel on a VPN endpoint is disabled.
--
-- For information about split-tunnel VPN endpoints, see
-- <https://docs.aws.amazon.com/vpn/latest/clientvpn-admin/split-tunnel-vpn.html Split-tunnel Client VPN endpoint>
-- in the /Client VPN Administrator Guide/.
createClientVpnEndpoint_splitTunnel :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Bool)
createClientVpnEndpoint_splitTunnel :: Lens' CreateClientVpnEndpoint (Maybe Bool)
createClientVpnEndpoint_splitTunnel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Bool
splitTunnel :: Maybe Bool
$sel:splitTunnel:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
splitTunnel} -> Maybe Bool
splitTunnel) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Bool
a -> CreateClientVpnEndpoint
s {$sel:splitTunnel:CreateClientVpnEndpoint' :: Maybe Bool
splitTunnel = Maybe Bool
a} :: CreateClientVpnEndpoint)

-- | The tags to apply to the Client VPN endpoint during creation.
createClientVpnEndpoint_tagSpecifications :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe [TagSpecification])
createClientVpnEndpoint_tagSpecifications :: Lens' CreateClientVpnEndpoint (Maybe [TagSpecification])
createClientVpnEndpoint_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe [TagSpecification]
a -> CreateClientVpnEndpoint
s {$sel:tagSpecifications:CreateClientVpnEndpoint' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateClientVpnEndpoint) 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 transport protocol to be used by the VPN session.
--
-- Default value: @udp@
createClientVpnEndpoint_transportProtocol :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe TransportProtocol)
createClientVpnEndpoint_transportProtocol :: Lens' CreateClientVpnEndpoint (Maybe TransportProtocol)
createClientVpnEndpoint_transportProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe TransportProtocol
transportProtocol :: Maybe TransportProtocol
$sel:transportProtocol:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe TransportProtocol
transportProtocol} -> Maybe TransportProtocol
transportProtocol) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe TransportProtocol
a -> CreateClientVpnEndpoint
s {$sel:transportProtocol:CreateClientVpnEndpoint' :: Maybe TransportProtocol
transportProtocol = Maybe TransportProtocol
a} :: CreateClientVpnEndpoint)

-- | The ID of the VPC to associate with the Client VPN endpoint. If no
-- security group IDs are specified in the request, the default security
-- group for the VPC is applied.
createClientVpnEndpoint_vpcId :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Text)
createClientVpnEndpoint_vpcId :: Lens' CreateClientVpnEndpoint (Maybe Text)
createClientVpnEndpoint_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Text
a -> CreateClientVpnEndpoint
s {$sel:vpcId:CreateClientVpnEndpoint' :: Maybe Text
vpcId = Maybe Text
a} :: CreateClientVpnEndpoint)

-- | The port number to assign to the Client VPN endpoint for TCP and UDP
-- traffic.
--
-- Valid Values: @443@ | @1194@
--
-- Default Value: @443@
createClientVpnEndpoint_vpnPort :: Lens.Lens' CreateClientVpnEndpoint (Prelude.Maybe Prelude.Int)
createClientVpnEndpoint_vpnPort :: Lens' CreateClientVpnEndpoint (Maybe Int)
createClientVpnEndpoint_vpnPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Maybe Int
vpnPort :: Maybe Int
$sel:vpnPort:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
vpnPort} -> Maybe Int
vpnPort) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Maybe Int
a -> CreateClientVpnEndpoint
s {$sel:vpnPort:CreateClientVpnEndpoint' :: Maybe Int
vpnPort = Maybe Int
a} :: CreateClientVpnEndpoint)

-- | The IPv4 address range, in CIDR notation, from which to assign client IP
-- addresses. The address range cannot overlap with the local CIDR of the
-- VPC in which the associated subnet is located, or the routes that you
-- add manually. The address range cannot be changed after the Client VPN
-- endpoint has been created. The CIDR block should be \/22 or greater.
createClientVpnEndpoint_clientCidrBlock :: Lens.Lens' CreateClientVpnEndpoint Prelude.Text
createClientVpnEndpoint_clientCidrBlock :: Lens' CreateClientVpnEndpoint Text
createClientVpnEndpoint_clientCidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Text
clientCidrBlock :: Text
$sel:clientCidrBlock:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
clientCidrBlock} -> Text
clientCidrBlock) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Text
a -> CreateClientVpnEndpoint
s {$sel:clientCidrBlock:CreateClientVpnEndpoint' :: Text
clientCidrBlock = Text
a} :: CreateClientVpnEndpoint)

-- | The ARN of the server certificate. For more information, see the
-- <https://docs.aws.amazon.com/acm/latest/userguide/ Certificate Manager User Guide>.
createClientVpnEndpoint_serverCertificateArn :: Lens.Lens' CreateClientVpnEndpoint Prelude.Text
createClientVpnEndpoint_serverCertificateArn :: Lens' CreateClientVpnEndpoint Text
createClientVpnEndpoint_serverCertificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {Text
serverCertificateArn :: Text
$sel:serverCertificateArn:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
serverCertificateArn} -> Text
serverCertificateArn) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} Text
a -> CreateClientVpnEndpoint
s {$sel:serverCertificateArn:CreateClientVpnEndpoint' :: Text
serverCertificateArn = Text
a} :: CreateClientVpnEndpoint)

-- | Information about the authentication method to be used to authenticate
-- clients.
createClientVpnEndpoint_authenticationOptions :: Lens.Lens' CreateClientVpnEndpoint [ClientVpnAuthenticationRequest]
createClientVpnEndpoint_authenticationOptions :: Lens' CreateClientVpnEndpoint [ClientVpnAuthenticationRequest]
createClientVpnEndpoint_authenticationOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {[ClientVpnAuthenticationRequest]
authenticationOptions :: [ClientVpnAuthenticationRequest]
$sel:authenticationOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> [ClientVpnAuthenticationRequest]
authenticationOptions} -> [ClientVpnAuthenticationRequest]
authenticationOptions) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} [ClientVpnAuthenticationRequest]
a -> CreateClientVpnEndpoint
s {$sel:authenticationOptions:CreateClientVpnEndpoint' :: [ClientVpnAuthenticationRequest]
authenticationOptions = [ClientVpnAuthenticationRequest]
a} :: CreateClientVpnEndpoint) 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

-- | Information about the client connection logging options.
--
-- If you enable client connection logging, data about client connections
-- is sent to a Cloudwatch Logs log stream. The following information is
-- logged:
--
-- -   Client connection requests
--
-- -   Client connection results (successful and unsuccessful)
--
-- -   Reasons for unsuccessful client connection requests
--
-- -   Client connection termination time
createClientVpnEndpoint_connectionLogOptions :: Lens.Lens' CreateClientVpnEndpoint ConnectionLogOptions
createClientVpnEndpoint_connectionLogOptions :: Lens' CreateClientVpnEndpoint ConnectionLogOptions
createClientVpnEndpoint_connectionLogOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpoint' {ConnectionLogOptions
connectionLogOptions :: ConnectionLogOptions
$sel:connectionLogOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> ConnectionLogOptions
connectionLogOptions} -> ConnectionLogOptions
connectionLogOptions) (\s :: CreateClientVpnEndpoint
s@CreateClientVpnEndpoint' {} ConnectionLogOptions
a -> CreateClientVpnEndpoint
s {$sel:connectionLogOptions:CreateClientVpnEndpoint' :: ConnectionLogOptions
connectionLogOptions = ConnectionLogOptions
a} :: CreateClientVpnEndpoint)

instance Core.AWSRequest CreateClientVpnEndpoint where
  type
    AWSResponse CreateClientVpnEndpoint =
      CreateClientVpnEndpointResponse
  request :: (Service -> Service)
-> CreateClientVpnEndpoint -> Request CreateClientVpnEndpoint
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 CreateClientVpnEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateClientVpnEndpoint)))
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 Text
-> Maybe ClientVpnEndpointStatus
-> Int
-> CreateClientVpnEndpointResponse
CreateClientVpnEndpointResponse'
            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
"clientVpnEndpointId")
            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
"dnsName")
            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
"status")
            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 CreateClientVpnEndpoint where
  hashWithSalt :: Int -> CreateClientVpnEndpoint -> Int
hashWithSalt Int
_salt CreateClientVpnEndpoint' {[ClientVpnAuthenticationRequest]
Maybe Bool
Maybe Int
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe ClientConnectOptions
Maybe ClientLoginBannerOptions
Maybe SelfServicePortal
Maybe TransportProtocol
Text
ConnectionLogOptions
connectionLogOptions :: ConnectionLogOptions
authenticationOptions :: [ClientVpnAuthenticationRequest]
serverCertificateArn :: Text
clientCidrBlock :: Text
vpnPort :: Maybe Int
vpcId :: Maybe Text
transportProtocol :: Maybe TransportProtocol
tagSpecifications :: Maybe [TagSpecification]
splitTunnel :: Maybe Bool
sessionTimeoutHours :: Maybe Int
selfServicePortal :: Maybe SelfServicePortal
securityGroupIds :: Maybe [Text]
dryRun :: Maybe Bool
dnsServers :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
clientLoginBannerOptions :: Maybe ClientLoginBannerOptions
clientConnectOptions :: Maybe ClientConnectOptions
$sel:connectionLogOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> ConnectionLogOptions
$sel:authenticationOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> [ClientVpnAuthenticationRequest]
$sel:serverCertificateArn:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:clientCidrBlock:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:vpnPort:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:vpcId:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:transportProtocol:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe TransportProtocol
$sel:tagSpecifications:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [TagSpecification]
$sel:splitTunnel:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:selfServicePortal:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe SelfServicePortal
$sel:securityGroupIds:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:dryRun:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:dnsServers:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:description:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientToken:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientLoginBannerOptions
$sel:clientConnectOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientConnectOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientConnectOptions
clientConnectOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientLoginBannerOptions
clientLoginBannerOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dnsServers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SelfServicePortal
selfServicePortal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
sessionTimeoutHours
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
splitTunnel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TransportProtocol
transportProtocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
vpnPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientCidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverCertificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ClientVpnAuthenticationRequest]
authenticationOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectionLogOptions
connectionLogOptions

instance Prelude.NFData CreateClientVpnEndpoint where
  rnf :: CreateClientVpnEndpoint -> ()
rnf CreateClientVpnEndpoint' {[ClientVpnAuthenticationRequest]
Maybe Bool
Maybe Int
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe ClientConnectOptions
Maybe ClientLoginBannerOptions
Maybe SelfServicePortal
Maybe TransportProtocol
Text
ConnectionLogOptions
connectionLogOptions :: ConnectionLogOptions
authenticationOptions :: [ClientVpnAuthenticationRequest]
serverCertificateArn :: Text
clientCidrBlock :: Text
vpnPort :: Maybe Int
vpcId :: Maybe Text
transportProtocol :: Maybe TransportProtocol
tagSpecifications :: Maybe [TagSpecification]
splitTunnel :: Maybe Bool
sessionTimeoutHours :: Maybe Int
selfServicePortal :: Maybe SelfServicePortal
securityGroupIds :: Maybe [Text]
dryRun :: Maybe Bool
dnsServers :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
clientLoginBannerOptions :: Maybe ClientLoginBannerOptions
clientConnectOptions :: Maybe ClientConnectOptions
$sel:connectionLogOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> ConnectionLogOptions
$sel:authenticationOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> [ClientVpnAuthenticationRequest]
$sel:serverCertificateArn:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:clientCidrBlock:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:vpnPort:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:vpcId:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:transportProtocol:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe TransportProtocol
$sel:tagSpecifications:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [TagSpecification]
$sel:splitTunnel:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:selfServicePortal:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe SelfServicePortal
$sel:securityGroupIds:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:dryRun:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:dnsServers:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:description:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientToken:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientLoginBannerOptions
$sel:clientConnectOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientConnectOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientConnectOptions
clientConnectOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientLoginBannerOptions
clientLoginBannerOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dnsServers
      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 [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SelfServicePortal
selfServicePortal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
sessionTimeoutHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
splitTunnel
      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 TransportProtocol
transportProtocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
vpnPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientCidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverCertificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ClientVpnAuthenticationRequest]
authenticationOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectionLogOptions
connectionLogOptions

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

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

instance Data.ToQuery CreateClientVpnEndpoint where
  toQuery :: CreateClientVpnEndpoint -> QueryString
toQuery CreateClientVpnEndpoint' {[ClientVpnAuthenticationRequest]
Maybe Bool
Maybe Int
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe ClientConnectOptions
Maybe ClientLoginBannerOptions
Maybe SelfServicePortal
Maybe TransportProtocol
Text
ConnectionLogOptions
connectionLogOptions :: ConnectionLogOptions
authenticationOptions :: [ClientVpnAuthenticationRequest]
serverCertificateArn :: Text
clientCidrBlock :: Text
vpnPort :: Maybe Int
vpcId :: Maybe Text
transportProtocol :: Maybe TransportProtocol
tagSpecifications :: Maybe [TagSpecification]
splitTunnel :: Maybe Bool
sessionTimeoutHours :: Maybe Int
selfServicePortal :: Maybe SelfServicePortal
securityGroupIds :: Maybe [Text]
dryRun :: Maybe Bool
dnsServers :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
clientLoginBannerOptions :: Maybe ClientLoginBannerOptions
clientConnectOptions :: Maybe ClientConnectOptions
$sel:connectionLogOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> ConnectionLogOptions
$sel:authenticationOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> [ClientVpnAuthenticationRequest]
$sel:serverCertificateArn:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:clientCidrBlock:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Text
$sel:vpnPort:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:vpcId:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:transportProtocol:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe TransportProtocol
$sel:tagSpecifications:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [TagSpecification]
$sel:splitTunnel:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:sessionTimeoutHours:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Int
$sel:selfServicePortal:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe SelfServicePortal
$sel:securityGroupIds:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:dryRun:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Bool
$sel:dnsServers:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe [Text]
$sel:description:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientToken:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe Text
$sel:clientLoginBannerOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientLoginBannerOptions
$sel:clientConnectOptions:CreateClientVpnEndpoint' :: CreateClientVpnEndpoint -> Maybe ClientConnectOptions
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateClientVpnEndpoint" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientConnectOptions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ClientConnectOptions
clientConnectOptions,
        ByteString
"ClientLoginBannerOptions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ClientLoginBannerOptions
clientLoginBannerOptions,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"DnsServers"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
dnsServers
          ),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        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
          ),
        ByteString
"SelfServicePortal" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SelfServicePortal
selfServicePortal,
        ByteString
"SessionTimeoutHours" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
sessionTimeoutHours,
        ByteString
"SplitTunnel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
splitTunnel,
        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
"TransportProtocol" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TransportProtocol
transportProtocol,
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
vpcId,
        ByteString
"VpnPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
vpnPort,
        ByteString
"ClientCidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientCidrBlock,
        ByteString
"ServerCertificateArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serverCertificateArn,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList
          ByteString
"Authentication"
          [ClientVpnAuthenticationRequest]
authenticationOptions,
        ByteString
"ConnectionLogOptions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ConnectionLogOptions
connectionLogOptions
      ]

-- | /See:/ 'newCreateClientVpnEndpointResponse' smart constructor.
data CreateClientVpnEndpointResponse = CreateClientVpnEndpointResponse'
  { -- | The ID of the Client VPN endpoint.
    CreateClientVpnEndpointResponse -> Maybe Text
clientVpnEndpointId :: Prelude.Maybe Prelude.Text,
    -- | The DNS name to be used by clients when establishing their VPN session.
    CreateClientVpnEndpointResponse -> Maybe Text
dnsName :: Prelude.Maybe Prelude.Text,
    -- | The current state of the Client VPN endpoint.
    CreateClientVpnEndpointResponse -> Maybe ClientVpnEndpointStatus
status :: Prelude.Maybe ClientVpnEndpointStatus,
    -- | The response's http status code.
    CreateClientVpnEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateClientVpnEndpointResponse
-> CreateClientVpnEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateClientVpnEndpointResponse
-> CreateClientVpnEndpointResponse -> Bool
$c/= :: CreateClientVpnEndpointResponse
-> CreateClientVpnEndpointResponse -> Bool
== :: CreateClientVpnEndpointResponse
-> CreateClientVpnEndpointResponse -> Bool
$c== :: CreateClientVpnEndpointResponse
-> CreateClientVpnEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateClientVpnEndpointResponse]
ReadPrec CreateClientVpnEndpointResponse
Int -> ReadS CreateClientVpnEndpointResponse
ReadS [CreateClientVpnEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateClientVpnEndpointResponse]
$creadListPrec :: ReadPrec [CreateClientVpnEndpointResponse]
readPrec :: ReadPrec CreateClientVpnEndpointResponse
$creadPrec :: ReadPrec CreateClientVpnEndpointResponse
readList :: ReadS [CreateClientVpnEndpointResponse]
$creadList :: ReadS [CreateClientVpnEndpointResponse]
readsPrec :: Int -> ReadS CreateClientVpnEndpointResponse
$creadsPrec :: Int -> ReadS CreateClientVpnEndpointResponse
Prelude.Read, Int -> CreateClientVpnEndpointResponse -> ShowS
[CreateClientVpnEndpointResponse] -> ShowS
CreateClientVpnEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateClientVpnEndpointResponse] -> ShowS
$cshowList :: [CreateClientVpnEndpointResponse] -> ShowS
show :: CreateClientVpnEndpointResponse -> String
$cshow :: CreateClientVpnEndpointResponse -> String
showsPrec :: Int -> CreateClientVpnEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateClientVpnEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateClientVpnEndpointResponse x
-> CreateClientVpnEndpointResponse
forall x.
CreateClientVpnEndpointResponse
-> Rep CreateClientVpnEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateClientVpnEndpointResponse x
-> CreateClientVpnEndpointResponse
$cfrom :: forall x.
CreateClientVpnEndpointResponse
-> Rep CreateClientVpnEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateClientVpnEndpointResponse' 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:
--
-- 'clientVpnEndpointId', 'createClientVpnEndpointResponse_clientVpnEndpointId' - The ID of the Client VPN endpoint.
--
-- 'dnsName', 'createClientVpnEndpointResponse_dnsName' - The DNS name to be used by clients when establishing their VPN session.
--
-- 'status', 'createClientVpnEndpointResponse_status' - The current state of the Client VPN endpoint.
--
-- 'httpStatus', 'createClientVpnEndpointResponse_httpStatus' - The response's http status code.
newCreateClientVpnEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateClientVpnEndpointResponse
newCreateClientVpnEndpointResponse :: Int -> CreateClientVpnEndpointResponse
newCreateClientVpnEndpointResponse Int
pHttpStatus_ =
  CreateClientVpnEndpointResponse'
    { $sel:clientVpnEndpointId:CreateClientVpnEndpointResponse' :: Maybe Text
clientVpnEndpointId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dnsName:CreateClientVpnEndpointResponse' :: Maybe Text
dnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateClientVpnEndpointResponse' :: Maybe ClientVpnEndpointStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateClientVpnEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the Client VPN endpoint.
createClientVpnEndpointResponse_clientVpnEndpointId :: Lens.Lens' CreateClientVpnEndpointResponse (Prelude.Maybe Prelude.Text)
createClientVpnEndpointResponse_clientVpnEndpointId :: Lens' CreateClientVpnEndpointResponse (Maybe Text)
createClientVpnEndpointResponse_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpointResponse' {Maybe Text
clientVpnEndpointId :: Maybe Text
$sel:clientVpnEndpointId:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe Text
clientVpnEndpointId} -> Maybe Text
clientVpnEndpointId) (\s :: CreateClientVpnEndpointResponse
s@CreateClientVpnEndpointResponse' {} Maybe Text
a -> CreateClientVpnEndpointResponse
s {$sel:clientVpnEndpointId:CreateClientVpnEndpointResponse' :: Maybe Text
clientVpnEndpointId = Maybe Text
a} :: CreateClientVpnEndpointResponse)

-- | The DNS name to be used by clients when establishing their VPN session.
createClientVpnEndpointResponse_dnsName :: Lens.Lens' CreateClientVpnEndpointResponse (Prelude.Maybe Prelude.Text)
createClientVpnEndpointResponse_dnsName :: Lens' CreateClientVpnEndpointResponse (Maybe Text)
createClientVpnEndpointResponse_dnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpointResponse' {Maybe Text
dnsName :: Maybe Text
$sel:dnsName:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe Text
dnsName} -> Maybe Text
dnsName) (\s :: CreateClientVpnEndpointResponse
s@CreateClientVpnEndpointResponse' {} Maybe Text
a -> CreateClientVpnEndpointResponse
s {$sel:dnsName:CreateClientVpnEndpointResponse' :: Maybe Text
dnsName = Maybe Text
a} :: CreateClientVpnEndpointResponse)

-- | The current state of the Client VPN endpoint.
createClientVpnEndpointResponse_status :: Lens.Lens' CreateClientVpnEndpointResponse (Prelude.Maybe ClientVpnEndpointStatus)
createClientVpnEndpointResponse_status :: Lens'
  CreateClientVpnEndpointResponse (Maybe ClientVpnEndpointStatus)
createClientVpnEndpointResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClientVpnEndpointResponse' {Maybe ClientVpnEndpointStatus
status :: Maybe ClientVpnEndpointStatus
$sel:status:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe ClientVpnEndpointStatus
status} -> Maybe ClientVpnEndpointStatus
status) (\s :: CreateClientVpnEndpointResponse
s@CreateClientVpnEndpointResponse' {} Maybe ClientVpnEndpointStatus
a -> CreateClientVpnEndpointResponse
s {$sel:status:CreateClientVpnEndpointResponse' :: Maybe ClientVpnEndpointStatus
status = Maybe ClientVpnEndpointStatus
a} :: CreateClientVpnEndpointResponse)

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

instance
  Prelude.NFData
    CreateClientVpnEndpointResponse
  where
  rnf :: CreateClientVpnEndpointResponse -> ()
rnf CreateClientVpnEndpointResponse' {Int
Maybe Text
Maybe ClientVpnEndpointStatus
httpStatus :: Int
status :: Maybe ClientVpnEndpointStatus
dnsName :: Maybe Text
clientVpnEndpointId :: Maybe Text
$sel:httpStatus:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Int
$sel:status:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe ClientVpnEndpointStatus
$sel:dnsName:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe Text
$sel:clientVpnEndpointId:CreateClientVpnEndpointResponse' :: CreateClientVpnEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientVpnEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientVpnEndpointStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus