{-# 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.ModifyVpnConnectionOptions
-- 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 connection options for your Site-to-Site VPN connection.
--
-- When you modify the VPN connection options, the VPN endpoint IP
-- addresses on the Amazon Web Services side do not change, and the tunnel
-- options do not change. Your VPN connection will be temporarily
-- unavailable for a brief period while the VPN connection is updated.
module Amazonka.EC2.ModifyVpnConnectionOptions
  ( -- * Creating a Request
    ModifyVpnConnectionOptions (..),
    newModifyVpnConnectionOptions,

    -- * Request Lenses
    modifyVpnConnectionOptions_dryRun,
    modifyVpnConnectionOptions_localIpv4NetworkCidr,
    modifyVpnConnectionOptions_localIpv6NetworkCidr,
    modifyVpnConnectionOptions_remoteIpv4NetworkCidr,
    modifyVpnConnectionOptions_remoteIpv6NetworkCidr,
    modifyVpnConnectionOptions_vpnConnectionId,

    -- * Destructuring the Response
    ModifyVpnConnectionOptionsResponse (..),
    newModifyVpnConnectionOptionsResponse,

    -- * Response Lenses
    modifyVpnConnectionOptionsResponse_vpnConnection,
    modifyVpnConnectionOptionsResponse_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:/ 'newModifyVpnConnectionOptions' smart constructor.
data ModifyVpnConnectionOptions = ModifyVpnConnectionOptions'
  { -- | 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@.
    ModifyVpnConnectionOptions -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The IPv4 CIDR on the customer gateway (on-premises) side of the VPN
    -- connection.
    --
    -- Default: @0.0.0.0\/0@
    ModifyVpnConnectionOptions -> Maybe Text
localIpv4NetworkCidr :: Prelude.Maybe Prelude.Text,
    -- | The IPv6 CIDR on the customer gateway (on-premises) side of the VPN
    -- connection.
    --
    -- Default: @::\/0@
    ModifyVpnConnectionOptions -> Maybe Text
localIpv6NetworkCidr :: Prelude.Maybe Prelude.Text,
    -- | The IPv4 CIDR on the Amazon Web Services side of the VPN connection.
    --
    -- Default: @0.0.0.0\/0@
    ModifyVpnConnectionOptions -> Maybe Text
remoteIpv4NetworkCidr :: Prelude.Maybe Prelude.Text,
    -- | The IPv6 CIDR on the Amazon Web Services side of the VPN connection.
    --
    -- Default: @::\/0@
    ModifyVpnConnectionOptions -> Maybe Text
remoteIpv6NetworkCidr :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Site-to-Site VPN connection.
    ModifyVpnConnectionOptions -> Text
vpnConnectionId :: Prelude.Text
  }
  deriving (ModifyVpnConnectionOptions -> ModifyVpnConnectionOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpnConnectionOptions -> ModifyVpnConnectionOptions -> Bool
$c/= :: ModifyVpnConnectionOptions -> ModifyVpnConnectionOptions -> Bool
== :: ModifyVpnConnectionOptions -> ModifyVpnConnectionOptions -> Bool
$c== :: ModifyVpnConnectionOptions -> ModifyVpnConnectionOptions -> Bool
Prelude.Eq, ReadPrec [ModifyVpnConnectionOptions]
ReadPrec ModifyVpnConnectionOptions
Int -> ReadS ModifyVpnConnectionOptions
ReadS [ModifyVpnConnectionOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpnConnectionOptions]
$creadListPrec :: ReadPrec [ModifyVpnConnectionOptions]
readPrec :: ReadPrec ModifyVpnConnectionOptions
$creadPrec :: ReadPrec ModifyVpnConnectionOptions
readList :: ReadS [ModifyVpnConnectionOptions]
$creadList :: ReadS [ModifyVpnConnectionOptions]
readsPrec :: Int -> ReadS ModifyVpnConnectionOptions
$creadsPrec :: Int -> ReadS ModifyVpnConnectionOptions
Prelude.Read, Int -> ModifyVpnConnectionOptions -> ShowS
[ModifyVpnConnectionOptions] -> ShowS
ModifyVpnConnectionOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpnConnectionOptions] -> ShowS
$cshowList :: [ModifyVpnConnectionOptions] -> ShowS
show :: ModifyVpnConnectionOptions -> String
$cshow :: ModifyVpnConnectionOptions -> String
showsPrec :: Int -> ModifyVpnConnectionOptions -> ShowS
$cshowsPrec :: Int -> ModifyVpnConnectionOptions -> ShowS
Prelude.Show, forall x.
Rep ModifyVpnConnectionOptions x -> ModifyVpnConnectionOptions
forall x.
ModifyVpnConnectionOptions -> Rep ModifyVpnConnectionOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyVpnConnectionOptions x -> ModifyVpnConnectionOptions
$cfrom :: forall x.
ModifyVpnConnectionOptions -> Rep ModifyVpnConnectionOptions x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpnConnectionOptions' 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', 'modifyVpnConnectionOptions_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@.
--
-- 'localIpv4NetworkCidr', 'modifyVpnConnectionOptions_localIpv4NetworkCidr' - The IPv4 CIDR on the customer gateway (on-premises) side of the VPN
-- connection.
--
-- Default: @0.0.0.0\/0@
--
-- 'localIpv6NetworkCidr', 'modifyVpnConnectionOptions_localIpv6NetworkCidr' - The IPv6 CIDR on the customer gateway (on-premises) side of the VPN
-- connection.
--
-- Default: @::\/0@
--
-- 'remoteIpv4NetworkCidr', 'modifyVpnConnectionOptions_remoteIpv4NetworkCidr' - The IPv4 CIDR on the Amazon Web Services side of the VPN connection.
--
-- Default: @0.0.0.0\/0@
--
-- 'remoteIpv6NetworkCidr', 'modifyVpnConnectionOptions_remoteIpv6NetworkCidr' - The IPv6 CIDR on the Amazon Web Services side of the VPN connection.
--
-- Default: @::\/0@
--
-- 'vpnConnectionId', 'modifyVpnConnectionOptions_vpnConnectionId' - The ID of the Site-to-Site VPN connection.
newModifyVpnConnectionOptions ::
  -- | 'vpnConnectionId'
  Prelude.Text ->
  ModifyVpnConnectionOptions
newModifyVpnConnectionOptions :: Text -> ModifyVpnConnectionOptions
newModifyVpnConnectionOptions Text
pVpnConnectionId_ =
  ModifyVpnConnectionOptions'
    { $sel:dryRun:ModifyVpnConnectionOptions' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
localIpv4NetworkCidr = forall a. Maybe a
Prelude.Nothing,
      $sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
localIpv6NetworkCidr = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
remoteIpv4NetworkCidr = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
remoteIpv6NetworkCidr = forall a. Maybe a
Prelude.Nothing,
      $sel:vpnConnectionId:ModifyVpnConnectionOptions' :: Text
vpnConnectionId = Text
pVpnConnectionId_
    }

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

-- | The IPv4 CIDR on the customer gateway (on-premises) side of the VPN
-- connection.
--
-- Default: @0.0.0.0\/0@
modifyVpnConnectionOptions_localIpv4NetworkCidr :: Lens.Lens' ModifyVpnConnectionOptions (Prelude.Maybe Prelude.Text)
modifyVpnConnectionOptions_localIpv4NetworkCidr :: Lens' ModifyVpnConnectionOptions (Maybe Text)
modifyVpnConnectionOptions_localIpv4NetworkCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnectionOptions' {Maybe Text
localIpv4NetworkCidr :: Maybe Text
$sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
localIpv4NetworkCidr} -> Maybe Text
localIpv4NetworkCidr) (\s :: ModifyVpnConnectionOptions
s@ModifyVpnConnectionOptions' {} Maybe Text
a -> ModifyVpnConnectionOptions
s {$sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
localIpv4NetworkCidr = Maybe Text
a} :: ModifyVpnConnectionOptions)

-- | The IPv6 CIDR on the customer gateway (on-premises) side of the VPN
-- connection.
--
-- Default: @::\/0@
modifyVpnConnectionOptions_localIpv6NetworkCidr :: Lens.Lens' ModifyVpnConnectionOptions (Prelude.Maybe Prelude.Text)
modifyVpnConnectionOptions_localIpv6NetworkCidr :: Lens' ModifyVpnConnectionOptions (Maybe Text)
modifyVpnConnectionOptions_localIpv6NetworkCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnectionOptions' {Maybe Text
localIpv6NetworkCidr :: Maybe Text
$sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
localIpv6NetworkCidr} -> Maybe Text
localIpv6NetworkCidr) (\s :: ModifyVpnConnectionOptions
s@ModifyVpnConnectionOptions' {} Maybe Text
a -> ModifyVpnConnectionOptions
s {$sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
localIpv6NetworkCidr = Maybe Text
a} :: ModifyVpnConnectionOptions)

-- | The IPv4 CIDR on the Amazon Web Services side of the VPN connection.
--
-- Default: @0.0.0.0\/0@
modifyVpnConnectionOptions_remoteIpv4NetworkCidr :: Lens.Lens' ModifyVpnConnectionOptions (Prelude.Maybe Prelude.Text)
modifyVpnConnectionOptions_remoteIpv4NetworkCidr :: Lens' ModifyVpnConnectionOptions (Maybe Text)
modifyVpnConnectionOptions_remoteIpv4NetworkCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnectionOptions' {Maybe Text
remoteIpv4NetworkCidr :: Maybe Text
$sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
remoteIpv4NetworkCidr} -> Maybe Text
remoteIpv4NetworkCidr) (\s :: ModifyVpnConnectionOptions
s@ModifyVpnConnectionOptions' {} Maybe Text
a -> ModifyVpnConnectionOptions
s {$sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
remoteIpv4NetworkCidr = Maybe Text
a} :: ModifyVpnConnectionOptions)

-- | The IPv6 CIDR on the Amazon Web Services side of the VPN connection.
--
-- Default: @::\/0@
modifyVpnConnectionOptions_remoteIpv6NetworkCidr :: Lens.Lens' ModifyVpnConnectionOptions (Prelude.Maybe Prelude.Text)
modifyVpnConnectionOptions_remoteIpv6NetworkCidr :: Lens' ModifyVpnConnectionOptions (Maybe Text)
modifyVpnConnectionOptions_remoteIpv6NetworkCidr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpnConnectionOptions' {Maybe Text
remoteIpv6NetworkCidr :: Maybe Text
$sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
remoteIpv6NetworkCidr} -> Maybe Text
remoteIpv6NetworkCidr) (\s :: ModifyVpnConnectionOptions
s@ModifyVpnConnectionOptions' {} Maybe Text
a -> ModifyVpnConnectionOptions
s {$sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: Maybe Text
remoteIpv6NetworkCidr = Maybe Text
a} :: ModifyVpnConnectionOptions)

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

instance Core.AWSRequest ModifyVpnConnectionOptions where
  type
    AWSResponse ModifyVpnConnectionOptions =
      ModifyVpnConnectionOptionsResponse
  request :: (Service -> Service)
-> ModifyVpnConnectionOptions -> Request ModifyVpnConnectionOptions
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 ModifyVpnConnectionOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyVpnConnectionOptions)))
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 -> ModifyVpnConnectionOptionsResponse
ModifyVpnConnectionOptionsResponse'
            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 ModifyVpnConnectionOptions where
  hashWithSalt :: Int -> ModifyVpnConnectionOptions -> Int
hashWithSalt Int
_salt ModifyVpnConnectionOptions' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
remoteIpv6NetworkCidr :: Maybe Text
remoteIpv4NetworkCidr :: Maybe Text
localIpv6NetworkCidr :: Maybe Text
localIpv4NetworkCidr :: Maybe Text
dryRun :: Maybe Bool
$sel:vpnConnectionId:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Text
$sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:dryRun:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> 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 Text
localIpv4NetworkCidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
localIpv6NetworkCidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
remoteIpv4NetworkCidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
remoteIpv6NetworkCidr
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpnConnectionId

instance Prelude.NFData ModifyVpnConnectionOptions where
  rnf :: ModifyVpnConnectionOptions -> ()
rnf ModifyVpnConnectionOptions' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
remoteIpv6NetworkCidr :: Maybe Text
remoteIpv4NetworkCidr :: Maybe Text
localIpv6NetworkCidr :: Maybe Text
localIpv4NetworkCidr :: Maybe Text
dryRun :: Maybe Bool
$sel:vpnConnectionId:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Text
$sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:dryRun:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> 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 Text
localIpv4NetworkCidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localIpv6NetworkCidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
remoteIpv4NetworkCidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
remoteIpv6NetworkCidr
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpnConnectionId

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

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

instance Data.ToQuery ModifyVpnConnectionOptions where
  toQuery :: ModifyVpnConnectionOptions -> QueryString
toQuery ModifyVpnConnectionOptions' {Maybe Bool
Maybe Text
Text
vpnConnectionId :: Text
remoteIpv6NetworkCidr :: Maybe Text
remoteIpv4NetworkCidr :: Maybe Text
localIpv6NetworkCidr :: Maybe Text
localIpv4NetworkCidr :: Maybe Text
dryRun :: Maybe Bool
$sel:vpnConnectionId:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Text
$sel:remoteIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:remoteIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv6NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:localIpv4NetworkCidr:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Text
$sel:dryRun:ModifyVpnConnectionOptions' :: ModifyVpnConnectionOptions -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyVpnConnectionOptions" :: 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
"LocalIpv4NetworkCidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
localIpv4NetworkCidr,
        ByteString
"LocalIpv6NetworkCidr" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
localIpv6NetworkCidr,
        ByteString
"RemoteIpv4NetworkCidr"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
remoteIpv4NetworkCidr,
        ByteString
"RemoteIpv6NetworkCidr"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
remoteIpv6NetworkCidr,
        ByteString
"VpnConnectionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpnConnectionId
      ]

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

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

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

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

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