{-# 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.QuickSight.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 an Amazon QuickSight user.
module Amazonka.QuickSight.UpdateUser
  ( -- * Creating a Request
    UpdateUser (..),
    newUpdateUser,

    -- * Request Lenses
    updateUser_customFederationProviderUrl,
    updateUser_customPermissionsName,
    updateUser_externalLoginFederationProviderType,
    updateUser_externalLoginId,
    updateUser_unapplyCustomPermissions,
    updateUser_userName,
    updateUser_awsAccountId,
    updateUser_namespace,
    updateUser_email,
    updateUser_role,

    -- * Destructuring the Response
    UpdateUserResponse (..),
    newUpdateUserResponse,

    -- * Response Lenses
    updateUserResponse_requestId,
    updateUserResponse_user,
    updateUserResponse_status,
  )
where

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 Amazonka.QuickSight.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateUser' smart constructor.
data UpdateUser = UpdateUser'
  { -- | The URL of the custom OpenID Connect (OIDC) provider that provides
    -- identity to let a user federate into Amazon QuickSight with an
    -- associated Identity and Access Management(IAM) role. This parameter
    -- should only be used when @ExternalLoginFederationProviderType@ parameter
    -- is set to @CUSTOM_OIDC@.
    UpdateUser -> Maybe Text
customFederationProviderUrl :: Prelude.Maybe Prelude.Text,
    -- | (Enterprise edition only) The name of the custom permissions profile
    -- that you want to assign to this user. Customized permissions allows you
    -- to control a user\'s access by restricting access the following
    -- operations:
    --
    -- -   Create and update data sources
    --
    -- -   Create and update datasets
    --
    -- -   Create and update email reports
    --
    -- -   Subscribe to email reports
    --
    -- A set of custom permissions includes any combination of these
    -- restrictions. Currently, you need to create the profile names for custom
    -- permission sets by using the Amazon QuickSight console. Then, you use
    -- the @RegisterUser@ API operation to assign the named set of permissions
    -- to a Amazon QuickSight user.
    --
    -- Amazon QuickSight custom permissions are applied through IAM policies.
    -- Therefore, they override the permissions typically granted by assigning
    -- Amazon QuickSight users to one of the default security cohorts in Amazon
    -- QuickSight (admin, author, reader).
    --
    -- This feature is available only to Amazon QuickSight Enterprise edition
    -- subscriptions.
    UpdateUser -> Maybe Text
customPermissionsName :: Prelude.Maybe Prelude.Text,
    -- | The type of supported external login provider that provides identity to
    -- let a user federate into Amazon QuickSight with an associated Identity
    -- and Access Management(IAM) role. The type of supported external login
    -- provider can be one of the following.
    --
    -- -   @COGNITO@: Amazon Cognito. The provider URL is
    --     cognito-identity.amazonaws.com. When choosing the @COGNITO@ provider
    --     type, don’t use the \"CustomFederationProviderUrl\" parameter which
    --     is only needed when the external provider is custom.
    --
    -- -   @CUSTOM_OIDC@: Custom OpenID Connect (OIDC) provider. When choosing
    --     @CUSTOM_OIDC@ type, use the @CustomFederationProviderUrl@ parameter
    --     to provide the custom OIDC provider URL.
    --
    -- -   @NONE@: This clears all the previously saved external login
    --     information for a user. Use the
    --     @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_DescribeUser.html DescribeUser>@ @
    --     API operation to check the external login information.
    UpdateUser -> Maybe Text
externalLoginFederationProviderType :: Prelude.Maybe Prelude.Text,
    -- | The identity ID for a user in the external login provider.
    UpdateUser -> Maybe Text
externalLoginId :: Prelude.Maybe Prelude.Text,
    -- | A flag that you use to indicate that you want to remove all custom
    -- permissions from this user. Using this parameter resets the user to the
    -- state it was in before a custom permissions profile was applied. This
    -- parameter defaults to NULL and it doesn\'t accept any other value.
    UpdateUser -> Maybe Bool
unapplyCustomPermissions :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon QuickSight user name that you want to update.
    UpdateUser -> Text
userName :: Prelude.Text,
    -- | The ID for the Amazon Web Services account that the user is in.
    -- Currently, you use the ID for the Amazon Web Services account that
    -- contains your Amazon QuickSight account.
    UpdateUser -> Text
awsAccountId :: Prelude.Text,
    -- | The namespace. Currently, you should set this to @default@.
    UpdateUser -> Text
namespace :: Prelude.Text,
    -- | The email address of the user that you want to update.
    UpdateUser -> Text
email :: Prelude.Text,
    -- | The Amazon QuickSight role of the user. The role can be one of the
    -- following default security cohorts:
    --
    -- -   @READER@: A user who has read-only access to dashboards.
    --
    -- -   @AUTHOR@: A user who can create data sources, datasets, analyses,
    --     and dashboards.
    --
    -- -   @ADMIN@: A user who is an author, who can also manage Amazon
    --     QuickSight settings.
    --
    -- The name of the Amazon QuickSight role is invisible to the user except
    -- for the console screens dealing with permissions.
    UpdateUser -> UserRole
role' :: UserRole
  }
  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:
--
-- 'customFederationProviderUrl', 'updateUser_customFederationProviderUrl' - The URL of the custom OpenID Connect (OIDC) provider that provides
-- identity to let a user federate into Amazon QuickSight with an
-- associated Identity and Access Management(IAM) role. This parameter
-- should only be used when @ExternalLoginFederationProviderType@ parameter
-- is set to @CUSTOM_OIDC@.
--
-- 'customPermissionsName', 'updateUser_customPermissionsName' - (Enterprise edition only) The name of the custom permissions profile
-- that you want to assign to this user. Customized permissions allows you
-- to control a user\'s access by restricting access the following
-- operations:
--
-- -   Create and update data sources
--
-- -   Create and update datasets
--
-- -   Create and update email reports
--
-- -   Subscribe to email reports
--
-- A set of custom permissions includes any combination of these
-- restrictions. Currently, you need to create the profile names for custom
-- permission sets by using the Amazon QuickSight console. Then, you use
-- the @RegisterUser@ API operation to assign the named set of permissions
-- to a Amazon QuickSight user.
--
-- Amazon QuickSight custom permissions are applied through IAM policies.
-- Therefore, they override the permissions typically granted by assigning
-- Amazon QuickSight users to one of the default security cohorts in Amazon
-- QuickSight (admin, author, reader).
--
-- This feature is available only to Amazon QuickSight Enterprise edition
-- subscriptions.
--
-- 'externalLoginFederationProviderType', 'updateUser_externalLoginFederationProviderType' - The type of supported external login provider that provides identity to
-- let a user federate into Amazon QuickSight with an associated Identity
-- and Access Management(IAM) role. The type of supported external login
-- provider can be one of the following.
--
-- -   @COGNITO@: Amazon Cognito. The provider URL is
--     cognito-identity.amazonaws.com. When choosing the @COGNITO@ provider
--     type, don’t use the \"CustomFederationProviderUrl\" parameter which
--     is only needed when the external provider is custom.
--
-- -   @CUSTOM_OIDC@: Custom OpenID Connect (OIDC) provider. When choosing
--     @CUSTOM_OIDC@ type, use the @CustomFederationProviderUrl@ parameter
--     to provide the custom OIDC provider URL.
--
-- -   @NONE@: This clears all the previously saved external login
--     information for a user. Use the
--     @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_DescribeUser.html DescribeUser>@ @
--     API operation to check the external login information.
--
-- 'externalLoginId', 'updateUser_externalLoginId' - The identity ID for a user in the external login provider.
--
-- 'unapplyCustomPermissions', 'updateUser_unapplyCustomPermissions' - A flag that you use to indicate that you want to remove all custom
-- permissions from this user. Using this parameter resets the user to the
-- state it was in before a custom permissions profile was applied. This
-- parameter defaults to NULL and it doesn\'t accept any other value.
--
-- 'userName', 'updateUser_userName' - The Amazon QuickSight user name that you want to update.
--
-- 'awsAccountId', 'updateUser_awsAccountId' - The ID for the Amazon Web Services account that the user is in.
-- Currently, you use the ID for the Amazon Web Services account that
-- contains your Amazon QuickSight account.
--
-- 'namespace', 'updateUser_namespace' - The namespace. Currently, you should set this to @default@.
--
-- 'email', 'updateUser_email' - The email address of the user that you want to update.
--
-- 'role'', 'updateUser_role' - The Amazon QuickSight role of the user. The role can be one of the
-- following default security cohorts:
--
-- -   @READER@: A user who has read-only access to dashboards.
--
-- -   @AUTHOR@: A user who can create data sources, datasets, analyses,
--     and dashboards.
--
-- -   @ADMIN@: A user who is an author, who can also manage Amazon
--     QuickSight settings.
--
-- The name of the Amazon QuickSight role is invisible to the user except
-- for the console screens dealing with permissions.
newUpdateUser ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'namespace'
  Prelude.Text ->
  -- | 'email'
  Prelude.Text ->
  -- | 'role''
  UserRole ->
  UpdateUser
newUpdateUser :: Text -> Text -> Text -> Text -> UserRole -> UpdateUser
newUpdateUser
  Text
pUserName_
  Text
pAwsAccountId_
  Text
pNamespace_
  Text
pEmail_
  UserRole
pRole_ =
    UpdateUser'
      { $sel:customFederationProviderUrl:UpdateUser' :: Maybe Text
customFederationProviderUrl =
          forall a. Maybe a
Prelude.Nothing,
        $sel:customPermissionsName:UpdateUser' :: Maybe Text
customPermissionsName = forall a. Maybe a
Prelude.Nothing,
        $sel:externalLoginFederationProviderType:UpdateUser' :: Maybe Text
externalLoginFederationProviderType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:externalLoginId:UpdateUser' :: Maybe Text
externalLoginId = forall a. Maybe a
Prelude.Nothing,
        $sel:unapplyCustomPermissions:UpdateUser' :: Maybe Bool
unapplyCustomPermissions = forall a. Maybe a
Prelude.Nothing,
        $sel:userName:UpdateUser' :: Text
userName = Text
pUserName_,
        $sel:awsAccountId:UpdateUser' :: Text
awsAccountId = Text
pAwsAccountId_,
        $sel:namespace:UpdateUser' :: Text
namespace = Text
pNamespace_,
        $sel:email:UpdateUser' :: Text
email = Text
pEmail_,
        $sel:role':UpdateUser' :: UserRole
role' = UserRole
pRole_
      }

-- | The URL of the custom OpenID Connect (OIDC) provider that provides
-- identity to let a user federate into Amazon QuickSight with an
-- associated Identity and Access Management(IAM) role. This parameter
-- should only be used when @ExternalLoginFederationProviderType@ parameter
-- is set to @CUSTOM_OIDC@.
updateUser_customFederationProviderUrl :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_customFederationProviderUrl :: Lens' UpdateUser (Maybe Text)
updateUser_customFederationProviderUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
customFederationProviderUrl :: Maybe Text
$sel:customFederationProviderUrl:UpdateUser' :: UpdateUser -> Maybe Text
customFederationProviderUrl} -> Maybe Text
customFederationProviderUrl) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:customFederationProviderUrl:UpdateUser' :: Maybe Text
customFederationProviderUrl = Maybe Text
a} :: UpdateUser)

-- | (Enterprise edition only) The name of the custom permissions profile
-- that you want to assign to this user. Customized permissions allows you
-- to control a user\'s access by restricting access the following
-- operations:
--
-- -   Create and update data sources
--
-- -   Create and update datasets
--
-- -   Create and update email reports
--
-- -   Subscribe to email reports
--
-- A set of custom permissions includes any combination of these
-- restrictions. Currently, you need to create the profile names for custom
-- permission sets by using the Amazon QuickSight console. Then, you use
-- the @RegisterUser@ API operation to assign the named set of permissions
-- to a Amazon QuickSight user.
--
-- Amazon QuickSight custom permissions are applied through IAM policies.
-- Therefore, they override the permissions typically granted by assigning
-- Amazon QuickSight users to one of the default security cohorts in Amazon
-- QuickSight (admin, author, reader).
--
-- This feature is available only to Amazon QuickSight Enterprise edition
-- subscriptions.
updateUser_customPermissionsName :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_customPermissionsName :: Lens' UpdateUser (Maybe Text)
updateUser_customPermissionsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
customPermissionsName :: Maybe Text
$sel:customPermissionsName:UpdateUser' :: UpdateUser -> Maybe Text
customPermissionsName} -> Maybe Text
customPermissionsName) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:customPermissionsName:UpdateUser' :: Maybe Text
customPermissionsName = Maybe Text
a} :: UpdateUser)

-- | The type of supported external login provider that provides identity to
-- let a user federate into Amazon QuickSight with an associated Identity
-- and Access Management(IAM) role. The type of supported external login
-- provider can be one of the following.
--
-- -   @COGNITO@: Amazon Cognito. The provider URL is
--     cognito-identity.amazonaws.com. When choosing the @COGNITO@ provider
--     type, don’t use the \"CustomFederationProviderUrl\" parameter which
--     is only needed when the external provider is custom.
--
-- -   @CUSTOM_OIDC@: Custom OpenID Connect (OIDC) provider. When choosing
--     @CUSTOM_OIDC@ type, use the @CustomFederationProviderUrl@ parameter
--     to provide the custom OIDC provider URL.
--
-- -   @NONE@: This clears all the previously saved external login
--     information for a user. Use the
--     @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_DescribeUser.html DescribeUser>@ @
--     API operation to check the external login information.
updateUser_externalLoginFederationProviderType :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_externalLoginFederationProviderType :: Lens' UpdateUser (Maybe Text)
updateUser_externalLoginFederationProviderType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
externalLoginFederationProviderType :: Maybe Text
$sel:externalLoginFederationProviderType:UpdateUser' :: UpdateUser -> Maybe Text
externalLoginFederationProviderType} -> Maybe Text
externalLoginFederationProviderType) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:externalLoginFederationProviderType:UpdateUser' :: Maybe Text
externalLoginFederationProviderType = Maybe Text
a} :: UpdateUser)

-- | The identity ID for a user in the external login provider.
updateUser_externalLoginId :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_externalLoginId :: Lens' UpdateUser (Maybe Text)
updateUser_externalLoginId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
externalLoginId :: Maybe Text
$sel:externalLoginId:UpdateUser' :: UpdateUser -> Maybe Text
externalLoginId} -> Maybe Text
externalLoginId) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:externalLoginId:UpdateUser' :: Maybe Text
externalLoginId = Maybe Text
a} :: UpdateUser)

-- | A flag that you use to indicate that you want to remove all custom
-- permissions from this user. Using this parameter resets the user to the
-- state it was in before a custom permissions profile was applied. This
-- parameter defaults to NULL and it doesn\'t accept any other value.
updateUser_unapplyCustomPermissions :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Bool)
updateUser_unapplyCustomPermissions :: Lens' UpdateUser (Maybe Bool)
updateUser_unapplyCustomPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Bool
unapplyCustomPermissions :: Maybe Bool
$sel:unapplyCustomPermissions:UpdateUser' :: UpdateUser -> Maybe Bool
unapplyCustomPermissions} -> Maybe Bool
unapplyCustomPermissions) (\s :: UpdateUser
s@UpdateUser' {} Maybe Bool
a -> UpdateUser
s {$sel:unapplyCustomPermissions:UpdateUser' :: Maybe Bool
unapplyCustomPermissions = Maybe Bool
a} :: UpdateUser)

-- | The Amazon QuickSight user name that you want to update.
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)

-- | The ID for the Amazon Web Services account that the user is in.
-- Currently, you use the ID for the Amazon Web Services account that
-- contains your Amazon QuickSight account.
updateUser_awsAccountId :: Lens.Lens' UpdateUser Prelude.Text
updateUser_awsAccountId :: Lens' UpdateUser Text
updateUser_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
awsAccountId :: Text
$sel:awsAccountId:UpdateUser' :: UpdateUser -> Text
awsAccountId} -> Text
awsAccountId) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:awsAccountId:UpdateUser' :: Text
awsAccountId = Text
a} :: UpdateUser)

-- | The namespace. Currently, you should set this to @default@.
updateUser_namespace :: Lens.Lens' UpdateUser Prelude.Text
updateUser_namespace :: Lens' UpdateUser Text
updateUser_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
namespace :: Text
$sel:namespace:UpdateUser' :: UpdateUser -> Text
namespace} -> Text
namespace) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:namespace:UpdateUser' :: Text
namespace = Text
a} :: UpdateUser)

-- | The email address of the user that you want to update.
updateUser_email :: Lens.Lens' UpdateUser Prelude.Text
updateUser_email :: Lens' UpdateUser Text
updateUser_email = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
email :: Text
$sel:email:UpdateUser' :: UpdateUser -> Text
email} -> Text
email) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:email:UpdateUser' :: Text
email = Text
a} :: UpdateUser)

-- | The Amazon QuickSight role of the user. The role can be one of the
-- following default security cohorts:
--
-- -   @READER@: A user who has read-only access to dashboards.
--
-- -   @AUTHOR@: A user who can create data sources, datasets, analyses,
--     and dashboards.
--
-- -   @ADMIN@: A user who is an author, who can also manage Amazon
--     QuickSight settings.
--
-- The name of the Amazon QuickSight role is invisible to the user except
-- for the console screens dealing with permissions.
updateUser_role :: Lens.Lens' UpdateUser UserRole
updateUser_role :: Lens' UpdateUser UserRole
updateUser_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {UserRole
role' :: UserRole
$sel:role':UpdateUser' :: UpdateUser -> UserRole
role'} -> UserRole
role') (\s :: UpdateUser
s@UpdateUser' {} UserRole
a -> UpdateUser
s {$sel:role':UpdateUser' :: UserRole
role' = UserRole
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, ToJSON a) => Service -> a -> Request a
Request.putJSON (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 =>
(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 ->
          Maybe Text -> Maybe User -> Int -> UpdateUserResponse
UpdateUserResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RequestId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"User")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable UpdateUser where
  hashWithSalt :: Int -> UpdateUser -> Int
hashWithSalt Int
_salt UpdateUser' {Maybe Bool
Maybe Text
Text
UserRole
role' :: UserRole
email :: Text
namespace :: Text
awsAccountId :: Text
userName :: Text
unapplyCustomPermissions :: Maybe Bool
externalLoginId :: Maybe Text
externalLoginFederationProviderType :: Maybe Text
customPermissionsName :: Maybe Text
customFederationProviderUrl :: Maybe Text
$sel:role':UpdateUser' :: UpdateUser -> UserRole
$sel:email:UpdateUser' :: UpdateUser -> Text
$sel:namespace:UpdateUser' :: UpdateUser -> Text
$sel:awsAccountId:UpdateUser' :: UpdateUser -> Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:unapplyCustomPermissions:UpdateUser' :: UpdateUser -> Maybe Bool
$sel:externalLoginId:UpdateUser' :: UpdateUser -> Maybe Text
$sel:externalLoginFederationProviderType:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customPermissionsName:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customFederationProviderUrl:UpdateUser' :: UpdateUser -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customFederationProviderUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customPermissionsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
externalLoginFederationProviderType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
externalLoginId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
unapplyCustomPermissions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
email
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserRole
role'

instance Prelude.NFData UpdateUser where
  rnf :: UpdateUser -> ()
rnf UpdateUser' {Maybe Bool
Maybe Text
Text
UserRole
role' :: UserRole
email :: Text
namespace :: Text
awsAccountId :: Text
userName :: Text
unapplyCustomPermissions :: Maybe Bool
externalLoginId :: Maybe Text
externalLoginFederationProviderType :: Maybe Text
customPermissionsName :: Maybe Text
customFederationProviderUrl :: Maybe Text
$sel:role':UpdateUser' :: UpdateUser -> UserRole
$sel:email:UpdateUser' :: UpdateUser -> Text
$sel:namespace:UpdateUser' :: UpdateUser -> Text
$sel:awsAccountId:UpdateUser' :: UpdateUser -> Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:unapplyCustomPermissions:UpdateUser' :: UpdateUser -> Maybe Bool
$sel:externalLoginId:UpdateUser' :: UpdateUser -> Maybe Text
$sel:externalLoginFederationProviderType:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customPermissionsName:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customFederationProviderUrl:UpdateUser' :: UpdateUser -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customFederationProviderUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customPermissionsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
externalLoginFederationProviderType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
externalLoginId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
unapplyCustomPermissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
email
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserRole
role'

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

instance Data.ToJSON UpdateUser where
  toJSON :: UpdateUser -> Value
toJSON UpdateUser' {Maybe Bool
Maybe Text
Text
UserRole
role' :: UserRole
email :: Text
namespace :: Text
awsAccountId :: Text
userName :: Text
unapplyCustomPermissions :: Maybe Bool
externalLoginId :: Maybe Text
externalLoginFederationProviderType :: Maybe Text
customPermissionsName :: Maybe Text
customFederationProviderUrl :: Maybe Text
$sel:role':UpdateUser' :: UpdateUser -> UserRole
$sel:email:UpdateUser' :: UpdateUser -> Text
$sel:namespace:UpdateUser' :: UpdateUser -> Text
$sel:awsAccountId:UpdateUser' :: UpdateUser -> Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:unapplyCustomPermissions:UpdateUser' :: UpdateUser -> Maybe Bool
$sel:externalLoginId:UpdateUser' :: UpdateUser -> Maybe Text
$sel:externalLoginFederationProviderType:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customPermissionsName:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customFederationProviderUrl:UpdateUser' :: UpdateUser -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CustomFederationProviderUrl" 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
customFederationProviderUrl,
            (Key
"CustomPermissionsName" 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
customPermissionsName,
            (Key
"ExternalLoginFederationProviderType" 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
externalLoginFederationProviderType,
            (Key
"ExternalLoginId" 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
externalLoginId,
            (Key
"UnapplyCustomPermissions" 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 Bool
unapplyCustomPermissions,
            forall a. a -> Maybe a
Prelude.Just (Key
"Email" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
email),
            forall a. a -> Maybe a
Prelude.Just (Key
"Role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserRole
role')
          ]
      )

instance Data.ToPath UpdateUser where
  toPath :: UpdateUser -> ByteString
toPath UpdateUser' {Maybe Bool
Maybe Text
Text
UserRole
role' :: UserRole
email :: Text
namespace :: Text
awsAccountId :: Text
userName :: Text
unapplyCustomPermissions :: Maybe Bool
externalLoginId :: Maybe Text
externalLoginFederationProviderType :: Maybe Text
customPermissionsName :: Maybe Text
customFederationProviderUrl :: Maybe Text
$sel:role':UpdateUser' :: UpdateUser -> UserRole
$sel:email:UpdateUser' :: UpdateUser -> Text
$sel:namespace:UpdateUser' :: UpdateUser -> Text
$sel:awsAccountId:UpdateUser' :: UpdateUser -> Text
$sel:userName:UpdateUser' :: UpdateUser -> Text
$sel:unapplyCustomPermissions:UpdateUser' :: UpdateUser -> Maybe Bool
$sel:externalLoginId:UpdateUser' :: UpdateUser -> Maybe Text
$sel:externalLoginFederationProviderType:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customPermissionsName:UpdateUser' :: UpdateUser -> Maybe Text
$sel:customFederationProviderUrl:UpdateUser' :: UpdateUser -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/namespaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
namespace,
        ByteString
"/users/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userName
      ]

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

-- | /See:/ 'newUpdateUserResponse' smart constructor.
data UpdateUserResponse = UpdateUserResponse'
  { -- | The Amazon Web Services request ID for this operation.
    UpdateUserResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon QuickSight user.
    UpdateUserResponse -> Maybe User
user :: Prelude.Maybe User,
    -- | The HTTP status of the request.
    UpdateUserResponse -> Int
status :: Prelude.Int
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'requestId', 'updateUserResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'user', 'updateUserResponse_user' - The Amazon QuickSight user.
--
-- 'status', 'updateUserResponse_status' - The HTTP status of the request.
newUpdateUserResponse ::
  -- | 'status'
  Prelude.Int ->
  UpdateUserResponse
newUpdateUserResponse :: Int -> UpdateUserResponse
newUpdateUserResponse Int
pStatus_ =
  UpdateUserResponse'
    { $sel:requestId:UpdateUserResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:user:UpdateUserResponse' :: Maybe User
user = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateUserResponse' :: Int
status = Int
pStatus_
    }

-- | The Amazon Web Services request ID for this operation.
updateUserResponse_requestId :: Lens.Lens' UpdateUserResponse (Prelude.Maybe Prelude.Text)
updateUserResponse_requestId :: Lens' UpdateUserResponse (Maybe Text)
updateUserResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:UpdateUserResponse' :: UpdateUserResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: UpdateUserResponse
s@UpdateUserResponse' {} Maybe Text
a -> UpdateUserResponse
s {$sel:requestId:UpdateUserResponse' :: Maybe Text
requestId = Maybe Text
a} :: UpdateUserResponse)

-- | The Amazon QuickSight user.
updateUserResponse_user :: Lens.Lens' UpdateUserResponse (Prelude.Maybe User)
updateUserResponse_user :: Lens' UpdateUserResponse (Maybe User)
updateUserResponse_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserResponse' {Maybe User
user :: Maybe User
$sel:user:UpdateUserResponse' :: UpdateUserResponse -> Maybe User
user} -> Maybe User
user) (\s :: UpdateUserResponse
s@UpdateUserResponse' {} Maybe User
a -> UpdateUserResponse
s {$sel:user:UpdateUserResponse' :: Maybe User
user = Maybe User
a} :: UpdateUserResponse)

-- | The HTTP status of the request.
updateUserResponse_status :: Lens.Lens' UpdateUserResponse Prelude.Int
updateUserResponse_status :: Lens' UpdateUserResponse Int
updateUserResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserResponse' {Int
status :: Int
$sel:status:UpdateUserResponse' :: UpdateUserResponse -> Int
status} -> Int
status) (\s :: UpdateUserResponse
s@UpdateUserResponse' {} Int
a -> UpdateUserResponse
s {$sel:status:UpdateUserResponse' :: Int
status = Int
a} :: UpdateUserResponse)

instance Prelude.NFData UpdateUserResponse where
  rnf :: UpdateUserResponse -> ()
rnf UpdateUserResponse' {Int
Maybe Text
Maybe User
status :: Int
user :: Maybe User
requestId :: Maybe Text
$sel:status:UpdateUserResponse' :: UpdateUserResponse -> Int
$sel:user:UpdateUserResponse' :: UpdateUserResponse -> Maybe User
$sel:requestId:UpdateUserResponse' :: UpdateUserResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe User
user
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
status