{-# 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.DeleteInternetGateway
-- 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 internet gateway. You must detach the internet
-- gateway from the VPC before you can delete it.
module Amazonka.EC2.DeleteInternetGateway
  ( -- * Creating a Request
    DeleteInternetGateway (..),
    newDeleteInternetGateway,

    -- * Request Lenses
    deleteInternetGateway_dryRun,
    deleteInternetGateway_internetGatewayId,

    -- * Destructuring the Response
    DeleteInternetGatewayResponse (..),
    newDeleteInternetGatewayResponse,
  )
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:/ 'newDeleteInternetGateway' smart constructor.
data DeleteInternetGateway = DeleteInternetGateway'
  { -- | 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@.
    DeleteInternetGateway -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the internet gateway.
    DeleteInternetGateway -> Text
internetGatewayId :: Prelude.Text
  }
  deriving (DeleteInternetGateway -> DeleteInternetGateway -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInternetGateway -> DeleteInternetGateway -> Bool
$c/= :: DeleteInternetGateway -> DeleteInternetGateway -> Bool
== :: DeleteInternetGateway -> DeleteInternetGateway -> Bool
$c== :: DeleteInternetGateway -> DeleteInternetGateway -> Bool
Prelude.Eq, ReadPrec [DeleteInternetGateway]
ReadPrec DeleteInternetGateway
Int -> ReadS DeleteInternetGateway
ReadS [DeleteInternetGateway]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInternetGateway]
$creadListPrec :: ReadPrec [DeleteInternetGateway]
readPrec :: ReadPrec DeleteInternetGateway
$creadPrec :: ReadPrec DeleteInternetGateway
readList :: ReadS [DeleteInternetGateway]
$creadList :: ReadS [DeleteInternetGateway]
readsPrec :: Int -> ReadS DeleteInternetGateway
$creadsPrec :: Int -> ReadS DeleteInternetGateway
Prelude.Read, Int -> DeleteInternetGateway -> ShowS
[DeleteInternetGateway] -> ShowS
DeleteInternetGateway -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInternetGateway] -> ShowS
$cshowList :: [DeleteInternetGateway] -> ShowS
show :: DeleteInternetGateway -> String
$cshow :: DeleteInternetGateway -> String
showsPrec :: Int -> DeleteInternetGateway -> ShowS
$cshowsPrec :: Int -> DeleteInternetGateway -> ShowS
Prelude.Show, forall x. Rep DeleteInternetGateway x -> DeleteInternetGateway
forall x. DeleteInternetGateway -> Rep DeleteInternetGateway x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteInternetGateway x -> DeleteInternetGateway
$cfrom :: forall x. DeleteInternetGateway -> Rep DeleteInternetGateway x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInternetGateway' 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', 'deleteInternetGateway_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@.
--
-- 'internetGatewayId', 'deleteInternetGateway_internetGatewayId' - The ID of the internet gateway.
newDeleteInternetGateway ::
  -- | 'internetGatewayId'
  Prelude.Text ->
  DeleteInternetGateway
newDeleteInternetGateway :: Text -> DeleteInternetGateway
newDeleteInternetGateway Text
pInternetGatewayId_ =
  DeleteInternetGateway'
    { $sel:dryRun:DeleteInternetGateway' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:internetGatewayId:DeleteInternetGateway' :: Text
internetGatewayId = Text
pInternetGatewayId_
    }

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

-- | The ID of the internet gateway.
deleteInternetGateway_internetGatewayId :: Lens.Lens' DeleteInternetGateway Prelude.Text
deleteInternetGateway_internetGatewayId :: Lens' DeleteInternetGateway Text
deleteInternetGateway_internetGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInternetGateway' {Text
internetGatewayId :: Text
$sel:internetGatewayId:DeleteInternetGateway' :: DeleteInternetGateway -> Text
internetGatewayId} -> Text
internetGatewayId) (\s :: DeleteInternetGateway
s@DeleteInternetGateway' {} Text
a -> DeleteInternetGateway
s {$sel:internetGatewayId:DeleteInternetGateway' :: Text
internetGatewayId = Text
a} :: DeleteInternetGateway)

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

instance Prelude.Hashable DeleteInternetGateway where
  hashWithSalt :: Int -> DeleteInternetGateway -> Int
hashWithSalt Int
_salt DeleteInternetGateway' {Maybe Bool
Text
internetGatewayId :: Text
dryRun :: Maybe Bool
$sel:internetGatewayId:DeleteInternetGateway' :: DeleteInternetGateway -> Text
$sel:dryRun:DeleteInternetGateway' :: DeleteInternetGateway -> 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
internetGatewayId

instance Prelude.NFData DeleteInternetGateway where
  rnf :: DeleteInternetGateway -> ()
rnf DeleteInternetGateway' {Maybe Bool
Text
internetGatewayId :: Text
dryRun :: Maybe Bool
$sel:internetGatewayId:DeleteInternetGateway' :: DeleteInternetGateway -> Text
$sel:dryRun:DeleteInternetGateway' :: DeleteInternetGateway -> 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
internetGatewayId

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

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

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

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

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

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