{-# 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.UpdateSecurityGroupRuleDescriptionsIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the description of an ingress (inbound) security group rule. You
-- can replace an existing description, or add a description to a rule that
-- did not have one previously. You can remove a description for a security
-- group rule by omitting the description parameter in the request.
module Amazonka.EC2.UpdateSecurityGroupRuleDescriptionsIngress
  ( -- * Creating a Request
    UpdateSecurityGroupRuleDescriptionsIngress (..),
    newUpdateSecurityGroupRuleDescriptionsIngress,

    -- * Request Lenses
    updateSecurityGroupRuleDescriptionsIngress_dryRun,
    updateSecurityGroupRuleDescriptionsIngress_groupId,
    updateSecurityGroupRuleDescriptionsIngress_groupName,
    updateSecurityGroupRuleDescriptionsIngress_ipPermissions,
    updateSecurityGroupRuleDescriptionsIngress_securityGroupRuleDescriptions,

    -- * Destructuring the Response
    UpdateSecurityGroupRuleDescriptionsIngressResponse (..),
    newUpdateSecurityGroupRuleDescriptionsIngressResponse,

    -- * Response Lenses
    updateSecurityGroupRuleDescriptionsIngressResponse_return,
    updateSecurityGroupRuleDescriptionsIngressResponse_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:/ 'newUpdateSecurityGroupRuleDescriptionsIngress' smart constructor.
data UpdateSecurityGroupRuleDescriptionsIngress = UpdateSecurityGroupRuleDescriptionsIngress'
  { -- | 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@.
    UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | 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.
    UpdateSecurityGroupRuleDescriptionsIngress -> 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.
    UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The IP permissions for the security group rule. You must specify either
    -- IP permissions or a description.
    UpdateSecurityGroupRuleDescriptionsIngress -> Maybe [IpPermission]
ipPermissions :: Prelude.Maybe [IpPermission],
    -- | [VPC only] The description for the ingress security group rules. You
    -- must specify either a description or IP permissions.
    UpdateSecurityGroupRuleDescriptionsIngress
-> Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions :: Prelude.Maybe [SecurityGroupRuleDescription]
  }
  deriving (UpdateSecurityGroupRuleDescriptionsIngress
-> UpdateSecurityGroupRuleDescriptionsIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSecurityGroupRuleDescriptionsIngress
-> UpdateSecurityGroupRuleDescriptionsIngress -> Bool
$c/= :: UpdateSecurityGroupRuleDescriptionsIngress
-> UpdateSecurityGroupRuleDescriptionsIngress -> Bool
== :: UpdateSecurityGroupRuleDescriptionsIngress
-> UpdateSecurityGroupRuleDescriptionsIngress -> Bool
$c== :: UpdateSecurityGroupRuleDescriptionsIngress
-> UpdateSecurityGroupRuleDescriptionsIngress -> Bool
Prelude.Eq, ReadPrec [UpdateSecurityGroupRuleDescriptionsIngress]
ReadPrec UpdateSecurityGroupRuleDescriptionsIngress
Int -> ReadS UpdateSecurityGroupRuleDescriptionsIngress
ReadS [UpdateSecurityGroupRuleDescriptionsIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSecurityGroupRuleDescriptionsIngress]
$creadListPrec :: ReadPrec [UpdateSecurityGroupRuleDescriptionsIngress]
readPrec :: ReadPrec UpdateSecurityGroupRuleDescriptionsIngress
$creadPrec :: ReadPrec UpdateSecurityGroupRuleDescriptionsIngress
readList :: ReadS [UpdateSecurityGroupRuleDescriptionsIngress]
$creadList :: ReadS [UpdateSecurityGroupRuleDescriptionsIngress]
readsPrec :: Int -> ReadS UpdateSecurityGroupRuleDescriptionsIngress
$creadsPrec :: Int -> ReadS UpdateSecurityGroupRuleDescriptionsIngress
Prelude.Read, Int -> UpdateSecurityGroupRuleDescriptionsIngress -> ShowS
[UpdateSecurityGroupRuleDescriptionsIngress] -> ShowS
UpdateSecurityGroupRuleDescriptionsIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSecurityGroupRuleDescriptionsIngress] -> ShowS
$cshowList :: [UpdateSecurityGroupRuleDescriptionsIngress] -> ShowS
show :: UpdateSecurityGroupRuleDescriptionsIngress -> String
$cshow :: UpdateSecurityGroupRuleDescriptionsIngress -> String
showsPrec :: Int -> UpdateSecurityGroupRuleDescriptionsIngress -> ShowS
$cshowsPrec :: Int -> UpdateSecurityGroupRuleDescriptionsIngress -> ShowS
Prelude.Show, forall x.
Rep UpdateSecurityGroupRuleDescriptionsIngress x
-> UpdateSecurityGroupRuleDescriptionsIngress
forall x.
UpdateSecurityGroupRuleDescriptionsIngress
-> Rep UpdateSecurityGroupRuleDescriptionsIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateSecurityGroupRuleDescriptionsIngress x
-> UpdateSecurityGroupRuleDescriptionsIngress
$cfrom :: forall x.
UpdateSecurityGroupRuleDescriptionsIngress
-> Rep UpdateSecurityGroupRuleDescriptionsIngress x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSecurityGroupRuleDescriptionsIngress' 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', 'updateSecurityGroupRuleDescriptionsIngress_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', 'updateSecurityGroupRuleDescriptionsIngress_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', 'updateSecurityGroupRuleDescriptionsIngress_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', 'updateSecurityGroupRuleDescriptionsIngress_ipPermissions' - The IP permissions for the security group rule. You must specify either
-- IP permissions or a description.
--
-- 'securityGroupRuleDescriptions', 'updateSecurityGroupRuleDescriptionsIngress_securityGroupRuleDescriptions' - [VPC only] The description for the ingress security group rules. You
-- must specify either a description or IP permissions.
newUpdateSecurityGroupRuleDescriptionsIngress ::
  UpdateSecurityGroupRuleDescriptionsIngress
newUpdateSecurityGroupRuleDescriptionsIngress :: UpdateSecurityGroupRuleDescriptionsIngress
newUpdateSecurityGroupRuleDescriptionsIngress =
  UpdateSecurityGroupRuleDescriptionsIngress'
    { $sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Text
groupId = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe [IpPermission]
ipPermissions = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions =
        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@.
updateSecurityGroupRuleDescriptionsIngress_dryRun :: Lens.Lens' UpdateSecurityGroupRuleDescriptionsIngress (Prelude.Maybe Prelude.Bool)
updateSecurityGroupRuleDescriptionsIngress_dryRun :: Lens' UpdateSecurityGroupRuleDescriptionsIngress (Maybe Bool)
updateSecurityGroupRuleDescriptionsIngress_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: UpdateSecurityGroupRuleDescriptionsIngress
s@UpdateSecurityGroupRuleDescriptionsIngress' {} Maybe Bool
a -> UpdateSecurityGroupRuleDescriptionsIngress
s {$sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Bool
dryRun = Maybe Bool
a} :: UpdateSecurityGroupRuleDescriptionsIngress)

-- | 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.
updateSecurityGroupRuleDescriptionsIngress_groupId :: Lens.Lens' UpdateSecurityGroupRuleDescriptionsIngress (Prelude.Maybe Prelude.Text)
updateSecurityGroupRuleDescriptionsIngress_groupId :: Lens' UpdateSecurityGroupRuleDescriptionsIngress (Maybe Text)
updateSecurityGroupRuleDescriptionsIngress_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Text
groupId :: Maybe Text
$sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
groupId} -> Maybe Text
groupId) (\s :: UpdateSecurityGroupRuleDescriptionsIngress
s@UpdateSecurityGroupRuleDescriptionsIngress' {} Maybe Text
a -> UpdateSecurityGroupRuleDescriptionsIngress
s {$sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Text
groupId = Maybe Text
a} :: UpdateSecurityGroupRuleDescriptionsIngress)

-- | [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.
updateSecurityGroupRuleDescriptionsIngress_groupName :: Lens.Lens' UpdateSecurityGroupRuleDescriptionsIngress (Prelude.Maybe Prelude.Text)
updateSecurityGroupRuleDescriptionsIngress_groupName :: Lens' UpdateSecurityGroupRuleDescriptionsIngress (Maybe Text)
updateSecurityGroupRuleDescriptionsIngress_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Text
groupName :: Maybe Text
$sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: UpdateSecurityGroupRuleDescriptionsIngress
s@UpdateSecurityGroupRuleDescriptionsIngress' {} Maybe Text
a -> UpdateSecurityGroupRuleDescriptionsIngress
s {$sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe Text
groupName = Maybe Text
a} :: UpdateSecurityGroupRuleDescriptionsIngress)

-- | The IP permissions for the security group rule. You must specify either
-- IP permissions or a description.
updateSecurityGroupRuleDescriptionsIngress_ipPermissions :: Lens.Lens' UpdateSecurityGroupRuleDescriptionsIngress (Prelude.Maybe [IpPermission])
updateSecurityGroupRuleDescriptionsIngress_ipPermissions :: Lens'
  UpdateSecurityGroupRuleDescriptionsIngress (Maybe [IpPermission])
updateSecurityGroupRuleDescriptionsIngress_ipPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecurityGroupRuleDescriptionsIngress' {Maybe [IpPermission]
ipPermissions :: Maybe [IpPermission]
$sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe [IpPermission]
ipPermissions} -> Maybe [IpPermission]
ipPermissions) (\s :: UpdateSecurityGroupRuleDescriptionsIngress
s@UpdateSecurityGroupRuleDescriptionsIngress' {} Maybe [IpPermission]
a -> UpdateSecurityGroupRuleDescriptionsIngress
s {$sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe [IpPermission]
ipPermissions = Maybe [IpPermission]
a} :: UpdateSecurityGroupRuleDescriptionsIngress) 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

-- | [VPC only] The description for the ingress security group rules. You
-- must specify either a description or IP permissions.
updateSecurityGroupRuleDescriptionsIngress_securityGroupRuleDescriptions :: Lens.Lens' UpdateSecurityGroupRuleDescriptionsIngress (Prelude.Maybe [SecurityGroupRuleDescription])
updateSecurityGroupRuleDescriptionsIngress_securityGroupRuleDescriptions :: Lens'
  UpdateSecurityGroupRuleDescriptionsIngress
  (Maybe [SecurityGroupRuleDescription])
updateSecurityGroupRuleDescriptionsIngress_securityGroupRuleDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecurityGroupRuleDescriptionsIngress' {Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions :: Maybe [SecurityGroupRuleDescription]
$sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress
-> Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions} -> Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions) (\s :: UpdateSecurityGroupRuleDescriptionsIngress
s@UpdateSecurityGroupRuleDescriptionsIngress' {} Maybe [SecurityGroupRuleDescription]
a -> UpdateSecurityGroupRuleDescriptionsIngress
s {$sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions = Maybe [SecurityGroupRuleDescription]
a} :: UpdateSecurityGroupRuleDescriptionsIngress) 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

instance
  Core.AWSRequest
    UpdateSecurityGroupRuleDescriptionsIngress
  where
  type
    AWSResponse
      UpdateSecurityGroupRuleDescriptionsIngress =
      UpdateSecurityGroupRuleDescriptionsIngressResponse
  request :: (Service -> Service)
-> UpdateSecurityGroupRuleDescriptionsIngress
-> Request UpdateSecurityGroupRuleDescriptionsIngress
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 UpdateSecurityGroupRuleDescriptionsIngress
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse UpdateSecurityGroupRuleDescriptionsIngress)))
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
-> Int -> UpdateSecurityGroupRuleDescriptionsIngressResponse
UpdateSecurityGroupRuleDescriptionsIngressResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    UpdateSecurityGroupRuleDescriptionsIngress
  where
  hashWithSalt :: Int -> UpdateSecurityGroupRuleDescriptionsIngress -> Int
hashWithSalt
    Int
_salt
    UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Bool
Maybe [SecurityGroupRuleDescription]
Maybe [IpPermission]
Maybe Text
securityGroupRuleDescriptions :: Maybe [SecurityGroupRuleDescription]
ipPermissions :: Maybe [IpPermission]
groupName :: Maybe Text
groupId :: Maybe Text
dryRun :: Maybe Bool
$sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress
-> Maybe [SecurityGroupRuleDescription]
$sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe [IpPermission]
$sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> 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
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IpPermission]
ipPermissions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions

instance
  Prelude.NFData
    UpdateSecurityGroupRuleDescriptionsIngress
  where
  rnf :: UpdateSecurityGroupRuleDescriptionsIngress -> ()
rnf UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Bool
Maybe [SecurityGroupRuleDescription]
Maybe [IpPermission]
Maybe Text
securityGroupRuleDescriptions :: Maybe [SecurityGroupRuleDescription]
ipPermissions :: Maybe [IpPermission]
groupName :: Maybe Text
groupId :: Maybe Text
dryRun :: Maybe Bool
$sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress
-> Maybe [SecurityGroupRuleDescription]
$sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe [IpPermission]
$sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> 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
      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 [SecurityGroupRuleDescription]
securityGroupRuleDescriptions

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

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

instance
  Data.ToQuery
    UpdateSecurityGroupRuleDescriptionsIngress
  where
  toQuery :: UpdateSecurityGroupRuleDescriptionsIngress -> QueryString
toQuery
    UpdateSecurityGroupRuleDescriptionsIngress' {Maybe Bool
Maybe [SecurityGroupRuleDescription]
Maybe [IpPermission]
Maybe Text
securityGroupRuleDescriptions :: Maybe [SecurityGroupRuleDescription]
ipPermissions :: Maybe [IpPermission]
groupName :: Maybe Text
groupId :: Maybe Text
dryRun :: Maybe Bool
$sel:securityGroupRuleDescriptions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress
-> Maybe [SecurityGroupRuleDescription]
$sel:ipPermissions:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe [IpPermission]
$sel:groupName:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:groupId:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Text
$sel:dryRun:UpdateSecurityGroupRuleDescriptionsIngress' :: UpdateSecurityGroupRuleDescriptionsIngress -> Maybe Bool
..} =
      forall a. Monoid a => [a] -> a
Prelude.mconcat
        [ ByteString
"Action"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"UpdateSecurityGroupRuleDescriptionsIngress" ::
                        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,
          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
            ),
          forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"SecurityGroupRuleDescription"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [SecurityGroupRuleDescription]
securityGroupRuleDescriptions
            )
        ]

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

-- |
-- Create a value of 'UpdateSecurityGroupRuleDescriptionsIngressResponse' 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'', 'updateSecurityGroupRuleDescriptionsIngressResponse_return' - Returns @true@ if the request succeeds; otherwise, returns an error.
--
-- 'httpStatus', 'updateSecurityGroupRuleDescriptionsIngressResponse_httpStatus' - The response's http status code.
newUpdateSecurityGroupRuleDescriptionsIngressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSecurityGroupRuleDescriptionsIngressResponse
newUpdateSecurityGroupRuleDescriptionsIngressResponse :: Int -> UpdateSecurityGroupRuleDescriptionsIngressResponse
newUpdateSecurityGroupRuleDescriptionsIngressResponse
  Int
pHttpStatus_ =
    UpdateSecurityGroupRuleDescriptionsIngressResponse'
      { $sel:return':UpdateSecurityGroupRuleDescriptionsIngressResponse' :: Maybe Bool
return' =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateSecurityGroupRuleDescriptionsIngressResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

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

instance
  Prelude.NFData
    UpdateSecurityGroupRuleDescriptionsIngressResponse
  where
  rnf :: UpdateSecurityGroupRuleDescriptionsIngressResponse -> ()
rnf
    UpdateSecurityGroupRuleDescriptionsIngressResponse' {Int
Maybe Bool
httpStatus :: Int
return' :: Maybe Bool
$sel:httpStatus:UpdateSecurityGroupRuleDescriptionsIngressResponse' :: UpdateSecurityGroupRuleDescriptionsIngressResponse -> Int
$sel:return':UpdateSecurityGroupRuleDescriptionsIngressResponse' :: UpdateSecurityGroupRuleDescriptionsIngressResponse -> 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 Int
httpStatus