{-# 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.CreateOptionGroup
-- 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 option group. You can create up to 20 option groups.
--
-- This command doesn\'t apply to RDS Custom.
module Amazonka.RDS.CreateOptionGroup
  ( -- * Creating a Request
    CreateOptionGroup (..),
    newCreateOptionGroup,

    -- * Request Lenses
    createOptionGroup_tags,
    createOptionGroup_optionGroupName,
    createOptionGroup_engineName,
    createOptionGroup_majorEngineVersion,
    createOptionGroup_optionGroupDescription,

    -- * Destructuring the Response
    CreateOptionGroupResponse (..),
    newCreateOptionGroupResponse,

    -- * Response Lenses
    createOptionGroupResponse_optionGroup,
    createOptionGroupResponse_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:/ 'newCreateOptionGroup' smart constructor.
data CreateOptionGroup = CreateOptionGroup'
  { -- | Tags to assign to the option group.
    CreateOptionGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Specifies the name of the option group to be created.
    --
    -- 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
    --
    -- Example: @myoptiongroup@
    CreateOptionGroup -> Text
optionGroupName :: Prelude.Text,
    -- | Specifies the name of the engine that this option group should be
    -- associated with.
    --
    -- Valid Values:
    --
    -- -   @mariadb@
    --
    -- -   @mysql@
    --
    -- -   @oracle-ee@
    --
    -- -   @oracle-ee-cdb@
    --
    -- -   @oracle-se2@
    --
    -- -   @oracle-se2-cdb@
    --
    -- -   @postgres@
    --
    -- -   @sqlserver-ee@
    --
    -- -   @sqlserver-se@
    --
    -- -   @sqlserver-ex@
    --
    -- -   @sqlserver-web@
    CreateOptionGroup -> Text
engineName :: Prelude.Text,
    -- | Specifies the major version of the engine that this option group should
    -- be associated with.
    CreateOptionGroup -> Text
majorEngineVersion :: Prelude.Text,
    -- | The description of the option group.
    CreateOptionGroup -> Text
optionGroupDescription :: Prelude.Text
  }
  deriving (CreateOptionGroup -> CreateOptionGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOptionGroup -> CreateOptionGroup -> Bool
$c/= :: CreateOptionGroup -> CreateOptionGroup -> Bool
== :: CreateOptionGroup -> CreateOptionGroup -> Bool
$c== :: CreateOptionGroup -> CreateOptionGroup -> Bool
Prelude.Eq, ReadPrec [CreateOptionGroup]
ReadPrec CreateOptionGroup
Int -> ReadS CreateOptionGroup
ReadS [CreateOptionGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOptionGroup]
$creadListPrec :: ReadPrec [CreateOptionGroup]
readPrec :: ReadPrec CreateOptionGroup
$creadPrec :: ReadPrec CreateOptionGroup
readList :: ReadS [CreateOptionGroup]
$creadList :: ReadS [CreateOptionGroup]
readsPrec :: Int -> ReadS CreateOptionGroup
$creadsPrec :: Int -> ReadS CreateOptionGroup
Prelude.Read, Int -> CreateOptionGroup -> ShowS
[CreateOptionGroup] -> ShowS
CreateOptionGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOptionGroup] -> ShowS
$cshowList :: [CreateOptionGroup] -> ShowS
show :: CreateOptionGroup -> String
$cshow :: CreateOptionGroup -> String
showsPrec :: Int -> CreateOptionGroup -> ShowS
$cshowsPrec :: Int -> CreateOptionGroup -> ShowS
Prelude.Show, forall x. Rep CreateOptionGroup x -> CreateOptionGroup
forall x. CreateOptionGroup -> Rep CreateOptionGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOptionGroup x -> CreateOptionGroup
$cfrom :: forall x. CreateOptionGroup -> Rep CreateOptionGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateOptionGroup' 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', 'createOptionGroup_tags' - Tags to assign to the option group.
--
-- 'optionGroupName', 'createOptionGroup_optionGroupName' - Specifies the name of the option group to be created.
--
-- 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
--
-- Example: @myoptiongroup@
--
-- 'engineName', 'createOptionGroup_engineName' - Specifies the name of the engine that this option group should be
-- associated with.
--
-- Valid Values:
--
-- -   @mariadb@
--
-- -   @mysql@
--
-- -   @oracle-ee@
--
-- -   @oracle-ee-cdb@
--
-- -   @oracle-se2@
--
-- -   @oracle-se2-cdb@
--
-- -   @postgres@
--
-- -   @sqlserver-ee@
--
-- -   @sqlserver-se@
--
-- -   @sqlserver-ex@
--
-- -   @sqlserver-web@
--
-- 'majorEngineVersion', 'createOptionGroup_majorEngineVersion' - Specifies the major version of the engine that this option group should
-- be associated with.
--
-- 'optionGroupDescription', 'createOptionGroup_optionGroupDescription' - The description of the option group.
newCreateOptionGroup ::
  -- | 'optionGroupName'
  Prelude.Text ->
  -- | 'engineName'
  Prelude.Text ->
  -- | 'majorEngineVersion'
  Prelude.Text ->
  -- | 'optionGroupDescription'
  Prelude.Text ->
  CreateOptionGroup
newCreateOptionGroup :: Text -> Text -> Text -> Text -> CreateOptionGroup
newCreateOptionGroup
  Text
pOptionGroupName_
  Text
pEngineName_
  Text
pMajorEngineVersion_
  Text
pOptionGroupDescription_ =
    CreateOptionGroup'
      { $sel:tags:CreateOptionGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:optionGroupName:CreateOptionGroup' :: Text
optionGroupName = Text
pOptionGroupName_,
        $sel:engineName:CreateOptionGroup' :: Text
engineName = Text
pEngineName_,
        $sel:majorEngineVersion:CreateOptionGroup' :: Text
majorEngineVersion = Text
pMajorEngineVersion_,
        $sel:optionGroupDescription:CreateOptionGroup' :: Text
optionGroupDescription = Text
pOptionGroupDescription_
      }

-- | Tags to assign to the option group.
createOptionGroup_tags :: Lens.Lens' CreateOptionGroup (Prelude.Maybe [Tag])
createOptionGroup_tags :: Lens' CreateOptionGroup (Maybe [Tag])
createOptionGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateOptionGroup' :: CreateOptionGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateOptionGroup
s@CreateOptionGroup' {} Maybe [Tag]
a -> CreateOptionGroup
s {$sel:tags:CreateOptionGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateOptionGroup) 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

-- | Specifies the name of the option group to be created.
--
-- 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
--
-- Example: @myoptiongroup@
createOptionGroup_optionGroupName :: Lens.Lens' CreateOptionGroup Prelude.Text
createOptionGroup_optionGroupName :: Lens' CreateOptionGroup Text
createOptionGroup_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroup' {Text
optionGroupName :: Text
$sel:optionGroupName:CreateOptionGroup' :: CreateOptionGroup -> Text
optionGroupName} -> Text
optionGroupName) (\s :: CreateOptionGroup
s@CreateOptionGroup' {} Text
a -> CreateOptionGroup
s {$sel:optionGroupName:CreateOptionGroup' :: Text
optionGroupName = Text
a} :: CreateOptionGroup)

-- | Specifies the name of the engine that this option group should be
-- associated with.
--
-- Valid Values:
--
-- -   @mariadb@
--
-- -   @mysql@
--
-- -   @oracle-ee@
--
-- -   @oracle-ee-cdb@
--
-- -   @oracle-se2@
--
-- -   @oracle-se2-cdb@
--
-- -   @postgres@
--
-- -   @sqlserver-ee@
--
-- -   @sqlserver-se@
--
-- -   @sqlserver-ex@
--
-- -   @sqlserver-web@
createOptionGroup_engineName :: Lens.Lens' CreateOptionGroup Prelude.Text
createOptionGroup_engineName :: Lens' CreateOptionGroup Text
createOptionGroup_engineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroup' {Text
engineName :: Text
$sel:engineName:CreateOptionGroup' :: CreateOptionGroup -> Text
engineName} -> Text
engineName) (\s :: CreateOptionGroup
s@CreateOptionGroup' {} Text
a -> CreateOptionGroup
s {$sel:engineName:CreateOptionGroup' :: Text
engineName = Text
a} :: CreateOptionGroup)

-- | Specifies the major version of the engine that this option group should
-- be associated with.
createOptionGroup_majorEngineVersion :: Lens.Lens' CreateOptionGroup Prelude.Text
createOptionGroup_majorEngineVersion :: Lens' CreateOptionGroup Text
createOptionGroup_majorEngineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroup' {Text
majorEngineVersion :: Text
$sel:majorEngineVersion:CreateOptionGroup' :: CreateOptionGroup -> Text
majorEngineVersion} -> Text
majorEngineVersion) (\s :: CreateOptionGroup
s@CreateOptionGroup' {} Text
a -> CreateOptionGroup
s {$sel:majorEngineVersion:CreateOptionGroup' :: Text
majorEngineVersion = Text
a} :: CreateOptionGroup)

-- | The description of the option group.
createOptionGroup_optionGroupDescription :: Lens.Lens' CreateOptionGroup Prelude.Text
createOptionGroup_optionGroupDescription :: Lens' CreateOptionGroup Text
createOptionGroup_optionGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroup' {Text
optionGroupDescription :: Text
$sel:optionGroupDescription:CreateOptionGroup' :: CreateOptionGroup -> Text
optionGroupDescription} -> Text
optionGroupDescription) (\s :: CreateOptionGroup
s@CreateOptionGroup' {} Text
a -> CreateOptionGroup
s {$sel:optionGroupDescription:CreateOptionGroup' :: Text
optionGroupDescription = Text
a} :: CreateOptionGroup)

instance Core.AWSRequest CreateOptionGroup where
  type
    AWSResponse CreateOptionGroup =
      CreateOptionGroupResponse
  request :: (Service -> Service)
-> CreateOptionGroup -> Request CreateOptionGroup
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 CreateOptionGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateOptionGroup)))
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
"CreateOptionGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe OptionGroup -> Int -> CreateOptionGroupResponse
CreateOptionGroupResponse'
            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
"OptionGroup")
            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 CreateOptionGroup where
  hashWithSalt :: Int -> CreateOptionGroup -> Int
hashWithSalt Int
_salt CreateOptionGroup' {Maybe [Tag]
Text
optionGroupDescription :: Text
majorEngineVersion :: Text
engineName :: Text
optionGroupName :: Text
tags :: Maybe [Tag]
$sel:optionGroupDescription:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:majorEngineVersion:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:engineName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:optionGroupName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:tags:CreateOptionGroup' :: CreateOptionGroup -> 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
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
engineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
majorEngineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
optionGroupDescription

instance Prelude.NFData CreateOptionGroup where
  rnf :: CreateOptionGroup -> ()
rnf CreateOptionGroup' {Maybe [Tag]
Text
optionGroupDescription :: Text
majorEngineVersion :: Text
engineName :: Text
optionGroupName :: Text
tags :: Maybe [Tag]
$sel:optionGroupDescription:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:majorEngineVersion:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:engineName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:optionGroupName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:tags:CreateOptionGroup' :: CreateOptionGroup -> 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
optionGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
engineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
majorEngineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
optionGroupDescription

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

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

instance Data.ToQuery CreateOptionGroup where
  toQuery :: CreateOptionGroup -> QueryString
toQuery CreateOptionGroup' {Maybe [Tag]
Text
optionGroupDescription :: Text
majorEngineVersion :: Text
engineName :: Text
optionGroupName :: Text
tags :: Maybe [Tag]
$sel:optionGroupDescription:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:majorEngineVersion:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:engineName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:optionGroupName:CreateOptionGroup' :: CreateOptionGroup -> Text
$sel:tags:CreateOptionGroup' :: CreateOptionGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateOptionGroup" :: 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
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
optionGroupName,
        ByteString
"EngineName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engineName,
        ByteString
"MajorEngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
majorEngineVersion,
        ByteString
"OptionGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
optionGroupDescription
      ]

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

-- |
-- Create a value of 'CreateOptionGroupResponse' 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:
--
-- 'optionGroup', 'createOptionGroupResponse_optionGroup' - Undocumented member.
--
-- 'httpStatus', 'createOptionGroupResponse_httpStatus' - The response's http status code.
newCreateOptionGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOptionGroupResponse
newCreateOptionGroupResponse :: Int -> CreateOptionGroupResponse
newCreateOptionGroupResponse Int
pHttpStatus_ =
  CreateOptionGroupResponse'
    { $sel:optionGroup:CreateOptionGroupResponse' :: Maybe OptionGroup
optionGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOptionGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createOptionGroupResponse_optionGroup :: Lens.Lens' CreateOptionGroupResponse (Prelude.Maybe OptionGroup)
createOptionGroupResponse_optionGroup :: Lens' CreateOptionGroupResponse (Maybe OptionGroup)
createOptionGroupResponse_optionGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOptionGroupResponse' {Maybe OptionGroup
optionGroup :: Maybe OptionGroup
$sel:optionGroup:CreateOptionGroupResponse' :: CreateOptionGroupResponse -> Maybe OptionGroup
optionGroup} -> Maybe OptionGroup
optionGroup) (\s :: CreateOptionGroupResponse
s@CreateOptionGroupResponse' {} Maybe OptionGroup
a -> CreateOptionGroupResponse
s {$sel:optionGroup:CreateOptionGroupResponse' :: Maybe OptionGroup
optionGroup = Maybe OptionGroup
a} :: CreateOptionGroupResponse)

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

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