{-# 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.UpdateUserHierarchy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Assigns the specified hierarchy group to the specified user.
module Amazonka.Connect.UpdateUserHierarchy
  ( -- * Creating a Request
    UpdateUserHierarchy (..),
    newUpdateUserHierarchy,

    -- * Request Lenses
    updateUserHierarchy_hierarchyGroupId,
    updateUserHierarchy_userId,
    updateUserHierarchy_instanceId,

    -- * Destructuring the Response
    UpdateUserHierarchyResponse (..),
    newUpdateUserHierarchyResponse,
  )
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:/ 'newUpdateUserHierarchy' smart constructor.
data UpdateUserHierarchy = UpdateUserHierarchy'
  { -- | The identifier of the hierarchy group.
    UpdateUserHierarchy -> Maybe Text
hierarchyGroupId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the user account.
    UpdateUserHierarchy -> Text
userId :: Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    UpdateUserHierarchy -> Text
instanceId :: Prelude.Text
  }
  deriving (UpdateUserHierarchy -> UpdateUserHierarchy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserHierarchy -> UpdateUserHierarchy -> Bool
$c/= :: UpdateUserHierarchy -> UpdateUserHierarchy -> Bool
== :: UpdateUserHierarchy -> UpdateUserHierarchy -> Bool
$c== :: UpdateUserHierarchy -> UpdateUserHierarchy -> Bool
Prelude.Eq, ReadPrec [UpdateUserHierarchy]
ReadPrec UpdateUserHierarchy
Int -> ReadS UpdateUserHierarchy
ReadS [UpdateUserHierarchy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserHierarchy]
$creadListPrec :: ReadPrec [UpdateUserHierarchy]
readPrec :: ReadPrec UpdateUserHierarchy
$creadPrec :: ReadPrec UpdateUserHierarchy
readList :: ReadS [UpdateUserHierarchy]
$creadList :: ReadS [UpdateUserHierarchy]
readsPrec :: Int -> ReadS UpdateUserHierarchy
$creadsPrec :: Int -> ReadS UpdateUserHierarchy
Prelude.Read, Int -> UpdateUserHierarchy -> ShowS
[UpdateUserHierarchy] -> ShowS
UpdateUserHierarchy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserHierarchy] -> ShowS
$cshowList :: [UpdateUserHierarchy] -> ShowS
show :: UpdateUserHierarchy -> String
$cshow :: UpdateUserHierarchy -> String
showsPrec :: Int -> UpdateUserHierarchy -> ShowS
$cshowsPrec :: Int -> UpdateUserHierarchy -> ShowS
Prelude.Show, forall x. Rep UpdateUserHierarchy x -> UpdateUserHierarchy
forall x. UpdateUserHierarchy -> Rep UpdateUserHierarchy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateUserHierarchy x -> UpdateUserHierarchy
$cfrom :: forall x. UpdateUserHierarchy -> Rep UpdateUserHierarchy x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserHierarchy' 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:
--
-- 'hierarchyGroupId', 'updateUserHierarchy_hierarchyGroupId' - The identifier of the hierarchy group.
--
-- 'userId', 'updateUserHierarchy_userId' - The identifier of the user account.
--
-- 'instanceId', 'updateUserHierarchy_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newUpdateUserHierarchy ::
  -- | 'userId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  UpdateUserHierarchy
newUpdateUserHierarchy :: Text -> Text -> UpdateUserHierarchy
newUpdateUserHierarchy Text
pUserId_ Text
pInstanceId_ =
  UpdateUserHierarchy'
    { $sel:hierarchyGroupId:UpdateUserHierarchy' :: Maybe Text
hierarchyGroupId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userId:UpdateUserHierarchy' :: Text
userId = Text
pUserId_,
      $sel:instanceId:UpdateUserHierarchy' :: Text
instanceId = Text
pInstanceId_
    }

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

-- | The identifier of the user account.
updateUserHierarchy_userId :: Lens.Lens' UpdateUserHierarchy Prelude.Text
updateUserHierarchy_userId :: Lens' UpdateUserHierarchy Text
updateUserHierarchy_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserHierarchy' {Text
userId :: Text
$sel:userId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
userId} -> Text
userId) (\s :: UpdateUserHierarchy
s@UpdateUserHierarchy' {} Text
a -> UpdateUserHierarchy
s {$sel:userId:UpdateUserHierarchy' :: Text
userId = Text
a} :: UpdateUserHierarchy)

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

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

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

instance Prelude.NFData UpdateUserHierarchy where
  rnf :: UpdateUserHierarchy -> ()
rnf UpdateUserHierarchy' {Maybe Text
Text
instanceId :: Text
userId :: Text
hierarchyGroupId :: Maybe Text
$sel:instanceId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:userId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:hierarchyGroupId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hierarchyGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders UpdateUserHierarchy where
  toHeaders :: UpdateUserHierarchy -> [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 UpdateUserHierarchy where
  toJSON :: UpdateUserHierarchy -> Value
toJSON UpdateUserHierarchy' {Maybe Text
Text
instanceId :: Text
userId :: Text
hierarchyGroupId :: Maybe Text
$sel:instanceId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:userId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:hierarchyGroupId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HierarchyGroupId" 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
hierarchyGroupId
          ]
      )

instance Data.ToPath UpdateUserHierarchy where
  toPath :: UpdateUserHierarchy -> ByteString
toPath UpdateUserHierarchy' {Maybe Text
Text
instanceId :: Text
userId :: Text
hierarchyGroupId :: Maybe Text
$sel:instanceId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:userId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Text
$sel:hierarchyGroupId:UpdateUserHierarchy' :: UpdateUserHierarchy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/users/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId,
        ByteString
"/hierarchy"
      ]

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

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

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

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