{-# 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.Connect.UpdateUserHierarchyGroupName
-- 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 the name of the user hierarchy group.
module Amazonka.Connect.UpdateUserHierarchyGroupName
  ( -- * Creating a Request
    UpdateUserHierarchyGroupName (..),
    newUpdateUserHierarchyGroupName,

    -- * Request Lenses
    updateUserHierarchyGroupName_name,
    updateUserHierarchyGroupName_hierarchyGroupId,
    updateUserHierarchyGroupName_instanceId,

    -- * Destructuring the Response
    UpdateUserHierarchyGroupNameResponse (..),
    newUpdateUserHierarchyGroupNameResponse,
  )
where

import Amazonka.Connect.Types
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

-- | /See:/ 'newUpdateUserHierarchyGroupName' smart constructor.
data UpdateUserHierarchyGroupName = UpdateUserHierarchyGroupName'
  { -- | The name of the hierarchy group. Must not be more than 100 characters.
    UpdateUserHierarchyGroupName -> Text
name :: Prelude.Text,
    -- | The identifier of the hierarchy group.
    UpdateUserHierarchyGroupName -> Text
hierarchyGroupId :: Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    UpdateUserHierarchyGroupName -> Text
instanceId :: Prelude.Text
  }
  deriving (UpdateUserHierarchyGroupName
-> UpdateUserHierarchyGroupName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserHierarchyGroupName
-> UpdateUserHierarchyGroupName -> Bool
$c/= :: UpdateUserHierarchyGroupName
-> UpdateUserHierarchyGroupName -> Bool
== :: UpdateUserHierarchyGroupName
-> UpdateUserHierarchyGroupName -> Bool
$c== :: UpdateUserHierarchyGroupName
-> UpdateUserHierarchyGroupName -> Bool
Prelude.Eq, ReadPrec [UpdateUserHierarchyGroupName]
ReadPrec UpdateUserHierarchyGroupName
Int -> ReadS UpdateUserHierarchyGroupName
ReadS [UpdateUserHierarchyGroupName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserHierarchyGroupName]
$creadListPrec :: ReadPrec [UpdateUserHierarchyGroupName]
readPrec :: ReadPrec UpdateUserHierarchyGroupName
$creadPrec :: ReadPrec UpdateUserHierarchyGroupName
readList :: ReadS [UpdateUserHierarchyGroupName]
$creadList :: ReadS [UpdateUserHierarchyGroupName]
readsPrec :: Int -> ReadS UpdateUserHierarchyGroupName
$creadsPrec :: Int -> ReadS UpdateUserHierarchyGroupName
Prelude.Read, Int -> UpdateUserHierarchyGroupName -> ShowS
[UpdateUserHierarchyGroupName] -> ShowS
UpdateUserHierarchyGroupName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserHierarchyGroupName] -> ShowS
$cshowList :: [UpdateUserHierarchyGroupName] -> ShowS
show :: UpdateUserHierarchyGroupName -> String
$cshow :: UpdateUserHierarchyGroupName -> String
showsPrec :: Int -> UpdateUserHierarchyGroupName -> ShowS
$cshowsPrec :: Int -> UpdateUserHierarchyGroupName -> ShowS
Prelude.Show, forall x.
Rep UpdateUserHierarchyGroupName x -> UpdateUserHierarchyGroupName
forall x.
UpdateUserHierarchyGroupName -> Rep UpdateUserHierarchyGroupName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateUserHierarchyGroupName x -> UpdateUserHierarchyGroupName
$cfrom :: forall x.
UpdateUserHierarchyGroupName -> Rep UpdateUserHierarchyGroupName x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserHierarchyGroupName' 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:
--
-- 'name', 'updateUserHierarchyGroupName_name' - The name of the hierarchy group. Must not be more than 100 characters.
--
-- 'hierarchyGroupId', 'updateUserHierarchyGroupName_hierarchyGroupId' - The identifier of the hierarchy group.
--
-- 'instanceId', 'updateUserHierarchyGroupName_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newUpdateUserHierarchyGroupName ::
  -- | 'name'
  Prelude.Text ->
  -- | 'hierarchyGroupId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  UpdateUserHierarchyGroupName
newUpdateUserHierarchyGroupName :: Text -> Text -> Text -> UpdateUserHierarchyGroupName
newUpdateUserHierarchyGroupName
  Text
pName_
  Text
pHierarchyGroupId_
  Text
pInstanceId_ =
    UpdateUserHierarchyGroupName'
      { $sel:name:UpdateUserHierarchyGroupName' :: Text
name = Text
pName_,
        $sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: Text
hierarchyGroupId = Text
pHierarchyGroupId_,
        $sel:instanceId:UpdateUserHierarchyGroupName' :: Text
instanceId = Text
pInstanceId_
      }

-- | The name of the hierarchy group. Must not be more than 100 characters.
updateUserHierarchyGroupName_name :: Lens.Lens' UpdateUserHierarchyGroupName Prelude.Text
updateUserHierarchyGroupName_name :: Lens' UpdateUserHierarchyGroupName Text
updateUserHierarchyGroupName_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserHierarchyGroupName' {Text
name :: Text
$sel:name:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
name} -> Text
name) (\s :: UpdateUserHierarchyGroupName
s@UpdateUserHierarchyGroupName' {} Text
a -> UpdateUserHierarchyGroupName
s {$sel:name:UpdateUserHierarchyGroupName' :: Text
name = Text
a} :: UpdateUserHierarchyGroupName)

-- | The identifier of the hierarchy group.
updateUserHierarchyGroupName_hierarchyGroupId :: Lens.Lens' UpdateUserHierarchyGroupName Prelude.Text
updateUserHierarchyGroupName_hierarchyGroupId :: Lens' UpdateUserHierarchyGroupName Text
updateUserHierarchyGroupName_hierarchyGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserHierarchyGroupName' {Text
hierarchyGroupId :: Text
$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
hierarchyGroupId} -> Text
hierarchyGroupId) (\s :: UpdateUserHierarchyGroupName
s@UpdateUserHierarchyGroupName' {} Text
a -> UpdateUserHierarchyGroupName
s {$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: Text
hierarchyGroupId = Text
a} :: UpdateUserHierarchyGroupName)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
updateUserHierarchyGroupName_instanceId :: Lens.Lens' UpdateUserHierarchyGroupName Prelude.Text
updateUserHierarchyGroupName_instanceId :: Lens' UpdateUserHierarchyGroupName Text
updateUserHierarchyGroupName_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserHierarchyGroupName' {Text
instanceId :: Text
$sel:instanceId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
instanceId} -> Text
instanceId) (\s :: UpdateUserHierarchyGroupName
s@UpdateUserHierarchyGroupName' {} Text
a -> UpdateUserHierarchyGroupName
s {$sel:instanceId:UpdateUserHierarchyGroupName' :: Text
instanceId = Text
a} :: UpdateUserHierarchyGroupName)

instance Core.AWSRequest UpdateUserHierarchyGroupName where
  type
    AWSResponse UpdateUserHierarchyGroupName =
      UpdateUserHierarchyGroupNameResponse
  request :: (Service -> Service)
-> UpdateUserHierarchyGroupName
-> Request UpdateUserHierarchyGroupName
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 UpdateUserHierarchyGroupName
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateUserHierarchyGroupName)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      UpdateUserHierarchyGroupNameResponse
UpdateUserHierarchyGroupNameResponse'

instance
  Prelude.Hashable
    UpdateUserHierarchyGroupName
  where
  hashWithSalt :: Int -> UpdateUserHierarchyGroupName -> Int
hashWithSalt Int
_salt UpdateUserHierarchyGroupName' {Text
instanceId :: Text
hierarchyGroupId :: Text
name :: Text
$sel:instanceId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:name:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hierarchyGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData UpdateUserHierarchyGroupName where
  rnf :: UpdateUserHierarchyGroupName -> ()
rnf UpdateUserHierarchyGroupName' {Text
instanceId :: Text
hierarchyGroupId :: Text
name :: Text
$sel:instanceId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:name:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
..} =
    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
hierarchyGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders UpdateUserHierarchyGroupName where
  toHeaders :: UpdateUserHierarchyGroupName -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateUserHierarchyGroupName where
  toJSON :: UpdateUserHierarchyGroupName -> Value
toJSON UpdateUserHierarchyGroupName' {Text
instanceId :: Text
hierarchyGroupId :: Text
name :: Text
$sel:instanceId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:name:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 UpdateUserHierarchyGroupName where
  toPath :: UpdateUserHierarchyGroupName -> ByteString
toPath UpdateUserHierarchyGroupName' {Text
instanceId :: Text
hierarchyGroupId :: Text
name :: Text
$sel:instanceId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:hierarchyGroupId:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
$sel:name:UpdateUserHierarchyGroupName' :: UpdateUserHierarchyGroupName -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/user-hierarchy-groups/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
hierarchyGroupId,
        ByteString
"/name"
      ]

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

-- | /See:/ 'newUpdateUserHierarchyGroupNameResponse' smart constructor.
data UpdateUserHierarchyGroupNameResponse = UpdateUserHierarchyGroupNameResponse'
  {
  }
  deriving (UpdateUserHierarchyGroupNameResponse
-> UpdateUserHierarchyGroupNameResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserHierarchyGroupNameResponse
-> UpdateUserHierarchyGroupNameResponse -> Bool
$c/= :: UpdateUserHierarchyGroupNameResponse
-> UpdateUserHierarchyGroupNameResponse -> Bool
== :: UpdateUserHierarchyGroupNameResponse
-> UpdateUserHierarchyGroupNameResponse -> Bool
$c== :: UpdateUserHierarchyGroupNameResponse
-> UpdateUserHierarchyGroupNameResponse -> Bool
Prelude.Eq, ReadPrec [UpdateUserHierarchyGroupNameResponse]
ReadPrec UpdateUserHierarchyGroupNameResponse
Int -> ReadS UpdateUserHierarchyGroupNameResponse
ReadS [UpdateUserHierarchyGroupNameResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserHierarchyGroupNameResponse]
$creadListPrec :: ReadPrec [UpdateUserHierarchyGroupNameResponse]
readPrec :: ReadPrec UpdateUserHierarchyGroupNameResponse
$creadPrec :: ReadPrec UpdateUserHierarchyGroupNameResponse
readList :: ReadS [UpdateUserHierarchyGroupNameResponse]
$creadList :: ReadS [UpdateUserHierarchyGroupNameResponse]
readsPrec :: Int -> ReadS UpdateUserHierarchyGroupNameResponse
$creadsPrec :: Int -> ReadS UpdateUserHierarchyGroupNameResponse
Prelude.Read, Int -> UpdateUserHierarchyGroupNameResponse -> ShowS
[UpdateUserHierarchyGroupNameResponse] -> ShowS
UpdateUserHierarchyGroupNameResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserHierarchyGroupNameResponse] -> ShowS
$cshowList :: [UpdateUserHierarchyGroupNameResponse] -> ShowS
show :: UpdateUserHierarchyGroupNameResponse -> String
$cshow :: UpdateUserHierarchyGroupNameResponse -> String
showsPrec :: Int -> UpdateUserHierarchyGroupNameResponse -> ShowS
$cshowsPrec :: Int -> UpdateUserHierarchyGroupNameResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateUserHierarchyGroupNameResponse x
-> UpdateUserHierarchyGroupNameResponse
forall x.
UpdateUserHierarchyGroupNameResponse
-> Rep UpdateUserHierarchyGroupNameResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateUserHierarchyGroupNameResponse x
-> UpdateUserHierarchyGroupNameResponse
$cfrom :: forall x.
UpdateUserHierarchyGroupNameResponse
-> Rep UpdateUserHierarchyGroupNameResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserHierarchyGroupNameResponse' 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.
newUpdateUserHierarchyGroupNameResponse ::
  UpdateUserHierarchyGroupNameResponse
newUpdateUserHierarchyGroupNameResponse :: UpdateUserHierarchyGroupNameResponse
newUpdateUserHierarchyGroupNameResponse =
  UpdateUserHierarchyGroupNameResponse
UpdateUserHierarchyGroupNameResponse'

instance
  Prelude.NFData
    UpdateUserHierarchyGroupNameResponse
  where
  rnf :: UpdateUserHierarchyGroupNameResponse -> ()
rnf UpdateUserHierarchyGroupNameResponse
_ = ()