{-# 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.IdentityStore.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 group within the specified identity store.
module Amazonka.IdentityStore.CreateGroup
  ( -- * Creating a Request
    CreateGroup (..),
    newCreateGroup,

    -- * Request Lenses
    createGroup_description,
    createGroup_displayName,
    createGroup_identityStoreId,

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

    -- * Response Lenses
    createGroupResponse_httpStatus,
    createGroupResponse_groupId,
    createGroupResponse_identityStoreId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IdentityStore.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'
  { -- | A string containing the description of the group.
    CreateGroup -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A string containing the name of the group. This value is commonly
    -- displayed when the group is referenced.
    CreateGroup -> Maybe (Sensitive Text)
displayName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The globally unique identifier for the identity store.
    CreateGroup -> Text
identityStoreId :: 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, 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:
--
-- 'description', 'createGroup_description' - A string containing the description of the group.
--
-- 'displayName', 'createGroup_displayName' - A string containing the name of the group. This value is commonly
-- displayed when the group is referenced.
--
-- 'identityStoreId', 'createGroup_identityStoreId' - The globally unique identifier for the identity store.
newCreateGroup ::
  -- | 'identityStoreId'
  Prelude.Text ->
  CreateGroup
newCreateGroup :: Text -> CreateGroup
newCreateGroup Text
pIdentityStoreId_ =
  CreateGroup'
    { $sel:description:CreateGroup' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:CreateGroup' :: Maybe (Sensitive Text)
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:identityStoreId:CreateGroup' :: Text
identityStoreId = Text
pIdentityStoreId_
    }

-- | A string containing the description of the group.
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 (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateGroup' :: CreateGroup -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateGroup
s@CreateGroup' {} Maybe (Sensitive Text)
a -> CreateGroup
s {$sel:description:CreateGroup' :: Maybe (Sensitive Text)
description = Maybe (Sensitive 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A string containing the name of the group. This value is commonly
-- displayed when the group is referenced.
createGroup_displayName :: Lens.Lens' CreateGroup (Prelude.Maybe Prelude.Text)
createGroup_displayName :: Lens' CreateGroup (Maybe Text)
createGroup_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Maybe (Sensitive Text)
displayName :: Maybe (Sensitive Text)
$sel:displayName:CreateGroup' :: CreateGroup -> Maybe (Sensitive Text)
displayName} -> Maybe (Sensitive Text)
displayName) (\s :: CreateGroup
s@CreateGroup' {} Maybe (Sensitive Text)
a -> CreateGroup
s {$sel:displayName:CreateGroup' :: Maybe (Sensitive Text)
displayName = Maybe (Sensitive 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The globally unique identifier for the identity store.
createGroup_identityStoreId :: Lens.Lens' CreateGroup Prelude.Text
createGroup_identityStoreId :: Lens' CreateGroup Text
createGroup_identityStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroup' {Text
identityStoreId :: Text
$sel:identityStoreId:CreateGroup' :: CreateGroup -> Text
identityStoreId} -> Text
identityStoreId) (\s :: CreateGroup
s@CreateGroup' {} Text
a -> CreateGroup
s {$sel:identityStoreId:CreateGroup' :: Text
identityStoreId = 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 ->
          Int -> Text -> Text -> 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"GroupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"IdentityStoreId")
      )

instance Prelude.Hashable CreateGroup where
  hashWithSalt :: Int -> CreateGroup -> Int
hashWithSalt Int
_salt CreateGroup' {Maybe (Sensitive Text)
Text
identityStoreId :: Text
displayName :: Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:identityStoreId:CreateGroup' :: CreateGroup -> Text
$sel:displayName:CreateGroup' :: CreateGroup -> Maybe (Sensitive Text)
$sel:description:CreateGroup' :: CreateGroup -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityStoreId

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

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

instance Data.ToJSON CreateGroup where
  toJSON :: CreateGroup -> Value
toJSON CreateGroup' {Maybe (Sensitive Text)
Text
identityStoreId :: Text
displayName :: Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:identityStoreId:CreateGroup' :: CreateGroup -> Text
$sel:displayName:CreateGroup' :: CreateGroup -> Maybe (Sensitive Text)
$sel:description:CreateGroup' :: CreateGroup -> Maybe (Sensitive 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 (Sensitive Text)
description,
            (Key
"DisplayName" 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 (Sensitive Text)
displayName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityStoreId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityStoreId)
          ]
      )

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 = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateGroupResponse' smart constructor.
data CreateGroupResponse = CreateGroupResponse'
  { -- | The response's http status code.
    CreateGroupResponse -> Int
httpStatus :: Prelude.Int,
    -- | The identifier of the newly created group in the identity store.
    CreateGroupResponse -> Text
groupId :: Prelude.Text,
    -- | The globally unique identifier for the identity store.
    CreateGroupResponse -> Text
identityStoreId :: Prelude.Text
  }
  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.
--
-- 'groupId', 'createGroupResponse_groupId' - The identifier of the newly created group in the identity store.
--
-- 'identityStoreId', 'createGroupResponse_identityStoreId' - The globally unique identifier for the identity store.
newCreateGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'groupId'
  Prelude.Text ->
  -- | 'identityStoreId'
  Prelude.Text ->
  CreateGroupResponse
newCreateGroupResponse :: Int -> Text -> Text -> CreateGroupResponse
newCreateGroupResponse
  Int
pHttpStatus_
  Text
pGroupId_
  Text
pIdentityStoreId_ =
    CreateGroupResponse'
      { $sel:httpStatus:CreateGroupResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:groupId:CreateGroupResponse' :: Text
groupId = Text
pGroupId_,
        $sel:identityStoreId:CreateGroupResponse' :: Text
identityStoreId = Text
pIdentityStoreId_
      }

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

-- | The identifier of the newly created group in the identity store.
createGroupResponse_groupId :: Lens.Lens' CreateGroupResponse Prelude.Text
createGroupResponse_groupId :: Lens' CreateGroupResponse Text
createGroupResponse_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Text
groupId :: Text
$sel:groupId:CreateGroupResponse' :: CreateGroupResponse -> Text
groupId} -> Text
groupId) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Text
a -> CreateGroupResponse
s {$sel:groupId:CreateGroupResponse' :: Text
groupId = Text
a} :: CreateGroupResponse)

-- | The globally unique identifier for the identity store.
createGroupResponse_identityStoreId :: Lens.Lens' CreateGroupResponse Prelude.Text
createGroupResponse_identityStoreId :: Lens' CreateGroupResponse Text
createGroupResponse_identityStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGroupResponse' {Text
identityStoreId :: Text
$sel:identityStoreId:CreateGroupResponse' :: CreateGroupResponse -> Text
identityStoreId} -> Text
identityStoreId) (\s :: CreateGroupResponse
s@CreateGroupResponse' {} Text
a -> CreateGroupResponse
s {$sel:identityStoreId:CreateGroupResponse' :: Text
identityStoreId = Text
a} :: CreateGroupResponse)

instance Prelude.NFData CreateGroupResponse where
  rnf :: CreateGroupResponse -> ()
rnf CreateGroupResponse' {Int
Text
identityStoreId :: Text
groupId :: Text
httpStatus :: Int
$sel:identityStoreId:CreateGroupResponse' :: CreateGroupResponse -> Text
$sel:groupId:CreateGroupResponse' :: CreateGroupResponse -> Text
$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 Text
groupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityStoreId