{-# 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.UpdateAttributeGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing attribute group with new details.
module Amazonka.ServiceCatalogAppRegistry.UpdateAttributeGroup
  ( -- * Creating a Request
    UpdateAttributeGroup (..),
    newUpdateAttributeGroup,

    -- * Request Lenses
    updateAttributeGroup_attributes,
    updateAttributeGroup_description,
    updateAttributeGroup_name,
    updateAttributeGroup_attributeGroup,

    -- * Destructuring the Response
    UpdateAttributeGroupResponse (..),
    newUpdateAttributeGroupResponse,

    -- * Response Lenses
    updateAttributeGroupResponse_attributeGroup,
    updateAttributeGroupResponse_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:/ 'newUpdateAttributeGroup' smart constructor.
data UpdateAttributeGroup = UpdateAttributeGroup'
  { -- | 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.
    UpdateAttributeGroup -> Maybe Text
attributes :: Prelude.Maybe Prelude.Text,
    -- | The description of the attribute group that the user provides.
    UpdateAttributeGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Deprecated: The new name of the attribute group. The name must be unique
    -- in the region in which you are updating the attribute group. Please do
    -- not use this field as we have stopped supporting name updates.
    UpdateAttributeGroup -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The name or ID of the attribute group that holds the attributes to
    -- describe the application.
    UpdateAttributeGroup -> Text
attributeGroup :: Prelude.Text
  }
  deriving (UpdateAttributeGroup -> UpdateAttributeGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAttributeGroup -> UpdateAttributeGroup -> Bool
$c/= :: UpdateAttributeGroup -> UpdateAttributeGroup -> Bool
== :: UpdateAttributeGroup -> UpdateAttributeGroup -> Bool
$c== :: UpdateAttributeGroup -> UpdateAttributeGroup -> Bool
Prelude.Eq, ReadPrec [UpdateAttributeGroup]
ReadPrec UpdateAttributeGroup
Int -> ReadS UpdateAttributeGroup
ReadS [UpdateAttributeGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAttributeGroup]
$creadListPrec :: ReadPrec [UpdateAttributeGroup]
readPrec :: ReadPrec UpdateAttributeGroup
$creadPrec :: ReadPrec UpdateAttributeGroup
readList :: ReadS [UpdateAttributeGroup]
$creadList :: ReadS [UpdateAttributeGroup]
readsPrec :: Int -> ReadS UpdateAttributeGroup
$creadsPrec :: Int -> ReadS UpdateAttributeGroup
Prelude.Read, Int -> UpdateAttributeGroup -> ShowS
[UpdateAttributeGroup] -> ShowS
UpdateAttributeGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAttributeGroup] -> ShowS
$cshowList :: [UpdateAttributeGroup] -> ShowS
show :: UpdateAttributeGroup -> String
$cshow :: UpdateAttributeGroup -> String
showsPrec :: Int -> UpdateAttributeGroup -> ShowS
$cshowsPrec :: Int -> UpdateAttributeGroup -> ShowS
Prelude.Show, forall x. Rep UpdateAttributeGroup x -> UpdateAttributeGroup
forall x. UpdateAttributeGroup -> Rep UpdateAttributeGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAttributeGroup x -> UpdateAttributeGroup
$cfrom :: forall x. UpdateAttributeGroup -> Rep UpdateAttributeGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAttributeGroup' 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:
--
-- 'attributes', 'updateAttributeGroup_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.
--
-- 'description', 'updateAttributeGroup_description' - The description of the attribute group that the user provides.
--
-- 'name', 'updateAttributeGroup_name' - Deprecated: The new name of the attribute group. The name must be unique
-- in the region in which you are updating the attribute group. Please do
-- not use this field as we have stopped supporting name updates.
--
-- 'attributeGroup', 'updateAttributeGroup_attributeGroup' - The name or ID of the attribute group that holds the attributes to
-- describe the application.
newUpdateAttributeGroup ::
  -- | 'attributeGroup'
  Prelude.Text ->
  UpdateAttributeGroup
newUpdateAttributeGroup :: Text -> UpdateAttributeGroup
newUpdateAttributeGroup Text
pAttributeGroup_ =
  UpdateAttributeGroup'
    { $sel:attributes:UpdateAttributeGroup' :: Maybe Text
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateAttributeGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateAttributeGroup' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:attributeGroup:UpdateAttributeGroup' :: Text
attributeGroup = Text
pAttributeGroup_
    }

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

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

-- | Deprecated: The new name of the attribute group. The name must be unique
-- in the region in which you are updating the attribute group. Please do
-- not use this field as we have stopped supporting name updates.
updateAttributeGroup_name :: Lens.Lens' UpdateAttributeGroup (Prelude.Maybe Prelude.Text)
updateAttributeGroup_name :: Lens' UpdateAttributeGroup (Maybe Text)
updateAttributeGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAttributeGroup' {Maybe Text
name :: Maybe Text
$sel:name:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateAttributeGroup
s@UpdateAttributeGroup' {} Maybe Text
a -> UpdateAttributeGroup
s {$sel:name:UpdateAttributeGroup' :: Maybe Text
name = Maybe Text
a} :: UpdateAttributeGroup)

-- | The name or ID of the attribute group that holds the attributes to
-- describe the application.
updateAttributeGroup_attributeGroup :: Lens.Lens' UpdateAttributeGroup Prelude.Text
updateAttributeGroup_attributeGroup :: Lens' UpdateAttributeGroup Text
updateAttributeGroup_attributeGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAttributeGroup' {Text
attributeGroup :: Text
$sel:attributeGroup:UpdateAttributeGroup' :: UpdateAttributeGroup -> Text
attributeGroup} -> Text
attributeGroup) (\s :: UpdateAttributeGroup
s@UpdateAttributeGroup' {} Text
a -> UpdateAttributeGroup
s {$sel:attributeGroup:UpdateAttributeGroup' :: Text
attributeGroup = Text
a} :: UpdateAttributeGroup)

instance Core.AWSRequest UpdateAttributeGroup where
  type
    AWSResponse UpdateAttributeGroup =
      UpdateAttributeGroupResponse
  request :: (Service -> Service)
-> UpdateAttributeGroup -> Request UpdateAttributeGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateAttributeGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAttributeGroup)))
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 -> UpdateAttributeGroupResponse
UpdateAttributeGroupResponse'
            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 UpdateAttributeGroup where
  hashWithSalt :: Int -> UpdateAttributeGroup -> Int
hashWithSalt Int
_salt UpdateAttributeGroup' {Maybe Text
Text
attributeGroup :: Text
name :: Maybe Text
description :: Maybe Text
attributes :: Maybe Text
$sel:attributeGroup:UpdateAttributeGroup' :: UpdateAttributeGroup -> Text
$sel:name:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:description:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:attributes:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeGroup

instance Prelude.NFData UpdateAttributeGroup where
  rnf :: UpdateAttributeGroup -> ()
rnf UpdateAttributeGroup' {Maybe Text
Text
attributeGroup :: Text
name :: Maybe Text
description :: Maybe Text
attributes :: Maybe Text
$sel:attributeGroup:UpdateAttributeGroup' :: UpdateAttributeGroup -> Text
$sel:name:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:description:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:attributes:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attributeGroup

instance Data.ToHeaders UpdateAttributeGroup where
  toHeaders :: UpdateAttributeGroup -> 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 UpdateAttributeGroup where
  toJSON :: UpdateAttributeGroup -> Value
toJSON UpdateAttributeGroup' {Maybe Text
Text
attributeGroup :: Text
name :: Maybe Text
description :: Maybe Text
attributes :: Maybe Text
$sel:attributeGroup:UpdateAttributeGroup' :: UpdateAttributeGroup -> Text
$sel:name:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:description:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:attributes:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"attributes" 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
attributes,
            (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
"name" 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
name
          ]
      )

instance Data.ToPath UpdateAttributeGroup where
  toPath :: UpdateAttributeGroup -> ByteString
toPath UpdateAttributeGroup' {Maybe Text
Text
attributeGroup :: Text
name :: Maybe Text
description :: Maybe Text
attributes :: Maybe Text
$sel:attributeGroup:UpdateAttributeGroup' :: UpdateAttributeGroup -> Text
$sel:name:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:description:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
$sel:attributes:UpdateAttributeGroup' :: UpdateAttributeGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/attribute-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
attributeGroup]

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

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

-- |
-- Create a value of 'UpdateAttributeGroupResponse' 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', 'updateAttributeGroupResponse_attributeGroup' - The updated information of the attribute group.
--
-- 'httpStatus', 'updateAttributeGroupResponse_httpStatus' - The response's http status code.
newUpdateAttributeGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAttributeGroupResponse
newUpdateAttributeGroupResponse :: Int -> UpdateAttributeGroupResponse
newUpdateAttributeGroupResponse Int
pHttpStatus_ =
  UpdateAttributeGroupResponse'
    { $sel:attributeGroup:UpdateAttributeGroupResponse' :: Maybe AttributeGroup
attributeGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAttributeGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated information of the attribute group.
updateAttributeGroupResponse_attributeGroup :: Lens.Lens' UpdateAttributeGroupResponse (Prelude.Maybe AttributeGroup)
updateAttributeGroupResponse_attributeGroup :: Lens' UpdateAttributeGroupResponse (Maybe AttributeGroup)
updateAttributeGroupResponse_attributeGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAttributeGroupResponse' {Maybe AttributeGroup
attributeGroup :: Maybe AttributeGroup
$sel:attributeGroup:UpdateAttributeGroupResponse' :: UpdateAttributeGroupResponse -> Maybe AttributeGroup
attributeGroup} -> Maybe AttributeGroup
attributeGroup) (\s :: UpdateAttributeGroupResponse
s@UpdateAttributeGroupResponse' {} Maybe AttributeGroup
a -> UpdateAttributeGroupResponse
s {$sel:attributeGroup:UpdateAttributeGroupResponse' :: Maybe AttributeGroup
attributeGroup = Maybe AttributeGroup
a} :: UpdateAttributeGroupResponse)

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

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