{-# 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.ResourceGroups.CreateGroup
-- 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 resource group with the specified name and description. You
-- can optionally include a resource query, or a service configuration. For
-- more information about constructing a resource query, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
-- For more information about service configurations, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- __Minimum permissions__
--
-- To run this command, you must have the following permissions:
--
-- -   @resource-groups:CreateGroup@
module Amazonka.ResourceGroups.CreateGroup
  ( -- * Creating a Request
    CreateGroup (..),
    newCreateGroup,

    -- * Request Lenses
    createGroup_configuration,
    createGroup_description,
    createGroup_resourceQuery,
    createGroup_tags,
    createGroup_name,

    -- * Destructuring the Response
    CreateGroupResponse (..),
    newCreateGroupResponse,

    -- * Response Lenses
    createGroupResponse_group,
    createGroupResponse_groupConfiguration,
    createGroupResponse_resourceQuery,
    createGroupResponse_tags,
    createGroupResponse_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 Amazonka.ResourceGroups.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateGroup' smart constructor.
data CreateGroup = CreateGroup'
  { -- | A configuration associates the resource group with an AWS service and
    -- specifies how the service can interact with the resources in the group.
    -- A configuration is an array of GroupConfigurationItem elements. For
    -- details about the syntax of service configurations, see
    -- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
    --
    -- A resource group can contain either a @Configuration@ or a
    -- @ResourceQuery@, but not both.
    CreateGroup -> Maybe [GroupConfigurationItem]
configuration :: Prelude.Maybe [GroupConfigurationItem],
    -- | The description of the resource group. Descriptions can consist of
    -- letters, numbers, hyphens, underscores, periods, and spaces.
    CreateGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The resource query that determines which AWS resources are members of
    -- this group. For more information about resource queries, see
    -- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
    --
    -- A resource group can contain either a @ResourceQuery@ or a
    -- @Configuration@, but not both.
    CreateGroup -> Maybe ResourceQuery
resourceQuery :: Prelude.Maybe ResourceQuery,
    -- | The tags to add to the group. A tag is key-value pair string.
    CreateGroup -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the group, which is the identifier of the group in other
    -- operations. You can\'t change the name of a resource group after you
    -- create it. A resource group name can consist of letters, numbers,
    -- hyphens, periods, and underscores. The name cannot start with @AWS@ or
    -- @aws@; these are reserved. A resource group name must be unique within
    -- each AWS Region in your AWS account.
    CreateGroup -> Text
name :: Prelude.Text
  }
  deriving (CreateGroup -> CreateGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGroup -> CreateGroup -> Bool
$c/= :: CreateGroup -> CreateGroup -> Bool
== :: CreateGroup -> CreateGroup -> Bool
$c== :: CreateGroup -> CreateGroup -> Bool
Prelude.Eq, ReadPrec [CreateGroup]
ReadPrec CreateGroup
Int -> ReadS CreateGroup
ReadS [CreateGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGroup]
$creadListPrec :: ReadPrec [CreateGroup]
readPrec :: ReadPrec CreateGroup
$creadPrec :: ReadPrec CreateGroup
readList :: ReadS [CreateGroup]
$creadList :: ReadS [CreateGroup]
readsPrec :: Int -> ReadS CreateGroup
$creadsPrec :: Int -> ReadS CreateGroup
Prelude.Read, Int -> CreateGroup -> ShowS
[CreateGroup] -> ShowS
CreateGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGroup] -> ShowS
$cshowList :: [CreateGroup] -> ShowS
show :: CreateGroup -> String
$cshow :: CreateGroup -> String
showsPrec :: Int -> CreateGroup -> ShowS
$cshowsPrec :: Int -> CreateGroup -> ShowS
Prelude.Show, forall x. Rep CreateGroup x -> CreateGroup
forall x. CreateGroup -> Rep CreateGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGroup x -> CreateGroup
$cfrom :: forall x. CreateGroup -> Rep CreateGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateGroup' 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:
--
-- 'configuration', 'createGroup_configuration' - A configuration associates the resource group with an AWS service and
-- specifies how the service can interact with the resources in the group.
-- A configuration is an array of GroupConfigurationItem elements. For
-- details about the syntax of service configurations, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- A resource group can contain either a @Configuration@ or a
-- @ResourceQuery@, but not both.
--
-- 'description', 'createGroup_description' - The description of the resource group. Descriptions can consist of
-- letters, numbers, hyphens, underscores, periods, and spaces.
--
-- 'resourceQuery', 'createGroup_resourceQuery' - The resource query that determines which AWS resources are members of
-- this group. For more information about resource queries, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
--
-- A resource group can contain either a @ResourceQuery@ or a
-- @Configuration@, but not both.
--
-- 'tags', 'createGroup_tags' - The tags to add to the group. A tag is key-value pair string.
--
-- 'name', 'createGroup_name' - The name of the group, which is the identifier of the group in other
-- operations. You can\'t change the name of a resource group after you
-- create it. A resource group name can consist of letters, numbers,
-- hyphens, periods, and underscores. The name cannot start with @AWS@ or
-- @aws@; these are reserved. A resource group name must be unique within
-- each AWS Region in your AWS account.
newCreateGroup ::
  -- | 'name'
  Prelude.Text ->
  CreateGroup
newCreateGroup :: Text -> CreateGroup
newCreateGroup Text
pName_ =
  CreateGroup'
    { $sel:configuration:CreateGroup' :: Maybe [GroupConfigurationItem]
configuration = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceQuery:CreateGroup' :: Maybe ResourceQuery
resourceQuery = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateGroup' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateGroup' :: Text
name = Text
pName_
    }

-- | A configuration associates the resource group with an AWS service and
-- specifies how the service can interact with the resources in the group.
-- A configuration is an array of GroupConfigurationItem elements. For
-- details about the syntax of service configurations, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- A resource group can contain either a @Configuration@ or a
-- @ResourceQuery@, but not both.
createGroup_configuration :: Lens.Lens' CreateGroup (Prelude.Maybe [GroupConfigurationItem])
createGroup_configuration :: Lens' CreateGroup (Maybe [GroupConfigurationItem])
createGroup_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe [GroupConfigurationItem]
configuration :: Maybe [GroupConfigurationItem]
$sel:configuration:CreateGroup' :: CreateGroup -> Maybe [GroupConfigurationItem]
configuration} -> Maybe [GroupConfigurationItem]
configuration) (\s :: CreateGroup
s@CreateGroup' {} Maybe [GroupConfigurationItem]
a -> CreateGroup
s {$sel:configuration:CreateGroup' :: Maybe [GroupConfigurationItem]
configuration = Maybe [GroupConfigurationItem]
a} :: CreateGroup) 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 description of the resource group. Descriptions can consist of
-- letters, numbers, hyphens, underscores, periods, and spaces.
createGroup_description :: Lens.Lens' CreateGroup (Prelude.Maybe Prelude.Text)
createGroup_description :: Lens' CreateGroup (Maybe Text)
createGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe Text
description :: Maybe Text
$sel:description:CreateGroup' :: CreateGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateGroup
s@CreateGroup' {} Maybe Text
a -> CreateGroup
s {$sel:description:CreateGroup' :: Maybe Text
description = Maybe Text
a} :: CreateGroup)

-- | The resource query that determines which AWS resources are members of
-- this group. For more information about resource queries, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
--
-- A resource group can contain either a @ResourceQuery@ or a
-- @Configuration@, but not both.
createGroup_resourceQuery :: Lens.Lens' CreateGroup (Prelude.Maybe ResourceQuery)
createGroup_resourceQuery :: Lens' CreateGroup (Maybe ResourceQuery)
createGroup_resourceQuery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe ResourceQuery
resourceQuery :: Maybe ResourceQuery
$sel:resourceQuery:CreateGroup' :: CreateGroup -> Maybe ResourceQuery
resourceQuery} -> Maybe ResourceQuery
resourceQuery) (\s :: CreateGroup
s@CreateGroup' {} Maybe ResourceQuery
a -> CreateGroup
s {$sel:resourceQuery:CreateGroup' :: Maybe ResourceQuery
resourceQuery = Maybe ResourceQuery
a} :: CreateGroup)

-- | The tags to add to the group. A tag is key-value pair string.
createGroup_tags :: Lens.Lens' CreateGroup (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createGroup_tags :: Lens' CreateGroup (Maybe (HashMap Text Text))
createGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateGroup' :: CreateGroup -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateGroup
s@CreateGroup' {} Maybe (HashMap Text Text)
a -> CreateGroup
s {$sel:tags:CreateGroup' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateGroup) 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 group, which is the identifier of the group in other
-- operations. You can\'t change the name of a resource group after you
-- create it. A resource group name can consist of letters, numbers,
-- hyphens, periods, and underscores. The name cannot start with @AWS@ or
-- @aws@; these are reserved. A resource group name must be unique within
-- each AWS Region in your AWS account.
createGroup_name :: Lens.Lens' CreateGroup Prelude.Text
createGroup_name :: Lens' CreateGroup Text
createGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Text
name :: Text
$sel:name:CreateGroup' :: CreateGroup -> Text
name} -> Text
name) (\s :: CreateGroup
s@CreateGroup' {} Text
a -> CreateGroup
s {$sel:name:CreateGroup' :: Text
name = Text
a} :: CreateGroup)

instance Core.AWSRequest CreateGroup where
  type AWSResponse CreateGroup = CreateGroupResponse
  request :: (Service -> Service) -> CreateGroup -> Request CreateGroup
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 CreateGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateGroup)))
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 Group
-> Maybe GroupConfiguration
-> Maybe ResourceQuery
-> Maybe (HashMap Text Text)
-> Int
-> CreateGroupResponse
CreateGroupResponse'
            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
"Group")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GroupConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ResourceQuery")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateGroup where
  hashWithSalt :: Int -> CreateGroup -> Int
hashWithSalt Int
_salt CreateGroup' {Maybe [GroupConfigurationItem]
Maybe Text
Maybe (HashMap Text Text)
Maybe ResourceQuery
Text
name :: Text
tags :: Maybe (HashMap Text Text)
resourceQuery :: Maybe ResourceQuery
description :: Maybe Text
configuration :: Maybe [GroupConfigurationItem]
$sel:name:CreateGroup' :: CreateGroup -> Text
$sel:tags:CreateGroup' :: CreateGroup -> Maybe (HashMap Text Text)
$sel:resourceQuery:CreateGroup' :: CreateGroup -> Maybe ResourceQuery
$sel:description:CreateGroup' :: CreateGroup -> Maybe Text
$sel:configuration:CreateGroup' :: CreateGroup -> Maybe [GroupConfigurationItem]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GroupConfigurationItem]
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceQuery
resourceQuery
      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

instance Prelude.NFData CreateGroup where
  rnf :: CreateGroup -> ()
rnf CreateGroup' {Maybe [GroupConfigurationItem]
Maybe Text
Maybe (HashMap Text Text)
Maybe ResourceQuery
Text
name :: Text
tags :: Maybe (HashMap Text Text)
resourceQuery :: Maybe ResourceQuery
description :: Maybe Text
configuration :: Maybe [GroupConfigurationItem]
$sel:name:CreateGroup' :: CreateGroup -> Text
$sel:tags:CreateGroup' :: CreateGroup -> Maybe (HashMap Text Text)
$sel:resourceQuery:CreateGroup' :: CreateGroup -> Maybe ResourceQuery
$sel:description:CreateGroup' :: CreateGroup -> Maybe Text
$sel:configuration:CreateGroup' :: CreateGroup -> Maybe [GroupConfigurationItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupConfigurationItem]
configuration
      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 ResourceQuery
resourceQuery
      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

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

instance Data.ToJSON CreateGroup where
  toJSON :: CreateGroup -> Value
toJSON CreateGroup' {Maybe [GroupConfigurationItem]
Maybe Text
Maybe (HashMap Text Text)
Maybe ResourceQuery
Text
name :: Text
tags :: Maybe (HashMap Text Text)
resourceQuery :: Maybe ResourceQuery
description :: Maybe Text
configuration :: Maybe [GroupConfigurationItem]
$sel:name:CreateGroup' :: CreateGroup -> Text
$sel:tags:CreateGroup' :: CreateGroup -> Maybe (HashMap Text Text)
$sel:resourceQuery:CreateGroup' :: CreateGroup -> Maybe ResourceQuery
$sel:description:CreateGroup' :: CreateGroup -> Maybe Text
$sel:configuration:CreateGroup' :: CreateGroup -> Maybe [GroupConfigurationItem]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Configuration" 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 [GroupConfigurationItem]
configuration,
            (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
"ResourceQuery" 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 ResourceQuery
resourceQuery,
            (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)
          ]
      )

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

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

-- | /See:/ 'newCreateGroupResponse' smart constructor.
data CreateGroupResponse = CreateGroupResponse'
  { -- | The description of the resource group.
    CreateGroupResponse -> Maybe Group
group' :: Prelude.Maybe Group,
    -- | The service configuration associated with the resource group. For
    -- details about the syntax of a service configuration, see
    -- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
    CreateGroupResponse -> Maybe GroupConfiguration
groupConfiguration :: Prelude.Maybe GroupConfiguration,
    -- | The resource query associated with the group. For more information about
    -- resource queries, see
    -- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
    CreateGroupResponse -> Maybe ResourceQuery
resourceQuery :: Prelude.Maybe ResourceQuery,
    -- | The tags associated with the group.
    CreateGroupResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateGroupResponse -> CreateGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGroupResponse -> CreateGroupResponse -> Bool
$c/= :: CreateGroupResponse -> CreateGroupResponse -> Bool
== :: CreateGroupResponse -> CreateGroupResponse -> Bool
$c== :: CreateGroupResponse -> CreateGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateGroupResponse]
ReadPrec CreateGroupResponse
Int -> ReadS CreateGroupResponse
ReadS [CreateGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGroupResponse]
$creadListPrec :: ReadPrec [CreateGroupResponse]
readPrec :: ReadPrec CreateGroupResponse
$creadPrec :: ReadPrec CreateGroupResponse
readList :: ReadS [CreateGroupResponse]
$creadList :: ReadS [CreateGroupResponse]
readsPrec :: Int -> ReadS CreateGroupResponse
$creadsPrec :: Int -> ReadS CreateGroupResponse
Prelude.Read, Int -> CreateGroupResponse -> ShowS
[CreateGroupResponse] -> ShowS
CreateGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGroupResponse] -> ShowS
$cshowList :: [CreateGroupResponse] -> ShowS
show :: CreateGroupResponse -> String
$cshow :: CreateGroupResponse -> String
showsPrec :: Int -> CreateGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateGroupResponse -> ShowS
Prelude.Show, forall x. Rep CreateGroupResponse x -> CreateGroupResponse
forall x. CreateGroupResponse -> Rep CreateGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGroupResponse x -> CreateGroupResponse
$cfrom :: forall x. CreateGroupResponse -> Rep CreateGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateGroupResponse' 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:
--
-- 'group'', 'createGroupResponse_group' - The description of the resource group.
--
-- 'groupConfiguration', 'createGroupResponse_groupConfiguration' - The service configuration associated with the resource group. For
-- details about the syntax of a service configuration, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- 'resourceQuery', 'createGroupResponse_resourceQuery' - The resource query associated with the group. For more information about
-- resource queries, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
--
-- 'tags', 'createGroupResponse_tags' - The tags associated with the group.
--
-- 'httpStatus', 'createGroupResponse_httpStatus' - The response's http status code.
newCreateGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateGroupResponse
newCreateGroupResponse :: Int -> CreateGroupResponse
newCreateGroupResponse Int
pHttpStatus_ =
  CreateGroupResponse'
    { $sel:group':CreateGroupResponse' :: Maybe Group
group' = forall a. Maybe a
Prelude.Nothing,
      $sel:groupConfiguration:CreateGroupResponse' :: Maybe GroupConfiguration
groupConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceQuery:CreateGroupResponse' :: Maybe ResourceQuery
resourceQuery = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateGroupResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The description of the resource group.
createGroupResponse_group :: Lens.Lens' CreateGroupResponse (Prelude.Maybe Group)
createGroupResponse_group :: Lens' CreateGroupResponse (Maybe Group)
createGroupResponse_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Maybe Group
group' :: Maybe Group
$sel:group':CreateGroupResponse' :: CreateGroupResponse -> Maybe Group
group'} -> Maybe Group
group') (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Maybe Group
a -> CreateGroupResponse
s {$sel:group':CreateGroupResponse' :: Maybe Group
group' = Maybe Group
a} :: CreateGroupResponse)

-- | The service configuration associated with the resource group. For
-- details about the syntax of a service configuration, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
createGroupResponse_groupConfiguration :: Lens.Lens' CreateGroupResponse (Prelude.Maybe GroupConfiguration)
createGroupResponse_groupConfiguration :: Lens' CreateGroupResponse (Maybe GroupConfiguration)
createGroupResponse_groupConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Maybe GroupConfiguration
groupConfiguration :: Maybe GroupConfiguration
$sel:groupConfiguration:CreateGroupResponse' :: CreateGroupResponse -> Maybe GroupConfiguration
groupConfiguration} -> Maybe GroupConfiguration
groupConfiguration) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Maybe GroupConfiguration
a -> CreateGroupResponse
s {$sel:groupConfiguration:CreateGroupResponse' :: Maybe GroupConfiguration
groupConfiguration = Maybe GroupConfiguration
a} :: CreateGroupResponse)

-- | The resource query associated with the group. For more information about
-- resource queries, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/gettingstarted-query.html#gettingstarted-query-cli-tag Create a tag-based group in Resource Groups>.
createGroupResponse_resourceQuery :: Lens.Lens' CreateGroupResponse (Prelude.Maybe ResourceQuery)
createGroupResponse_resourceQuery :: Lens' CreateGroupResponse (Maybe ResourceQuery)
createGroupResponse_resourceQuery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Maybe ResourceQuery
resourceQuery :: Maybe ResourceQuery
$sel:resourceQuery:CreateGroupResponse' :: CreateGroupResponse -> Maybe ResourceQuery
resourceQuery} -> Maybe ResourceQuery
resourceQuery) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Maybe ResourceQuery
a -> CreateGroupResponse
s {$sel:resourceQuery:CreateGroupResponse' :: Maybe ResourceQuery
resourceQuery = Maybe ResourceQuery
a} :: CreateGroupResponse)

-- | The tags associated with the group.
createGroupResponse_tags :: Lens.Lens' CreateGroupResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createGroupResponse_tags :: Lens' CreateGroupResponse (Maybe (HashMap Text Text))
createGroupResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateGroupResponse' :: CreateGroupResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Maybe (HashMap Text Text)
a -> CreateGroupResponse
s {$sel:tags:CreateGroupResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateGroupResponse) 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 response's http status code.
createGroupResponse_httpStatus :: Lens.Lens' CreateGroupResponse Prelude.Int
createGroupResponse_httpStatus :: Lens' CreateGroupResponse Int
createGroupResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateGroupResponse' :: CreateGroupResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Int
a -> CreateGroupResponse
s {$sel:httpStatus:CreateGroupResponse' :: Int
httpStatus = Int
a} :: CreateGroupResponse)

instance Prelude.NFData CreateGroupResponse where
  rnf :: CreateGroupResponse -> ()
rnf CreateGroupResponse' {Int
Maybe (HashMap Text Text)
Maybe Group
Maybe GroupConfiguration
Maybe ResourceQuery
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
resourceQuery :: Maybe ResourceQuery
groupConfiguration :: Maybe GroupConfiguration
group' :: Maybe Group
$sel:httpStatus:CreateGroupResponse' :: CreateGroupResponse -> Int
$sel:tags:CreateGroupResponse' :: CreateGroupResponse -> Maybe (HashMap Text Text)
$sel:resourceQuery:CreateGroupResponse' :: CreateGroupResponse -> Maybe ResourceQuery
$sel:groupConfiguration:CreateGroupResponse' :: CreateGroupResponse -> Maybe GroupConfiguration
$sel:group':CreateGroupResponse' :: CreateGroupResponse -> Maybe Group
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Group
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GroupConfiguration
groupConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceQuery
resourceQuery
      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 Int
httpStatus