{-# 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.AuthorizeSecurityGroupIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds the specified inbound (ingress) rules to a security group.
--
-- An inbound rule permits instances to receive traffic from the specified
-- IPv4 or IPv6 CIDR address range, or from the instances that are
-- associated with the specified destination security groups. When
-- specifying an inbound rule for your security group in a VPC, the
-- @IpPermissions@ must include a source for the traffic.
--
-- You specify a protocol for each rule (for example, TCP). For TCP and
-- UDP, you must also specify the destination port or port range. For
-- ICMP\/ICMPv6, you must also specify the ICMP\/ICMPv6 type and code. You
-- can use -1 to mean all types or all codes.
--
-- Rule changes are propagated to instances within the security group as
-- quickly as possible. However, a small delay might occur.
--
-- For more information about VPC security group quotas, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/amazon-vpc-limits.html Amazon VPC quotas>.
--
-- 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.AuthorizeSecurityGroupIngress
  ( -- * Creating a Request
    AuthorizeSecurityGroupIngress (..),
    newAuthorizeSecurityGroupIngress,

    -- * Request Lenses
    authorizeSecurityGroupIngress_cidrIp,
    authorizeSecurityGroupIngress_dryRun,
    authorizeSecurityGroupIngress_fromPort,
    authorizeSecurityGroupIngress_groupId,
    authorizeSecurityGroupIngress_groupName,
    authorizeSecurityGroupIngress_ipPermissions,
    authorizeSecurityGroupIngress_ipProtocol,
    authorizeSecurityGroupIngress_sourceSecurityGroupName,
    authorizeSecurityGroupIngress_sourceSecurityGroupOwnerId,
    authorizeSecurityGroupIngress_tagSpecifications,
    authorizeSecurityGroupIngress_toPort,

    -- * Destructuring the Response
    AuthorizeSecurityGroupIngressResponse (..),
    newAuthorizeSecurityGroupIngressResponse,

    -- * Response Lenses
    authorizeSecurityGroupIngressResponse_return,
    authorizeSecurityGroupIngressResponse_securityGroupRules,
    authorizeSecurityGroupIngressResponse_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:/ 'newAuthorizeSecurityGroupIngress' smart constructor.
data AuthorizeSecurityGroupIngress = AuthorizeSecurityGroupIngress'
  { -- | The IPv4 address range, in CIDR format. You can\'t specify this
    -- parameter when specifying a source security group. To specify an IPv6
    -- address range, use a set of IP permissions.
    --
    -- Alternatively, use a set of IP permissions to specify multiple rules and
    -- a description for the rule.
    AuthorizeSecurityGroupIngress -> 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@.
    AuthorizeSecurityGroupIngress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The start of port range for the TCP and UDP protocols, or an ICMP type
    -- number. For the ICMP type number, use @-1@ to specify all types. If you
    -- specify all ICMP types, you must specify all codes.
    --
    -- Alternatively, use a set of IP permissions to specify multiple rules and
    -- a description for the rule.
    AuthorizeSecurityGroupIngress -> Maybe Int
fromPort :: Prelude.Maybe Prelude.Int,
    -- | The ID of the security group. You must specify either the security group
    -- ID or the security group name in the request. For security groups in a
    -- nondefault VPC, you must specify the security group ID.
    AuthorizeSecurityGroupIngress -> Maybe Text
groupId :: Prelude.Maybe Prelude.Text,
    -- | [EC2-Classic, default VPC] The name of the security group. You must
    -- specify either the security group ID or the security group name in the
    -- request. For security groups in a nondefault VPC, you must specify the
    -- security group ID.
    AuthorizeSecurityGroupIngress -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The sets of IP permissions.
    AuthorizeSecurityGroupIngress -> Maybe [IpPermission]
ipPermissions :: Prelude.Maybe [IpPermission],
    -- | The IP protocol name (@tcp@, @udp@, @icmp@) or number (see
    -- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
    -- To specify @icmpv6@, use a set of IP permissions.
    --
    -- [VPC only] Use @-1@ to specify all protocols. If you specify @-1@ or a
    -- protocol other than @tcp@, @udp@, or @icmp@, traffic on all ports is
    -- allowed, regardless of any ports you specify.
    --
    -- Alternatively, use a set of IP permissions to specify multiple rules and
    -- a description for the rule.
    AuthorizeSecurityGroupIngress -> Maybe Text
ipProtocol :: Prelude.Maybe Prelude.Text,
    -- | [EC2-Classic, default VPC] The name of the source security group. You
    -- can\'t specify this parameter in combination with the following
    -- parameters: the CIDR IP address range, the start of the port range, the
    -- IP protocol, and the end of the port range. Creates rules that grant
    -- full ICMP, UDP, and TCP access. To create a rule with a specific IP
    -- protocol and port range, use a set of IP permissions instead. For
    -- EC2-VPC, the source security group must be in the same VPC.
    AuthorizeSecurityGroupIngress -> Maybe Text
sourceSecurityGroupName :: Prelude.Maybe Prelude.Text,
    -- | [nondefault VPC] The Amazon Web Services account ID for the source
    -- security group, if the source security group is in a different account.
    -- You can\'t specify this parameter in combination with the following
    -- parameters: the CIDR IP address range, the IP protocol, the start of the
    -- port range, and the end of the port range. Creates rules that grant full
    -- ICMP, UDP, and TCP access. To create a rule with a specific IP protocol
    -- and port range, use a set of IP permissions instead.
    AuthorizeSecurityGroupIngress -> Maybe Text
sourceSecurityGroupOwnerId :: Prelude.Maybe Prelude.Text,
    -- | [VPC Only] The tags applied to the security group rule.
    AuthorizeSecurityGroupIngress -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The end of port range for the TCP and UDP protocols, or an ICMP code
    -- number. For the ICMP code number, use @-1@ to specify all codes. If you
    -- specify all ICMP types, you must specify all codes.
    --
    -- Alternatively, use a set of IP permissions to specify multiple rules and
    -- a description for the rule.
    AuthorizeSecurityGroupIngress -> Maybe Int
toPort :: Prelude.Maybe Prelude.Int
  }
  deriving (AuthorizeSecurityGroupIngress
-> AuthorizeSecurityGroupIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeSecurityGroupIngress
-> AuthorizeSecurityGroupIngress -> Bool
$c/= :: AuthorizeSecurityGroupIngress
-> AuthorizeSecurityGroupIngress -> Bool
== :: AuthorizeSecurityGroupIngress
-> AuthorizeSecurityGroupIngress -> Bool
$c== :: AuthorizeSecurityGroupIngress
-> AuthorizeSecurityGroupIngress -> Bool
Prelude.Eq, ReadPrec [AuthorizeSecurityGroupIngress]
ReadPrec AuthorizeSecurityGroupIngress
Int -> ReadS AuthorizeSecurityGroupIngress
ReadS [AuthorizeSecurityGroupIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeSecurityGroupIngress]
$creadListPrec :: ReadPrec [AuthorizeSecurityGroupIngress]
readPrec :: ReadPrec AuthorizeSecurityGroupIngress
$creadPrec :: ReadPrec AuthorizeSecurityGroupIngress
readList :: ReadS [AuthorizeSecurityGroupIngress]
$creadList :: ReadS [AuthorizeSecurityGroupIngress]
readsPrec :: Int -> ReadS AuthorizeSecurityGroupIngress
$creadsPrec :: Int -> ReadS AuthorizeSecurityGroupIngress
Prelude.Read, Int -> AuthorizeSecurityGroupIngress -> ShowS
[AuthorizeSecurityGroupIngress] -> ShowS
AuthorizeSecurityGroupIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeSecurityGroupIngress] -> ShowS
$cshowList :: [AuthorizeSecurityGroupIngress] -> ShowS
show :: AuthorizeSecurityGroupIngress -> String
$cshow :: AuthorizeSecurityGroupIngress -> String
showsPrec :: Int -> AuthorizeSecurityGroupIngress -> ShowS
$cshowsPrec :: Int -> AuthorizeSecurityGroupIngress -> ShowS
Prelude.Show, forall x.
Rep AuthorizeSecurityGroupIngress x
-> AuthorizeSecurityGroupIngress
forall x.
AuthorizeSecurityGroupIngress
-> Rep AuthorizeSecurityGroupIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeSecurityGroupIngress x
-> AuthorizeSecurityGroupIngress
$cfrom :: forall x.
AuthorizeSecurityGroupIngress
-> Rep AuthorizeSecurityGroupIngress x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeSecurityGroupIngress' 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', 'authorizeSecurityGroupIngress_cidrIp' - The IPv4 address range, in CIDR format. You can\'t specify this
-- parameter when specifying a source security group. To specify an IPv6
-- address range, use a set of IP permissions.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
--
-- 'dryRun', 'authorizeSecurityGroupIngress_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', 'authorizeSecurityGroupIngress_fromPort' - The start of port range for the TCP and UDP protocols, or an ICMP type
-- number. For the ICMP type number, use @-1@ to specify all types. If you
-- specify all ICMP types, you must specify all codes.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
--
-- 'groupId', 'authorizeSecurityGroupIngress_groupId' - The ID of the security group. You must specify either the security group
-- ID or the security group name in the request. For security groups in a
-- nondefault VPC, you must specify the security group ID.
--
-- 'groupName', 'authorizeSecurityGroupIngress_groupName' - [EC2-Classic, default VPC] The name of the security group. You must
-- specify either the security group ID or the security group name in the
-- request. For security groups in a nondefault VPC, you must specify the
-- security group ID.
--
-- 'ipPermissions', 'authorizeSecurityGroupIngress_ipPermissions' - The sets of IP permissions.
--
-- 'ipProtocol', 'authorizeSecurityGroupIngress_ipProtocol' - The IP protocol name (@tcp@, @udp@, @icmp@) or number (see
-- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
-- To specify @icmpv6@, use a set of IP permissions.
--
-- [VPC only] Use @-1@ to specify all protocols. If you specify @-1@ or a
-- protocol other than @tcp@, @udp@, or @icmp@, traffic on all ports is
-- allowed, regardless of any ports you specify.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
--
-- 'sourceSecurityGroupName', 'authorizeSecurityGroupIngress_sourceSecurityGroupName' - [EC2-Classic, default VPC] The name of the source security group. You
-- can\'t specify this parameter in combination with the following
-- parameters: the CIDR IP address range, the start of the port range, the
-- IP protocol, and the end of the port range. Creates rules that grant
-- full ICMP, UDP, and TCP access. To create a rule with a specific IP
-- protocol and port range, use a set of IP permissions instead. For
-- EC2-VPC, the source security group must be in the same VPC.
--
-- 'sourceSecurityGroupOwnerId', 'authorizeSecurityGroupIngress_sourceSecurityGroupOwnerId' - [nondefault VPC] The Amazon Web Services account ID for the source
-- security group, if the source security group is in a different account.
-- You can\'t specify this parameter in combination with the following
-- parameters: the CIDR IP address range, the IP protocol, the start of the
-- port range, and the end of the port range. Creates rules that grant full
-- ICMP, UDP, and TCP access. To create a rule with a specific IP protocol
-- and port range, use a set of IP permissions instead.
--
-- 'tagSpecifications', 'authorizeSecurityGroupIngress_tagSpecifications' - [VPC Only] The tags applied to the security group rule.
--
-- 'toPort', 'authorizeSecurityGroupIngress_toPort' - The end of port range for the TCP and UDP protocols, or an ICMP code
-- number. For the ICMP code number, use @-1@ to specify all codes. If you
-- specify all ICMP types, you must specify all codes.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
newAuthorizeSecurityGroupIngress ::
  AuthorizeSecurityGroupIngress
newAuthorizeSecurityGroupIngress :: AuthorizeSecurityGroupIngress
newAuthorizeSecurityGroupIngress =
  AuthorizeSecurityGroupIngress'
    { $sel:cidrIp:AuthorizeSecurityGroupIngress' :: Maybe Text
cidrIp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:AuthorizeSecurityGroupIngress' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:fromPort:AuthorizeSecurityGroupIngress' :: Maybe Int
fromPort = forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:AuthorizeSecurityGroupIngress' :: Maybe Text
groupId = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:AuthorizeSecurityGroupIngress' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:ipPermissions:AuthorizeSecurityGroupIngress' :: Maybe [IpPermission]
ipPermissions = forall a. Maybe a
Prelude.Nothing,
      $sel:ipProtocol:AuthorizeSecurityGroupIngress' :: Maybe Text
ipProtocol = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSecurityGroupName:AuthorizeSecurityGroupIngress' :: Maybe Text
sourceSecurityGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceSecurityGroupOwnerId:AuthorizeSecurityGroupIngress' :: Maybe Text
sourceSecurityGroupOwnerId = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:AuthorizeSecurityGroupIngress' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:toPort:AuthorizeSecurityGroupIngress' :: Maybe Int
toPort = forall a. Maybe a
Prelude.Nothing
    }

-- | The IPv4 address range, in CIDR format. You can\'t specify this
-- parameter when specifying a source security group. To specify an IPv6
-- address range, use a set of IP permissions.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
authorizeSecurityGroupIngress_cidrIp :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeSecurityGroupIngress_cidrIp :: Lens' AuthorizeSecurityGroupIngress (Maybe Text)
authorizeSecurityGroupIngress_cidrIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Text
cidrIp :: Maybe Text
$sel:cidrIp:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
cidrIp} -> Maybe Text
cidrIp) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Text
a -> AuthorizeSecurityGroupIngress
s {$sel:cidrIp:AuthorizeSecurityGroupIngress' :: Maybe Text
cidrIp = Maybe Text
a} :: AuthorizeSecurityGroupIngress)

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

-- | The start of port range for the TCP and UDP protocols, or an ICMP type
-- number. For the ICMP type number, use @-1@ to specify all types. If you
-- specify all ICMP types, you must specify all codes.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
authorizeSecurityGroupIngress_fromPort :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Int)
authorizeSecurityGroupIngress_fromPort :: Lens' AuthorizeSecurityGroupIngress (Maybe Int)
authorizeSecurityGroupIngress_fromPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Int
fromPort :: Maybe Int
$sel:fromPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
fromPort} -> Maybe Int
fromPort) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Int
a -> AuthorizeSecurityGroupIngress
s {$sel:fromPort:AuthorizeSecurityGroupIngress' :: Maybe Int
fromPort = Maybe Int
a} :: AuthorizeSecurityGroupIngress)

-- | The ID of the security group. You must specify either the security group
-- ID or the security group name in the request. For security groups in a
-- nondefault VPC, you must specify the security group ID.
authorizeSecurityGroupIngress_groupId :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeSecurityGroupIngress_groupId :: Lens' AuthorizeSecurityGroupIngress (Maybe Text)
authorizeSecurityGroupIngress_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Text
groupId :: Maybe Text
$sel:groupId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
groupId} -> Maybe Text
groupId) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Text
a -> AuthorizeSecurityGroupIngress
s {$sel:groupId:AuthorizeSecurityGroupIngress' :: Maybe Text
groupId = Maybe Text
a} :: AuthorizeSecurityGroupIngress)

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

-- | The sets of IP permissions.
authorizeSecurityGroupIngress_ipPermissions :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe [IpPermission])
authorizeSecurityGroupIngress_ipPermissions :: Lens' AuthorizeSecurityGroupIngress (Maybe [IpPermission])
authorizeSecurityGroupIngress_ipPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe [IpPermission]
ipPermissions :: Maybe [IpPermission]
$sel:ipPermissions:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [IpPermission]
ipPermissions} -> Maybe [IpPermission]
ipPermissions) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe [IpPermission]
a -> AuthorizeSecurityGroupIngress
s {$sel:ipPermissions:AuthorizeSecurityGroupIngress' :: Maybe [IpPermission]
ipPermissions = Maybe [IpPermission]
a} :: AuthorizeSecurityGroupIngress) 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 IP protocol name (@tcp@, @udp@, @icmp@) or number (see
-- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
-- To specify @icmpv6@, use a set of IP permissions.
--
-- [VPC only] Use @-1@ to specify all protocols. If you specify @-1@ or a
-- protocol other than @tcp@, @udp@, or @icmp@, traffic on all ports is
-- allowed, regardless of any ports you specify.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
authorizeSecurityGroupIngress_ipProtocol :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeSecurityGroupIngress_ipProtocol :: Lens' AuthorizeSecurityGroupIngress (Maybe Text)
authorizeSecurityGroupIngress_ipProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Text
ipProtocol :: Maybe Text
$sel:ipProtocol:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
ipProtocol} -> Maybe Text
ipProtocol) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Text
a -> AuthorizeSecurityGroupIngress
s {$sel:ipProtocol:AuthorizeSecurityGroupIngress' :: Maybe Text
ipProtocol = Maybe Text
a} :: AuthorizeSecurityGroupIngress)

-- | [EC2-Classic, default VPC] The name of the source security group. You
-- can\'t specify this parameter in combination with the following
-- parameters: the CIDR IP address range, the start of the port range, the
-- IP protocol, and the end of the port range. Creates rules that grant
-- full ICMP, UDP, and TCP access. To create a rule with a specific IP
-- protocol and port range, use a set of IP permissions instead. For
-- EC2-VPC, the source security group must be in the same VPC.
authorizeSecurityGroupIngress_sourceSecurityGroupName :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeSecurityGroupIngress_sourceSecurityGroupName :: Lens' AuthorizeSecurityGroupIngress (Maybe Text)
authorizeSecurityGroupIngress_sourceSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Text
sourceSecurityGroupName :: Maybe Text
$sel:sourceSecurityGroupName:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
sourceSecurityGroupName} -> Maybe Text
sourceSecurityGroupName) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Text
a -> AuthorizeSecurityGroupIngress
s {$sel:sourceSecurityGroupName:AuthorizeSecurityGroupIngress' :: Maybe Text
sourceSecurityGroupName = Maybe Text
a} :: AuthorizeSecurityGroupIngress)

-- | [nondefault VPC] The Amazon Web Services account ID for the source
-- security group, if the source security group is in a different account.
-- You can\'t specify this parameter in combination with the following
-- parameters: the CIDR IP address range, the IP protocol, the start of the
-- port range, and the end of the port range. Creates rules that grant full
-- ICMP, UDP, and TCP access. To create a rule with a specific IP protocol
-- and port range, use a set of IP permissions instead.
authorizeSecurityGroupIngress_sourceSecurityGroupOwnerId :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeSecurityGroupIngress_sourceSecurityGroupOwnerId :: Lens' AuthorizeSecurityGroupIngress (Maybe Text)
authorizeSecurityGroupIngress_sourceSecurityGroupOwnerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Text
sourceSecurityGroupOwnerId :: Maybe Text
$sel:sourceSecurityGroupOwnerId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
sourceSecurityGroupOwnerId} -> Maybe Text
sourceSecurityGroupOwnerId) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Text
a -> AuthorizeSecurityGroupIngress
s {$sel:sourceSecurityGroupOwnerId:AuthorizeSecurityGroupIngress' :: Maybe Text
sourceSecurityGroupOwnerId = Maybe Text
a} :: AuthorizeSecurityGroupIngress)

-- | [VPC Only] The tags applied to the security group rule.
authorizeSecurityGroupIngress_tagSpecifications :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe [TagSpecification])
authorizeSecurityGroupIngress_tagSpecifications :: Lens' AuthorizeSecurityGroupIngress (Maybe [TagSpecification])
authorizeSecurityGroupIngress_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe [TagSpecification]
a -> AuthorizeSecurityGroupIngress
s {$sel:tagSpecifications:AuthorizeSecurityGroupIngress' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: AuthorizeSecurityGroupIngress) 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 end of port range for the TCP and UDP protocols, or an ICMP code
-- number. For the ICMP code number, use @-1@ to specify all codes. If you
-- specify all ICMP types, you must specify all codes.
--
-- Alternatively, use a set of IP permissions to specify multiple rules and
-- a description for the rule.
authorizeSecurityGroupIngress_toPort :: Lens.Lens' AuthorizeSecurityGroupIngress (Prelude.Maybe Prelude.Int)
authorizeSecurityGroupIngress_toPort :: Lens' AuthorizeSecurityGroupIngress (Maybe Int)
authorizeSecurityGroupIngress_toPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngress' {Maybe Int
toPort :: Maybe Int
$sel:toPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
toPort} -> Maybe Int
toPort) (\s :: AuthorizeSecurityGroupIngress
s@AuthorizeSecurityGroupIngress' {} Maybe Int
a -> AuthorizeSecurityGroupIngress
s {$sel:toPort:AuthorizeSecurityGroupIngress' :: Maybe Int
toPort = Maybe Int
a} :: AuthorizeSecurityGroupIngress)

instance
  Core.AWSRequest
    AuthorizeSecurityGroupIngress
  where
  type
    AWSResponse AuthorizeSecurityGroupIngress =
      AuthorizeSecurityGroupIngressResponse
  request :: (Service -> Service)
-> AuthorizeSecurityGroupIngress
-> Request AuthorizeSecurityGroupIngress
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 AuthorizeSecurityGroupIngress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AuthorizeSecurityGroupIngress)))
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 [SecurityGroupRule]
-> Int
-> AuthorizeSecurityGroupIngressResponse
AuthorizeSecurityGroupIngressResponse'
            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
"securityGroupRuleSet"
                            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
    AuthorizeSecurityGroupIngress
  where
  hashWithSalt :: Int -> AuthorizeSecurityGroupIngress -> Int
hashWithSalt Int
_salt AuthorizeSecurityGroupIngress' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe [IpPermission]
Maybe Text
toPort :: Maybe Int
tagSpecifications :: Maybe [TagSpecification]
sourceSecurityGroupOwnerId :: Maybe Text
sourceSecurityGroupName :: Maybe Text
ipProtocol :: Maybe Text
ipPermissions :: Maybe [IpPermission]
groupName :: Maybe Text
groupId :: Maybe Text
fromPort :: Maybe Int
dryRun :: Maybe Bool
cidrIp :: Maybe Text
$sel:toPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
$sel:tagSpecifications:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [TagSpecification]
$sel:sourceSecurityGroupOwnerId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:sourceSecurityGroupName:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:ipProtocol:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:ipPermissions:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [IpPermission]
$sel:groupName:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:groupId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:fromPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
$sel:dryRun:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Bool
$sel:cidrIp:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> 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 Text
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName
      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
sourceSecurityGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceSecurityGroupOwnerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
toPort

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

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

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

instance Data.ToQuery AuthorizeSecurityGroupIngress where
  toQuery :: AuthorizeSecurityGroupIngress -> QueryString
toQuery AuthorizeSecurityGroupIngress' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe [IpPermission]
Maybe Text
toPort :: Maybe Int
tagSpecifications :: Maybe [TagSpecification]
sourceSecurityGroupOwnerId :: Maybe Text
sourceSecurityGroupName :: Maybe Text
ipProtocol :: Maybe Text
ipPermissions :: Maybe [IpPermission]
groupName :: Maybe Text
groupId :: Maybe Text
fromPort :: Maybe Int
dryRun :: Maybe Bool
cidrIp :: Maybe Text
$sel:toPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
$sel:tagSpecifications:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [TagSpecification]
$sel:sourceSecurityGroupOwnerId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:sourceSecurityGroupName:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:ipProtocol:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:ipPermissions:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe [IpPermission]
$sel:groupName:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:groupId:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
$sel:fromPort:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Int
$sel:dryRun:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Bool
$sel:cidrIp:AuthorizeSecurityGroupIngress' :: AuthorizeSecurityGroupIngress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"AuthorizeSecurityGroupIngress" ::
                      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,
        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,
        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,
        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,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"ToPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
toPort
      ]

-- | /See:/ 'newAuthorizeSecurityGroupIngressResponse' smart constructor.
data AuthorizeSecurityGroupIngressResponse = AuthorizeSecurityGroupIngressResponse'
  { -- | Returns @true@ if the request succeeds; otherwise, returns an error.
    AuthorizeSecurityGroupIngressResponse -> Maybe Bool
return' :: Prelude.Maybe Prelude.Bool,
    -- | Information about the inbound (ingress) security group rules that were
    -- added.
    AuthorizeSecurityGroupIngressResponse -> Maybe [SecurityGroupRule]
securityGroupRules :: Prelude.Maybe [SecurityGroupRule],
    -- | The response's http status code.
    AuthorizeSecurityGroupIngressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AuthorizeSecurityGroupIngressResponse
-> AuthorizeSecurityGroupIngressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeSecurityGroupIngressResponse
-> AuthorizeSecurityGroupIngressResponse -> Bool
$c/= :: AuthorizeSecurityGroupIngressResponse
-> AuthorizeSecurityGroupIngressResponse -> Bool
== :: AuthorizeSecurityGroupIngressResponse
-> AuthorizeSecurityGroupIngressResponse -> Bool
$c== :: AuthorizeSecurityGroupIngressResponse
-> AuthorizeSecurityGroupIngressResponse -> Bool
Prelude.Eq, ReadPrec [AuthorizeSecurityGroupIngressResponse]
ReadPrec AuthorizeSecurityGroupIngressResponse
Int -> ReadS AuthorizeSecurityGroupIngressResponse
ReadS [AuthorizeSecurityGroupIngressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeSecurityGroupIngressResponse]
$creadListPrec :: ReadPrec [AuthorizeSecurityGroupIngressResponse]
readPrec :: ReadPrec AuthorizeSecurityGroupIngressResponse
$creadPrec :: ReadPrec AuthorizeSecurityGroupIngressResponse
readList :: ReadS [AuthorizeSecurityGroupIngressResponse]
$creadList :: ReadS [AuthorizeSecurityGroupIngressResponse]
readsPrec :: Int -> ReadS AuthorizeSecurityGroupIngressResponse
$creadsPrec :: Int -> ReadS AuthorizeSecurityGroupIngressResponse
Prelude.Read, Int -> AuthorizeSecurityGroupIngressResponse -> ShowS
[AuthorizeSecurityGroupIngressResponse] -> ShowS
AuthorizeSecurityGroupIngressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeSecurityGroupIngressResponse] -> ShowS
$cshowList :: [AuthorizeSecurityGroupIngressResponse] -> ShowS
show :: AuthorizeSecurityGroupIngressResponse -> String
$cshow :: AuthorizeSecurityGroupIngressResponse -> String
showsPrec :: Int -> AuthorizeSecurityGroupIngressResponse -> ShowS
$cshowsPrec :: Int -> AuthorizeSecurityGroupIngressResponse -> ShowS
Prelude.Show, forall x.
Rep AuthorizeSecurityGroupIngressResponse x
-> AuthorizeSecurityGroupIngressResponse
forall x.
AuthorizeSecurityGroupIngressResponse
-> Rep AuthorizeSecurityGroupIngressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeSecurityGroupIngressResponse x
-> AuthorizeSecurityGroupIngressResponse
$cfrom :: forall x.
AuthorizeSecurityGroupIngressResponse
-> Rep AuthorizeSecurityGroupIngressResponse x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeSecurityGroupIngressResponse' 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'', 'authorizeSecurityGroupIngressResponse_return' - Returns @true@ if the request succeeds; otherwise, returns an error.
--
-- 'securityGroupRules', 'authorizeSecurityGroupIngressResponse_securityGroupRules' - Information about the inbound (ingress) security group rules that were
-- added.
--
-- 'httpStatus', 'authorizeSecurityGroupIngressResponse_httpStatus' - The response's http status code.
newAuthorizeSecurityGroupIngressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AuthorizeSecurityGroupIngressResponse
newAuthorizeSecurityGroupIngressResponse :: Int -> AuthorizeSecurityGroupIngressResponse
newAuthorizeSecurityGroupIngressResponse Int
pHttpStatus_ =
  AuthorizeSecurityGroupIngressResponse'
    { $sel:return':AuthorizeSecurityGroupIngressResponse' :: Maybe Bool
return' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupRules:AuthorizeSecurityGroupIngressResponse' :: Maybe [SecurityGroupRule]
securityGroupRules = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AuthorizeSecurityGroupIngressResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | Information about the inbound (ingress) security group rules that were
-- added.
authorizeSecurityGroupIngressResponse_securityGroupRules :: Lens.Lens' AuthorizeSecurityGroupIngressResponse (Prelude.Maybe [SecurityGroupRule])
authorizeSecurityGroupIngressResponse_securityGroupRules :: Lens'
  AuthorizeSecurityGroupIngressResponse (Maybe [SecurityGroupRule])
authorizeSecurityGroupIngressResponse_securityGroupRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngressResponse' {Maybe [SecurityGroupRule]
securityGroupRules :: Maybe [SecurityGroupRule]
$sel:securityGroupRules:AuthorizeSecurityGroupIngressResponse' :: AuthorizeSecurityGroupIngressResponse -> Maybe [SecurityGroupRule]
securityGroupRules} -> Maybe [SecurityGroupRule]
securityGroupRules) (\s :: AuthorizeSecurityGroupIngressResponse
s@AuthorizeSecurityGroupIngressResponse' {} Maybe [SecurityGroupRule]
a -> AuthorizeSecurityGroupIngressResponse
s {$sel:securityGroupRules:AuthorizeSecurityGroupIngressResponse' :: Maybe [SecurityGroupRule]
securityGroupRules = Maybe [SecurityGroupRule]
a} :: AuthorizeSecurityGroupIngressResponse) 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.
authorizeSecurityGroupIngressResponse_httpStatus :: Lens.Lens' AuthorizeSecurityGroupIngressResponse Prelude.Int
authorizeSecurityGroupIngressResponse_httpStatus :: Lens' AuthorizeSecurityGroupIngressResponse Int
authorizeSecurityGroupIngressResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeSecurityGroupIngressResponse' {Int
httpStatus :: Int
$sel:httpStatus:AuthorizeSecurityGroupIngressResponse' :: AuthorizeSecurityGroupIngressResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AuthorizeSecurityGroupIngressResponse
s@AuthorizeSecurityGroupIngressResponse' {} Int
a -> AuthorizeSecurityGroupIngressResponse
s {$sel:httpStatus:AuthorizeSecurityGroupIngressResponse' :: Int
httpStatus = Int
a} :: AuthorizeSecurityGroupIngressResponse)

instance
  Prelude.NFData
    AuthorizeSecurityGroupIngressResponse
  where
  rnf :: AuthorizeSecurityGroupIngressResponse -> ()
rnf AuthorizeSecurityGroupIngressResponse' {Int
Maybe Bool
Maybe [SecurityGroupRule]
httpStatus :: Int
securityGroupRules :: Maybe [SecurityGroupRule]
return' :: Maybe Bool
$sel:httpStatus:AuthorizeSecurityGroupIngressResponse' :: AuthorizeSecurityGroupIngressResponse -> Int
$sel:securityGroupRules:AuthorizeSecurityGroupIngressResponse' :: AuthorizeSecurityGroupIngressResponse -> Maybe [SecurityGroupRule]
$sel:return':AuthorizeSecurityGroupIngressResponse' :: AuthorizeSecurityGroupIngressResponse -> 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 [SecurityGroupRule]
securityGroupRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus