{-# 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.IAM.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 new group.
--
-- For information about the number of groups you can create, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html IAM and STS quotas>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreateGroup
  ( -- * Creating a Request
    CreateGroup (..),
    newCreateGroup,

    -- * Request Lenses
    createGroup_path,
    createGroup_groupName,

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

    -- * Response Lenses
    createGroupResponse_httpStatus,
    createGroupResponse_group,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateGroup' smart constructor.
data CreateGroup = CreateGroup'
  { -- | The path to the group. For more information about paths, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    --
    -- This parameter is optional. If it is not included, it defaults to a
    -- slash (\/).
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of either a forward slash (\/) by itself or a string that
    -- must begin and end with forward slashes. In addition, it can contain any
    -- ASCII character from the ! (@\\u0021@) through the DEL character
    -- (@\\u007F@), including most punctuation characters, digits, and upper
    -- and lowercased letters.
    CreateGroup -> Maybe Text
path :: Prelude.Maybe Prelude.Text,
    -- | The name of the group to create. Do not include the path in this value.
    --
    -- IAM user, group, role, and policy names must be unique within the
    -- account. Names are not distinguished by case. For example, you cannot
    -- create resources named both \"MyResource\" and \"myresource\".
    CreateGroup -> Text
groupName :: 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:
--
-- 'path', 'createGroup_path' - The path to the group. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- 'groupName', 'createGroup_groupName' - The name of the group to create. Do not include the path in this value.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
newCreateGroup ::
  -- | 'groupName'
  Prelude.Text ->
  CreateGroup
newCreateGroup :: Text -> CreateGroup
newCreateGroup Text
pGroupName_ =
  CreateGroup'
    { $sel:path:CreateGroup' :: Maybe Text
path = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:CreateGroup' :: Text
groupName = Text
pGroupName_
    }

-- | The path to the group. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
createGroup_path :: Lens.Lens' CreateGroup (Prelude.Maybe Prelude.Text)
createGroup_path :: Lens' CreateGroup (Maybe Text)
createGroup_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe Text
path :: Maybe Text
$sel:path:CreateGroup' :: CreateGroup -> Maybe Text
path} -> Maybe Text
path) (\s :: CreateGroup
s@CreateGroup' {} Maybe Text
a -> CreateGroup
s {$sel:path:CreateGroup' :: Maybe Text
path = Maybe Text
a} :: CreateGroup)

-- | The name of the group to create. Do not include the path in this value.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
createGroup_groupName :: Lens.Lens' CreateGroup Prelude.Text
createGroup_groupName :: Lens' CreateGroup Text
createGroup_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Text
groupName :: Text
$sel:groupName:CreateGroup' :: CreateGroup -> Text
groupName} -> Text
groupName) (\s :: CreateGroup
s@CreateGroup' {} Text
a -> CreateGroup
s {$sel:groupName:CreateGroup' :: Text
groupName = 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 => Service -> a -> Request a
Request.postQuery (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 =>
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
"CreateGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Group -> CreateGroupResponse
CreateGroupResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Group")
      )

instance Prelude.Hashable CreateGroup where
  hashWithSalt :: Int -> CreateGroup -> Int
hashWithSalt Int
_salt CreateGroup' {Maybe Text
Text
groupName :: Text
path :: Maybe Text
$sel:groupName:CreateGroup' :: CreateGroup -> Text
$sel:path:CreateGroup' :: CreateGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupName

instance Prelude.NFData CreateGroup where
  rnf :: CreateGroup -> ()
rnf CreateGroup' {Maybe Text
Text
groupName :: Text
path :: Maybe Text
$sel:groupName:CreateGroup' :: CreateGroup -> Text
$sel:path:CreateGroup' :: CreateGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
path
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupName

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.ToPath CreateGroup where
  toPath :: CreateGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateGroup where
  toQuery :: CreateGroup -> QueryString
toQuery CreateGroup' {Maybe Text
Text
groupName :: Text
path :: Maybe Text
$sel:groupName:CreateGroup' :: CreateGroup -> Text
$sel:path:CreateGroup' :: CreateGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"Path" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
path,
        ByteString
"GroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
groupName
      ]

-- | Contains the response to a successful CreateGroup request.
--
-- /See:/ 'newCreateGroupResponse' smart constructor.
data CreateGroupResponse = CreateGroupResponse'
  { -- | The response's http status code.
    CreateGroupResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing details about the new group.
    CreateGroupResponse -> Group
group' :: Group
  }
  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:
--
-- 'httpStatus', 'createGroupResponse_httpStatus' - The response's http status code.
--
-- 'group'', 'createGroupResponse_group' - A structure containing details about the new group.
newCreateGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'group''
  Group ->
  CreateGroupResponse
newCreateGroupResponse :: Int -> Group -> CreateGroupResponse
newCreateGroupResponse Int
pHttpStatus_ Group
pGroup_ =
  CreateGroupResponse'
    { $sel:httpStatus:CreateGroupResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:group':CreateGroupResponse' :: Group
group' = Group
pGroup_
    }

-- | 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)

-- | A structure containing details about the new group.
createGroupResponse_group :: Lens.Lens' CreateGroupResponse Group
createGroupResponse_group :: Lens' CreateGroupResponse Group
createGroupResponse_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Group
group' :: Group
$sel:group':CreateGroupResponse' :: CreateGroupResponse -> Group
group'} -> Group
group') (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Group
a -> CreateGroupResponse
s {$sel:group':CreateGroupResponse' :: Group
group' = Group
a} :: CreateGroupResponse)

instance Prelude.NFData CreateGroupResponse where
  rnf :: CreateGroupResponse -> ()
rnf CreateGroupResponse' {Int
Group
group' :: Group
httpStatus :: Int
$sel:group':CreateGroupResponse' :: CreateGroupResponse -> Group
$sel:httpStatus:CreateGroupResponse' :: CreateGroupResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Group
group'