{-# 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.CreateVerifiedAccessEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- An Amazon Web Services Verified Access endpoint is where you define your
-- application along with an optional endpoint-level access policy.
module Amazonka.EC2.CreateVerifiedAccessEndpoint
  ( -- * Creating a Request
    CreateVerifiedAccessEndpoint (..),
    newCreateVerifiedAccessEndpoint,

    -- * Request Lenses
    createVerifiedAccessEndpoint_clientToken,
    createVerifiedAccessEndpoint_description,
    createVerifiedAccessEndpoint_dryRun,
    createVerifiedAccessEndpoint_loadBalancerOptions,
    createVerifiedAccessEndpoint_networkInterfaceOptions,
    createVerifiedAccessEndpoint_policyDocument,
    createVerifiedAccessEndpoint_securityGroupIds,
    createVerifiedAccessEndpoint_tagSpecifications,
    createVerifiedAccessEndpoint_verifiedAccessGroupId,
    createVerifiedAccessEndpoint_endpointType,
    createVerifiedAccessEndpoint_attachmentType,
    createVerifiedAccessEndpoint_domainCertificateArn,
    createVerifiedAccessEndpoint_applicationDomain,
    createVerifiedAccessEndpoint_endpointDomainPrefix,

    -- * Destructuring the Response
    CreateVerifiedAccessEndpointResponse (..),
    newCreateVerifiedAccessEndpointResponse,

    -- * Response Lenses
    createVerifiedAccessEndpointResponse_verifiedAccessEndpoint,
    createVerifiedAccessEndpointResponse_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:/ 'newCreateVerifiedAccessEndpoint' smart constructor.
data CreateVerifiedAccessEndpoint = CreateVerifiedAccessEndpoint'
  { -- | A unique, case-sensitive token that you provide to ensure idempotency of
    -- your modification request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    CreateVerifiedAccessEndpoint -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the Amazon Web Services Verified Access endpoint.
    CreateVerifiedAccessEndpoint -> Maybe Text
description :: 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@.
    CreateVerifiedAccessEndpoint -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The load balancer details if creating the Amazon Web Services Verified
    -- Access endpoint as @load-balancer@type.
    CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions :: Prelude.Maybe CreateVerifiedAccessEndpointLoadBalancerOptions,
    -- | The network interface details if creating the Amazon Web Services
    -- Verified Access endpoint as @network-interface@type.
    CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions :: Prelude.Maybe CreateVerifiedAccessEndpointEniOptions,
    -- | The Amazon Web Services Verified Access policy document.
    CreateVerifiedAccessEndpoint -> Maybe Text
policyDocument :: Prelude.Maybe Prelude.Text,
    -- | The Amazon EC2 security groups to associate with the Amazon Web Services
    -- Verified Access endpoint.
    CreateVerifiedAccessEndpoint -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The tags to assign to the Amazon Web Services Verified Access endpoint.
    CreateVerifiedAccessEndpoint -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the Verified Access group to associate the endpoint with.
    CreateVerifiedAccessEndpoint -> Text
verifiedAccessGroupId :: Prelude.Text,
    -- | The type of Amazon Web Services Verified Access endpoint to create.
    CreateVerifiedAccessEndpoint -> VerifiedAccessEndpointType
endpointType :: VerifiedAccessEndpointType,
    -- | The Amazon Web Services network component Verified Access attaches to.
    CreateVerifiedAccessEndpoint
-> VerifiedAccessEndpointAttachmentType
attachmentType :: VerifiedAccessEndpointAttachmentType,
    -- | The ARN of the public TLS\/SSL certificate in Amazon Web Services
    -- Certificate Manager to associate with the endpoint. The CN in the
    -- certificate must match the DNS name your end users will use to reach
    -- your application.
    CreateVerifiedAccessEndpoint -> Text
domainCertificateArn :: Prelude.Text,
    -- | The DNS name for users to reach your application.
    CreateVerifiedAccessEndpoint -> Text
applicationDomain :: Prelude.Text,
    -- | A custom identifier that gets prepended to a DNS name that is generated
    -- for the endpoint.
    CreateVerifiedAccessEndpoint -> Text
endpointDomainPrefix :: Prelude.Text
  }
  deriving (CreateVerifiedAccessEndpoint
-> CreateVerifiedAccessEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVerifiedAccessEndpoint
-> CreateVerifiedAccessEndpoint -> Bool
$c/= :: CreateVerifiedAccessEndpoint
-> CreateVerifiedAccessEndpoint -> Bool
== :: CreateVerifiedAccessEndpoint
-> CreateVerifiedAccessEndpoint -> Bool
$c== :: CreateVerifiedAccessEndpoint
-> CreateVerifiedAccessEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateVerifiedAccessEndpoint]
ReadPrec CreateVerifiedAccessEndpoint
Int -> ReadS CreateVerifiedAccessEndpoint
ReadS [CreateVerifiedAccessEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVerifiedAccessEndpoint]
$creadListPrec :: ReadPrec [CreateVerifiedAccessEndpoint]
readPrec :: ReadPrec CreateVerifiedAccessEndpoint
$creadPrec :: ReadPrec CreateVerifiedAccessEndpoint
readList :: ReadS [CreateVerifiedAccessEndpoint]
$creadList :: ReadS [CreateVerifiedAccessEndpoint]
readsPrec :: Int -> ReadS CreateVerifiedAccessEndpoint
$creadsPrec :: Int -> ReadS CreateVerifiedAccessEndpoint
Prelude.Read, Int -> CreateVerifiedAccessEndpoint -> ShowS
[CreateVerifiedAccessEndpoint] -> ShowS
CreateVerifiedAccessEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVerifiedAccessEndpoint] -> ShowS
$cshowList :: [CreateVerifiedAccessEndpoint] -> ShowS
show :: CreateVerifiedAccessEndpoint -> String
$cshow :: CreateVerifiedAccessEndpoint -> String
showsPrec :: Int -> CreateVerifiedAccessEndpoint -> ShowS
$cshowsPrec :: Int -> CreateVerifiedAccessEndpoint -> ShowS
Prelude.Show, forall x.
Rep CreateVerifiedAccessEndpoint x -> CreateVerifiedAccessEndpoint
forall x.
CreateVerifiedAccessEndpoint -> Rep CreateVerifiedAccessEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVerifiedAccessEndpoint x -> CreateVerifiedAccessEndpoint
$cfrom :: forall x.
CreateVerifiedAccessEndpoint -> Rep CreateVerifiedAccessEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateVerifiedAccessEndpoint' 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', 'createVerifiedAccessEndpoint_clientToken' - A unique, case-sensitive token that you provide to ensure idempotency of
-- your modification request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'description', 'createVerifiedAccessEndpoint_description' - A description for the Amazon Web Services Verified Access endpoint.
--
-- 'dryRun', 'createVerifiedAccessEndpoint_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@.
--
-- 'loadBalancerOptions', 'createVerifiedAccessEndpoint_loadBalancerOptions' - The load balancer details if creating the Amazon Web Services Verified
-- Access endpoint as @load-balancer@type.
--
-- 'networkInterfaceOptions', 'createVerifiedAccessEndpoint_networkInterfaceOptions' - The network interface details if creating the Amazon Web Services
-- Verified Access endpoint as @network-interface@type.
--
-- 'policyDocument', 'createVerifiedAccessEndpoint_policyDocument' - The Amazon Web Services Verified Access policy document.
--
-- 'securityGroupIds', 'createVerifiedAccessEndpoint_securityGroupIds' - The Amazon EC2 security groups to associate with the Amazon Web Services
-- Verified Access endpoint.
--
-- 'tagSpecifications', 'createVerifiedAccessEndpoint_tagSpecifications' - The tags to assign to the Amazon Web Services Verified Access endpoint.
--
-- 'verifiedAccessGroupId', 'createVerifiedAccessEndpoint_verifiedAccessGroupId' - The ID of the Verified Access group to associate the endpoint with.
--
-- 'endpointType', 'createVerifiedAccessEndpoint_endpointType' - The type of Amazon Web Services Verified Access endpoint to create.
--
-- 'attachmentType', 'createVerifiedAccessEndpoint_attachmentType' - The Amazon Web Services network component Verified Access attaches to.
--
-- 'domainCertificateArn', 'createVerifiedAccessEndpoint_domainCertificateArn' - The ARN of the public TLS\/SSL certificate in Amazon Web Services
-- Certificate Manager to associate with the endpoint. The CN in the
-- certificate must match the DNS name your end users will use to reach
-- your application.
--
-- 'applicationDomain', 'createVerifiedAccessEndpoint_applicationDomain' - The DNS name for users to reach your application.
--
-- 'endpointDomainPrefix', 'createVerifiedAccessEndpoint_endpointDomainPrefix' - A custom identifier that gets prepended to a DNS name that is generated
-- for the endpoint.
newCreateVerifiedAccessEndpoint ::
  -- | 'verifiedAccessGroupId'
  Prelude.Text ->
  -- | 'endpointType'
  VerifiedAccessEndpointType ->
  -- | 'attachmentType'
  VerifiedAccessEndpointAttachmentType ->
  -- | 'domainCertificateArn'
  Prelude.Text ->
  -- | 'applicationDomain'
  Prelude.Text ->
  -- | 'endpointDomainPrefix'
  Prelude.Text ->
  CreateVerifiedAccessEndpoint
newCreateVerifiedAccessEndpoint :: Text
-> VerifiedAccessEndpointType
-> VerifiedAccessEndpointAttachmentType
-> Text
-> Text
-> Text
-> CreateVerifiedAccessEndpoint
newCreateVerifiedAccessEndpoint
  Text
pVerifiedAccessGroupId_
  VerifiedAccessEndpointType
pEndpointType_
  VerifiedAccessEndpointAttachmentType
pAttachmentType_
  Text
pDomainCertificateArn_
  Text
pApplicationDomain_
  Text
pEndpointDomainPrefix_ =
    CreateVerifiedAccessEndpoint'
      { $sel:clientToken:CreateVerifiedAccessEndpoint' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateVerifiedAccessEndpoint' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:CreateVerifiedAccessEndpoint' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:policyDocument:CreateVerifiedAccessEndpoint' :: Maybe Text
policyDocument = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: Text
verifiedAccessGroupId =
          Text
pVerifiedAccessGroupId_,
        $sel:endpointType:CreateVerifiedAccessEndpoint' :: VerifiedAccessEndpointType
endpointType = VerifiedAccessEndpointType
pEndpointType_,
        $sel:attachmentType:CreateVerifiedAccessEndpoint' :: VerifiedAccessEndpointAttachmentType
attachmentType = VerifiedAccessEndpointAttachmentType
pAttachmentType_,
        $sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: Text
domainCertificateArn = Text
pDomainCertificateArn_,
        $sel:applicationDomain:CreateVerifiedAccessEndpoint' :: Text
applicationDomain = Text
pApplicationDomain_,
        $sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: Text
endpointDomainPrefix = Text
pEndpointDomainPrefix_
      }

-- | A unique, case-sensitive token that you provide to ensure idempotency of
-- your modification request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
createVerifiedAccessEndpoint_clientToken :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe Prelude.Text)
createVerifiedAccessEndpoint_clientToken :: Lens' CreateVerifiedAccessEndpoint (Maybe Text)
createVerifiedAccessEndpoint_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe Text
a -> CreateVerifiedAccessEndpoint
s {$sel:clientToken:CreateVerifiedAccessEndpoint' :: Maybe Text
clientToken = Maybe Text
a} :: CreateVerifiedAccessEndpoint)

-- | A description for the Amazon Web Services Verified Access endpoint.
createVerifiedAccessEndpoint_description :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe Prelude.Text)
createVerifiedAccessEndpoint_description :: Lens' CreateVerifiedAccessEndpoint (Maybe Text)
createVerifiedAccessEndpoint_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe Text
description :: Maybe Text
$sel:description:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe Text
a -> CreateVerifiedAccessEndpoint
s {$sel:description:CreateVerifiedAccessEndpoint' :: Maybe Text
description = Maybe Text
a} :: CreateVerifiedAccessEndpoint)

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

-- | The load balancer details if creating the Amazon Web Services Verified
-- Access endpoint as @load-balancer@type.
createVerifiedAccessEndpoint_loadBalancerOptions :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe CreateVerifiedAccessEndpointLoadBalancerOptions)
createVerifiedAccessEndpoint_loadBalancerOptions :: Lens'
  CreateVerifiedAccessEndpoint
  (Maybe CreateVerifiedAccessEndpointLoadBalancerOptions)
createVerifiedAccessEndpoint_loadBalancerOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
$sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions} -> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
a -> CreateVerifiedAccessEndpoint
s {$sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions = Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
a} :: CreateVerifiedAccessEndpoint)

-- | The network interface details if creating the Amazon Web Services
-- Verified Access endpoint as @network-interface@type.
createVerifiedAccessEndpoint_networkInterfaceOptions :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe CreateVerifiedAccessEndpointEniOptions)
createVerifiedAccessEndpoint_networkInterfaceOptions :: Lens'
  CreateVerifiedAccessEndpoint
  (Maybe CreateVerifiedAccessEndpointEniOptions)
createVerifiedAccessEndpoint_networkInterfaceOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions :: Maybe CreateVerifiedAccessEndpointEniOptions
$sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions} -> Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe CreateVerifiedAccessEndpointEniOptions
a -> CreateVerifiedAccessEndpoint
s {$sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions = Maybe CreateVerifiedAccessEndpointEniOptions
a} :: CreateVerifiedAccessEndpoint)

-- | The Amazon Web Services Verified Access policy document.
createVerifiedAccessEndpoint_policyDocument :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe Prelude.Text)
createVerifiedAccessEndpoint_policyDocument :: Lens' CreateVerifiedAccessEndpoint (Maybe Text)
createVerifiedAccessEndpoint_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe Text
policyDocument :: Maybe Text
$sel:policyDocument:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
policyDocument} -> Maybe Text
policyDocument) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe Text
a -> CreateVerifiedAccessEndpoint
s {$sel:policyDocument:CreateVerifiedAccessEndpoint' :: Maybe Text
policyDocument = Maybe Text
a} :: CreateVerifiedAccessEndpoint)

-- | The Amazon EC2 security groups to associate with the Amazon Web Services
-- Verified Access endpoint.
createVerifiedAccessEndpoint_securityGroupIds :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe [Prelude.Text])
createVerifiedAccessEndpoint_securityGroupIds :: Lens' CreateVerifiedAccessEndpoint (Maybe [Text])
createVerifiedAccessEndpoint_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe [Text]
a -> CreateVerifiedAccessEndpoint
s {$sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateVerifiedAccessEndpoint) 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 assign to the Amazon Web Services Verified Access endpoint.
createVerifiedAccessEndpoint_tagSpecifications :: Lens.Lens' CreateVerifiedAccessEndpoint (Prelude.Maybe [TagSpecification])
createVerifiedAccessEndpoint_tagSpecifications :: Lens' CreateVerifiedAccessEndpoint (Maybe [TagSpecification])
createVerifiedAccessEndpoint_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Maybe [TagSpecification]
a -> CreateVerifiedAccessEndpoint
s {$sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVerifiedAccessEndpoint) 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 ID of the Verified Access group to associate the endpoint with.
createVerifiedAccessEndpoint_verifiedAccessGroupId :: Lens.Lens' CreateVerifiedAccessEndpoint Prelude.Text
createVerifiedAccessEndpoint_verifiedAccessGroupId :: Lens' CreateVerifiedAccessEndpoint Text
createVerifiedAccessEndpoint_verifiedAccessGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Text
verifiedAccessGroupId :: Text
$sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
verifiedAccessGroupId} -> Text
verifiedAccessGroupId) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Text
a -> CreateVerifiedAccessEndpoint
s {$sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: Text
verifiedAccessGroupId = Text
a} :: CreateVerifiedAccessEndpoint)

-- | The type of Amazon Web Services Verified Access endpoint to create.
createVerifiedAccessEndpoint_endpointType :: Lens.Lens' CreateVerifiedAccessEndpoint VerifiedAccessEndpointType
createVerifiedAccessEndpoint_endpointType :: Lens' CreateVerifiedAccessEndpoint VerifiedAccessEndpointType
createVerifiedAccessEndpoint_endpointType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {VerifiedAccessEndpointType
endpointType :: VerifiedAccessEndpointType
$sel:endpointType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> VerifiedAccessEndpointType
endpointType} -> VerifiedAccessEndpointType
endpointType) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} VerifiedAccessEndpointType
a -> CreateVerifiedAccessEndpoint
s {$sel:endpointType:CreateVerifiedAccessEndpoint' :: VerifiedAccessEndpointType
endpointType = VerifiedAccessEndpointType
a} :: CreateVerifiedAccessEndpoint)

-- | The Amazon Web Services network component Verified Access attaches to.
createVerifiedAccessEndpoint_attachmentType :: Lens.Lens' CreateVerifiedAccessEndpoint VerifiedAccessEndpointAttachmentType
createVerifiedAccessEndpoint_attachmentType :: Lens'
  CreateVerifiedAccessEndpoint VerifiedAccessEndpointAttachmentType
createVerifiedAccessEndpoint_attachmentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {VerifiedAccessEndpointAttachmentType
attachmentType :: VerifiedAccessEndpointAttachmentType
$sel:attachmentType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> VerifiedAccessEndpointAttachmentType
attachmentType} -> VerifiedAccessEndpointAttachmentType
attachmentType) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} VerifiedAccessEndpointAttachmentType
a -> CreateVerifiedAccessEndpoint
s {$sel:attachmentType:CreateVerifiedAccessEndpoint' :: VerifiedAccessEndpointAttachmentType
attachmentType = VerifiedAccessEndpointAttachmentType
a} :: CreateVerifiedAccessEndpoint)

-- | The ARN of the public TLS\/SSL certificate in Amazon Web Services
-- Certificate Manager to associate with the endpoint. The CN in the
-- certificate must match the DNS name your end users will use to reach
-- your application.
createVerifiedAccessEndpoint_domainCertificateArn :: Lens.Lens' CreateVerifiedAccessEndpoint Prelude.Text
createVerifiedAccessEndpoint_domainCertificateArn :: Lens' CreateVerifiedAccessEndpoint Text
createVerifiedAccessEndpoint_domainCertificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Text
domainCertificateArn :: Text
$sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
domainCertificateArn} -> Text
domainCertificateArn) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Text
a -> CreateVerifiedAccessEndpoint
s {$sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: Text
domainCertificateArn = Text
a} :: CreateVerifiedAccessEndpoint)

-- | The DNS name for users to reach your application.
createVerifiedAccessEndpoint_applicationDomain :: Lens.Lens' CreateVerifiedAccessEndpoint Prelude.Text
createVerifiedAccessEndpoint_applicationDomain :: Lens' CreateVerifiedAccessEndpoint Text
createVerifiedAccessEndpoint_applicationDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Text
applicationDomain :: Text
$sel:applicationDomain:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
applicationDomain} -> Text
applicationDomain) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Text
a -> CreateVerifiedAccessEndpoint
s {$sel:applicationDomain:CreateVerifiedAccessEndpoint' :: Text
applicationDomain = Text
a} :: CreateVerifiedAccessEndpoint)

-- | A custom identifier that gets prepended to a DNS name that is generated
-- for the endpoint.
createVerifiedAccessEndpoint_endpointDomainPrefix :: Lens.Lens' CreateVerifiedAccessEndpoint Prelude.Text
createVerifiedAccessEndpoint_endpointDomainPrefix :: Lens' CreateVerifiedAccessEndpoint Text
createVerifiedAccessEndpoint_endpointDomainPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpoint' {Text
endpointDomainPrefix :: Text
$sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
endpointDomainPrefix} -> Text
endpointDomainPrefix) (\s :: CreateVerifiedAccessEndpoint
s@CreateVerifiedAccessEndpoint' {} Text
a -> CreateVerifiedAccessEndpoint
s {$sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: Text
endpointDomainPrefix = Text
a} :: CreateVerifiedAccessEndpoint)

instance Core.AWSRequest CreateVerifiedAccessEndpoint where
  type
    AWSResponse CreateVerifiedAccessEndpoint =
      CreateVerifiedAccessEndpointResponse
  request :: (Service -> Service)
-> CreateVerifiedAccessEndpoint
-> Request CreateVerifiedAccessEndpoint
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 CreateVerifiedAccessEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateVerifiedAccessEndpoint)))
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 VerifiedAccessEndpoint
-> Int -> CreateVerifiedAccessEndpointResponse
CreateVerifiedAccessEndpointResponse'
            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
"verifiedAccessEndpoint")
            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
    CreateVerifiedAccessEndpoint
  where
  hashWithSalt :: Int -> CreateVerifiedAccessEndpoint -> Int
hashWithSalt Int
_salt CreateVerifiedAccessEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
Maybe CreateVerifiedAccessEndpointEniOptions
Text
VerifiedAccessEndpointAttachmentType
VerifiedAccessEndpointType
endpointDomainPrefix :: Text
applicationDomain :: Text
domainCertificateArn :: Text
attachmentType :: VerifiedAccessEndpointAttachmentType
endpointType :: VerifiedAccessEndpointType
verifiedAccessGroupId :: Text
tagSpecifications :: Maybe [TagSpecification]
securityGroupIds :: Maybe [Text]
policyDocument :: Maybe Text
networkInterfaceOptions :: Maybe CreateVerifiedAccessEndpointEniOptions
loadBalancerOptions :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:applicationDomain:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:attachmentType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> VerifiedAccessEndpointAttachmentType
$sel:endpointType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> VerifiedAccessEndpointType
$sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [TagSpecification]
$sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [Text]
$sel:policyDocument:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointEniOptions
$sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
$sel:dryRun:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Bool
$sel:description:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:clientToken:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> 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 Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policyDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
verifiedAccessGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VerifiedAccessEndpointType
endpointType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VerifiedAccessEndpointAttachmentType
attachmentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainCertificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationDomain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointDomainPrefix

instance Prelude.NFData CreateVerifiedAccessEndpoint where
  rnf :: CreateVerifiedAccessEndpoint -> ()
rnf CreateVerifiedAccessEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
Maybe CreateVerifiedAccessEndpointEniOptions
Text
VerifiedAccessEndpointAttachmentType
VerifiedAccessEndpointType
endpointDomainPrefix :: Text
applicationDomain :: Text
domainCertificateArn :: Text
attachmentType :: VerifiedAccessEndpointAttachmentType
endpointType :: VerifiedAccessEndpointType
verifiedAccessGroupId :: Text
tagSpecifications :: Maybe [TagSpecification]
securityGroupIds :: Maybe [Text]
policyDocument :: Maybe Text
networkInterfaceOptions :: Maybe CreateVerifiedAccessEndpointEniOptions
loadBalancerOptions :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:applicationDomain:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:attachmentType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> VerifiedAccessEndpointAttachmentType
$sel:endpointType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> VerifiedAccessEndpointType
$sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [TagSpecification]
$sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [Text]
$sel:policyDocument:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointEniOptions
$sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
$sel:dryRun:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Bool
$sel:description:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:clientToken:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> 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 Text
description
      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 CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions
      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 [Text]
securityGroupIds
      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 Text
verifiedAccessGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VerifiedAccessEndpointType
endpointType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VerifiedAccessEndpointAttachmentType
attachmentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainCertificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationDomain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointDomainPrefix

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

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

instance Data.ToQuery CreateVerifiedAccessEndpoint where
  toQuery :: CreateVerifiedAccessEndpoint -> QueryString
toQuery CreateVerifiedAccessEndpoint' {Maybe Bool
Maybe [Text]
Maybe [TagSpecification]
Maybe Text
Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
Maybe CreateVerifiedAccessEndpointEniOptions
Text
VerifiedAccessEndpointAttachmentType
VerifiedAccessEndpointType
endpointDomainPrefix :: Text
applicationDomain :: Text
domainCertificateArn :: Text
attachmentType :: VerifiedAccessEndpointAttachmentType
endpointType :: VerifiedAccessEndpointType
verifiedAccessGroupId :: Text
tagSpecifications :: Maybe [TagSpecification]
securityGroupIds :: Maybe [Text]
policyDocument :: Maybe Text
networkInterfaceOptions :: Maybe CreateVerifiedAccessEndpointEniOptions
loadBalancerOptions :: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
dryRun :: Maybe Bool
description :: Maybe Text
clientToken :: Maybe Text
$sel:endpointDomainPrefix:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:applicationDomain:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:domainCertificateArn:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:attachmentType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> VerifiedAccessEndpointAttachmentType
$sel:endpointType:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> VerifiedAccessEndpointType
$sel:verifiedAccessGroupId:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Text
$sel:tagSpecifications:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [TagSpecification]
$sel:securityGroupIds:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe [Text]
$sel:policyDocument:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:networkInterfaceOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointEniOptions
$sel:loadBalancerOptions:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint
-> Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
$sel:dryRun:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Bool
$sel:description:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
$sel:clientToken:CreateVerifiedAccessEndpoint' :: CreateVerifiedAccessEndpoint -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateVerifiedAccessEndpoint" ::
                      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
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"LoadBalancerOptions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CreateVerifiedAccessEndpointLoadBalancerOptions
loadBalancerOptions,
        ByteString
"NetworkInterfaceOptions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CreateVerifiedAccessEndpointEniOptions
networkInterfaceOptions,
        ByteString
"PolicyDocument" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
policyDocument,
        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
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"VerifiedAccessGroupId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
verifiedAccessGroupId,
        ByteString
"EndpointType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: VerifiedAccessEndpointType
endpointType,
        ByteString
"AttachmentType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: VerifiedAccessEndpointAttachmentType
attachmentType,
        ByteString
"DomainCertificateArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domainCertificateArn,
        ByteString
"ApplicationDomain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
applicationDomain,
        ByteString
"EndpointDomainPrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
endpointDomainPrefix
      ]

-- | /See:/ 'newCreateVerifiedAccessEndpointResponse' smart constructor.
data CreateVerifiedAccessEndpointResponse = CreateVerifiedAccessEndpointResponse'
  { -- | The ID of the Amazon Web Services Verified Access endpoint.
    CreateVerifiedAccessEndpointResponse
-> Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint :: Prelude.Maybe VerifiedAccessEndpoint,
    -- | The response's http status code.
    CreateVerifiedAccessEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateVerifiedAccessEndpointResponse
-> CreateVerifiedAccessEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVerifiedAccessEndpointResponse
-> CreateVerifiedAccessEndpointResponse -> Bool
$c/= :: CreateVerifiedAccessEndpointResponse
-> CreateVerifiedAccessEndpointResponse -> Bool
== :: CreateVerifiedAccessEndpointResponse
-> CreateVerifiedAccessEndpointResponse -> Bool
$c== :: CreateVerifiedAccessEndpointResponse
-> CreateVerifiedAccessEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateVerifiedAccessEndpointResponse]
ReadPrec CreateVerifiedAccessEndpointResponse
Int -> ReadS CreateVerifiedAccessEndpointResponse
ReadS [CreateVerifiedAccessEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVerifiedAccessEndpointResponse]
$creadListPrec :: ReadPrec [CreateVerifiedAccessEndpointResponse]
readPrec :: ReadPrec CreateVerifiedAccessEndpointResponse
$creadPrec :: ReadPrec CreateVerifiedAccessEndpointResponse
readList :: ReadS [CreateVerifiedAccessEndpointResponse]
$creadList :: ReadS [CreateVerifiedAccessEndpointResponse]
readsPrec :: Int -> ReadS CreateVerifiedAccessEndpointResponse
$creadsPrec :: Int -> ReadS CreateVerifiedAccessEndpointResponse
Prelude.Read, Int -> CreateVerifiedAccessEndpointResponse -> ShowS
[CreateVerifiedAccessEndpointResponse] -> ShowS
CreateVerifiedAccessEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVerifiedAccessEndpointResponse] -> ShowS
$cshowList :: [CreateVerifiedAccessEndpointResponse] -> ShowS
show :: CreateVerifiedAccessEndpointResponse -> String
$cshow :: CreateVerifiedAccessEndpointResponse -> String
showsPrec :: Int -> CreateVerifiedAccessEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateVerifiedAccessEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateVerifiedAccessEndpointResponse x
-> CreateVerifiedAccessEndpointResponse
forall x.
CreateVerifiedAccessEndpointResponse
-> Rep CreateVerifiedAccessEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVerifiedAccessEndpointResponse x
-> CreateVerifiedAccessEndpointResponse
$cfrom :: forall x.
CreateVerifiedAccessEndpointResponse
-> Rep CreateVerifiedAccessEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVerifiedAccessEndpointResponse' 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:
--
-- 'verifiedAccessEndpoint', 'createVerifiedAccessEndpointResponse_verifiedAccessEndpoint' - The ID of the Amazon Web Services Verified Access endpoint.
--
-- 'httpStatus', 'createVerifiedAccessEndpointResponse_httpStatus' - The response's http status code.
newCreateVerifiedAccessEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVerifiedAccessEndpointResponse
newCreateVerifiedAccessEndpointResponse :: Int -> CreateVerifiedAccessEndpointResponse
newCreateVerifiedAccessEndpointResponse Int
pHttpStatus_ =
  CreateVerifiedAccessEndpointResponse'
    { $sel:verifiedAccessEndpoint:CreateVerifiedAccessEndpointResponse' :: Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVerifiedAccessEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the Amazon Web Services Verified Access endpoint.
createVerifiedAccessEndpointResponse_verifiedAccessEndpoint :: Lens.Lens' CreateVerifiedAccessEndpointResponse (Prelude.Maybe VerifiedAccessEndpoint)
createVerifiedAccessEndpointResponse_verifiedAccessEndpoint :: Lens'
  CreateVerifiedAccessEndpointResponse (Maybe VerifiedAccessEndpoint)
createVerifiedAccessEndpointResponse_verifiedAccessEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVerifiedAccessEndpointResponse' {Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint :: Maybe VerifiedAccessEndpoint
$sel:verifiedAccessEndpoint:CreateVerifiedAccessEndpointResponse' :: CreateVerifiedAccessEndpointResponse
-> Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint} -> Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint) (\s :: CreateVerifiedAccessEndpointResponse
s@CreateVerifiedAccessEndpointResponse' {} Maybe VerifiedAccessEndpoint
a -> CreateVerifiedAccessEndpointResponse
s {$sel:verifiedAccessEndpoint:CreateVerifiedAccessEndpointResponse' :: Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint = Maybe VerifiedAccessEndpoint
a} :: CreateVerifiedAccessEndpointResponse)

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

instance
  Prelude.NFData
    CreateVerifiedAccessEndpointResponse
  where
  rnf :: CreateVerifiedAccessEndpointResponse -> ()
rnf CreateVerifiedAccessEndpointResponse' {Int
Maybe VerifiedAccessEndpoint
httpStatus :: Int
verifiedAccessEndpoint :: Maybe VerifiedAccessEndpoint
$sel:httpStatus:CreateVerifiedAccessEndpointResponse' :: CreateVerifiedAccessEndpointResponse -> Int
$sel:verifiedAccessEndpoint:CreateVerifiedAccessEndpointResponse' :: CreateVerifiedAccessEndpointResponse
-> Maybe VerifiedAccessEndpoint
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe VerifiedAccessEndpoint
verifiedAccessEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus