{-# 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.DeleteLocalGatewayRoute
-- 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 route from the specified local gateway route
-- table.
module Amazonka.EC2.DeleteLocalGatewayRoute
  ( -- * Creating a Request
    DeleteLocalGatewayRoute (..),
    newDeleteLocalGatewayRoute,

    -- * Request Lenses
    deleteLocalGatewayRoute_dryRun,
    deleteLocalGatewayRoute_destinationCidrBlock,
    deleteLocalGatewayRoute_localGatewayRouteTableId,

    -- * Destructuring the Response
    DeleteLocalGatewayRouteResponse (..),
    newDeleteLocalGatewayRouteResponse,

    -- * Response Lenses
    deleteLocalGatewayRouteResponse_route,
    deleteLocalGatewayRouteResponse_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:/ 'newDeleteLocalGatewayRoute' smart constructor.
data DeleteLocalGatewayRoute = DeleteLocalGatewayRoute'
  { -- | 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@.
    DeleteLocalGatewayRoute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The CIDR range for the route. This must match the CIDR for the route
    -- exactly.
    DeleteLocalGatewayRoute -> Text
destinationCidrBlock :: Prelude.Text,
    -- | The ID of the local gateway route table.
    DeleteLocalGatewayRoute -> Text
localGatewayRouteTableId :: Prelude.Text
  }
  deriving (DeleteLocalGatewayRoute -> DeleteLocalGatewayRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteLocalGatewayRoute -> DeleteLocalGatewayRoute -> Bool
$c/= :: DeleteLocalGatewayRoute -> DeleteLocalGatewayRoute -> Bool
== :: DeleteLocalGatewayRoute -> DeleteLocalGatewayRoute -> Bool
$c== :: DeleteLocalGatewayRoute -> DeleteLocalGatewayRoute -> Bool
Prelude.Eq, ReadPrec [DeleteLocalGatewayRoute]
ReadPrec DeleteLocalGatewayRoute
Int -> ReadS DeleteLocalGatewayRoute
ReadS [DeleteLocalGatewayRoute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteLocalGatewayRoute]
$creadListPrec :: ReadPrec [DeleteLocalGatewayRoute]
readPrec :: ReadPrec DeleteLocalGatewayRoute
$creadPrec :: ReadPrec DeleteLocalGatewayRoute
readList :: ReadS [DeleteLocalGatewayRoute]
$creadList :: ReadS [DeleteLocalGatewayRoute]
readsPrec :: Int -> ReadS DeleteLocalGatewayRoute
$creadsPrec :: Int -> ReadS DeleteLocalGatewayRoute
Prelude.Read, Int -> DeleteLocalGatewayRoute -> ShowS
[DeleteLocalGatewayRoute] -> ShowS
DeleteLocalGatewayRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteLocalGatewayRoute] -> ShowS
$cshowList :: [DeleteLocalGatewayRoute] -> ShowS
show :: DeleteLocalGatewayRoute -> String
$cshow :: DeleteLocalGatewayRoute -> String
showsPrec :: Int -> DeleteLocalGatewayRoute -> ShowS
$cshowsPrec :: Int -> DeleteLocalGatewayRoute -> ShowS
Prelude.Show, forall x. Rep DeleteLocalGatewayRoute x -> DeleteLocalGatewayRoute
forall x. DeleteLocalGatewayRoute -> Rep DeleteLocalGatewayRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteLocalGatewayRoute x -> DeleteLocalGatewayRoute
$cfrom :: forall x. DeleteLocalGatewayRoute -> Rep DeleteLocalGatewayRoute x
Prelude.Generic)

-- |
-- Create a value of 'DeleteLocalGatewayRoute' 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', 'deleteLocalGatewayRoute_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@.
--
-- 'destinationCidrBlock', 'deleteLocalGatewayRoute_destinationCidrBlock' - The CIDR range for the route. This must match the CIDR for the route
-- exactly.
--
-- 'localGatewayRouteTableId', 'deleteLocalGatewayRoute_localGatewayRouteTableId' - The ID of the local gateway route table.
newDeleteLocalGatewayRoute ::
  -- | 'destinationCidrBlock'
  Prelude.Text ->
  -- | 'localGatewayRouteTableId'
  Prelude.Text ->
  DeleteLocalGatewayRoute
newDeleteLocalGatewayRoute :: Text -> Text -> DeleteLocalGatewayRoute
newDeleteLocalGatewayRoute
  Text
pDestinationCidrBlock_
  Text
pLocalGatewayRouteTableId_ =
    DeleteLocalGatewayRoute'
      { $sel:dryRun:DeleteLocalGatewayRoute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: Text
destinationCidrBlock = Text
pDestinationCidrBlock_,
        $sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: Text
localGatewayRouteTableId =
          Text
pLocalGatewayRouteTableId_
      }

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

-- | The CIDR range for the route. This must match the CIDR for the route
-- exactly.
deleteLocalGatewayRoute_destinationCidrBlock :: Lens.Lens' DeleteLocalGatewayRoute Prelude.Text
deleteLocalGatewayRoute_destinationCidrBlock :: Lens' DeleteLocalGatewayRoute Text
deleteLocalGatewayRoute_destinationCidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLocalGatewayRoute' {Text
destinationCidrBlock :: Text
$sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
destinationCidrBlock} -> Text
destinationCidrBlock) (\s :: DeleteLocalGatewayRoute
s@DeleteLocalGatewayRoute' {} Text
a -> DeleteLocalGatewayRoute
s {$sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: Text
destinationCidrBlock = Text
a} :: DeleteLocalGatewayRoute)

-- | The ID of the local gateway route table.
deleteLocalGatewayRoute_localGatewayRouteTableId :: Lens.Lens' DeleteLocalGatewayRoute Prelude.Text
deleteLocalGatewayRoute_localGatewayRouteTableId :: Lens' DeleteLocalGatewayRoute Text
deleteLocalGatewayRoute_localGatewayRouteTableId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLocalGatewayRoute' {Text
localGatewayRouteTableId :: Text
$sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
localGatewayRouteTableId} -> Text
localGatewayRouteTableId) (\s :: DeleteLocalGatewayRoute
s@DeleteLocalGatewayRoute' {} Text
a -> DeleteLocalGatewayRoute
s {$sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: Text
localGatewayRouteTableId = Text
a} :: DeleteLocalGatewayRoute)

instance Core.AWSRequest DeleteLocalGatewayRoute where
  type
    AWSResponse DeleteLocalGatewayRoute =
      DeleteLocalGatewayRouteResponse
  request :: (Service -> Service)
-> DeleteLocalGatewayRoute -> Request DeleteLocalGatewayRoute
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 DeleteLocalGatewayRoute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteLocalGatewayRoute)))
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 LocalGatewayRoute -> Int -> DeleteLocalGatewayRouteResponse
DeleteLocalGatewayRouteResponse'
            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
"route")
            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 DeleteLocalGatewayRoute where
  hashWithSalt :: Int -> DeleteLocalGatewayRoute -> Int
hashWithSalt Int
_salt DeleteLocalGatewayRoute' {Maybe Bool
Text
localGatewayRouteTableId :: Text
destinationCidrBlock :: Text
dryRun :: Maybe Bool
$sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:dryRun:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> 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` Text
destinationCidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
localGatewayRouteTableId

instance Prelude.NFData DeleteLocalGatewayRoute where
  rnf :: DeleteLocalGatewayRoute -> ()
rnf DeleteLocalGatewayRoute' {Maybe Bool
Text
localGatewayRouteTableId :: Text
destinationCidrBlock :: Text
dryRun :: Maybe Bool
$sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:dryRun:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> 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 Text
destinationCidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
localGatewayRouteTableId

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

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

instance Data.ToQuery DeleteLocalGatewayRoute where
  toQuery :: DeleteLocalGatewayRoute -> QueryString
toQuery DeleteLocalGatewayRoute' {Maybe Bool
Text
localGatewayRouteTableId :: Text
destinationCidrBlock :: Text
dryRun :: Maybe Bool
$sel:localGatewayRouteTableId:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:destinationCidrBlock:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Text
$sel:dryRun:DeleteLocalGatewayRoute' :: DeleteLocalGatewayRoute -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteLocalGatewayRoute" :: 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
"DestinationCidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
destinationCidrBlock,
        ByteString
"LocalGatewayRouteTableId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
localGatewayRouteTableId
      ]

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

-- |
-- Create a value of 'DeleteLocalGatewayRouteResponse' 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:
--
-- 'route', 'deleteLocalGatewayRouteResponse_route' - Information about the route.
--
-- 'httpStatus', 'deleteLocalGatewayRouteResponse_httpStatus' - The response's http status code.
newDeleteLocalGatewayRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteLocalGatewayRouteResponse
newDeleteLocalGatewayRouteResponse :: Int -> DeleteLocalGatewayRouteResponse
newDeleteLocalGatewayRouteResponse Int
pHttpStatus_ =
  DeleteLocalGatewayRouteResponse'
    { $sel:route:DeleteLocalGatewayRouteResponse' :: Maybe LocalGatewayRoute
route =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteLocalGatewayRouteResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the route.
deleteLocalGatewayRouteResponse_route :: Lens.Lens' DeleteLocalGatewayRouteResponse (Prelude.Maybe LocalGatewayRoute)
deleteLocalGatewayRouteResponse_route :: Lens' DeleteLocalGatewayRouteResponse (Maybe LocalGatewayRoute)
deleteLocalGatewayRouteResponse_route = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLocalGatewayRouteResponse' {Maybe LocalGatewayRoute
route :: Maybe LocalGatewayRoute
$sel:route:DeleteLocalGatewayRouteResponse' :: DeleteLocalGatewayRouteResponse -> Maybe LocalGatewayRoute
route} -> Maybe LocalGatewayRoute
route) (\s :: DeleteLocalGatewayRouteResponse
s@DeleteLocalGatewayRouteResponse' {} Maybe LocalGatewayRoute
a -> DeleteLocalGatewayRouteResponse
s {$sel:route:DeleteLocalGatewayRouteResponse' :: Maybe LocalGatewayRoute
route = Maybe LocalGatewayRoute
a} :: DeleteLocalGatewayRouteResponse)

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

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