{-# 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.CreateVpnConnection
-- 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 VPN connection between an existing virtual private gateway or
-- transit gateway and a customer gateway. The supported connection type is
-- @ipsec.1@.
--
-- The response includes information that you need to give to your network
-- administrator to configure your customer gateway.
--
-- We strongly recommend that you use HTTPS when calling this operation
-- because the response contains sensitive cryptographic information for
-- configuring your customer gateway device.
--
-- If you decide to shut down your VPN connection for any reason and later
-- create a new VPN connection, you must reconfigure your customer gateway
-- with the new information returned from this call.
--
-- This is an idempotent operation. If you perform the operation more than
-- once, Amazon EC2 doesn\'t return an error.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpn/latest/s2svpn/VPC_VPN.html Amazon Web Services Site-to-Site VPN>
-- in the /Amazon Web Services Site-to-Site VPN User Guide/.
module Amazonka.EC2.CreateVpnConnection
  ( -- * Creating a Request
    CreateVpnConnection (..),
    newCreateVpnConnection,

    -- * Request Lenses
    createVpnConnection_dryRun,
    createVpnConnection_options,
    createVpnConnection_tagSpecifications,
    createVpnConnection_transitGatewayId,
    createVpnConnection_vpnGatewayId,
    createVpnConnection_customerGatewayId,
    createVpnConnection_type,

    -- * Destructuring the Response
    CreateVpnConnectionResponse (..),
    newCreateVpnConnectionResponse,

    -- * Response Lenses
    createVpnConnectionResponse_vpnConnection,
    createVpnConnectionResponse_httpStatus,
  )
where

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

-- | Contains the parameters for CreateVpnConnection.
--
-- /See:/ 'newCreateVpnConnection' smart constructor.
data CreateVpnConnection = CreateVpnConnection'
  { -- | 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@.
    CreateVpnConnection -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The options for the VPN connection.
    CreateVpnConnection -> Maybe VpnConnectionOptionsSpecification
options :: Prelude.Maybe VpnConnectionOptionsSpecification,
    -- | The tags to apply to the VPN connection.
    CreateVpnConnection -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the transit gateway. If you specify a transit gateway, you
    -- cannot specify a virtual private gateway.
    CreateVpnConnection -> Maybe Text
transitGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the virtual private gateway. If you specify a virtual private
    -- gateway, you cannot specify a transit gateway.
    CreateVpnConnection -> Maybe Text
vpnGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the customer gateway.
    CreateVpnConnection -> Text
customerGatewayId :: Prelude.Text,
    -- | The type of VPN connection (@ipsec.1@).
    CreateVpnConnection -> Text
type' :: Prelude.Text
  }
  deriving (CreateVpnConnection -> CreateVpnConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpnConnection -> CreateVpnConnection -> Bool
$c/= :: CreateVpnConnection -> CreateVpnConnection -> Bool
== :: CreateVpnConnection -> CreateVpnConnection -> Bool
$c== :: CreateVpnConnection -> CreateVpnConnection -> Bool
Prelude.Eq, ReadPrec [CreateVpnConnection]
ReadPrec CreateVpnConnection
Int -> ReadS CreateVpnConnection
ReadS [CreateVpnConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpnConnection]
$creadListPrec :: ReadPrec [CreateVpnConnection]
readPrec :: ReadPrec CreateVpnConnection
$creadPrec :: ReadPrec CreateVpnConnection
readList :: ReadS [CreateVpnConnection]
$creadList :: ReadS [CreateVpnConnection]
readsPrec :: Int -> ReadS CreateVpnConnection
$creadsPrec :: Int -> ReadS CreateVpnConnection
Prelude.Read, Int -> CreateVpnConnection -> ShowS
[CreateVpnConnection] -> ShowS
CreateVpnConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpnConnection] -> ShowS
$cshowList :: [CreateVpnConnection] -> ShowS
show :: CreateVpnConnection -> String
$cshow :: CreateVpnConnection -> String
showsPrec :: Int -> CreateVpnConnection -> ShowS
$cshowsPrec :: Int -> CreateVpnConnection -> ShowS
Prelude.Show, forall x. Rep CreateVpnConnection x -> CreateVpnConnection
forall x. CreateVpnConnection -> Rep CreateVpnConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVpnConnection x -> CreateVpnConnection
$cfrom :: forall x. CreateVpnConnection -> Rep CreateVpnConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpnConnection' 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:
--
-- 'dryRun', 'createVpnConnection_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@.
--
-- 'options', 'createVpnConnection_options' - The options for the VPN connection.
--
-- 'tagSpecifications', 'createVpnConnection_tagSpecifications' - The tags to apply to the VPN connection.
--
-- 'transitGatewayId', 'createVpnConnection_transitGatewayId' - The ID of the transit gateway. If you specify a transit gateway, you
-- cannot specify a virtual private gateway.
--
-- 'vpnGatewayId', 'createVpnConnection_vpnGatewayId' - The ID of the virtual private gateway. If you specify a virtual private
-- gateway, you cannot specify a transit gateway.
--
-- 'customerGatewayId', 'createVpnConnection_customerGatewayId' - The ID of the customer gateway.
--
-- 'type'', 'createVpnConnection_type' - The type of VPN connection (@ipsec.1@).
newCreateVpnConnection ::
  -- | 'customerGatewayId'
  Prelude.Text ->
  -- | 'type''
  Prelude.Text ->
  CreateVpnConnection
newCreateVpnConnection :: Text -> Text -> CreateVpnConnection
newCreateVpnConnection Text
pCustomerGatewayId_ Text
pType_ =
  CreateVpnConnection'
    { $sel:dryRun:CreateVpnConnection' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:options:CreateVpnConnection' :: Maybe VpnConnectionOptionsSpecification
options = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateVpnConnection' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:transitGatewayId:CreateVpnConnection' :: Maybe Text
transitGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpnGatewayId:CreateVpnConnection' :: Maybe Text
vpnGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:customerGatewayId:CreateVpnConnection' :: Text
customerGatewayId = Text
pCustomerGatewayId_,
      $sel:type':CreateVpnConnection' :: Text
type' = Text
pType_
    }

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

-- | The options for the VPN connection.
createVpnConnection_options :: Lens.Lens' CreateVpnConnection (Prelude.Maybe VpnConnectionOptionsSpecification)
createVpnConnection_options :: Lens' CreateVpnConnection (Maybe VpnConnectionOptionsSpecification)
createVpnConnection_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Maybe VpnConnectionOptionsSpecification
options :: Maybe VpnConnectionOptionsSpecification
$sel:options:CreateVpnConnection' :: CreateVpnConnection -> Maybe VpnConnectionOptionsSpecification
options} -> Maybe VpnConnectionOptionsSpecification
options) (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Maybe VpnConnectionOptionsSpecification
a -> CreateVpnConnection
s {$sel:options:CreateVpnConnection' :: Maybe VpnConnectionOptionsSpecification
options = Maybe VpnConnectionOptionsSpecification
a} :: CreateVpnConnection)

-- | The tags to apply to the VPN connection.
createVpnConnection_tagSpecifications :: Lens.Lens' CreateVpnConnection (Prelude.Maybe [TagSpecification])
createVpnConnection_tagSpecifications :: Lens' CreateVpnConnection (Maybe [TagSpecification])
createVpnConnection_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVpnConnection' :: CreateVpnConnection -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Maybe [TagSpecification]
a -> CreateVpnConnection
s {$sel:tagSpecifications:CreateVpnConnection' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVpnConnection) 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 transit gateway. If you specify a transit gateway, you
-- cannot specify a virtual private gateway.
createVpnConnection_transitGatewayId :: Lens.Lens' CreateVpnConnection (Prelude.Maybe Prelude.Text)
createVpnConnection_transitGatewayId :: Lens' CreateVpnConnection (Maybe Text)
createVpnConnection_transitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Maybe Text
transitGatewayId :: Maybe Text
$sel:transitGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
transitGatewayId} -> Maybe Text
transitGatewayId) (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Maybe Text
a -> CreateVpnConnection
s {$sel:transitGatewayId:CreateVpnConnection' :: Maybe Text
transitGatewayId = Maybe Text
a} :: CreateVpnConnection)

-- | The ID of the virtual private gateway. If you specify a virtual private
-- gateway, you cannot specify a transit gateway.
createVpnConnection_vpnGatewayId :: Lens.Lens' CreateVpnConnection (Prelude.Maybe Prelude.Text)
createVpnConnection_vpnGatewayId :: Lens' CreateVpnConnection (Maybe Text)
createVpnConnection_vpnGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Maybe Text
vpnGatewayId :: Maybe Text
$sel:vpnGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
vpnGatewayId} -> Maybe Text
vpnGatewayId) (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Maybe Text
a -> CreateVpnConnection
s {$sel:vpnGatewayId:CreateVpnConnection' :: Maybe Text
vpnGatewayId = Maybe Text
a} :: CreateVpnConnection)

-- | The ID of the customer gateway.
createVpnConnection_customerGatewayId :: Lens.Lens' CreateVpnConnection Prelude.Text
createVpnConnection_customerGatewayId :: Lens' CreateVpnConnection Text
createVpnConnection_customerGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Text
customerGatewayId :: Text
$sel:customerGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Text
customerGatewayId} -> Text
customerGatewayId) (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Text
a -> CreateVpnConnection
s {$sel:customerGatewayId:CreateVpnConnection' :: Text
customerGatewayId = Text
a} :: CreateVpnConnection)

-- | The type of VPN connection (@ipsec.1@).
createVpnConnection_type :: Lens.Lens' CreateVpnConnection Prelude.Text
createVpnConnection_type :: Lens' CreateVpnConnection Text
createVpnConnection_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnection' {Text
type' :: Text
$sel:type':CreateVpnConnection' :: CreateVpnConnection -> Text
type'} -> Text
type') (\s :: CreateVpnConnection
s@CreateVpnConnection' {} Text
a -> CreateVpnConnection
s {$sel:type':CreateVpnConnection' :: Text
type' = Text
a} :: CreateVpnConnection)

instance Core.AWSRequest CreateVpnConnection where
  type
    AWSResponse CreateVpnConnection =
      CreateVpnConnectionResponse
  request :: (Service -> Service)
-> CreateVpnConnection -> Request CreateVpnConnection
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 CreateVpnConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateVpnConnection)))
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 VpnConnection -> Int -> CreateVpnConnectionResponse
CreateVpnConnectionResponse'
            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
"vpnConnection")
            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 CreateVpnConnection where
  hashWithSalt :: Int -> CreateVpnConnection -> Int
hashWithSalt Int
_salt CreateVpnConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe VpnConnectionOptionsSpecification
Text
type' :: Text
customerGatewayId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe VpnConnectionOptionsSpecification
dryRun :: Maybe Bool
$sel:type':CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:customerGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:vpnGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:transitGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:tagSpecifications:CreateVpnConnection' :: CreateVpnConnection -> Maybe [TagSpecification]
$sel:options:CreateVpnConnection' :: CreateVpnConnection -> Maybe VpnConnectionOptionsSpecification
$sel:dryRun:CreateVpnConnection' :: CreateVpnConnection -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpnConnectionOptionsSpecification
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
transitGatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpnGatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
customerGatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
type'

instance Prelude.NFData CreateVpnConnection where
  rnf :: CreateVpnConnection -> ()
rnf CreateVpnConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe VpnConnectionOptionsSpecification
Text
type' :: Text
customerGatewayId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe VpnConnectionOptionsSpecification
dryRun :: Maybe Bool
$sel:type':CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:customerGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:vpnGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:transitGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:tagSpecifications:CreateVpnConnection' :: CreateVpnConnection -> Maybe [TagSpecification]
$sel:options:CreateVpnConnection' :: CreateVpnConnection -> Maybe VpnConnectionOptionsSpecification
$sel:dryRun:CreateVpnConnection' :: CreateVpnConnection -> Maybe Bool
..} =
    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 VpnConnectionOptionsSpecification
options
      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 Text
transitGatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpnGatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
customerGatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
type'

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

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

instance Data.ToQuery CreateVpnConnection where
  toQuery :: CreateVpnConnection -> QueryString
toQuery CreateVpnConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe VpnConnectionOptionsSpecification
Text
type' :: Text
customerGatewayId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe VpnConnectionOptionsSpecification
dryRun :: Maybe Bool
$sel:type':CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:customerGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Text
$sel:vpnGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:transitGatewayId:CreateVpnConnection' :: CreateVpnConnection -> Maybe Text
$sel:tagSpecifications:CreateVpnConnection' :: CreateVpnConnection -> Maybe [TagSpecification]
$sel:options:CreateVpnConnection' :: CreateVpnConnection -> Maybe VpnConnectionOptionsSpecification
$sel:dryRun:CreateVpnConnection' :: CreateVpnConnection -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateVpnConnection" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Options" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe VpnConnectionOptionsSpecification
options,
        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
"TransitGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
transitGatewayId,
        ByteString
"VpnGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
vpnGatewayId,
        ByteString
"CustomerGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
customerGatewayId,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
type'
      ]

-- | Contains the output of CreateVpnConnection.
--
-- /See:/ 'newCreateVpnConnectionResponse' smart constructor.
data CreateVpnConnectionResponse = CreateVpnConnectionResponse'
  { -- | Information about the VPN connection.
    CreateVpnConnectionResponse -> Maybe VpnConnection
vpnConnection :: Prelude.Maybe VpnConnection,
    -- | The response's http status code.
    CreateVpnConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateVpnConnectionResponse -> CreateVpnConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpnConnectionResponse -> CreateVpnConnectionResponse -> Bool
$c/= :: CreateVpnConnectionResponse -> CreateVpnConnectionResponse -> Bool
== :: CreateVpnConnectionResponse -> CreateVpnConnectionResponse -> Bool
$c== :: CreateVpnConnectionResponse -> CreateVpnConnectionResponse -> Bool
Prelude.Eq, ReadPrec [CreateVpnConnectionResponse]
ReadPrec CreateVpnConnectionResponse
Int -> ReadS CreateVpnConnectionResponse
ReadS [CreateVpnConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpnConnectionResponse]
$creadListPrec :: ReadPrec [CreateVpnConnectionResponse]
readPrec :: ReadPrec CreateVpnConnectionResponse
$creadPrec :: ReadPrec CreateVpnConnectionResponse
readList :: ReadS [CreateVpnConnectionResponse]
$creadList :: ReadS [CreateVpnConnectionResponse]
readsPrec :: Int -> ReadS CreateVpnConnectionResponse
$creadsPrec :: Int -> ReadS CreateVpnConnectionResponse
Prelude.Read, Int -> CreateVpnConnectionResponse -> ShowS
[CreateVpnConnectionResponse] -> ShowS
CreateVpnConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpnConnectionResponse] -> ShowS
$cshowList :: [CreateVpnConnectionResponse] -> ShowS
show :: CreateVpnConnectionResponse -> String
$cshow :: CreateVpnConnectionResponse -> String
showsPrec :: Int -> CreateVpnConnectionResponse -> ShowS
$cshowsPrec :: Int -> CreateVpnConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateVpnConnectionResponse x -> CreateVpnConnectionResponse
forall x.
CreateVpnConnectionResponse -> Rep CreateVpnConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVpnConnectionResponse x -> CreateVpnConnectionResponse
$cfrom :: forall x.
CreateVpnConnectionResponse -> Rep CreateVpnConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpnConnectionResponse' 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:
--
-- 'vpnConnection', 'createVpnConnectionResponse_vpnConnection' - Information about the VPN connection.
--
-- 'httpStatus', 'createVpnConnectionResponse_httpStatus' - The response's http status code.
newCreateVpnConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVpnConnectionResponse
newCreateVpnConnectionResponse :: Int -> CreateVpnConnectionResponse
newCreateVpnConnectionResponse Int
pHttpStatus_ =
  CreateVpnConnectionResponse'
    { $sel:vpnConnection:CreateVpnConnectionResponse' :: Maybe VpnConnection
vpnConnection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVpnConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the VPN connection.
createVpnConnectionResponse_vpnConnection :: Lens.Lens' CreateVpnConnectionResponse (Prelude.Maybe VpnConnection)
createVpnConnectionResponse_vpnConnection :: Lens' CreateVpnConnectionResponse (Maybe VpnConnection)
createVpnConnectionResponse_vpnConnection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpnConnectionResponse' {Maybe VpnConnection
vpnConnection :: Maybe VpnConnection
$sel:vpnConnection:CreateVpnConnectionResponse' :: CreateVpnConnectionResponse -> Maybe VpnConnection
vpnConnection} -> Maybe VpnConnection
vpnConnection) (\s :: CreateVpnConnectionResponse
s@CreateVpnConnectionResponse' {} Maybe VpnConnection
a -> CreateVpnConnectionResponse
s {$sel:vpnConnection:CreateVpnConnectionResponse' :: Maybe VpnConnection
vpnConnection = Maybe VpnConnection
a} :: CreateVpnConnectionResponse)

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

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