{-# 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.DeleteSecurityGroup
-- 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 a security group.
--
-- If you attempt to delete a security group that is associated with an
-- instance, or is referenced by another security group, the operation
-- fails with @InvalidGroup.InUse@ in EC2-Classic or @DependencyViolation@
-- in EC2-VPC.
--
-- We are retiring EC2-Classic. We recommend that you migrate from
-- EC2-Classic to a VPC. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/vpc-migrate.html Migrate from EC2-Classic to a VPC>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.DeleteSecurityGroup
  ( -- * Creating a Request
    DeleteSecurityGroup (..),
    newDeleteSecurityGroup,

    -- * Request Lenses
    deleteSecurityGroup_dryRun,
    deleteSecurityGroup_groupId,
    deleteSecurityGroup_groupName,

    -- * Destructuring the Response
    DeleteSecurityGroupResponse (..),
    newDeleteSecurityGroupResponse,
  )
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:/ 'newDeleteSecurityGroup' smart constructor.
data DeleteSecurityGroup = DeleteSecurityGroup'
  { -- | 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@.
    DeleteSecurityGroup -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the security group. Required for a nondefault VPC.
    DeleteSecurityGroup -> Maybe Text
groupId :: Prelude.Maybe Prelude.Text,
    -- | [EC2-Classic, default VPC] The name of the security group. You can
    -- specify either the security group name or the security group ID. For
    -- security groups in a nondefault VPC, you must specify the security group
    -- ID.
    DeleteSecurityGroup -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text
  }
  deriving (DeleteSecurityGroup -> DeleteSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSecurityGroup -> DeleteSecurityGroup -> Bool
$c/= :: DeleteSecurityGroup -> DeleteSecurityGroup -> Bool
== :: DeleteSecurityGroup -> DeleteSecurityGroup -> Bool
$c== :: DeleteSecurityGroup -> DeleteSecurityGroup -> Bool
Prelude.Eq, ReadPrec [DeleteSecurityGroup]
ReadPrec DeleteSecurityGroup
Int -> ReadS DeleteSecurityGroup
ReadS [DeleteSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSecurityGroup]
$creadListPrec :: ReadPrec [DeleteSecurityGroup]
readPrec :: ReadPrec DeleteSecurityGroup
$creadPrec :: ReadPrec DeleteSecurityGroup
readList :: ReadS [DeleteSecurityGroup]
$creadList :: ReadS [DeleteSecurityGroup]
readsPrec :: Int -> ReadS DeleteSecurityGroup
$creadsPrec :: Int -> ReadS DeleteSecurityGroup
Prelude.Read, Int -> DeleteSecurityGroup -> ShowS
[DeleteSecurityGroup] -> ShowS
DeleteSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSecurityGroup] -> ShowS
$cshowList :: [DeleteSecurityGroup] -> ShowS
show :: DeleteSecurityGroup -> String
$cshow :: DeleteSecurityGroup -> String
showsPrec :: Int -> DeleteSecurityGroup -> ShowS
$cshowsPrec :: Int -> DeleteSecurityGroup -> ShowS
Prelude.Show, forall x. Rep DeleteSecurityGroup x -> DeleteSecurityGroup
forall x. DeleteSecurityGroup -> Rep DeleteSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteSecurityGroup x -> DeleteSecurityGroup
$cfrom :: forall x. DeleteSecurityGroup -> Rep DeleteSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSecurityGroup' 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', 'deleteSecurityGroup_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@.
--
-- 'groupId', 'deleteSecurityGroup_groupId' - The ID of the security group. Required for a nondefault VPC.
--
-- 'groupName', 'deleteSecurityGroup_groupName' - [EC2-Classic, default VPC] The name of the security group. You can
-- specify either the security group name or the security group ID. For
-- security groups in a nondefault VPC, you must specify the security group
-- ID.
newDeleteSecurityGroup ::
  DeleteSecurityGroup
newDeleteSecurityGroup :: DeleteSecurityGroup
newDeleteSecurityGroup =
  DeleteSecurityGroup'
    { $sel:dryRun:DeleteSecurityGroup' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:DeleteSecurityGroup' :: Maybe Text
groupId = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:DeleteSecurityGroup' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The ID of the security group. Required for a nondefault VPC.
deleteSecurityGroup_groupId :: Lens.Lens' DeleteSecurityGroup (Prelude.Maybe Prelude.Text)
deleteSecurityGroup_groupId :: Lens' DeleteSecurityGroup (Maybe Text)
deleteSecurityGroup_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSecurityGroup' {Maybe Text
groupId :: Maybe Text
$sel:groupId:DeleteSecurityGroup' :: DeleteSecurityGroup -> Maybe Text
groupId} -> Maybe Text
groupId) (\s :: DeleteSecurityGroup
s@DeleteSecurityGroup' {} Maybe Text
a -> DeleteSecurityGroup
s {$sel:groupId:DeleteSecurityGroup' :: Maybe Text
groupId = Maybe Text
a} :: DeleteSecurityGroup)

-- | [EC2-Classic, default VPC] The name of the security group. You can
-- specify either the security group name or the security group ID. For
-- security groups in a nondefault VPC, you must specify the security group
-- ID.
deleteSecurityGroup_groupName :: Lens.Lens' DeleteSecurityGroup (Prelude.Maybe Prelude.Text)
deleteSecurityGroup_groupName :: Lens' DeleteSecurityGroup (Maybe Text)
deleteSecurityGroup_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSecurityGroup' {Maybe Text
groupName :: Maybe Text
$sel:groupName:DeleteSecurityGroup' :: DeleteSecurityGroup -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: DeleteSecurityGroup
s@DeleteSecurityGroup' {} Maybe Text
a -> DeleteSecurityGroup
s {$sel:groupName:DeleteSecurityGroup' :: Maybe Text
groupName = Maybe Text
a} :: DeleteSecurityGroup)

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

instance Prelude.Hashable DeleteSecurityGroup where
  hashWithSalt :: Int -> DeleteSecurityGroup -> Int
hashWithSalt Int
_salt DeleteSecurityGroup' {Maybe Bool
Maybe Text
groupName :: Maybe Text
groupId :: Maybe Text
dryRun :: Maybe Bool
$sel:groupName:DeleteSecurityGroup' :: DeleteSecurityGroup -> Maybe Text
$sel:groupId:DeleteSecurityGroup' :: DeleteSecurityGroup -> Maybe Text
$sel:dryRun:DeleteSecurityGroup' :: DeleteSecurityGroup -> 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
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName

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

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

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

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

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

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

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