{-# 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.UpdateUserIdentityInfo
-- 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 identity information for the specified user.
--
-- We strongly recommend limiting who has the ability to invoke
-- @UpdateUserIdentityInfo@. Someone with that ability can change the login
-- credentials of other users by changing their email address. This poses a
-- security risk to your organization. They can change the email address of
-- a user to the attacker\'s email address, and then reset the password
-- through email. For more information, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/security-profile-best-practices.html Best Practices for Security Profiles>
-- in the /Amazon Connect Administrator Guide/.
module Amazonka.Connect.UpdateUserIdentityInfo
  ( -- * Creating a Request
    UpdateUserIdentityInfo (..),
    newUpdateUserIdentityInfo,

    -- * Request Lenses
    updateUserIdentityInfo_identityInfo,
    updateUserIdentityInfo_userId,
    updateUserIdentityInfo_instanceId,

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

-- |
-- Create a value of 'UpdateUserIdentityInfo' 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:
--
-- 'identityInfo', 'updateUserIdentityInfo_identityInfo' - The identity information for the user.
--
-- 'userId', 'updateUserIdentityInfo_userId' - The identifier of the user account.
--
-- 'instanceId', 'updateUserIdentityInfo_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newUpdateUserIdentityInfo ::
  -- | 'identityInfo'
  UserIdentityInfo ->
  -- | 'userId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  UpdateUserIdentityInfo
newUpdateUserIdentityInfo :: UserIdentityInfo -> Text -> Text -> UpdateUserIdentityInfo
newUpdateUserIdentityInfo
  UserIdentityInfo
pIdentityInfo_
  Text
pUserId_
  Text
pInstanceId_ =
    UpdateUserIdentityInfo'
      { $sel:identityInfo:UpdateUserIdentityInfo' :: UserIdentityInfo
identityInfo =
          UserIdentityInfo
pIdentityInfo_,
        $sel:userId:UpdateUserIdentityInfo' :: Text
userId = Text
pUserId_,
        $sel:instanceId:UpdateUserIdentityInfo' :: Text
instanceId = Text
pInstanceId_
      }

-- | The identity information for the user.
updateUserIdentityInfo_identityInfo :: Lens.Lens' UpdateUserIdentityInfo UserIdentityInfo
updateUserIdentityInfo_identityInfo :: Lens' UpdateUserIdentityInfo UserIdentityInfo
updateUserIdentityInfo_identityInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserIdentityInfo' {UserIdentityInfo
identityInfo :: UserIdentityInfo
$sel:identityInfo:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> UserIdentityInfo
identityInfo} -> UserIdentityInfo
identityInfo) (\s :: UpdateUserIdentityInfo
s@UpdateUserIdentityInfo' {} UserIdentityInfo
a -> UpdateUserIdentityInfo
s {$sel:identityInfo:UpdateUserIdentityInfo' :: UserIdentityInfo
identityInfo = UserIdentityInfo
a} :: UpdateUserIdentityInfo)

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

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

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

instance Prelude.Hashable UpdateUserIdentityInfo where
  hashWithSalt :: Int -> UpdateUserIdentityInfo -> Int
hashWithSalt Int
_salt UpdateUserIdentityInfo' {Text
UserIdentityInfo
instanceId :: Text
userId :: Text
identityInfo :: UserIdentityInfo
$sel:instanceId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:userId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:identityInfo:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> UserIdentityInfo
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserIdentityInfo
identityInfo
      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 UpdateUserIdentityInfo where
  rnf :: UpdateUserIdentityInfo -> ()
rnf UpdateUserIdentityInfo' {Text
UserIdentityInfo
instanceId :: Text
userId :: Text
identityInfo :: UserIdentityInfo
$sel:instanceId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:userId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:identityInfo:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> UserIdentityInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf UserIdentityInfo
identityInfo
      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 UpdateUserIdentityInfo where
  toHeaders :: UpdateUserIdentityInfo -> [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 UpdateUserIdentityInfo where
  toJSON :: UpdateUserIdentityInfo -> Value
toJSON UpdateUserIdentityInfo' {Text
UserIdentityInfo
instanceId :: Text
userId :: Text
identityInfo :: UserIdentityInfo
$sel:instanceId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:userId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:identityInfo:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> UserIdentityInfo
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"IdentityInfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserIdentityInfo
identityInfo)]
      )

instance Data.ToPath UpdateUserIdentityInfo where
  toPath :: UpdateUserIdentityInfo -> ByteString
toPath UpdateUserIdentityInfo' {Text
UserIdentityInfo
instanceId :: Text
userId :: Text
identityInfo :: UserIdentityInfo
$sel:instanceId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:userId:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> Text
$sel:identityInfo:UpdateUserIdentityInfo' :: UpdateUserIdentityInfo -> UserIdentityInfo
..} =
    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
"/identity-info"
      ]

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

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

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

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