{-# 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.UpdateUser
-- 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 and\/or the path of the specified IAM user.
--
-- You should understand the implications of changing an IAM user\'s path
-- or name. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_users_manage.html#id_users_renaming Renaming an IAM user>
-- and
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_groups_manage_rename.html Renaming an IAM group>
-- in the /IAM User Guide/.
--
-- To change a user name, the requester must have appropriate permissions
-- on both the source object and the target object. For example, to change
-- Bob to Robert, the entity making the request must have permission on Bob
-- and Robert, or must have permission on all (*). For more information
-- about permissions, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/PermissionsAndPolicies.html Permissions and policies>.
module Amazonka.IAM.UpdateUser
  ( -- * Creating a Request
    UpdateUser (..),
    newUpdateUser,

    -- * Request Lenses
    updateUser_newPath,
    updateUser_newUserName,
    updateUser_userName,

    -- * Destructuring the Response
    UpdateUserResponse (..),
    newUpdateUserResponse,
  )
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:/ 'newUpdateUser' smart constructor.
data UpdateUser = UpdateUser'
  { -- | New path for the IAM user. Include this parameter only if you\'re
    -- changing the user\'s path.
    --
    -- 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.
    UpdateUser -> Maybe Text
newPath' :: Prelude.Maybe Prelude.Text,
    -- | New name for the user. Include this parameter only if you\'re changing
    -- the user\'s name.
    --
    -- 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\".
    UpdateUser -> Maybe Text
newUserName' :: Prelude.Maybe Prelude.Text,
    -- | Name of the user to update. If you\'re changing the name of the user,
    -- this is the original user name.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    UpdateUser -> Text
userName :: Prelude.Text
  }
  deriving (UpdateUser -> UpdateUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUser -> UpdateUser -> Bool
$c/= :: UpdateUser -> UpdateUser -> Bool
== :: UpdateUser -> UpdateUser -> Bool
$c== :: UpdateUser -> UpdateUser -> Bool
Prelude.Eq, ReadPrec [UpdateUser]
ReadPrec UpdateUser
Int -> ReadS UpdateUser
ReadS [UpdateUser]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUser]
$creadListPrec :: ReadPrec [UpdateUser]
readPrec :: ReadPrec UpdateUser
$creadPrec :: ReadPrec UpdateUser
readList :: ReadS [UpdateUser]
$creadList :: ReadS [UpdateUser]
readsPrec :: Int -> ReadS UpdateUser
$creadsPrec :: Int -> ReadS UpdateUser
Prelude.Read, Int -> UpdateUser -> ShowS
[UpdateUser] -> ShowS
UpdateUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUser] -> ShowS
$cshowList :: [UpdateUser] -> ShowS
show :: UpdateUser -> String
$cshow :: UpdateUser -> String
showsPrec :: Int -> UpdateUser -> ShowS
$cshowsPrec :: Int -> UpdateUser -> ShowS
Prelude.Show, forall x. Rep UpdateUser x -> UpdateUser
forall x. UpdateUser -> Rep UpdateUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateUser x -> UpdateUser
$cfrom :: forall x. UpdateUser -> Rep UpdateUser x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUser' 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:
--
-- 'newPath'', 'updateUser_newPath' - New path for the IAM user. Include this parameter only if you\'re
-- changing the user\'s path.
--
-- 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.
--
-- 'newUserName'', 'updateUser_newUserName' - New name for the user. Include this parameter only if you\'re changing
-- the user\'s name.
--
-- 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\".
--
-- 'userName', 'updateUser_userName' - Name of the user to update. If you\'re changing the name of the user,
-- this is the original user name.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newUpdateUser ::
  -- | 'userName'
  Prelude.Text ->
  UpdateUser
newUpdateUser :: Text -> UpdateUser
newUpdateUser Text
pUserName_ =
  UpdateUser'
    { $sel:newPath':UpdateUser' :: Maybe Text
newPath' = forall a. Maybe a
Prelude.Nothing,
      $sel:newUserName':UpdateUser' :: Maybe Text
newUserName' = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:UpdateUser' :: Text
userName = Text
pUserName_
    }

-- | New path for the IAM user. Include this parameter only if you\'re
-- changing the user\'s path.
--
-- 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.
updateUser_newPath :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_newPath :: Lens' UpdateUser (Maybe Text)
updateUser_newPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
newPath' :: Maybe Text
$sel:newPath':UpdateUser' :: UpdateUser -> Maybe Text
newPath'} -> Maybe Text
newPath') (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:newPath':UpdateUser' :: Maybe Text
newPath' = Maybe Text
a} :: UpdateUser)

-- | New name for the user. Include this parameter only if you\'re changing
-- the user\'s name.
--
-- 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\".
updateUser_newUserName :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_newUserName :: Lens' UpdateUser (Maybe Text)
updateUser_newUserName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
newUserName' :: Maybe Text
$sel:newUserName':UpdateUser' :: UpdateUser -> Maybe Text
newUserName'} -> Maybe Text
newUserName') (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:newUserName':UpdateUser' :: Maybe Text
newUserName' = Maybe Text
a} :: UpdateUser)

-- | Name of the user to update. If you\'re changing the name of the user,
-- this is the original user name.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
updateUser_userName :: Lens.Lens' UpdateUser Prelude.Text
updateUser_userName :: Lens' UpdateUser Text
updateUser_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
userName :: Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
userName} -> Text
userName) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:userName:UpdateUser' :: Text
userName = Text
a} :: UpdateUser)

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

instance Prelude.Hashable UpdateUser where
  hashWithSalt :: Int -> UpdateUser -> Int
hashWithSalt Int
_salt UpdateUser' {Maybe Text
Text
userName :: Text
newUserName' :: Maybe Text
newPath' :: Maybe Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:newUserName':UpdateUser' :: UpdateUser -> Maybe Text
$sel:newPath':UpdateUser' :: UpdateUser -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newPath'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newUserName'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName

instance Prelude.NFData UpdateUser where
  rnf :: UpdateUser -> ()
rnf UpdateUser' {Maybe Text
Text
userName :: Text
newUserName' :: Maybe Text
newPath' :: Maybe Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:newUserName':UpdateUser' :: UpdateUser -> Maybe Text
$sel:newPath':UpdateUser' :: UpdateUser -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newPath'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newUserName'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName

instance Data.ToHeaders UpdateUser where
  toHeaders :: UpdateUser -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath UpdateUser where
  toPath :: UpdateUser -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery UpdateUser where
  toQuery :: UpdateUser -> QueryString
toQuery UpdateUser' {Maybe Text
Text
userName :: Text
newUserName' :: Maybe Text
newPath' :: Maybe Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:newUserName':UpdateUser' :: UpdateUser -> Maybe Text
$sel:newPath':UpdateUser' :: UpdateUser -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UpdateUser" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"NewPath" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newPath',
        ByteString
"NewUserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newUserName',
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
userName
      ]

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

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

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