{-# 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.RevokeSecurityGroupEgress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- [VPC only] Removes the specified outbound (egress) rules from a security
-- group for EC2-VPC. This action does not apply to security groups for use
-- in EC2-Classic.
--
-- You can specify rules using either rule IDs or security group rule
-- properties. If you use rule properties, the values that you specify (for
-- example, ports) must match the existing rule\'s values exactly. Each
-- rule has a protocol, from and to ports, and destination (CIDR range,
-- security group, or prefix list). For the TCP and UDP protocols, you must
-- also specify the destination port or range of ports. For the ICMP
-- protocol, you must also specify the ICMP type and code. If the security
-- group rule has a description, you do not need to specify the description
-- to revoke the rule.
--
-- [Default VPC] If the values you specify do not match the existing
-- rule\'s values, no error is returned, and the output describes the
-- security group rules that were not revoked.
--
-- Amazon Web Services recommends that you describe the security group to
-- verify that the rules were removed.
--
-- Rule changes are propagated to instances within the security group as
-- quickly as possible. However, a small delay might occur.
module Amazonka.EC2.RevokeSecurityGroupEgress
  ( -- * Creating a Request
    RevokeSecurityGroupEgress (..),
    newRevokeSecurityGroupEgress,

    -- * Request Lenses
    revokeSecurityGroupEgress_cidrIp,
    revokeSecurityGroupEgress_dryRun,
    revokeSecurityGroupEgress_fromPort,
    revokeSecurityGroupEgress_ipPermissions,
    revokeSecurityGroupEgress_ipProtocol,
    revokeSecurityGroupEgress_securityGroupRuleIds,
    revokeSecurityGroupEgress_sourceSecurityGroupName,
    revokeSecurityGroupEgress_sourceSecurityGroupOwnerId,
    revokeSecurityGroupEgress_toPort,
    revokeSecurityGroupEgress_groupId,

    -- * Destructuring the Response
    RevokeSecurityGroupEgressResponse (..),
    newRevokeSecurityGroupEgressResponse,

    -- * Response Lenses
    revokeSecurityGroupEgressResponse_return,
    revokeSecurityGroupEgressResponse_unknownIpPermissions,
    revokeSecurityGroupEgressResponse_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:/ 'newRevokeSecurityGroupEgress' smart constructor.
data RevokeSecurityGroupEgress = RevokeSecurityGroupEgress'
  { -- | Not supported. Use a set of IP permissions to specify the CIDR.
    RevokeSecurityGroupEgress -> Maybe Text
cidrIp :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    RevokeSecurityGroupEgress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Not supported. Use a set of IP permissions to specify the port.
    RevokeSecurityGroupEgress -> Maybe Int
fromPort :: Prelude.Maybe Prelude.Int,
    -- | The sets of IP permissions. You can\'t specify a destination security
    -- group and a CIDR IP address range in the same set of permissions.
    RevokeSecurityGroupEgress -> Maybe [IpPermission]
ipPermissions :: Prelude.Maybe [IpPermission],
    -- | Not supported. Use a set of IP permissions to specify the protocol name
    -- or number.
    RevokeSecurityGroupEgress -> Maybe Text
ipProtocol :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the security group rules.
    RevokeSecurityGroupEgress -> Maybe [Text]
securityGroupRuleIds :: Prelude.Maybe [Prelude.Text],
    -- | Not supported. Use a set of IP permissions to specify a destination
    -- security group.
    RevokeSecurityGroupEgress -> Maybe Text
sourceSecurityGroupName :: Prelude.Maybe Prelude.Text,
    -- | Not supported. Use a set of IP permissions to specify a destination
    -- security group.
    RevokeSecurityGroupEgress -> Maybe Text
sourceSecurityGroupOwnerId :: Prelude.Maybe Prelude.Text,
    -- | Not supported. Use a set of IP permissions to specify the port.
    RevokeSecurityGroupEgress -> Maybe Int
toPort :: Prelude.Maybe Prelude.Int,
    -- | The ID of the security group.
    RevokeSecurityGroupEgress -> Text
groupId :: Prelude.Text
  }
  deriving (RevokeSecurityGroupEgress -> RevokeSecurityGroupEgress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSecurityGroupEgress -> RevokeSecurityGroupEgress -> Bool
$c/= :: RevokeSecurityGroupEgress -> RevokeSecurityGroupEgress -> Bool
== :: RevokeSecurityGroupEgress -> RevokeSecurityGroupEgress -> Bool
$c== :: RevokeSecurityGroupEgress -> RevokeSecurityGroupEgress -> Bool
Prelude.Eq, ReadPrec [RevokeSecurityGroupEgress]
ReadPrec RevokeSecurityGroupEgress
Int -> ReadS RevokeSecurityGroupEgress
ReadS [RevokeSecurityGroupEgress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeSecurityGroupEgress]
$creadListPrec :: ReadPrec [RevokeSecurityGroupEgress]
readPrec :: ReadPrec RevokeSecurityGroupEgress
$creadPrec :: ReadPrec RevokeSecurityGroupEgress
readList :: ReadS [RevokeSecurityGroupEgress]
$creadList :: ReadS [RevokeSecurityGroupEgress]
readsPrec :: Int -> ReadS RevokeSecurityGroupEgress
$creadsPrec :: Int -> ReadS RevokeSecurityGroupEgress
Prelude.Read, Int -> RevokeSecurityGroupEgress -> ShowS
[RevokeSecurityGroupEgress] -> ShowS
RevokeSecurityGroupEgress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSecurityGroupEgress] -> ShowS
$cshowList :: [RevokeSecurityGroupEgress] -> ShowS
show :: RevokeSecurityGroupEgress -> String
$cshow :: RevokeSecurityGroupEgress -> String
showsPrec :: Int -> RevokeSecurityGroupEgress -> ShowS
$cshowsPrec :: Int -> RevokeSecurityGroupEgress -> ShowS
Prelude.Show, forall x.
Rep RevokeSecurityGroupEgress x -> RevokeSecurityGroupEgress
forall x.
RevokeSecurityGroupEgress -> Rep RevokeSecurityGroupEgress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RevokeSecurityGroupEgress x -> RevokeSecurityGroupEgress
$cfrom :: forall x.
RevokeSecurityGroupEgress -> Rep RevokeSecurityGroupEgress x
Prelude.Generic)

-- |
-- Create a value of 'RevokeSecurityGroupEgress' 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:
--
-- 'cidrIp', 'revokeSecurityGroupEgress_cidrIp' - Not supported. Use a set of IP permissions to specify the CIDR.
--
-- 'dryRun', 'revokeSecurityGroupEgress_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@.
--
-- 'fromPort', 'revokeSecurityGroupEgress_fromPort' - Not supported. Use a set of IP permissions to specify the port.
--
-- 'ipPermissions', 'revokeSecurityGroupEgress_ipPermissions' - The sets of IP permissions. You can\'t specify a destination security
-- group and a CIDR IP address range in the same set of permissions.
--
-- 'ipProtocol', 'revokeSecurityGroupEgress_ipProtocol' - Not supported. Use a set of IP permissions to specify the protocol name
-- or number.
--
-- 'securityGroupRuleIds', 'revokeSecurityGroupEgress_securityGroupRuleIds' - The IDs of the security group rules.
--
-- 'sourceSecurityGroupName', 'revokeSecurityGroupEgress_sourceSecurityGroupName' - Not supported. Use a set of IP permissions to specify a destination
-- security group.
--
-- 'sourceSecurityGroupOwnerId', 'revokeSecurityGroupEgress_sourceSecurityGroupOwnerId' - Not supported. Use a set of IP permissions to specify a destination
-- security group.
--
-- 'toPort', 'revokeSecurityGroupEgress_toPort' - Not supported. Use a set of IP permissions to specify the port.
--
-- 'groupId', 'revokeSecurityGroupEgress_groupId' - The ID of the security group.
newRevokeSecurityGroupEgress ::
  -- | 'groupId'
  Prelude.Text ->
  RevokeSecurityGroupEgress
newRevokeSecurityGroupEgress :: Text -> RevokeSecurityGroupEgress
newRevokeSecurityGroupEgress Text
pGroupId_ =
  RevokeSecurityGroupEgress'
    { $sel:cidrIp:RevokeSecurityGroupEgress' :: Maybe Text
cidrIp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:RevokeSecurityGroupEgress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:fromPort:RevokeSecurityGroupEgress' :: Maybe Int
fromPort = forall a. Maybe a
Prelude.Nothing,
      $sel:ipPermissions:RevokeSecurityGroupEgress' :: Maybe [IpPermission]
ipPermissions = forall a. Maybe a
Prelude.Nothing,
      $sel:ipProtocol:RevokeSecurityGroupEgress' :: Maybe Text
ipProtocol = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: Maybe [Text]
securityGroupRuleIds = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: Maybe Text
sourceSecurityGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: Maybe Text
sourceSecurityGroupOwnerId = forall a. Maybe a
Prelude.Nothing,
      $sel:toPort:RevokeSecurityGroupEgress' :: Maybe Int
toPort = forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:RevokeSecurityGroupEgress' :: Text
groupId = Text
pGroupId_
    }

-- | Not supported. Use a set of IP permissions to specify the CIDR.
revokeSecurityGroupEgress_cidrIp :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Text)
revokeSecurityGroupEgress_cidrIp :: Lens' RevokeSecurityGroupEgress (Maybe Text)
revokeSecurityGroupEgress_cidrIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Text
cidrIp :: Maybe Text
$sel:cidrIp:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
cidrIp} -> Maybe Text
cidrIp) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Text
a -> RevokeSecurityGroupEgress
s {$sel:cidrIp:RevokeSecurityGroupEgress' :: Maybe Text
cidrIp = Maybe Text
a} :: RevokeSecurityGroupEgress)

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

-- | Not supported. Use a set of IP permissions to specify the port.
revokeSecurityGroupEgress_fromPort :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Int)
revokeSecurityGroupEgress_fromPort :: Lens' RevokeSecurityGroupEgress (Maybe Int)
revokeSecurityGroupEgress_fromPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Int
fromPort :: Maybe Int
$sel:fromPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
fromPort} -> Maybe Int
fromPort) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Int
a -> RevokeSecurityGroupEgress
s {$sel:fromPort:RevokeSecurityGroupEgress' :: Maybe Int
fromPort = Maybe Int
a} :: RevokeSecurityGroupEgress)

-- | The sets of IP permissions. You can\'t specify a destination security
-- group and a CIDR IP address range in the same set of permissions.
revokeSecurityGroupEgress_ipPermissions :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe [IpPermission])
revokeSecurityGroupEgress_ipPermissions :: Lens' RevokeSecurityGroupEgress (Maybe [IpPermission])
revokeSecurityGroupEgress_ipPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe [IpPermission]
ipPermissions :: Maybe [IpPermission]
$sel:ipPermissions:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [IpPermission]
ipPermissions} -> Maybe [IpPermission]
ipPermissions) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe [IpPermission]
a -> RevokeSecurityGroupEgress
s {$sel:ipPermissions:RevokeSecurityGroupEgress' :: Maybe [IpPermission]
ipPermissions = Maybe [IpPermission]
a} :: RevokeSecurityGroupEgress) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Not supported. Use a set of IP permissions to specify the protocol name
-- or number.
revokeSecurityGroupEgress_ipProtocol :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Text)
revokeSecurityGroupEgress_ipProtocol :: Lens' RevokeSecurityGroupEgress (Maybe Text)
revokeSecurityGroupEgress_ipProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Text
ipProtocol :: Maybe Text
$sel:ipProtocol:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
ipProtocol} -> Maybe Text
ipProtocol) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Text
a -> RevokeSecurityGroupEgress
s {$sel:ipProtocol:RevokeSecurityGroupEgress' :: Maybe Text
ipProtocol = Maybe Text
a} :: RevokeSecurityGroupEgress)

-- | The IDs of the security group rules.
revokeSecurityGroupEgress_securityGroupRuleIds :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe [Prelude.Text])
revokeSecurityGroupEgress_securityGroupRuleIds :: Lens' RevokeSecurityGroupEgress (Maybe [Text])
revokeSecurityGroupEgress_securityGroupRuleIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe [Text]
securityGroupRuleIds :: Maybe [Text]
$sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [Text]
securityGroupRuleIds} -> Maybe [Text]
securityGroupRuleIds) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe [Text]
a -> RevokeSecurityGroupEgress
s {$sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: Maybe [Text]
securityGroupRuleIds = Maybe [Text]
a} :: RevokeSecurityGroupEgress) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Not supported. Use a set of IP permissions to specify a destination
-- security group.
revokeSecurityGroupEgress_sourceSecurityGroupName :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Text)
revokeSecurityGroupEgress_sourceSecurityGroupName :: Lens' RevokeSecurityGroupEgress (Maybe Text)
revokeSecurityGroupEgress_sourceSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Text
sourceSecurityGroupName :: Maybe Text
$sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
sourceSecurityGroupName} -> Maybe Text
sourceSecurityGroupName) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Text
a -> RevokeSecurityGroupEgress
s {$sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: Maybe Text
sourceSecurityGroupName = Maybe Text
a} :: RevokeSecurityGroupEgress)

-- | Not supported. Use a set of IP permissions to specify a destination
-- security group.
revokeSecurityGroupEgress_sourceSecurityGroupOwnerId :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Text)
revokeSecurityGroupEgress_sourceSecurityGroupOwnerId :: Lens' RevokeSecurityGroupEgress (Maybe Text)
revokeSecurityGroupEgress_sourceSecurityGroupOwnerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Text
sourceSecurityGroupOwnerId :: Maybe Text
$sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
sourceSecurityGroupOwnerId} -> Maybe Text
sourceSecurityGroupOwnerId) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Text
a -> RevokeSecurityGroupEgress
s {$sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: Maybe Text
sourceSecurityGroupOwnerId = Maybe Text
a} :: RevokeSecurityGroupEgress)

-- | Not supported. Use a set of IP permissions to specify the port.
revokeSecurityGroupEgress_toPort :: Lens.Lens' RevokeSecurityGroupEgress (Prelude.Maybe Prelude.Int)
revokeSecurityGroupEgress_toPort :: Lens' RevokeSecurityGroupEgress (Maybe Int)
revokeSecurityGroupEgress_toPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Maybe Int
toPort :: Maybe Int
$sel:toPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
toPort} -> Maybe Int
toPort) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Maybe Int
a -> RevokeSecurityGroupEgress
s {$sel:toPort:RevokeSecurityGroupEgress' :: Maybe Int
toPort = Maybe Int
a} :: RevokeSecurityGroupEgress)

-- | The ID of the security group.
revokeSecurityGroupEgress_groupId :: Lens.Lens' RevokeSecurityGroupEgress Prelude.Text
revokeSecurityGroupEgress_groupId :: Lens' RevokeSecurityGroupEgress Text
revokeSecurityGroupEgress_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgress' {Text
groupId :: Text
$sel:groupId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Text
groupId} -> Text
groupId) (\s :: RevokeSecurityGroupEgress
s@RevokeSecurityGroupEgress' {} Text
a -> RevokeSecurityGroupEgress
s {$sel:groupId:RevokeSecurityGroupEgress' :: Text
groupId = Text
a} :: RevokeSecurityGroupEgress)

instance Core.AWSRequest RevokeSecurityGroupEgress where
  type
    AWSResponse RevokeSecurityGroupEgress =
      RevokeSecurityGroupEgressResponse
  request :: (Service -> Service)
-> RevokeSecurityGroupEgress -> Request RevokeSecurityGroupEgress
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 RevokeSecurityGroupEgress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RevokeSecurityGroupEgress)))
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 Bool
-> Maybe [IpPermission] -> Int -> RevokeSecurityGroupEgressResponse
RevokeSecurityGroupEgressResponse'
            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
"return")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"unknownIpPermissionSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 RevokeSecurityGroupEgress where
  hashWithSalt :: Int -> RevokeSecurityGroupEgress -> Int
hashWithSalt Int
_salt RevokeSecurityGroupEgress' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [IpPermission]
Maybe Text
Text
groupId :: Text
toPort :: Maybe Int
sourceSecurityGroupOwnerId :: Maybe Text
sourceSecurityGroupName :: Maybe Text
securityGroupRuleIds :: Maybe [Text]
ipProtocol :: Maybe Text
ipPermissions :: Maybe [IpPermission]
fromPort :: Maybe Int
dryRun :: Maybe Bool
cidrIp :: Maybe Text
$sel:groupId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Text
$sel:toPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [Text]
$sel:ipProtocol:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:ipPermissions:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [IpPermission]
$sel:fromPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:dryRun:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Bool
$sel:cidrIp:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cidrIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
fromPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IpPermission]
ipPermissions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipProtocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupRuleIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceSecurityGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceSecurityGroupOwnerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
toPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupId

instance Prelude.NFData RevokeSecurityGroupEgress where
  rnf :: RevokeSecurityGroupEgress -> ()
rnf RevokeSecurityGroupEgress' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [IpPermission]
Maybe Text
Text
groupId :: Text
toPort :: Maybe Int
sourceSecurityGroupOwnerId :: Maybe Text
sourceSecurityGroupName :: Maybe Text
securityGroupRuleIds :: Maybe [Text]
ipProtocol :: Maybe Text
ipPermissions :: Maybe [IpPermission]
fromPort :: Maybe Int
dryRun :: Maybe Bool
cidrIp :: Maybe Text
$sel:groupId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Text
$sel:toPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [Text]
$sel:ipProtocol:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:ipPermissions:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [IpPermission]
$sel:fromPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:dryRun:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Bool
$sel:cidrIp:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cidrIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
fromPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [IpPermission]
ipPermissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipProtocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupRuleIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceSecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceSecurityGroupOwnerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
toPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupId

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

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

instance Data.ToQuery RevokeSecurityGroupEgress where
  toQuery :: RevokeSecurityGroupEgress -> QueryString
toQuery RevokeSecurityGroupEgress' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [IpPermission]
Maybe Text
Text
groupId :: Text
toPort :: Maybe Int
sourceSecurityGroupOwnerId :: Maybe Text
sourceSecurityGroupName :: Maybe Text
securityGroupRuleIds :: Maybe [Text]
ipProtocol :: Maybe Text
ipPermissions :: Maybe [IpPermission]
fromPort :: Maybe Int
dryRun :: Maybe Bool
cidrIp :: Maybe Text
$sel:groupId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Text
$sel:toPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:sourceSecurityGroupOwnerId:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:sourceSecurityGroupName:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:securityGroupRuleIds:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [Text]
$sel:ipProtocol:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
$sel:ipPermissions:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe [IpPermission]
$sel:fromPort:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Int
$sel:dryRun:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Bool
$sel:cidrIp:RevokeSecurityGroupEgress' :: RevokeSecurityGroupEgress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RevokeSecurityGroupEgress" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"CidrIp" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cidrIp,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"FromPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
fromPort,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"IpPermissions"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [IpPermission]
ipPermissions
          ),
        ByteString
"IpProtocol" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipProtocol,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"SecurityGroupRuleId"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
securityGroupRuleIds
          ),
        ByteString
"SourceSecurityGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sourceSecurityGroupName,
        ByteString
"SourceSecurityGroupOwnerId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sourceSecurityGroupOwnerId,
        ByteString
"ToPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
toPort,
        ByteString
"GroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
groupId
      ]

-- | /See:/ 'newRevokeSecurityGroupEgressResponse' smart constructor.
data RevokeSecurityGroupEgressResponse = RevokeSecurityGroupEgressResponse'
  { -- | Returns @true@ if the request succeeds; otherwise, returns an error.
    RevokeSecurityGroupEgressResponse -> Maybe Bool
return' :: Prelude.Maybe Prelude.Bool,
    -- | The outbound rules that were unknown to the service. In some cases,
    -- @unknownIpPermissionSet@ might be in a different format from the request
    -- parameter.
    RevokeSecurityGroupEgressResponse -> Maybe [IpPermission]
unknownIpPermissions :: Prelude.Maybe [IpPermission],
    -- | The response's http status code.
    RevokeSecurityGroupEgressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RevokeSecurityGroupEgressResponse
-> RevokeSecurityGroupEgressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSecurityGroupEgressResponse
-> RevokeSecurityGroupEgressResponse -> Bool
$c/= :: RevokeSecurityGroupEgressResponse
-> RevokeSecurityGroupEgressResponse -> Bool
== :: RevokeSecurityGroupEgressResponse
-> RevokeSecurityGroupEgressResponse -> Bool
$c== :: RevokeSecurityGroupEgressResponse
-> RevokeSecurityGroupEgressResponse -> Bool
Prelude.Eq, ReadPrec [RevokeSecurityGroupEgressResponse]
ReadPrec RevokeSecurityGroupEgressResponse
Int -> ReadS RevokeSecurityGroupEgressResponse
ReadS [RevokeSecurityGroupEgressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeSecurityGroupEgressResponse]
$creadListPrec :: ReadPrec [RevokeSecurityGroupEgressResponse]
readPrec :: ReadPrec RevokeSecurityGroupEgressResponse
$creadPrec :: ReadPrec RevokeSecurityGroupEgressResponse
readList :: ReadS [RevokeSecurityGroupEgressResponse]
$creadList :: ReadS [RevokeSecurityGroupEgressResponse]
readsPrec :: Int -> ReadS RevokeSecurityGroupEgressResponse
$creadsPrec :: Int -> ReadS RevokeSecurityGroupEgressResponse
Prelude.Read, Int -> RevokeSecurityGroupEgressResponse -> ShowS
[RevokeSecurityGroupEgressResponse] -> ShowS
RevokeSecurityGroupEgressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSecurityGroupEgressResponse] -> ShowS
$cshowList :: [RevokeSecurityGroupEgressResponse] -> ShowS
show :: RevokeSecurityGroupEgressResponse -> String
$cshow :: RevokeSecurityGroupEgressResponse -> String
showsPrec :: Int -> RevokeSecurityGroupEgressResponse -> ShowS
$cshowsPrec :: Int -> RevokeSecurityGroupEgressResponse -> ShowS
Prelude.Show, forall x.
Rep RevokeSecurityGroupEgressResponse x
-> RevokeSecurityGroupEgressResponse
forall x.
RevokeSecurityGroupEgressResponse
-> Rep RevokeSecurityGroupEgressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RevokeSecurityGroupEgressResponse x
-> RevokeSecurityGroupEgressResponse
$cfrom :: forall x.
RevokeSecurityGroupEgressResponse
-> Rep RevokeSecurityGroupEgressResponse x
Prelude.Generic)

-- |
-- Create a value of 'RevokeSecurityGroupEgressResponse' 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:
--
-- 'return'', 'revokeSecurityGroupEgressResponse_return' - Returns @true@ if the request succeeds; otherwise, returns an error.
--
-- 'unknownIpPermissions', 'revokeSecurityGroupEgressResponse_unknownIpPermissions' - The outbound rules that were unknown to the service. In some cases,
-- @unknownIpPermissionSet@ might be in a different format from the request
-- parameter.
--
-- 'httpStatus', 'revokeSecurityGroupEgressResponse_httpStatus' - The response's http status code.
newRevokeSecurityGroupEgressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RevokeSecurityGroupEgressResponse
newRevokeSecurityGroupEgressResponse :: Int -> RevokeSecurityGroupEgressResponse
newRevokeSecurityGroupEgressResponse Int
pHttpStatus_ =
  RevokeSecurityGroupEgressResponse'
    { $sel:return':RevokeSecurityGroupEgressResponse' :: Maybe Bool
return' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:unknownIpPermissions:RevokeSecurityGroupEgressResponse' :: Maybe [IpPermission]
unknownIpPermissions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RevokeSecurityGroupEgressResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns @true@ if the request succeeds; otherwise, returns an error.
revokeSecurityGroupEgressResponse_return :: Lens.Lens' RevokeSecurityGroupEgressResponse (Prelude.Maybe Prelude.Bool)
revokeSecurityGroupEgressResponse_return :: Lens' RevokeSecurityGroupEgressResponse (Maybe Bool)
revokeSecurityGroupEgressResponse_return = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgressResponse' {Maybe Bool
return' :: Maybe Bool
$sel:return':RevokeSecurityGroupEgressResponse' :: RevokeSecurityGroupEgressResponse -> Maybe Bool
return'} -> Maybe Bool
return') (\s :: RevokeSecurityGroupEgressResponse
s@RevokeSecurityGroupEgressResponse' {} Maybe Bool
a -> RevokeSecurityGroupEgressResponse
s {$sel:return':RevokeSecurityGroupEgressResponse' :: Maybe Bool
return' = Maybe Bool
a} :: RevokeSecurityGroupEgressResponse)

-- | The outbound rules that were unknown to the service. In some cases,
-- @unknownIpPermissionSet@ might be in a different format from the request
-- parameter.
revokeSecurityGroupEgressResponse_unknownIpPermissions :: Lens.Lens' RevokeSecurityGroupEgressResponse (Prelude.Maybe [IpPermission])
revokeSecurityGroupEgressResponse_unknownIpPermissions :: Lens' RevokeSecurityGroupEgressResponse (Maybe [IpPermission])
revokeSecurityGroupEgressResponse_unknownIpPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeSecurityGroupEgressResponse' {Maybe [IpPermission]
unknownIpPermissions :: Maybe [IpPermission]
$sel:unknownIpPermissions:RevokeSecurityGroupEgressResponse' :: RevokeSecurityGroupEgressResponse -> Maybe [IpPermission]
unknownIpPermissions} -> Maybe [IpPermission]
unknownIpPermissions) (\s :: RevokeSecurityGroupEgressResponse
s@RevokeSecurityGroupEgressResponse' {} Maybe [IpPermission]
a -> RevokeSecurityGroupEgressResponse
s {$sel:unknownIpPermissions:RevokeSecurityGroupEgressResponse' :: Maybe [IpPermission]
unknownIpPermissions = Maybe [IpPermission]
a} :: RevokeSecurityGroupEgressResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    RevokeSecurityGroupEgressResponse
  where
  rnf :: RevokeSecurityGroupEgressResponse -> ()
rnf RevokeSecurityGroupEgressResponse' {Int
Maybe Bool
Maybe [IpPermission]
httpStatus :: Int
unknownIpPermissions :: Maybe [IpPermission]
return' :: Maybe Bool
$sel:httpStatus:RevokeSecurityGroupEgressResponse' :: RevokeSecurityGroupEgressResponse -> Int
$sel:unknownIpPermissions:RevokeSecurityGroupEgressResponse' :: RevokeSecurityGroupEgressResponse -> Maybe [IpPermission]
$sel:return':RevokeSecurityGroupEgressResponse' :: RevokeSecurityGroupEgressResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
return'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [IpPermission]
unknownIpPermissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus