{-# 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.DeleteVpnConnectionRoute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified static route associated with a VPN connection
-- between an existing virtual private gateway and a VPN customer gateway.
-- The static route allows traffic to be routed from the virtual private
-- gateway to the VPN customer gateway.
module Amazonka.EC2.DeleteVpnConnectionRoute
  ( -- * Creating a Request
    DeleteVpnConnectionRoute (..),
    newDeleteVpnConnectionRoute,

    -- * Request Lenses
    deleteVpnConnectionRoute_destinationCidrBlock,
    deleteVpnConnectionRoute_vpnConnectionId,

    -- * Destructuring the Response
    DeleteVpnConnectionRouteResponse (..),
    newDeleteVpnConnectionRouteResponse,
  )
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 DeleteVpnConnectionRoute.
--
-- /See:/ 'newDeleteVpnConnectionRoute' smart constructor.
data DeleteVpnConnectionRoute = DeleteVpnConnectionRoute'
  { -- | The CIDR block associated with the local subnet of the customer network.
    DeleteVpnConnectionRoute -> Text
destinationCidrBlock :: Prelude.Text,
    -- | The ID of the VPN connection.
    DeleteVpnConnectionRoute -> Text
vpnConnectionId :: Prelude.Text
  }
  deriving (DeleteVpnConnectionRoute -> DeleteVpnConnectionRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteVpnConnectionRoute -> DeleteVpnConnectionRoute -> Bool
$c/= :: DeleteVpnConnectionRoute -> DeleteVpnConnectionRoute -> Bool
== :: DeleteVpnConnectionRoute -> DeleteVpnConnectionRoute -> Bool
$c== :: DeleteVpnConnectionRoute -> DeleteVpnConnectionRoute -> Bool
Prelude.Eq, ReadPrec [DeleteVpnConnectionRoute]
ReadPrec DeleteVpnConnectionRoute
Int -> ReadS DeleteVpnConnectionRoute
ReadS [DeleteVpnConnectionRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteVpnConnectionRoute]
$creadListPrec :: ReadPrec [DeleteVpnConnectionRoute]
readPrec :: ReadPrec DeleteVpnConnectionRoute
$creadPrec :: ReadPrec DeleteVpnConnectionRoute
readList :: ReadS [DeleteVpnConnectionRoute]
$creadList :: ReadS [DeleteVpnConnectionRoute]
readsPrec :: Int -> ReadS DeleteVpnConnectionRoute
$creadsPrec :: Int -> ReadS DeleteVpnConnectionRoute
Prelude.Read, Int -> DeleteVpnConnectionRoute -> ShowS
[DeleteVpnConnectionRoute] -> ShowS
DeleteVpnConnectionRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteVpnConnectionRoute] -> ShowS
$cshowList :: [DeleteVpnConnectionRoute] -> ShowS
show :: DeleteVpnConnectionRoute -> String
$cshow :: DeleteVpnConnectionRoute -> String
showsPrec :: Int -> DeleteVpnConnectionRoute -> ShowS
$cshowsPrec :: Int -> DeleteVpnConnectionRoute -> ShowS
Prelude.Show, forall x.
Rep DeleteVpnConnectionRoute x -> DeleteVpnConnectionRoute
forall x.
DeleteVpnConnectionRoute -> Rep DeleteVpnConnectionRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteVpnConnectionRoute x -> DeleteVpnConnectionRoute
$cfrom :: forall x.
DeleteVpnConnectionRoute -> Rep DeleteVpnConnectionRoute x
Prelude.Generic)

-- |
-- Create a value of 'DeleteVpnConnectionRoute' 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:
--
-- 'destinationCidrBlock', 'deleteVpnConnectionRoute_destinationCidrBlock' - The CIDR block associated with the local subnet of the customer network.
--
-- 'vpnConnectionId', 'deleteVpnConnectionRoute_vpnConnectionId' - The ID of the VPN connection.
newDeleteVpnConnectionRoute ::
  -- | 'destinationCidrBlock'
  Prelude.Text ->
  -- | 'vpnConnectionId'
  Prelude.Text ->
  DeleteVpnConnectionRoute
newDeleteVpnConnectionRoute :: Text -> Text -> DeleteVpnConnectionRoute
newDeleteVpnConnectionRoute
  Text
pDestinationCidrBlock_
  Text
pVpnConnectionId_ =
    DeleteVpnConnectionRoute'
      { $sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: Text
destinationCidrBlock =
          Text
pDestinationCidrBlock_,
        $sel:vpnConnectionId:DeleteVpnConnectionRoute' :: Text
vpnConnectionId = Text
pVpnConnectionId_
      }

-- | The CIDR block associated with the local subnet of the customer network.
deleteVpnConnectionRoute_destinationCidrBlock :: Lens.Lens' DeleteVpnConnectionRoute Prelude.Text
deleteVpnConnectionRoute_destinationCidrBlock :: Lens' DeleteVpnConnectionRoute Text
deleteVpnConnectionRoute_destinationCidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteVpnConnectionRoute' {Text
destinationCidrBlock :: Text
$sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
destinationCidrBlock} -> Text
destinationCidrBlock) (\s :: DeleteVpnConnectionRoute
s@DeleteVpnConnectionRoute' {} Text
a -> DeleteVpnConnectionRoute
s {$sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: Text
destinationCidrBlock = Text
a} :: DeleteVpnConnectionRoute)

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

instance Core.AWSRequest DeleteVpnConnectionRoute where
  type
    AWSResponse DeleteVpnConnectionRoute =
      DeleteVpnConnectionRouteResponse
  request :: (Service -> Service)
-> DeleteVpnConnectionRoute -> Request DeleteVpnConnectionRoute
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 DeleteVpnConnectionRoute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteVpnConnectionRoute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteVpnConnectionRouteResponse
DeleteVpnConnectionRouteResponse'

instance Prelude.Hashable DeleteVpnConnectionRoute where
  hashWithSalt :: Int -> DeleteVpnConnectionRoute -> Int
hashWithSalt Int
_salt DeleteVpnConnectionRoute' {Text
vpnConnectionId :: Text
destinationCidrBlock :: Text
$sel:vpnConnectionId:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
$sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationCidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpnConnectionId

instance Prelude.NFData DeleteVpnConnectionRoute where
  rnf :: DeleteVpnConnectionRoute -> ()
rnf DeleteVpnConnectionRoute' {Text
vpnConnectionId :: Text
destinationCidrBlock :: Text
$sel:vpnConnectionId:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
$sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
destinationCidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpnConnectionId

instance Data.ToHeaders DeleteVpnConnectionRoute where
  toHeaders :: DeleteVpnConnectionRoute -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteVpnConnectionRoute where
  toQuery :: DeleteVpnConnectionRoute -> QueryString
toQuery DeleteVpnConnectionRoute' {Text
vpnConnectionId :: Text
destinationCidrBlock :: Text
$sel:vpnConnectionId:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
$sel:destinationCidrBlock:DeleteVpnConnectionRoute' :: DeleteVpnConnectionRoute -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteVpnConnectionRoute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DestinationCidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
destinationCidrBlock,
        ByteString
"VpnConnectionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpnConnectionId
      ]

-- | /See:/ 'newDeleteVpnConnectionRouteResponse' smart constructor.
data DeleteVpnConnectionRouteResponse = DeleteVpnConnectionRouteResponse'
  {
  }
  deriving (DeleteVpnConnectionRouteResponse
-> DeleteVpnConnectionRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteVpnConnectionRouteResponse
-> DeleteVpnConnectionRouteResponse -> Bool
$c/= :: DeleteVpnConnectionRouteResponse
-> DeleteVpnConnectionRouteResponse -> Bool
== :: DeleteVpnConnectionRouteResponse
-> DeleteVpnConnectionRouteResponse -> Bool
$c== :: DeleteVpnConnectionRouteResponse
-> DeleteVpnConnectionRouteResponse -> Bool
Prelude.Eq, ReadPrec [DeleteVpnConnectionRouteResponse]
ReadPrec DeleteVpnConnectionRouteResponse
Int -> ReadS DeleteVpnConnectionRouteResponse
ReadS [DeleteVpnConnectionRouteResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteVpnConnectionRouteResponse]
$creadListPrec :: ReadPrec [DeleteVpnConnectionRouteResponse]
readPrec :: ReadPrec DeleteVpnConnectionRouteResponse
$creadPrec :: ReadPrec DeleteVpnConnectionRouteResponse
readList :: ReadS [DeleteVpnConnectionRouteResponse]
$creadList :: ReadS [DeleteVpnConnectionRouteResponse]
readsPrec :: Int -> ReadS DeleteVpnConnectionRouteResponse
$creadsPrec :: Int -> ReadS DeleteVpnConnectionRouteResponse
Prelude.Read, Int -> DeleteVpnConnectionRouteResponse -> ShowS
[DeleteVpnConnectionRouteResponse] -> ShowS
DeleteVpnConnectionRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteVpnConnectionRouteResponse] -> ShowS
$cshowList :: [DeleteVpnConnectionRouteResponse] -> ShowS
show :: DeleteVpnConnectionRouteResponse -> String
$cshow :: DeleteVpnConnectionRouteResponse -> String
showsPrec :: Int -> DeleteVpnConnectionRouteResponse -> ShowS
$cshowsPrec :: Int -> DeleteVpnConnectionRouteResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteVpnConnectionRouteResponse x
-> DeleteVpnConnectionRouteResponse
forall x.
DeleteVpnConnectionRouteResponse
-> Rep DeleteVpnConnectionRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteVpnConnectionRouteResponse x
-> DeleteVpnConnectionRouteResponse
$cfrom :: forall x.
DeleteVpnConnectionRouteResponse
-> Rep DeleteVpnConnectionRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteVpnConnectionRouteResponse' 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.
newDeleteVpnConnectionRouteResponse ::
  DeleteVpnConnectionRouteResponse
newDeleteVpnConnectionRouteResponse :: DeleteVpnConnectionRouteResponse
newDeleteVpnConnectionRouteResponse =
  DeleteVpnConnectionRouteResponse
DeleteVpnConnectionRouteResponse'

instance
  Prelude.NFData
    DeleteVpnConnectionRouteResponse
  where
  rnf :: DeleteVpnConnectionRouteResponse -> ()
rnf DeleteVpnConnectionRouteResponse
_ = ()