{-# 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.ModifyVpnConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the customer gateway or the target gateway of an Amazon Web
-- Services Site-to-Site VPN connection. To modify the target gateway, the
-- following migration options are available:
--
-- -   An existing virtual private gateway to a new virtual private gateway
--
-- -   An existing virtual private gateway to a transit gateway
--
-- -   An existing transit gateway to a new transit gateway
--
-- -   An existing transit gateway to a virtual private gateway
--
-- Before you perform the migration to the new gateway, you must configure
-- the new gateway. Use CreateVpnGateway to create a virtual private
-- gateway, or CreateTransitGateway to create a transit gateway.
--
-- This step is required when you migrate from a virtual private gateway
-- with static routes to a transit gateway.
--
-- You must delete the static routes before you migrate to the new gateway.
--
-- Keep a copy of the static route before you delete it. You will need to
-- add back these routes to the transit gateway after the VPN connection
-- migration is complete.
--
-- After you migrate to the new gateway, you might need to modify your VPC
-- route table. Use CreateRoute and DeleteRoute to make the changes
-- described in
-- <https://docs.aws.amazon.com/vpn/latest/s2svpn/modify-vpn-target.html#step-update-routing Update VPC route tables>
-- in the /Amazon Web Services Site-to-Site VPN User Guide/.
--
-- When the new gateway is a transit gateway, modify the transit gateway
-- route table to allow traffic between the VPC and the Amazon Web Services
-- Site-to-Site VPN connection. Use CreateTransitGatewayRoute to add the
-- routes.
--
-- If you deleted VPN static routes, you must add the static routes to the
-- transit gateway route table.
--
-- After you perform this operation, the VPN endpoint\'s IP addresses on
-- the Amazon Web Services side and the tunnel options remain intact. Your
-- Amazon Web Services Site-to-Site VPN connection will be temporarily
-- unavailable for a brief period while we provision the new endpoints.
module Amazonka.EC2.ModifyVpnConnection
  ( -- * Creating a Request
    ModifyVpnConnection (..),
    newModifyVpnConnection,

    -- * Request Lenses
    modifyVpnConnection_customerGatewayId,
    modifyVpnConnection_dryRun,
    modifyVpnConnection_transitGatewayId,
    modifyVpnConnection_vpnGatewayId,
    modifyVpnConnection_vpnConnectionId,

    -- * Destructuring the Response
    ModifyVpnConnectionResponse (..),
    newModifyVpnConnectionResponse,

    -- * Response Lenses
    modifyVpnConnectionResponse_vpnConnection,
    modifyVpnConnectionResponse_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:/ 'newModifyVpnConnection' smart constructor.
data ModifyVpnConnection = ModifyVpnConnection'
  { -- | The ID of the customer gateway at your end of the VPN connection.
    ModifyVpnConnection -> Maybe Text
customerGatewayId :: 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@.
    ModifyVpnConnection -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the transit gateway.
    ModifyVpnConnection -> Maybe Text
transitGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the virtual private gateway at the Amazon Web Services side of
    -- the VPN connection.
    ModifyVpnConnection -> Maybe Text
vpnGatewayId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the VPN connection.
    ModifyVpnConnection -> Text
vpnConnectionId :: Prelude.Text
  }
  deriving (ModifyVpnConnection -> ModifyVpnConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpnConnection -> ModifyVpnConnection -> Bool
$c/= :: ModifyVpnConnection -> ModifyVpnConnection -> Bool
== :: ModifyVpnConnection -> ModifyVpnConnection -> Bool
$c== :: ModifyVpnConnection -> ModifyVpnConnection -> Bool
Prelude.Eq, ReadPrec [ModifyVpnConnection]
ReadPrec ModifyVpnConnection
Int -> ReadS ModifyVpnConnection
ReadS [ModifyVpnConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpnConnection]
$creadListPrec :: ReadPrec [ModifyVpnConnection]
readPrec :: ReadPrec ModifyVpnConnection
$creadPrec :: ReadPrec ModifyVpnConnection
readList :: ReadS [ModifyVpnConnection]
$creadList :: ReadS [ModifyVpnConnection]
readsPrec :: Int -> ReadS ModifyVpnConnection
$creadsPrec :: Int -> ReadS ModifyVpnConnection
Prelude.Read, Int -> ModifyVpnConnection -> ShowS
[ModifyVpnConnection] -> ShowS
ModifyVpnConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpnConnection] -> ShowS
$cshowList :: [ModifyVpnConnection] -> ShowS
show :: ModifyVpnConnection -> String
$cshow :: ModifyVpnConnection -> String
showsPrec :: Int -> ModifyVpnConnection -> ShowS
$cshowsPrec :: Int -> ModifyVpnConnection -> ShowS
Prelude.Show, forall x. Rep ModifyVpnConnection x -> ModifyVpnConnection
forall x. ModifyVpnConnection -> Rep ModifyVpnConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyVpnConnection x -> ModifyVpnConnection
$cfrom :: forall x. ModifyVpnConnection -> Rep ModifyVpnConnection x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpnConnection' 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:
--
-- 'customerGatewayId', 'modifyVpnConnection_customerGatewayId' - The ID of the customer gateway at your end of the VPN connection.
--
-- 'dryRun', 'modifyVpnConnection_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@.
--
-- 'transitGatewayId', 'modifyVpnConnection_transitGatewayId' - The ID of the transit gateway.
--
-- 'vpnGatewayId', 'modifyVpnConnection_vpnGatewayId' - The ID of the virtual private gateway at the Amazon Web Services side of
-- the VPN connection.
--
-- 'vpnConnectionId', 'modifyVpnConnection_vpnConnectionId' - The ID of the VPN connection.
newModifyVpnConnection ::
  -- | 'vpnConnectionId'
  Prelude.Text ->
  ModifyVpnConnection
newModifyVpnConnection :: Text -> ModifyVpnConnection
newModifyVpnConnection Text
pVpnConnectionId_ =
  ModifyVpnConnection'
    { $sel:customerGatewayId:ModifyVpnConnection' :: Maybe Text
customerGatewayId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyVpnConnection' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:transitGatewayId:ModifyVpnConnection' :: Maybe Text
transitGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpnGatewayId:ModifyVpnConnection' :: Maybe Text
vpnGatewayId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpnConnectionId:ModifyVpnConnection' :: Text
vpnConnectionId = Text
pVpnConnectionId_
    }

-- | The ID of the customer gateway at your end of the VPN connection.
modifyVpnConnection_customerGatewayId :: Lens.Lens' ModifyVpnConnection (Prelude.Maybe Prelude.Text)
modifyVpnConnection_customerGatewayId :: Lens' ModifyVpnConnection (Maybe Text)
modifyVpnConnection_customerGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnection' {Maybe Text
customerGatewayId :: Maybe Text
$sel:customerGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
customerGatewayId} -> Maybe Text
customerGatewayId) (\s :: ModifyVpnConnection
s@ModifyVpnConnection' {} Maybe Text
a -> ModifyVpnConnection
s {$sel:customerGatewayId:ModifyVpnConnection' :: Maybe Text
customerGatewayId = Maybe Text
a} :: ModifyVpnConnection)

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

-- | The ID of the transit gateway.
modifyVpnConnection_transitGatewayId :: Lens.Lens' ModifyVpnConnection (Prelude.Maybe Prelude.Text)
modifyVpnConnection_transitGatewayId :: Lens' ModifyVpnConnection (Maybe Text)
modifyVpnConnection_transitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnection' {Maybe Text
transitGatewayId :: Maybe Text
$sel:transitGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
transitGatewayId} -> Maybe Text
transitGatewayId) (\s :: ModifyVpnConnection
s@ModifyVpnConnection' {} Maybe Text
a -> ModifyVpnConnection
s {$sel:transitGatewayId:ModifyVpnConnection' :: Maybe Text
transitGatewayId = Maybe Text
a} :: ModifyVpnConnection)

-- | The ID of the virtual private gateway at the Amazon Web Services side of
-- the VPN connection.
modifyVpnConnection_vpnGatewayId :: Lens.Lens' ModifyVpnConnection (Prelude.Maybe Prelude.Text)
modifyVpnConnection_vpnGatewayId :: Lens' ModifyVpnConnection (Maybe Text)
modifyVpnConnection_vpnGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnection' {Maybe Text
vpnGatewayId :: Maybe Text
$sel:vpnGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
vpnGatewayId} -> Maybe Text
vpnGatewayId) (\s :: ModifyVpnConnection
s@ModifyVpnConnection' {} Maybe Text
a -> ModifyVpnConnection
s {$sel:vpnGatewayId:ModifyVpnConnection' :: Maybe Text
vpnGatewayId = Maybe Text
a} :: ModifyVpnConnection)

-- | The ID of the VPN connection.
modifyVpnConnection_vpnConnectionId :: Lens.Lens' ModifyVpnConnection Prelude.Text
modifyVpnConnection_vpnConnectionId :: Lens' ModifyVpnConnection Text
modifyVpnConnection_vpnConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnection' {Text
vpnConnectionId :: Text
$sel:vpnConnectionId:ModifyVpnConnection' :: ModifyVpnConnection -> Text
vpnConnectionId} -> Text
vpnConnectionId) (\s :: ModifyVpnConnection
s@ModifyVpnConnection' {} Text
a -> ModifyVpnConnection
s {$sel:vpnConnectionId:ModifyVpnConnection' :: Text
vpnConnectionId = Text
a} :: ModifyVpnConnection)

instance Core.AWSRequest ModifyVpnConnection where
  type
    AWSResponse ModifyVpnConnection =
      ModifyVpnConnectionResponse
  request :: (Service -> Service)
-> ModifyVpnConnection -> Request ModifyVpnConnection
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 ModifyVpnConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyVpnConnection)))
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 -> ModifyVpnConnectionResponse
ModifyVpnConnectionResponse'
            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 ModifyVpnConnection where
  hashWithSalt :: Int -> ModifyVpnConnection -> Int
hashWithSalt Int
_salt ModifyVpnConnection' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
dryRun :: Maybe Bool
customerGatewayId :: Maybe Text
$sel:vpnConnectionId:ModifyVpnConnection' :: ModifyVpnConnection -> Text
$sel:vpnGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:transitGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:dryRun:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Bool
$sel:customerGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customerGatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      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
vpnConnectionId

instance Prelude.NFData ModifyVpnConnection where
  rnf :: ModifyVpnConnection -> ()
rnf ModifyVpnConnection' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
dryRun :: Maybe Bool
customerGatewayId :: Maybe Text
$sel:vpnConnectionId:ModifyVpnConnection' :: ModifyVpnConnection -> Text
$sel:vpnGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:transitGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:dryRun:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Bool
$sel:customerGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customerGatewayId
      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
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
vpnConnectionId

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

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

instance Data.ToQuery ModifyVpnConnection where
  toQuery :: ModifyVpnConnection -> QueryString
toQuery ModifyVpnConnection' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
vpnGatewayId :: Maybe Text
transitGatewayId :: Maybe Text
dryRun :: Maybe Bool
customerGatewayId :: Maybe Text
$sel:vpnConnectionId:ModifyVpnConnection' :: ModifyVpnConnection -> Text
$sel:vpnGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:transitGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
$sel:dryRun:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Bool
$sel:customerGatewayId:ModifyVpnConnection' :: ModifyVpnConnection -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyVpnConnection" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"CustomerGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
customerGatewayId,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        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
"VpnConnectionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpnConnectionId
      ]

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

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

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

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

instance Prelude.NFData ModifyVpnConnectionResponse where
  rnf :: ModifyVpnConnectionResponse -> ()
rnf ModifyVpnConnectionResponse' {Int
Maybe VpnConnection
httpStatus :: Int
vpnConnection :: Maybe VpnConnection
$sel:httpStatus:ModifyVpnConnectionResponse' :: ModifyVpnConnectionResponse -> Int
$sel:vpnConnection:ModifyVpnConnectionResponse' :: ModifyVpnConnectionResponse -> 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