{-# 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.RDS.AuthorizeDBSecurityGroupIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables ingress to a DBSecurityGroup using one of two forms of
-- authorization. First, EC2 or VPC security groups can be added to the
-- DBSecurityGroup if the application using the database is running on EC2
-- or VPC instances. Second, IP ranges are available if the application
-- accessing your database is running on the internet. Required parameters
-- for this API are one of CIDR range, EC2SecurityGroupId for VPC, or
-- (EC2SecurityGroupOwnerId and either EC2SecurityGroupName or
-- EC2SecurityGroupId for non-VPC).
--
-- You can\'t authorize ingress from an EC2 security group in one Amazon
-- Web Services Region to an Amazon RDS DB instance in another. You can\'t
-- authorize ingress from a VPC security group in one VPC to an Amazon RDS
-- DB instance in another.
--
-- For an overview of CIDR ranges, go to the
-- <http://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing Wikipedia Tutorial>.
--
-- EC2-Classic was retired on August 15, 2022. If you haven\'t migrated
-- from EC2-Classic to a VPC, we recommend that you migrate as soon as
-- possible. 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 EC2 User Guide/, the blog
-- <http://aws.amazon.com/blogs/aws/ec2-classic-is-retiring-heres-how-to-prepare/ EC2-Classic Networking is Retiring – Here’s How to Prepare>,
-- and
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_VPC.Non-VPC2VPC.html Moving a DB instance not in a VPC into a VPC>
-- in the /Amazon RDS User Guide/.
module Amazonka.RDS.AuthorizeDBSecurityGroupIngress
  ( -- * Creating a Request
    AuthorizeDBSecurityGroupIngress (..),
    newAuthorizeDBSecurityGroupIngress,

    -- * Request Lenses
    authorizeDBSecurityGroupIngress_cidrip,
    authorizeDBSecurityGroupIngress_eC2SecurityGroupId,
    authorizeDBSecurityGroupIngress_eC2SecurityGroupName,
    authorizeDBSecurityGroupIngress_eC2SecurityGroupOwnerId,
    authorizeDBSecurityGroupIngress_dbSecurityGroupName,

    -- * Destructuring the Response
    AuthorizeDBSecurityGroupIngressResponse (..),
    newAuthorizeDBSecurityGroupIngressResponse,

    -- * Response Lenses
    authorizeDBSecurityGroupIngressResponse_dbSecurityGroup,
    authorizeDBSecurityGroupIngressResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newAuthorizeDBSecurityGroupIngress' smart constructor.
data AuthorizeDBSecurityGroupIngress = AuthorizeDBSecurityGroupIngress'
  { -- | The IP range to authorize.
    AuthorizeDBSecurityGroupIngress -> Maybe Text
cidrip :: Prelude.Maybe Prelude.Text,
    -- | Id of the EC2 security group to authorize. For VPC DB security groups,
    -- @EC2SecurityGroupId@ must be provided. Otherwise,
    -- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
    -- @EC2SecurityGroupId@ must be provided.
    AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupId :: Prelude.Maybe Prelude.Text,
    -- | Name of the EC2 security group to authorize. For VPC DB security groups,
    -- @EC2SecurityGroupId@ must be provided. Otherwise,
    -- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
    -- @EC2SecurityGroupId@ must be provided.
    AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupName :: Prelude.Maybe Prelude.Text,
    -- | Amazon Web Services account number of the owner of the EC2 security
    -- group specified in the @EC2SecurityGroupName@ parameter. The Amazon Web
    -- Services access key ID isn\'t an acceptable value. For VPC DB security
    -- groups, @EC2SecurityGroupId@ must be provided. Otherwise,
    -- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
    -- @EC2SecurityGroupId@ must be provided.
    AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupOwnerId :: Prelude.Maybe Prelude.Text,
    -- | The name of the DB security group to add authorization to.
    AuthorizeDBSecurityGroupIngress -> Text
dbSecurityGroupName :: Prelude.Text
  }
  deriving (AuthorizeDBSecurityGroupIngress
-> AuthorizeDBSecurityGroupIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeDBSecurityGroupIngress
-> AuthorizeDBSecurityGroupIngress -> Bool
$c/= :: AuthorizeDBSecurityGroupIngress
-> AuthorizeDBSecurityGroupIngress -> Bool
== :: AuthorizeDBSecurityGroupIngress
-> AuthorizeDBSecurityGroupIngress -> Bool
$c== :: AuthorizeDBSecurityGroupIngress
-> AuthorizeDBSecurityGroupIngress -> Bool
Prelude.Eq, ReadPrec [AuthorizeDBSecurityGroupIngress]
ReadPrec AuthorizeDBSecurityGroupIngress
Int -> ReadS AuthorizeDBSecurityGroupIngress
ReadS [AuthorizeDBSecurityGroupIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeDBSecurityGroupIngress]
$creadListPrec :: ReadPrec [AuthorizeDBSecurityGroupIngress]
readPrec :: ReadPrec AuthorizeDBSecurityGroupIngress
$creadPrec :: ReadPrec AuthorizeDBSecurityGroupIngress
readList :: ReadS [AuthorizeDBSecurityGroupIngress]
$creadList :: ReadS [AuthorizeDBSecurityGroupIngress]
readsPrec :: Int -> ReadS AuthorizeDBSecurityGroupIngress
$creadsPrec :: Int -> ReadS AuthorizeDBSecurityGroupIngress
Prelude.Read, Int -> AuthorizeDBSecurityGroupIngress -> ShowS
[AuthorizeDBSecurityGroupIngress] -> ShowS
AuthorizeDBSecurityGroupIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeDBSecurityGroupIngress] -> ShowS
$cshowList :: [AuthorizeDBSecurityGroupIngress] -> ShowS
show :: AuthorizeDBSecurityGroupIngress -> String
$cshow :: AuthorizeDBSecurityGroupIngress -> String
showsPrec :: Int -> AuthorizeDBSecurityGroupIngress -> ShowS
$cshowsPrec :: Int -> AuthorizeDBSecurityGroupIngress -> ShowS
Prelude.Show, forall x.
Rep AuthorizeDBSecurityGroupIngress x
-> AuthorizeDBSecurityGroupIngress
forall x.
AuthorizeDBSecurityGroupIngress
-> Rep AuthorizeDBSecurityGroupIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeDBSecurityGroupIngress x
-> AuthorizeDBSecurityGroupIngress
$cfrom :: forall x.
AuthorizeDBSecurityGroupIngress
-> Rep AuthorizeDBSecurityGroupIngress x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeDBSecurityGroupIngress' 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', 'authorizeDBSecurityGroupIngress_cidrip' - The IP range to authorize.
--
-- 'eC2SecurityGroupId', 'authorizeDBSecurityGroupIngress_eC2SecurityGroupId' - Id of the EC2 security group to authorize. For VPC DB security groups,
-- @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
--
-- 'eC2SecurityGroupName', 'authorizeDBSecurityGroupIngress_eC2SecurityGroupName' - Name of the EC2 security group to authorize. For VPC DB security groups,
-- @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
--
-- 'eC2SecurityGroupOwnerId', 'authorizeDBSecurityGroupIngress_eC2SecurityGroupOwnerId' - Amazon Web Services account number of the owner of the EC2 security
-- group specified in the @EC2SecurityGroupName@ parameter. The Amazon Web
-- Services access key ID isn\'t an acceptable value. For VPC DB security
-- groups, @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
--
-- 'dbSecurityGroupName', 'authorizeDBSecurityGroupIngress_dbSecurityGroupName' - The name of the DB security group to add authorization to.
newAuthorizeDBSecurityGroupIngress ::
  -- | 'dbSecurityGroupName'
  Prelude.Text ->
  AuthorizeDBSecurityGroupIngress
newAuthorizeDBSecurityGroupIngress :: Text -> AuthorizeDBSecurityGroupIngress
newAuthorizeDBSecurityGroupIngress
  Text
pDBSecurityGroupName_ =
    AuthorizeDBSecurityGroupIngress'
      { $sel:cidrip:AuthorizeDBSecurityGroupIngress' :: Maybe Text
cidrip =
          forall a. Maybe a
Prelude.Nothing,
        $sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupId = forall a. Maybe a
Prelude.Nothing,
        $sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupOwnerId = forall a. Maybe a
Prelude.Nothing,
        $sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: Text
dbSecurityGroupName =
          Text
pDBSecurityGroupName_
      }

-- | The IP range to authorize.
authorizeDBSecurityGroupIngress_cidrip :: Lens.Lens' AuthorizeDBSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeDBSecurityGroupIngress_cidrip :: Lens' AuthorizeDBSecurityGroupIngress (Maybe Text)
authorizeDBSecurityGroupIngress_cidrip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngress' {Maybe Text
cidrip :: Maybe Text
$sel:cidrip:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
cidrip} -> Maybe Text
cidrip) (\s :: AuthorizeDBSecurityGroupIngress
s@AuthorizeDBSecurityGroupIngress' {} Maybe Text
a -> AuthorizeDBSecurityGroupIngress
s {$sel:cidrip:AuthorizeDBSecurityGroupIngress' :: Maybe Text
cidrip = Maybe Text
a} :: AuthorizeDBSecurityGroupIngress)

-- | Id of the EC2 security group to authorize. For VPC DB security groups,
-- @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
authorizeDBSecurityGroupIngress_eC2SecurityGroupId :: Lens.Lens' AuthorizeDBSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupId :: Lens' AuthorizeDBSecurityGroupIngress (Maybe Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngress' {Maybe Text
eC2SecurityGroupId :: Maybe Text
$sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupId} -> Maybe Text
eC2SecurityGroupId) (\s :: AuthorizeDBSecurityGroupIngress
s@AuthorizeDBSecurityGroupIngress' {} Maybe Text
a -> AuthorizeDBSecurityGroupIngress
s {$sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupId = Maybe Text
a} :: AuthorizeDBSecurityGroupIngress)

-- | Name of the EC2 security group to authorize. For VPC DB security groups,
-- @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
authorizeDBSecurityGroupIngress_eC2SecurityGroupName :: Lens.Lens' AuthorizeDBSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupName :: Lens' AuthorizeDBSecurityGroupIngress (Maybe Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngress' {Maybe Text
eC2SecurityGroupName :: Maybe Text
$sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupName} -> Maybe Text
eC2SecurityGroupName) (\s :: AuthorizeDBSecurityGroupIngress
s@AuthorizeDBSecurityGroupIngress' {} Maybe Text
a -> AuthorizeDBSecurityGroupIngress
s {$sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupName = Maybe Text
a} :: AuthorizeDBSecurityGroupIngress)

-- | Amazon Web Services account number of the owner of the EC2 security
-- group specified in the @EC2SecurityGroupName@ parameter. The Amazon Web
-- Services access key ID isn\'t an acceptable value. For VPC DB security
-- groups, @EC2SecurityGroupId@ must be provided. Otherwise,
-- @EC2SecurityGroupOwnerId@ and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
authorizeDBSecurityGroupIngress_eC2SecurityGroupOwnerId :: Lens.Lens' AuthorizeDBSecurityGroupIngress (Prelude.Maybe Prelude.Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupOwnerId :: Lens' AuthorizeDBSecurityGroupIngress (Maybe Text)
authorizeDBSecurityGroupIngress_eC2SecurityGroupOwnerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngress' {Maybe Text
eC2SecurityGroupOwnerId :: Maybe Text
$sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupOwnerId} -> Maybe Text
eC2SecurityGroupOwnerId) (\s :: AuthorizeDBSecurityGroupIngress
s@AuthorizeDBSecurityGroupIngress' {} Maybe Text
a -> AuthorizeDBSecurityGroupIngress
s {$sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupOwnerId = Maybe Text
a} :: AuthorizeDBSecurityGroupIngress)

-- | The name of the DB security group to add authorization to.
authorizeDBSecurityGroupIngress_dbSecurityGroupName :: Lens.Lens' AuthorizeDBSecurityGroupIngress Prelude.Text
authorizeDBSecurityGroupIngress_dbSecurityGroupName :: Lens' AuthorizeDBSecurityGroupIngress Text
authorizeDBSecurityGroupIngress_dbSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngress' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Text
dbSecurityGroupName} -> Text
dbSecurityGroupName) (\s :: AuthorizeDBSecurityGroupIngress
s@AuthorizeDBSecurityGroupIngress' {} Text
a -> AuthorizeDBSecurityGroupIngress
s {$sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: Text
dbSecurityGroupName = Text
a} :: AuthorizeDBSecurityGroupIngress)

instance
  Core.AWSRequest
    AuthorizeDBSecurityGroupIngress
  where
  type
    AWSResponse AuthorizeDBSecurityGroupIngress =
      AuthorizeDBSecurityGroupIngressResponse
  request :: (Service -> Service)
-> AuthorizeDBSecurityGroupIngress
-> Request AuthorizeDBSecurityGroupIngress
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 AuthorizeDBSecurityGroupIngress
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AuthorizeDBSecurityGroupIngress)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"AuthorizeDBSecurityGroupIngressResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSecurityGroup
-> Int -> AuthorizeDBSecurityGroupIngressResponse
AuthorizeDBSecurityGroupIngressResponse'
            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
"DBSecurityGroup")
            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
    AuthorizeDBSecurityGroupIngress
  where
  hashWithSalt :: Int -> AuthorizeDBSecurityGroupIngress -> Int
hashWithSalt
    Int
_salt
    AuthorizeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> 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 Text
eC2SecurityGroupId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eC2SecurityGroupName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eC2SecurityGroupOwnerId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSecurityGroupName

instance
  Prelude.NFData
    AuthorizeDBSecurityGroupIngress
  where
  rnf :: AuthorizeDBSecurityGroupIngress -> ()
rnf AuthorizeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> 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 Text
eC2SecurityGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eC2SecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eC2SecurityGroupOwnerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbSecurityGroupName

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

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

instance Data.ToQuery AuthorizeDBSecurityGroupIngress where
  toQuery :: AuthorizeDBSecurityGroupIngress -> QueryString
toQuery AuthorizeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:AuthorizeDBSecurityGroupIngress' :: AuthorizeDBSecurityGroupIngress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"AuthorizeDBSecurityGroupIngress" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"CIDRIP" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cidrip,
        ByteString
"EC2SecurityGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eC2SecurityGroupId,
        ByteString
"EC2SecurityGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eC2SecurityGroupName,
        ByteString
"EC2SecurityGroupOwnerId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
eC2SecurityGroupOwnerId,
        ByteString
"DBSecurityGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSecurityGroupName
      ]

-- | /See:/ 'newAuthorizeDBSecurityGroupIngressResponse' smart constructor.
data AuthorizeDBSecurityGroupIngressResponse = AuthorizeDBSecurityGroupIngressResponse'
  { AuthorizeDBSecurityGroupIngressResponse -> Maybe DBSecurityGroup
dbSecurityGroup :: Prelude.Maybe DBSecurityGroup,
    -- | The response's http status code.
    AuthorizeDBSecurityGroupIngressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AuthorizeDBSecurityGroupIngressResponse
-> AuthorizeDBSecurityGroupIngressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeDBSecurityGroupIngressResponse
-> AuthorizeDBSecurityGroupIngressResponse -> Bool
$c/= :: AuthorizeDBSecurityGroupIngressResponse
-> AuthorizeDBSecurityGroupIngressResponse -> Bool
== :: AuthorizeDBSecurityGroupIngressResponse
-> AuthorizeDBSecurityGroupIngressResponse -> Bool
$c== :: AuthorizeDBSecurityGroupIngressResponse
-> AuthorizeDBSecurityGroupIngressResponse -> Bool
Prelude.Eq, ReadPrec [AuthorizeDBSecurityGroupIngressResponse]
ReadPrec AuthorizeDBSecurityGroupIngressResponse
Int -> ReadS AuthorizeDBSecurityGroupIngressResponse
ReadS [AuthorizeDBSecurityGroupIngressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeDBSecurityGroupIngressResponse]
$creadListPrec :: ReadPrec [AuthorizeDBSecurityGroupIngressResponse]
readPrec :: ReadPrec AuthorizeDBSecurityGroupIngressResponse
$creadPrec :: ReadPrec AuthorizeDBSecurityGroupIngressResponse
readList :: ReadS [AuthorizeDBSecurityGroupIngressResponse]
$creadList :: ReadS [AuthorizeDBSecurityGroupIngressResponse]
readsPrec :: Int -> ReadS AuthorizeDBSecurityGroupIngressResponse
$creadsPrec :: Int -> ReadS AuthorizeDBSecurityGroupIngressResponse
Prelude.Read, Int -> AuthorizeDBSecurityGroupIngressResponse -> ShowS
[AuthorizeDBSecurityGroupIngressResponse] -> ShowS
AuthorizeDBSecurityGroupIngressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeDBSecurityGroupIngressResponse] -> ShowS
$cshowList :: [AuthorizeDBSecurityGroupIngressResponse] -> ShowS
show :: AuthorizeDBSecurityGroupIngressResponse -> String
$cshow :: AuthorizeDBSecurityGroupIngressResponse -> String
showsPrec :: Int -> AuthorizeDBSecurityGroupIngressResponse -> ShowS
$cshowsPrec :: Int -> AuthorizeDBSecurityGroupIngressResponse -> ShowS
Prelude.Show, forall x.
Rep AuthorizeDBSecurityGroupIngressResponse x
-> AuthorizeDBSecurityGroupIngressResponse
forall x.
AuthorizeDBSecurityGroupIngressResponse
-> Rep AuthorizeDBSecurityGroupIngressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeDBSecurityGroupIngressResponse x
-> AuthorizeDBSecurityGroupIngressResponse
$cfrom :: forall x.
AuthorizeDBSecurityGroupIngressResponse
-> Rep AuthorizeDBSecurityGroupIngressResponse x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeDBSecurityGroupIngressResponse' 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:
--
-- 'dbSecurityGroup', 'authorizeDBSecurityGroupIngressResponse_dbSecurityGroup' - Undocumented member.
--
-- 'httpStatus', 'authorizeDBSecurityGroupIngressResponse_httpStatus' - The response's http status code.
newAuthorizeDBSecurityGroupIngressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AuthorizeDBSecurityGroupIngressResponse
newAuthorizeDBSecurityGroupIngressResponse :: Int -> AuthorizeDBSecurityGroupIngressResponse
newAuthorizeDBSecurityGroupIngressResponse
  Int
pHttpStatus_ =
    AuthorizeDBSecurityGroupIngressResponse'
      { $sel:dbSecurityGroup:AuthorizeDBSecurityGroupIngressResponse' :: Maybe DBSecurityGroup
dbSecurityGroup =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AuthorizeDBSecurityGroupIngressResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Undocumented member.
authorizeDBSecurityGroupIngressResponse_dbSecurityGroup :: Lens.Lens' AuthorizeDBSecurityGroupIngressResponse (Prelude.Maybe DBSecurityGroup)
authorizeDBSecurityGroupIngressResponse_dbSecurityGroup :: Lens'
  AuthorizeDBSecurityGroupIngressResponse (Maybe DBSecurityGroup)
authorizeDBSecurityGroupIngressResponse_dbSecurityGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeDBSecurityGroupIngressResponse' {Maybe DBSecurityGroup
dbSecurityGroup :: Maybe DBSecurityGroup
$sel:dbSecurityGroup:AuthorizeDBSecurityGroupIngressResponse' :: AuthorizeDBSecurityGroupIngressResponse -> Maybe DBSecurityGroup
dbSecurityGroup} -> Maybe DBSecurityGroup
dbSecurityGroup) (\s :: AuthorizeDBSecurityGroupIngressResponse
s@AuthorizeDBSecurityGroupIngressResponse' {} Maybe DBSecurityGroup
a -> AuthorizeDBSecurityGroupIngressResponse
s {$sel:dbSecurityGroup:AuthorizeDBSecurityGroupIngressResponse' :: Maybe DBSecurityGroup
dbSecurityGroup = Maybe DBSecurityGroup
a} :: AuthorizeDBSecurityGroupIngressResponse)

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

instance
  Prelude.NFData
    AuthorizeDBSecurityGroupIngressResponse
  where
  rnf :: AuthorizeDBSecurityGroupIngressResponse -> ()
rnf AuthorizeDBSecurityGroupIngressResponse' {Int
Maybe DBSecurityGroup
httpStatus :: Int
dbSecurityGroup :: Maybe DBSecurityGroup
$sel:httpStatus:AuthorizeDBSecurityGroupIngressResponse' :: AuthorizeDBSecurityGroupIngressResponse -> Int
$sel:dbSecurityGroup:AuthorizeDBSecurityGroupIngressResponse' :: AuthorizeDBSecurityGroupIngressResponse -> Maybe DBSecurityGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DBSecurityGroup
dbSecurityGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus