{-# 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.ServiceCatalogAppRegistry.CreateAttributeGroup
-- 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 attribute group as a container for user-defined
-- attributes. This feature enables users to have full control over their
-- cloud application\'s metadata in a rich machine-readable format to
-- facilitate integration with automated workflows and third-party tools.
module Amazonka.ServiceCatalogAppRegistry.CreateAttributeGroup
  ( -- * Creating a Request
    CreateAttributeGroup (..),
    newCreateAttributeGroup,

    -- * Request Lenses
    createAttributeGroup_description,
    createAttributeGroup_tags,
    createAttributeGroup_name,
    createAttributeGroup_attributes,
    createAttributeGroup_clientToken,

    -- * Destructuring the Response
    CreateAttributeGroupResponse (..),
    newCreateAttributeGroupResponse,

    -- * Response Lenses
    createAttributeGroupResponse_attributeGroup,
    createAttributeGroupResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.ServiceCatalogAppRegistry.Types

-- | /See:/ 'newCreateAttributeGroup' smart constructor.
data CreateAttributeGroup = CreateAttributeGroup'
  { -- | The description of the attribute group that the user provides.
    CreateAttributeGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Key-value pairs you can use to associate with the attribute group.
    CreateAttributeGroup -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the attribute group.
    CreateAttributeGroup -> Text
name :: Prelude.Text,
    -- | A JSON string in the form of nested key-value pairs that represent the
    -- attributes in the group and describes an application and its components.
    CreateAttributeGroup -> Text
attributes :: Prelude.Text,
    -- | A unique identifier that you provide to ensure idempotency. If you retry
    -- a request that completed successfully using the same client token and
    -- the same parameters, the retry succeeds without performing any further
    -- actions. If you retry a successful request using the same client token,
    -- but one or more of the parameters are different, the retry fails.
    CreateAttributeGroup -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateAttributeGroup -> CreateAttributeGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAttributeGroup -> CreateAttributeGroup -> Bool
$c/= :: CreateAttributeGroup -> CreateAttributeGroup -> Bool
== :: CreateAttributeGroup -> CreateAttributeGroup -> Bool
$c== :: CreateAttributeGroup -> CreateAttributeGroup -> Bool
Prelude.Eq, ReadPrec [CreateAttributeGroup]
ReadPrec CreateAttributeGroup
Int -> ReadS CreateAttributeGroup
ReadS [CreateAttributeGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAttributeGroup]
$creadListPrec :: ReadPrec [CreateAttributeGroup]
readPrec :: ReadPrec CreateAttributeGroup
$creadPrec :: ReadPrec CreateAttributeGroup
readList :: ReadS [CreateAttributeGroup]
$creadList :: ReadS [CreateAttributeGroup]
readsPrec :: Int -> ReadS CreateAttributeGroup
$creadsPrec :: Int -> ReadS CreateAttributeGroup
Prelude.Read, Int -> CreateAttributeGroup -> ShowS
[CreateAttributeGroup] -> ShowS
CreateAttributeGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAttributeGroup] -> ShowS
$cshowList :: [CreateAttributeGroup] -> ShowS
show :: CreateAttributeGroup -> String
$cshow :: CreateAttributeGroup -> String
showsPrec :: Int -> CreateAttributeGroup -> ShowS
$cshowsPrec :: Int -> CreateAttributeGroup -> ShowS
Prelude.Show, forall x. Rep CreateAttributeGroup x -> CreateAttributeGroup
forall x. CreateAttributeGroup -> Rep CreateAttributeGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAttributeGroup x -> CreateAttributeGroup
$cfrom :: forall x. CreateAttributeGroup -> Rep CreateAttributeGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateAttributeGroup' 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:
--
-- 'description', 'createAttributeGroup_description' - The description of the attribute group that the user provides.
--
-- 'tags', 'createAttributeGroup_tags' - Key-value pairs you can use to associate with the attribute group.
--
-- 'name', 'createAttributeGroup_name' - The name of the attribute group.
--
-- 'attributes', 'createAttributeGroup_attributes' - A JSON string in the form of nested key-value pairs that represent the
-- attributes in the group and describes an application and its components.
--
-- 'clientToken', 'createAttributeGroup_clientToken' - A unique identifier that you provide to ensure idempotency. If you retry
-- a request that completed successfully using the same client token and
-- the same parameters, the retry succeeds without performing any further
-- actions. If you retry a successful request using the same client token,
-- but one or more of the parameters are different, the retry fails.
newCreateAttributeGroup ::
  -- | 'name'
  Prelude.Text ->
  -- | 'attributes'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateAttributeGroup
newCreateAttributeGroup :: Text -> Text -> Text -> CreateAttributeGroup
newCreateAttributeGroup
  Text
pName_
  Text
pAttributes_
  Text
pClientToken_ =
    CreateAttributeGroup'
      { $sel:description:CreateAttributeGroup' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateAttributeGroup' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateAttributeGroup' :: Text
name = Text
pName_,
        $sel:attributes:CreateAttributeGroup' :: Text
attributes = Text
pAttributes_,
        $sel:clientToken:CreateAttributeGroup' :: Text
clientToken = Text
pClientToken_
      }

-- | The description of the attribute group that the user provides.
createAttributeGroup_description :: Lens.Lens' CreateAttributeGroup (Prelude.Maybe Prelude.Text)
createAttributeGroup_description :: Lens' CreateAttributeGroup (Maybe Text)
createAttributeGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroup' {Maybe Text
description :: Maybe Text
$sel:description:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateAttributeGroup
s@CreateAttributeGroup' {} Maybe Text
a -> CreateAttributeGroup
s {$sel:description:CreateAttributeGroup' :: Maybe Text
description = Maybe Text
a} :: CreateAttributeGroup)

-- | Key-value pairs you can use to associate with the attribute group.
createAttributeGroup_tags :: Lens.Lens' CreateAttributeGroup (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createAttributeGroup_tags :: Lens' CreateAttributeGroup (Maybe (HashMap Text Text))
createAttributeGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroup' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateAttributeGroup
s@CreateAttributeGroup' {} Maybe (HashMap Text Text)
a -> CreateAttributeGroup
s {$sel:tags:CreateAttributeGroup' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateAttributeGroup) 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 of the attribute group.
createAttributeGroup_name :: Lens.Lens' CreateAttributeGroup Prelude.Text
createAttributeGroup_name :: Lens' CreateAttributeGroup Text
createAttributeGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroup' {Text
name :: Text
$sel:name:CreateAttributeGroup' :: CreateAttributeGroup -> Text
name} -> Text
name) (\s :: CreateAttributeGroup
s@CreateAttributeGroup' {} Text
a -> CreateAttributeGroup
s {$sel:name:CreateAttributeGroup' :: Text
name = Text
a} :: CreateAttributeGroup)

-- | A JSON string in the form of nested key-value pairs that represent the
-- attributes in the group and describes an application and its components.
createAttributeGroup_attributes :: Lens.Lens' CreateAttributeGroup Prelude.Text
createAttributeGroup_attributes :: Lens' CreateAttributeGroup Text
createAttributeGroup_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroup' {Text
attributes :: Text
$sel:attributes:CreateAttributeGroup' :: CreateAttributeGroup -> Text
attributes} -> Text
attributes) (\s :: CreateAttributeGroup
s@CreateAttributeGroup' {} Text
a -> CreateAttributeGroup
s {$sel:attributes:CreateAttributeGroup' :: Text
attributes = Text
a} :: CreateAttributeGroup)

-- | A unique identifier that you provide to ensure idempotency. If you retry
-- a request that completed successfully using the same client token and
-- the same parameters, the retry succeeds without performing any further
-- actions. If you retry a successful request using the same client token,
-- but one or more of the parameters are different, the retry fails.
createAttributeGroup_clientToken :: Lens.Lens' CreateAttributeGroup Prelude.Text
createAttributeGroup_clientToken :: Lens' CreateAttributeGroup Text
createAttributeGroup_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroup' {Text
clientToken :: Text
$sel:clientToken:CreateAttributeGroup' :: CreateAttributeGroup -> Text
clientToken} -> Text
clientToken) (\s :: CreateAttributeGroup
s@CreateAttributeGroup' {} Text
a -> CreateAttributeGroup
s {$sel:clientToken:CreateAttributeGroup' :: Text
clientToken = Text
a} :: CreateAttributeGroup)

instance Core.AWSRequest CreateAttributeGroup where
  type
    AWSResponse CreateAttributeGroup =
      CreateAttributeGroupResponse
  request :: (Service -> Service)
-> CreateAttributeGroup -> Request CreateAttributeGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateAttributeGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAttributeGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe AttributeGroup -> Int -> CreateAttributeGroupResponse
CreateAttributeGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"attributeGroup")
            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 CreateAttributeGroup where
  hashWithSalt :: Int -> CreateAttributeGroup -> Int
hashWithSalt Int
_salt CreateAttributeGroup' {Maybe Text
Maybe (HashMap Text Text)
Text
clientToken :: Text
attributes :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:clientToken:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:attributes:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:name:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:tags:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe (HashMap Text Text)
$sel:description:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateAttributeGroup where
  rnf :: CreateAttributeGroup -> ()
rnf CreateAttributeGroup' {Maybe Text
Maybe (HashMap Text Text)
Text
clientToken :: Text
attributes :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:clientToken:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:attributes:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:name:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:tags:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe (HashMap Text Text)
$sel:description:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateAttributeGroup where
  toHeaders :: CreateAttributeGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateAttributeGroup where
  toJSON :: CreateAttributeGroup -> Value
toJSON CreateAttributeGroup' {Maybe Text
Maybe (HashMap Text Text)
Text
clientToken :: Text
attributes :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
description :: Maybe Text
$sel:clientToken:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:attributes:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:name:CreateAttributeGroup' :: CreateAttributeGroup -> Text
$sel:tags:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe (HashMap Text Text)
$sel:description:CreateAttributeGroup' :: CreateAttributeGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"attributes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attributes),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

instance Data.ToQuery CreateAttributeGroup where
  toQuery :: CreateAttributeGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'CreateAttributeGroupResponse' 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:
--
-- 'attributeGroup', 'createAttributeGroupResponse_attributeGroup' - Information about the attribute group.
--
-- 'httpStatus', 'createAttributeGroupResponse_httpStatus' - The response's http status code.
newCreateAttributeGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAttributeGroupResponse
newCreateAttributeGroupResponse :: Int -> CreateAttributeGroupResponse
newCreateAttributeGroupResponse Int
pHttpStatus_ =
  CreateAttributeGroupResponse'
    { $sel:attributeGroup:CreateAttributeGroupResponse' :: Maybe AttributeGroup
attributeGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAttributeGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the attribute group.
createAttributeGroupResponse_attributeGroup :: Lens.Lens' CreateAttributeGroupResponse (Prelude.Maybe AttributeGroup)
createAttributeGroupResponse_attributeGroup :: Lens' CreateAttributeGroupResponse (Maybe AttributeGroup)
createAttributeGroupResponse_attributeGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAttributeGroupResponse' {Maybe AttributeGroup
attributeGroup :: Maybe AttributeGroup
$sel:attributeGroup:CreateAttributeGroupResponse' :: CreateAttributeGroupResponse -> Maybe AttributeGroup
attributeGroup} -> Maybe AttributeGroup
attributeGroup) (\s :: CreateAttributeGroupResponse
s@CreateAttributeGroupResponse' {} Maybe AttributeGroup
a -> CreateAttributeGroupResponse
s {$sel:attributeGroup:CreateAttributeGroupResponse' :: Maybe AttributeGroup
attributeGroup = Maybe AttributeGroup
a} :: CreateAttributeGroupResponse)

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

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