{-# 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.RevokeDBSecurityGroupIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Revokes ingress from a DBSecurityGroup for previously authorized IP
-- ranges or EC2 or VPC security groups. Required parameters for this API
-- are one of CIDRIP, EC2SecurityGroupId for VPC, or
-- (EC2SecurityGroupOwnerId and either EC2SecurityGroupName or
-- EC2SecurityGroupId).
--
-- 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.RevokeDBSecurityGroupIngress
  ( -- * Creating a Request
    RevokeDBSecurityGroupIngress (..),
    newRevokeDBSecurityGroupIngress,

    -- * Request Lenses
    revokeDBSecurityGroupIngress_cidrip,
    revokeDBSecurityGroupIngress_eC2SecurityGroupId,
    revokeDBSecurityGroupIngress_eC2SecurityGroupName,
    revokeDBSecurityGroupIngress_eC2SecurityGroupOwnerId,
    revokeDBSecurityGroupIngress_dbSecurityGroupName,

    -- * Destructuring the Response
    RevokeDBSecurityGroupIngressResponse (..),
    newRevokeDBSecurityGroupIngressResponse,

    -- * Response Lenses
    revokeDBSecurityGroupIngressResponse_dbSecurityGroup,
    revokeDBSecurityGroupIngressResponse_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:/ 'newRevokeDBSecurityGroupIngress' smart constructor.
data RevokeDBSecurityGroupIngress = RevokeDBSecurityGroupIngress'
  { -- | The IP range to revoke access from. Must be a valid CIDR range. If
    -- @CIDRIP@ is specified, @EC2SecurityGroupName@, @EC2SecurityGroupId@ and
    -- @EC2SecurityGroupOwnerId@ can\'t be provided.
    RevokeDBSecurityGroupIngress -> Maybe Text
cidrip :: Prelude.Maybe Prelude.Text,
    -- | The id of the EC2 security group to revoke access from. For VPC DB
    -- security groups, @EC2SecurityGroupId@ must be provided. Otherwise,
    -- EC2SecurityGroupOwnerId and either @EC2SecurityGroupName@ or
    -- @EC2SecurityGroupId@ must be provided.
    RevokeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupId :: Prelude.Maybe Prelude.Text,
    -- | The name of the EC2 security group to revoke access from. For VPC DB
    -- security groups, @EC2SecurityGroupId@ must be provided. Otherwise,
    -- EC2SecurityGroupOwnerId and either @EC2SecurityGroupName@ or
    -- @EC2SecurityGroupId@ must be provided.
    RevokeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupName :: Prelude.Maybe Prelude.Text,
    -- | The 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.
    RevokeDBSecurityGroupIngress -> Maybe Text
eC2SecurityGroupOwnerId :: Prelude.Maybe Prelude.Text,
    -- | The name of the DB security group to revoke ingress from.
    RevokeDBSecurityGroupIngress -> Text
dbSecurityGroupName :: Prelude.Text
  }
  deriving (RevokeDBSecurityGroupIngress
-> RevokeDBSecurityGroupIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeDBSecurityGroupIngress
-> RevokeDBSecurityGroupIngress -> Bool
$c/= :: RevokeDBSecurityGroupIngress
-> RevokeDBSecurityGroupIngress -> Bool
== :: RevokeDBSecurityGroupIngress
-> RevokeDBSecurityGroupIngress -> Bool
$c== :: RevokeDBSecurityGroupIngress
-> RevokeDBSecurityGroupIngress -> Bool
Prelude.Eq, ReadPrec [RevokeDBSecurityGroupIngress]
ReadPrec RevokeDBSecurityGroupIngress
Int -> ReadS RevokeDBSecurityGroupIngress
ReadS [RevokeDBSecurityGroupIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeDBSecurityGroupIngress]
$creadListPrec :: ReadPrec [RevokeDBSecurityGroupIngress]
readPrec :: ReadPrec RevokeDBSecurityGroupIngress
$creadPrec :: ReadPrec RevokeDBSecurityGroupIngress
readList :: ReadS [RevokeDBSecurityGroupIngress]
$creadList :: ReadS [RevokeDBSecurityGroupIngress]
readsPrec :: Int -> ReadS RevokeDBSecurityGroupIngress
$creadsPrec :: Int -> ReadS RevokeDBSecurityGroupIngress
Prelude.Read, Int -> RevokeDBSecurityGroupIngress -> ShowS
[RevokeDBSecurityGroupIngress] -> ShowS
RevokeDBSecurityGroupIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeDBSecurityGroupIngress] -> ShowS
$cshowList :: [RevokeDBSecurityGroupIngress] -> ShowS
show :: RevokeDBSecurityGroupIngress -> String
$cshow :: RevokeDBSecurityGroupIngress -> String
showsPrec :: Int -> RevokeDBSecurityGroupIngress -> ShowS
$cshowsPrec :: Int -> RevokeDBSecurityGroupIngress -> ShowS
Prelude.Show, forall x.
Rep RevokeDBSecurityGroupIngress x -> RevokeDBSecurityGroupIngress
forall x.
RevokeDBSecurityGroupIngress -> Rep RevokeDBSecurityGroupIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RevokeDBSecurityGroupIngress x -> RevokeDBSecurityGroupIngress
$cfrom :: forall x.
RevokeDBSecurityGroupIngress -> Rep RevokeDBSecurityGroupIngress x
Prelude.Generic)

-- |
-- Create a value of 'RevokeDBSecurityGroupIngress' 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', 'revokeDBSecurityGroupIngress_cidrip' - The IP range to revoke access from. Must be a valid CIDR range. If
-- @CIDRIP@ is specified, @EC2SecurityGroupName@, @EC2SecurityGroupId@ and
-- @EC2SecurityGroupOwnerId@ can\'t be provided.
--
-- 'eC2SecurityGroupId', 'revokeDBSecurityGroupIngress_eC2SecurityGroupId' - The id of the EC2 security group to revoke access from. For VPC DB
-- security groups, @EC2SecurityGroupId@ must be provided. Otherwise,
-- EC2SecurityGroupOwnerId and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
--
-- 'eC2SecurityGroupName', 'revokeDBSecurityGroupIngress_eC2SecurityGroupName' - The name of the EC2 security group to revoke access from. For VPC DB
-- security groups, @EC2SecurityGroupId@ must be provided. Otherwise,
-- EC2SecurityGroupOwnerId and either @EC2SecurityGroupName@ or
-- @EC2SecurityGroupId@ must be provided.
--
-- 'eC2SecurityGroupOwnerId', 'revokeDBSecurityGroupIngress_eC2SecurityGroupOwnerId' - The 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', 'revokeDBSecurityGroupIngress_dbSecurityGroupName' - The name of the DB security group to revoke ingress from.
newRevokeDBSecurityGroupIngress ::
  -- | 'dbSecurityGroupName'
  Prelude.Text ->
  RevokeDBSecurityGroupIngress
newRevokeDBSecurityGroupIngress :: Text -> RevokeDBSecurityGroupIngress
newRevokeDBSecurityGroupIngress Text
pDBSecurityGroupName_ =
  RevokeDBSecurityGroupIngress'
    { $sel:cidrip:RevokeDBSecurityGroupIngress' :: Maybe Text
cidrip =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eC2SecurityGroupId:RevokeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:eC2SecurityGroupName:RevokeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:eC2SecurityGroupOwnerId:RevokeDBSecurityGroupIngress' :: Maybe Text
eC2SecurityGroupOwnerId = forall a. Maybe a
Prelude.Nothing,
      $sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: Text
dbSecurityGroupName = Text
pDBSecurityGroupName_
    }

-- | The IP range to revoke access from. Must be a valid CIDR range. If
-- @CIDRIP@ is specified, @EC2SecurityGroupName@, @EC2SecurityGroupId@ and
-- @EC2SecurityGroupOwnerId@ can\'t be provided.
revokeDBSecurityGroupIngress_cidrip :: Lens.Lens' RevokeDBSecurityGroupIngress (Prelude.Maybe Prelude.Text)
revokeDBSecurityGroupIngress_cidrip :: Lens' RevokeDBSecurityGroupIngress (Maybe Text)
revokeDBSecurityGroupIngress_cidrip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeDBSecurityGroupIngress' {Maybe Text
cidrip :: Maybe Text
$sel:cidrip:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
cidrip} -> Maybe Text
cidrip) (\s :: RevokeDBSecurityGroupIngress
s@RevokeDBSecurityGroupIngress' {} Maybe Text
a -> RevokeDBSecurityGroupIngress
s {$sel:cidrip:RevokeDBSecurityGroupIngress' :: Maybe Text
cidrip = Maybe Text
a} :: RevokeDBSecurityGroupIngress)

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

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

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

-- | The name of the DB security group to revoke ingress from.
revokeDBSecurityGroupIngress_dbSecurityGroupName :: Lens.Lens' RevokeDBSecurityGroupIngress Prelude.Text
revokeDBSecurityGroupIngress_dbSecurityGroupName :: Lens' RevokeDBSecurityGroupIngress Text
revokeDBSecurityGroupIngress_dbSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokeDBSecurityGroupIngress' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Text
dbSecurityGroupName} -> Text
dbSecurityGroupName) (\s :: RevokeDBSecurityGroupIngress
s@RevokeDBSecurityGroupIngress' {} Text
a -> RevokeDBSecurityGroupIngress
s {$sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: Text
dbSecurityGroupName = Text
a} :: RevokeDBSecurityGroupIngress)

instance Core.AWSRequest RevokeDBSecurityGroupIngress where
  type
    AWSResponse RevokeDBSecurityGroupIngress =
      RevokeDBSecurityGroupIngressResponse
  request :: (Service -> Service)
-> RevokeDBSecurityGroupIngress
-> Request RevokeDBSecurityGroupIngress
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 RevokeDBSecurityGroupIngress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RevokeDBSecurityGroupIngress)))
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
"RevokeDBSecurityGroupIngressResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSecurityGroup
-> Int -> RevokeDBSecurityGroupIngressResponse
RevokeDBSecurityGroupIngressResponse'
            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
    RevokeDBSecurityGroupIngress
  where
  hashWithSalt :: Int -> RevokeDBSecurityGroupIngress -> Int
hashWithSalt Int
_salt RevokeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> 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 RevokeDBSecurityGroupIngress where
  rnf :: RevokeDBSecurityGroupIngress -> ()
rnf RevokeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> 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 RevokeDBSecurityGroupIngress where
  toHeaders :: RevokeDBSecurityGroupIngress -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery RevokeDBSecurityGroupIngress where
  toQuery :: RevokeDBSecurityGroupIngress -> QueryString
toQuery RevokeDBSecurityGroupIngress' {Maybe Text
Text
dbSecurityGroupName :: Text
eC2SecurityGroupOwnerId :: Maybe Text
eC2SecurityGroupName :: Maybe Text
eC2SecurityGroupId :: Maybe Text
cidrip :: Maybe Text
$sel:dbSecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Text
$sel:eC2SecurityGroupOwnerId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupName:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:eC2SecurityGroupId:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
$sel:cidrip:RevokeDBSecurityGroupIngress' :: RevokeDBSecurityGroupIngress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RevokeDBSecurityGroupIngress" ::
                      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:/ 'newRevokeDBSecurityGroupIngressResponse' smart constructor.
data RevokeDBSecurityGroupIngressResponse = RevokeDBSecurityGroupIngressResponse'
  { RevokeDBSecurityGroupIngressResponse -> Maybe DBSecurityGroup
dbSecurityGroup :: Prelude.Maybe DBSecurityGroup,
    -- | The response's http status code.
    RevokeDBSecurityGroupIngressResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RevokeDBSecurityGroupIngressResponse
-> RevokeDBSecurityGroupIngressResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeDBSecurityGroupIngressResponse
-> RevokeDBSecurityGroupIngressResponse -> Bool
$c/= :: RevokeDBSecurityGroupIngressResponse
-> RevokeDBSecurityGroupIngressResponse -> Bool
== :: RevokeDBSecurityGroupIngressResponse
-> RevokeDBSecurityGroupIngressResponse -> Bool
$c== :: RevokeDBSecurityGroupIngressResponse
-> RevokeDBSecurityGroupIngressResponse -> Bool
Prelude.Eq, ReadPrec [RevokeDBSecurityGroupIngressResponse]
ReadPrec RevokeDBSecurityGroupIngressResponse
Int -> ReadS RevokeDBSecurityGroupIngressResponse
ReadS [RevokeDBSecurityGroupIngressResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokeDBSecurityGroupIngressResponse]
$creadListPrec :: ReadPrec [RevokeDBSecurityGroupIngressResponse]
readPrec :: ReadPrec RevokeDBSecurityGroupIngressResponse
$creadPrec :: ReadPrec RevokeDBSecurityGroupIngressResponse
readList :: ReadS [RevokeDBSecurityGroupIngressResponse]
$creadList :: ReadS [RevokeDBSecurityGroupIngressResponse]
readsPrec :: Int -> ReadS RevokeDBSecurityGroupIngressResponse
$creadsPrec :: Int -> ReadS RevokeDBSecurityGroupIngressResponse
Prelude.Read, Int -> RevokeDBSecurityGroupIngressResponse -> ShowS
[RevokeDBSecurityGroupIngressResponse] -> ShowS
RevokeDBSecurityGroupIngressResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeDBSecurityGroupIngressResponse] -> ShowS
$cshowList :: [RevokeDBSecurityGroupIngressResponse] -> ShowS
show :: RevokeDBSecurityGroupIngressResponse -> String
$cshow :: RevokeDBSecurityGroupIngressResponse -> String
showsPrec :: Int -> RevokeDBSecurityGroupIngressResponse -> ShowS
$cshowsPrec :: Int -> RevokeDBSecurityGroupIngressResponse -> ShowS
Prelude.Show, forall x.
Rep RevokeDBSecurityGroupIngressResponse x
-> RevokeDBSecurityGroupIngressResponse
forall x.
RevokeDBSecurityGroupIngressResponse
-> Rep RevokeDBSecurityGroupIngressResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RevokeDBSecurityGroupIngressResponse x
-> RevokeDBSecurityGroupIngressResponse
$cfrom :: forall x.
RevokeDBSecurityGroupIngressResponse
-> Rep RevokeDBSecurityGroupIngressResponse x
Prelude.Generic)

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

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

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

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