{-# 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.CreateDBSecurityGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new DB security group. DB security groups control access to a
-- DB instance.
--
-- A DB security group controls access to EC2-Classic DB instances that are
-- not in a VPC.
--
-- 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.CreateDBSecurityGroup
  ( -- * Creating a Request
    CreateDBSecurityGroup (..),
    newCreateDBSecurityGroup,

    -- * Request Lenses
    createDBSecurityGroup_tags,
    createDBSecurityGroup_dbSecurityGroupName,
    createDBSecurityGroup_dbSecurityGroupDescription,

    -- * Destructuring the Response
    CreateDBSecurityGroupResponse (..),
    newCreateDBSecurityGroupResponse,

    -- * Response Lenses
    createDBSecurityGroupResponse_dbSecurityGroup,
    createDBSecurityGroupResponse_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:/ 'newCreateDBSecurityGroup' smart constructor.
data CreateDBSecurityGroup = CreateDBSecurityGroup'
  { -- | Tags to assign to the DB security group.
    CreateDBSecurityGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the DB security group. This value is stored as a lowercase
    -- string.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 255 letters, numbers, or hyphens.
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- -   Must not be \"Default\"
    --
    -- Example: @mysecuritygroup@
    CreateDBSecurityGroup -> Text
dbSecurityGroupName :: Prelude.Text,
    -- | The description for the DB security group.
    CreateDBSecurityGroup -> Text
dbSecurityGroupDescription :: Prelude.Text
  }
  deriving (CreateDBSecurityGroup -> CreateDBSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDBSecurityGroup -> CreateDBSecurityGroup -> Bool
$c/= :: CreateDBSecurityGroup -> CreateDBSecurityGroup -> Bool
== :: CreateDBSecurityGroup -> CreateDBSecurityGroup -> Bool
$c== :: CreateDBSecurityGroup -> CreateDBSecurityGroup -> Bool
Prelude.Eq, ReadPrec [CreateDBSecurityGroup]
ReadPrec CreateDBSecurityGroup
Int -> ReadS CreateDBSecurityGroup
ReadS [CreateDBSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDBSecurityGroup]
$creadListPrec :: ReadPrec [CreateDBSecurityGroup]
readPrec :: ReadPrec CreateDBSecurityGroup
$creadPrec :: ReadPrec CreateDBSecurityGroup
readList :: ReadS [CreateDBSecurityGroup]
$creadList :: ReadS [CreateDBSecurityGroup]
readsPrec :: Int -> ReadS CreateDBSecurityGroup
$creadsPrec :: Int -> ReadS CreateDBSecurityGroup
Prelude.Read, Int -> CreateDBSecurityGroup -> ShowS
[CreateDBSecurityGroup] -> ShowS
CreateDBSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDBSecurityGroup] -> ShowS
$cshowList :: [CreateDBSecurityGroup] -> ShowS
show :: CreateDBSecurityGroup -> String
$cshow :: CreateDBSecurityGroup -> String
showsPrec :: Int -> CreateDBSecurityGroup -> ShowS
$cshowsPrec :: Int -> CreateDBSecurityGroup -> ShowS
Prelude.Show, forall x. Rep CreateDBSecurityGroup x -> CreateDBSecurityGroup
forall x. CreateDBSecurityGroup -> Rep CreateDBSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDBSecurityGroup x -> CreateDBSecurityGroup
$cfrom :: forall x. CreateDBSecurityGroup -> Rep CreateDBSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateDBSecurityGroup' 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:
--
-- 'tags', 'createDBSecurityGroup_tags' - Tags to assign to the DB security group.
--
-- 'dbSecurityGroupName', 'createDBSecurityGroup_dbSecurityGroupName' - The name for the DB security group. This value is stored as a lowercase
-- string.
--
-- Constraints:
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- -   Must not be \"Default\"
--
-- Example: @mysecuritygroup@
--
-- 'dbSecurityGroupDescription', 'createDBSecurityGroup_dbSecurityGroupDescription' - The description for the DB security group.
newCreateDBSecurityGroup ::
  -- | 'dbSecurityGroupName'
  Prelude.Text ->
  -- | 'dbSecurityGroupDescription'
  Prelude.Text ->
  CreateDBSecurityGroup
newCreateDBSecurityGroup :: Text -> Text -> CreateDBSecurityGroup
newCreateDBSecurityGroup
  Text
pDBSecurityGroupName_
  Text
pDBSecurityGroupDescription_ =
    CreateDBSecurityGroup'
      { $sel:tags:CreateDBSecurityGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:dbSecurityGroupName:CreateDBSecurityGroup' :: Text
dbSecurityGroupName = Text
pDBSecurityGroupName_,
        $sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: Text
dbSecurityGroupDescription =
          Text
pDBSecurityGroupDescription_
      }

-- | Tags to assign to the DB security group.
createDBSecurityGroup_tags :: Lens.Lens' CreateDBSecurityGroup (Prelude.Maybe [Tag])
createDBSecurityGroup_tags :: Lens' CreateDBSecurityGroup (Maybe [Tag])
createDBSecurityGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSecurityGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDBSecurityGroup
s@CreateDBSecurityGroup' {} Maybe [Tag]
a -> CreateDBSecurityGroup
s {$sel:tags:CreateDBSecurityGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDBSecurityGroup) 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 name for the DB security group. This value is stored as a lowercase
-- string.
--
-- Constraints:
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- -   Must not be \"Default\"
--
-- Example: @mysecuritygroup@
createDBSecurityGroup_dbSecurityGroupName :: Lens.Lens' CreateDBSecurityGroup Prelude.Text
createDBSecurityGroup_dbSecurityGroupName :: Lens' CreateDBSecurityGroup Text
createDBSecurityGroup_dbSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSecurityGroup' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
dbSecurityGroupName} -> Text
dbSecurityGroupName) (\s :: CreateDBSecurityGroup
s@CreateDBSecurityGroup' {} Text
a -> CreateDBSecurityGroup
s {$sel:dbSecurityGroupName:CreateDBSecurityGroup' :: Text
dbSecurityGroupName = Text
a} :: CreateDBSecurityGroup)

-- | The description for the DB security group.
createDBSecurityGroup_dbSecurityGroupDescription :: Lens.Lens' CreateDBSecurityGroup Prelude.Text
createDBSecurityGroup_dbSecurityGroupDescription :: Lens' CreateDBSecurityGroup Text
createDBSecurityGroup_dbSecurityGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSecurityGroup' {Text
dbSecurityGroupDescription :: Text
$sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
dbSecurityGroupDescription} -> Text
dbSecurityGroupDescription) (\s :: CreateDBSecurityGroup
s@CreateDBSecurityGroup' {} Text
a -> CreateDBSecurityGroup
s {$sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: Text
dbSecurityGroupDescription = Text
a} :: CreateDBSecurityGroup)

instance Core.AWSRequest CreateDBSecurityGroup where
  type
    AWSResponse CreateDBSecurityGroup =
      CreateDBSecurityGroupResponse
  request :: (Service -> Service)
-> CreateDBSecurityGroup -> Request CreateDBSecurityGroup
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 CreateDBSecurityGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDBSecurityGroup)))
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
"CreateDBSecurityGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSecurityGroup -> Int -> CreateDBSecurityGroupResponse
CreateDBSecurityGroupResponse'
            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 CreateDBSecurityGroup where
  hashWithSalt :: Int -> CreateDBSecurityGroup -> Int
hashWithSalt Int
_salt CreateDBSecurityGroup' {Maybe [Tag]
Text
dbSecurityGroupDescription :: Text
dbSecurityGroupName :: Text
tags :: Maybe [Tag]
$sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:dbSecurityGroupName:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:tags:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSecurityGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSecurityGroupDescription

instance Prelude.NFData CreateDBSecurityGroup where
  rnf :: CreateDBSecurityGroup -> ()
rnf CreateDBSecurityGroup' {Maybe [Tag]
Text
dbSecurityGroupDescription :: Text
dbSecurityGroupName :: Text
tags :: Maybe [Tag]
$sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:dbSecurityGroupName:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:tags:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbSecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbSecurityGroupDescription

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

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

instance Data.ToQuery CreateDBSecurityGroup where
  toQuery :: CreateDBSecurityGroup -> QueryString
toQuery CreateDBSecurityGroup' {Maybe [Tag]
Text
dbSecurityGroupDescription :: Text
dbSecurityGroupName :: Text
tags :: Maybe [Tag]
$sel:dbSecurityGroupDescription:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:dbSecurityGroupName:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Text
$sel:tags:CreateDBSecurityGroup' :: CreateDBSecurityGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateDBSecurityGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"DBSecurityGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSecurityGroupName,
        ByteString
"DBSecurityGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSecurityGroupDescription
      ]

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

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

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

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

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