{-# 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.FinSpaceData.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)
--
-- Modifies the details of the specified user account. You cannot update
-- the @userId@ for a user.
module Amazonka.FinSpaceData.UpdateUser
  ( -- * Creating a Request
    UpdateUser (..),
    newUpdateUser,

    -- * Request Lenses
    updateUser_apiAccess,
    updateUser_apiAccessPrincipalArn,
    updateUser_clientToken,
    updateUser_firstName,
    updateUser_lastName,
    updateUser_type,
    updateUser_userId,

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

    -- * Response Lenses
    updateUserResponse_userId,
    updateUserResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.FinSpaceData.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'
  { -- | The option to indicate whether the user can use the
    -- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
    -- then be used to access other FinSpace Data API operations.
    --
    -- -   @ENABLED@ – The user has permissions to use the APIs.
    --
    -- -   @DISABLED@ – The user does not have permissions to use any APIs.
    UpdateUser -> Maybe ApiAccess
apiAccess :: Prelude.Maybe ApiAccess,
    -- | The ARN identifier of an AWS user or role that is allowed to call the
    -- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
    -- a specific FinSpace user. This must be an IAM role within your FinSpace
    -- account.
    UpdateUser -> Maybe Text
apiAccessPrincipalArn :: Prelude.Maybe Prelude.Text,
    -- | A token that ensures idempotency. This token expires in 10 minutes.
    UpdateUser -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The first name of the user.
    UpdateUser -> Maybe (Sensitive Text)
firstName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The last name of the user.
    UpdateUser -> Maybe (Sensitive Text)
lastName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The option to indicate the type of user.
    --
    -- -   @SUPER_USER@– A user with permission to all the functionality and
    --     data in FinSpace.
    --
    -- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
    --     are assigned permissions by adding them to a permission group.
    UpdateUser -> Maybe UserType
type' :: Prelude.Maybe UserType,
    -- | The unique identifier for the user account to update.
    UpdateUser -> Text
userId :: 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, 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:
--
-- 'apiAccess', 'updateUser_apiAccess' - The option to indicate whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
--
-- 'apiAccessPrincipalArn', 'updateUser_apiAccessPrincipalArn' - The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
--
-- 'clientToken', 'updateUser_clientToken' - A token that ensures idempotency. This token expires in 10 minutes.
--
-- 'firstName', 'updateUser_firstName' - The first name of the user.
--
-- 'lastName', 'updateUser_lastName' - The last name of the user.
--
-- 'type'', 'updateUser_type' - The option to indicate the type of user.
--
-- -   @SUPER_USER@– A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
--
-- 'userId', 'updateUser_userId' - The unique identifier for the user account to update.
newUpdateUser ::
  -- | 'userId'
  Prelude.Text ->
  UpdateUser
newUpdateUser :: Text -> UpdateUser
newUpdateUser Text
pUserId_ =
  UpdateUser'
    { $sel:apiAccess:UpdateUser' :: Maybe ApiAccess
apiAccess = forall a. Maybe a
Prelude.Nothing,
      $sel:apiAccessPrincipalArn:UpdateUser' :: Maybe Text
apiAccessPrincipalArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:UpdateUser' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:UpdateUser' :: Maybe (Sensitive Text)
firstName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:UpdateUser' :: Maybe (Sensitive Text)
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateUser' :: Maybe UserType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:userId:UpdateUser' :: Text
userId = Text
pUserId_
    }

-- | The option to indicate whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
updateUser_apiAccess :: Lens.Lens' UpdateUser (Prelude.Maybe ApiAccess)
updateUser_apiAccess :: Lens' UpdateUser (Maybe ApiAccess)
updateUser_apiAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe ApiAccess
apiAccess :: Maybe ApiAccess
$sel:apiAccess:UpdateUser' :: UpdateUser -> Maybe ApiAccess
apiAccess} -> Maybe ApiAccess
apiAccess) (\s :: UpdateUser
s@UpdateUser' {} Maybe ApiAccess
a -> UpdateUser
s {$sel:apiAccess:UpdateUser' :: Maybe ApiAccess
apiAccess = Maybe ApiAccess
a} :: UpdateUser)

-- | The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
updateUser_apiAccessPrincipalArn :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_apiAccessPrincipalArn :: Lens' UpdateUser (Maybe Text)
updateUser_apiAccessPrincipalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
apiAccessPrincipalArn :: Maybe Text
$sel:apiAccessPrincipalArn:UpdateUser' :: UpdateUser -> Maybe Text
apiAccessPrincipalArn} -> Maybe Text
apiAccessPrincipalArn) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:apiAccessPrincipalArn:UpdateUser' :: Maybe Text
apiAccessPrincipalArn = Maybe Text
a} :: UpdateUser)

-- | A token that ensures idempotency. This token expires in 10 minutes.
updateUser_clientToken :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_clientToken :: Lens' UpdateUser (Maybe Text)
updateUser_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateUser' :: UpdateUser -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:clientToken:UpdateUser' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateUser)

-- | The first name of the user.
updateUser_firstName :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_firstName :: Lens' UpdateUser (Maybe Text)
updateUser_firstName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
$sel:firstName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
firstName} -> Maybe (Sensitive Text)
firstName) (\s :: UpdateUser
s@UpdateUser' {} Maybe (Sensitive Text)
a -> UpdateUser
s {$sel:firstName:UpdateUser' :: Maybe (Sensitive Text)
firstName = Maybe (Sensitive Text)
a} :: UpdateUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The last name of the user.
updateUser_lastName :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_lastName :: Lens' UpdateUser (Maybe Text)
updateUser_lastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe (Sensitive Text)
lastName :: Maybe (Sensitive Text)
$sel:lastName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
lastName} -> Maybe (Sensitive Text)
lastName) (\s :: UpdateUser
s@UpdateUser' {} Maybe (Sensitive Text)
a -> UpdateUser
s {$sel:lastName:UpdateUser' :: Maybe (Sensitive Text)
lastName = Maybe (Sensitive Text)
a} :: UpdateUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The option to indicate the type of user.
--
-- -   @SUPER_USER@– A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
updateUser_type :: Lens.Lens' UpdateUser (Prelude.Maybe UserType)
updateUser_type :: Lens' UpdateUser (Maybe UserType)
updateUser_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe UserType
type' :: Maybe UserType
$sel:type':UpdateUser' :: UpdateUser -> Maybe UserType
type'} -> Maybe UserType
type') (\s :: UpdateUser
s@UpdateUser' {} Maybe UserType
a -> UpdateUser
s {$sel:type':UpdateUser' :: Maybe UserType
type' = Maybe UserType
a} :: UpdateUser)

-- | The unique identifier for the user account to update.
updateUser_userId :: Lens.Lens' UpdateUser Prelude.Text
updateUser_userId :: Lens' UpdateUser Text
updateUser_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
userId :: Text
$sel:userId:UpdateUser' :: UpdateUser -> Text
userId} -> Text
userId) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:userId:UpdateUser' :: Text
userId = 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, 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 -> 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
"userId")
            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 Text
Maybe (Sensitive Text)
Maybe ApiAccess
Maybe UserType
Text
userId :: Text
type' :: Maybe UserType
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:userId:UpdateUser' :: UpdateUser -> Text
$sel:type':UpdateUser' :: UpdateUser -> Maybe UserType
$sel:lastName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:firstName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:clientToken:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccessPrincipalArn:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccess:UpdateUser' :: UpdateUser -> Maybe ApiAccess
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiAccess
apiAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
apiAccessPrincipalArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
firstName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
lastName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData UpdateUser where
  rnf :: UpdateUser -> ()
rnf UpdateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Maybe UserType
Text
userId :: Text
type' :: Maybe UserType
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:userId:UpdateUser' :: UpdateUser -> Text
$sel:type':UpdateUser' :: UpdateUser -> Maybe UserType
$sel:lastName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:firstName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:clientToken:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccessPrincipalArn:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccess:UpdateUser' :: UpdateUser -> Maybe ApiAccess
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiAccess
apiAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiAccessPrincipalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
firstName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
lastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

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.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateUser where
  toJSON :: UpdateUser -> Value
toJSON UpdateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Maybe UserType
Text
userId :: Text
type' :: Maybe UserType
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:userId:UpdateUser' :: UpdateUser -> Text
$sel:type':UpdateUser' :: UpdateUser -> Maybe UserType
$sel:lastName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:firstName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:clientToken:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccessPrincipalArn:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccess:UpdateUser' :: UpdateUser -> Maybe ApiAccess
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"apiAccess" 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 ApiAccess
apiAccess,
            (Key
"apiAccessPrincipalArn" 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
apiAccessPrincipalArn,
            (Key
"clientToken" 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
clientToken,
            (Key
"firstName" 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 (Sensitive Text)
firstName,
            (Key
"lastName" 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 (Sensitive Text)
lastName,
            (Key
"type" 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 UserType
type'
          ]
      )

instance Data.ToPath UpdateUser where
  toPath :: UpdateUser -> ByteString
toPath UpdateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Maybe UserType
Text
userId :: Text
type' :: Maybe UserType
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:userId:UpdateUser' :: UpdateUser -> Text
$sel:type':UpdateUser' :: UpdateUser -> Maybe UserType
$sel:lastName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:firstName:UpdateUser' :: UpdateUser -> Maybe (Sensitive Text)
$sel:clientToken:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccessPrincipalArn:UpdateUser' :: UpdateUser -> Maybe Text
$sel:apiAccess:UpdateUser' :: UpdateUser -> Maybe ApiAccess
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/user/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId]

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 unique identifier of the updated user account.
    UpdateUserResponse -> Maybe Text
userId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateUserResponse -> Int
httpStatus :: 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:
--
-- 'userId', 'updateUserResponse_userId' - The unique identifier of the updated user account.
--
-- 'httpStatus', 'updateUserResponse_httpStatus' - The response's http status code.
newUpdateUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateUserResponse
newUpdateUserResponse :: Int -> UpdateUserResponse
newUpdateUserResponse Int
pHttpStatus_ =
  UpdateUserResponse'
    { $sel:userId:UpdateUserResponse' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateUserResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The response's http status code.
updateUserResponse_httpStatus :: Lens.Lens' UpdateUserResponse Prelude.Int
updateUserResponse_httpStatus :: Lens' UpdateUserResponse Int
updateUserResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateUserResponse' :: UpdateUserResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateUserResponse
s@UpdateUserResponse' {} Int
a -> UpdateUserResponse
s {$sel:httpStatus:UpdateUserResponse' :: Int
httpStatus = Int
a} :: UpdateUserResponse)

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