{-# 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.CustomerProfiles.UpdateProfile
-- 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 properties of a profile. The ProfileId is required for
-- updating a customer profile.
--
-- When calling the UpdateProfile API, specifying an empty string value
-- means that any existing value will be removed. Not specifying a string
-- value means that any value already there will be kept.
module Amazonka.CustomerProfiles.UpdateProfile
  ( -- * Creating a Request
    UpdateProfile (..),
    newUpdateProfile,

    -- * Request Lenses
    updateProfile_accountNumber,
    updateProfile_additionalInformation,
    updateProfile_address,
    updateProfile_attributes,
    updateProfile_billingAddress,
    updateProfile_birthDate,
    updateProfile_businessEmailAddress,
    updateProfile_businessName,
    updateProfile_businessPhoneNumber,
    updateProfile_emailAddress,
    updateProfile_firstName,
    updateProfile_gender,
    updateProfile_genderString,
    updateProfile_homePhoneNumber,
    updateProfile_lastName,
    updateProfile_mailingAddress,
    updateProfile_middleName,
    updateProfile_mobilePhoneNumber,
    updateProfile_partyType,
    updateProfile_partyTypeString,
    updateProfile_personalEmailAddress,
    updateProfile_phoneNumber,
    updateProfile_shippingAddress,
    updateProfile_domainName,
    updateProfile_profileId,

    -- * Destructuring the Response
    UpdateProfileResponse (..),
    newUpdateProfileResponse,

    -- * Response Lenses
    updateProfileResponse_httpStatus,
    updateProfileResponse_profileId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CustomerProfiles.Types
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:/ 'newUpdateProfile' smart constructor.
data UpdateProfile = UpdateProfile'
  { -- | A unique account number that you have given to the customer.
    UpdateProfile -> Maybe Text
accountNumber :: Prelude.Maybe Prelude.Text,
    -- | Any additional information relevant to the customer’s profile.
    UpdateProfile -> Maybe Text
additionalInformation :: Prelude.Maybe Prelude.Text,
    -- | A generic address associated with the customer that is not mailing,
    -- shipping, or billing.
    UpdateProfile -> Maybe UpdateAddress
address :: Prelude.Maybe UpdateAddress,
    -- | A key value pair of attributes of a customer profile.
    UpdateProfile -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The customer’s billing address.
    UpdateProfile -> Maybe UpdateAddress
billingAddress :: Prelude.Maybe UpdateAddress,
    -- | The customer’s birth date.
    UpdateProfile -> Maybe Text
birthDate :: Prelude.Maybe Prelude.Text,
    -- | The customer’s business email address.
    UpdateProfile -> Maybe Text
businessEmailAddress :: Prelude.Maybe Prelude.Text,
    -- | The name of the customer’s business.
    UpdateProfile -> Maybe Text
businessName :: Prelude.Maybe Prelude.Text,
    -- | The customer’s business phone number.
    UpdateProfile -> Maybe Text
businessPhoneNumber :: Prelude.Maybe Prelude.Text,
    -- | The customer’s email address, which has not been specified as a personal
    -- or business address.
    UpdateProfile -> Maybe Text
emailAddress :: Prelude.Maybe Prelude.Text,
    -- | The customer’s first name.
    UpdateProfile -> Maybe Text
firstName :: Prelude.Maybe Prelude.Text,
    -- | The gender with which the customer identifies.
    UpdateProfile -> Maybe Gender
gender :: Prelude.Maybe Gender,
    -- | An alternative to @Gender@ which accepts any string as input.
    UpdateProfile -> Maybe Text
genderString :: Prelude.Maybe Prelude.Text,
    -- | The customer’s home phone number.
    UpdateProfile -> Maybe Text
homePhoneNumber :: Prelude.Maybe Prelude.Text,
    -- | The customer’s last name.
    UpdateProfile -> Maybe Text
lastName :: Prelude.Maybe Prelude.Text,
    -- | The customer’s mailing address.
    UpdateProfile -> Maybe UpdateAddress
mailingAddress :: Prelude.Maybe UpdateAddress,
    -- | The customer’s middle name.
    UpdateProfile -> Maybe Text
middleName :: Prelude.Maybe Prelude.Text,
    -- | The customer’s mobile phone number.
    UpdateProfile -> Maybe Text
mobilePhoneNumber :: Prelude.Maybe Prelude.Text,
    -- | The type of profile used to describe the customer.
    UpdateProfile -> Maybe PartyType
partyType :: Prelude.Maybe PartyType,
    -- | An alternative to @PartyType@ which accepts any string as input.
    UpdateProfile -> Maybe Text
partyTypeString :: Prelude.Maybe Prelude.Text,
    -- | The customer’s personal email address.
    UpdateProfile -> Maybe Text
personalEmailAddress :: Prelude.Maybe Prelude.Text,
    -- | The customer’s phone number, which has not been specified as a mobile,
    -- home, or business number.
    UpdateProfile -> Maybe Text
phoneNumber :: Prelude.Maybe Prelude.Text,
    -- | The customer’s shipping address.
    UpdateProfile -> Maybe UpdateAddress
shippingAddress :: Prelude.Maybe UpdateAddress,
    -- | The unique name of the domain.
    UpdateProfile -> Text
domainName :: Prelude.Text,
    -- | The unique identifier of a customer profile.
    UpdateProfile -> Text
profileId :: Prelude.Text
  }
  deriving (UpdateProfile -> UpdateProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProfile -> UpdateProfile -> Bool
$c/= :: UpdateProfile -> UpdateProfile -> Bool
== :: UpdateProfile -> UpdateProfile -> Bool
$c== :: UpdateProfile -> UpdateProfile -> Bool
Prelude.Eq, ReadPrec [UpdateProfile]
ReadPrec UpdateProfile
Int -> ReadS UpdateProfile
ReadS [UpdateProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProfile]
$creadListPrec :: ReadPrec [UpdateProfile]
readPrec :: ReadPrec UpdateProfile
$creadPrec :: ReadPrec UpdateProfile
readList :: ReadS [UpdateProfile]
$creadList :: ReadS [UpdateProfile]
readsPrec :: Int -> ReadS UpdateProfile
$creadsPrec :: Int -> ReadS UpdateProfile
Prelude.Read, Int -> UpdateProfile -> ShowS
[UpdateProfile] -> ShowS
UpdateProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProfile] -> ShowS
$cshowList :: [UpdateProfile] -> ShowS
show :: UpdateProfile -> String
$cshow :: UpdateProfile -> String
showsPrec :: Int -> UpdateProfile -> ShowS
$cshowsPrec :: Int -> UpdateProfile -> ShowS
Prelude.Show, forall x. Rep UpdateProfile x -> UpdateProfile
forall x. UpdateProfile -> Rep UpdateProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateProfile x -> UpdateProfile
$cfrom :: forall x. UpdateProfile -> Rep UpdateProfile x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProfile' 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:
--
-- 'accountNumber', 'updateProfile_accountNumber' - A unique account number that you have given to the customer.
--
-- 'additionalInformation', 'updateProfile_additionalInformation' - Any additional information relevant to the customer’s profile.
--
-- 'address', 'updateProfile_address' - A generic address associated with the customer that is not mailing,
-- shipping, or billing.
--
-- 'attributes', 'updateProfile_attributes' - A key value pair of attributes of a customer profile.
--
-- 'billingAddress', 'updateProfile_billingAddress' - The customer’s billing address.
--
-- 'birthDate', 'updateProfile_birthDate' - The customer’s birth date.
--
-- 'businessEmailAddress', 'updateProfile_businessEmailAddress' - The customer’s business email address.
--
-- 'businessName', 'updateProfile_businessName' - The name of the customer’s business.
--
-- 'businessPhoneNumber', 'updateProfile_businessPhoneNumber' - The customer’s business phone number.
--
-- 'emailAddress', 'updateProfile_emailAddress' - The customer’s email address, which has not been specified as a personal
-- or business address.
--
-- 'firstName', 'updateProfile_firstName' - The customer’s first name.
--
-- 'gender', 'updateProfile_gender' - The gender with which the customer identifies.
--
-- 'genderString', 'updateProfile_genderString' - An alternative to @Gender@ which accepts any string as input.
--
-- 'homePhoneNumber', 'updateProfile_homePhoneNumber' - The customer’s home phone number.
--
-- 'lastName', 'updateProfile_lastName' - The customer’s last name.
--
-- 'mailingAddress', 'updateProfile_mailingAddress' - The customer’s mailing address.
--
-- 'middleName', 'updateProfile_middleName' - The customer’s middle name.
--
-- 'mobilePhoneNumber', 'updateProfile_mobilePhoneNumber' - The customer’s mobile phone number.
--
-- 'partyType', 'updateProfile_partyType' - The type of profile used to describe the customer.
--
-- 'partyTypeString', 'updateProfile_partyTypeString' - An alternative to @PartyType@ which accepts any string as input.
--
-- 'personalEmailAddress', 'updateProfile_personalEmailAddress' - The customer’s personal email address.
--
-- 'phoneNumber', 'updateProfile_phoneNumber' - The customer’s phone number, which has not been specified as a mobile,
-- home, or business number.
--
-- 'shippingAddress', 'updateProfile_shippingAddress' - The customer’s shipping address.
--
-- 'domainName', 'updateProfile_domainName' - The unique name of the domain.
--
-- 'profileId', 'updateProfile_profileId' - The unique identifier of a customer profile.
newUpdateProfile ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'profileId'
  Prelude.Text ->
  UpdateProfile
newUpdateProfile :: Text -> Text -> UpdateProfile
newUpdateProfile Text
pDomainName_ Text
pProfileId_ =
  UpdateProfile'
    { $sel:accountNumber:UpdateProfile' :: Maybe Text
accountNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:additionalInformation:UpdateProfile' :: Maybe Text
additionalInformation = forall a. Maybe a
Prelude.Nothing,
      $sel:address:UpdateProfile' :: Maybe UpdateAddress
address = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:UpdateProfile' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:billingAddress:UpdateProfile' :: Maybe UpdateAddress
billingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:birthDate:UpdateProfile' :: Maybe Text
birthDate = forall a. Maybe a
Prelude.Nothing,
      $sel:businessEmailAddress:UpdateProfile' :: Maybe Text
businessEmailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:businessName:UpdateProfile' :: Maybe Text
businessName = forall a. Maybe a
Prelude.Nothing,
      $sel:businessPhoneNumber:UpdateProfile' :: Maybe Text
businessPhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:emailAddress:UpdateProfile' :: Maybe Text
emailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:UpdateProfile' :: Maybe Text
firstName = forall a. Maybe a
Prelude.Nothing,
      $sel:gender:UpdateProfile' :: Maybe Gender
gender = forall a. Maybe a
Prelude.Nothing,
      $sel:genderString:UpdateProfile' :: Maybe Text
genderString = forall a. Maybe a
Prelude.Nothing,
      $sel:homePhoneNumber:UpdateProfile' :: Maybe Text
homePhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:UpdateProfile' :: Maybe Text
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:mailingAddress:UpdateProfile' :: Maybe UpdateAddress
mailingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:middleName:UpdateProfile' :: Maybe Text
middleName = forall a. Maybe a
Prelude.Nothing,
      $sel:mobilePhoneNumber:UpdateProfile' :: Maybe Text
mobilePhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:partyType:UpdateProfile' :: Maybe PartyType
partyType = forall a. Maybe a
Prelude.Nothing,
      $sel:partyTypeString:UpdateProfile' :: Maybe Text
partyTypeString = forall a. Maybe a
Prelude.Nothing,
      $sel:personalEmailAddress:UpdateProfile' :: Maybe Text
personalEmailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumber:UpdateProfile' :: Maybe Text
phoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:shippingAddress:UpdateProfile' :: Maybe UpdateAddress
shippingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:UpdateProfile' :: Text
domainName = Text
pDomainName_,
      $sel:profileId:UpdateProfile' :: Text
profileId = Text
pProfileId_
    }

-- | A unique account number that you have given to the customer.
updateProfile_accountNumber :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_accountNumber :: Lens' UpdateProfile (Maybe Text)
updateProfile_accountNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
accountNumber :: Maybe Text
$sel:accountNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
accountNumber} -> Maybe Text
accountNumber) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:accountNumber:UpdateProfile' :: Maybe Text
accountNumber = Maybe Text
a} :: UpdateProfile)

-- | Any additional information relevant to the customer’s profile.
updateProfile_additionalInformation :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_additionalInformation :: Lens' UpdateProfile (Maybe Text)
updateProfile_additionalInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
additionalInformation :: Maybe Text
$sel:additionalInformation:UpdateProfile' :: UpdateProfile -> Maybe Text
additionalInformation} -> Maybe Text
additionalInformation) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:additionalInformation:UpdateProfile' :: Maybe Text
additionalInformation = Maybe Text
a} :: UpdateProfile)

-- | A generic address associated with the customer that is not mailing,
-- shipping, or billing.
updateProfile_address :: Lens.Lens' UpdateProfile (Prelude.Maybe UpdateAddress)
updateProfile_address :: Lens' UpdateProfile (Maybe UpdateAddress)
updateProfile_address = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe UpdateAddress
address :: Maybe UpdateAddress
$sel:address:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
address} -> Maybe UpdateAddress
address) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe UpdateAddress
a -> UpdateProfile
s {$sel:address:UpdateProfile' :: Maybe UpdateAddress
address = Maybe UpdateAddress
a} :: UpdateProfile)

-- | A key value pair of attributes of a customer profile.
updateProfile_attributes :: Lens.Lens' UpdateProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateProfile_attributes :: Lens' UpdateProfile (Maybe (HashMap Text Text))
updateProfile_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:UpdateProfile' :: UpdateProfile -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe (HashMap Text Text)
a -> UpdateProfile
s {$sel:attributes:UpdateProfile' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: UpdateProfile) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The customer’s billing address.
updateProfile_billingAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe UpdateAddress)
updateProfile_billingAddress :: Lens' UpdateProfile (Maybe UpdateAddress)
updateProfile_billingAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe UpdateAddress
billingAddress :: Maybe UpdateAddress
$sel:billingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
billingAddress} -> Maybe UpdateAddress
billingAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe UpdateAddress
a -> UpdateProfile
s {$sel:billingAddress:UpdateProfile' :: Maybe UpdateAddress
billingAddress = Maybe UpdateAddress
a} :: UpdateProfile)

-- | The customer’s birth date.
updateProfile_birthDate :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_birthDate :: Lens' UpdateProfile (Maybe Text)
updateProfile_birthDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
birthDate :: Maybe Text
$sel:birthDate:UpdateProfile' :: UpdateProfile -> Maybe Text
birthDate} -> Maybe Text
birthDate) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:birthDate:UpdateProfile' :: Maybe Text
birthDate = Maybe Text
a} :: UpdateProfile)

-- | The customer’s business email address.
updateProfile_businessEmailAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_businessEmailAddress :: Lens' UpdateProfile (Maybe Text)
updateProfile_businessEmailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
businessEmailAddress :: Maybe Text
$sel:businessEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
businessEmailAddress} -> Maybe Text
businessEmailAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:businessEmailAddress:UpdateProfile' :: Maybe Text
businessEmailAddress = Maybe Text
a} :: UpdateProfile)

-- | The name of the customer’s business.
updateProfile_businessName :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_businessName :: Lens' UpdateProfile (Maybe Text)
updateProfile_businessName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
businessName :: Maybe Text
$sel:businessName:UpdateProfile' :: UpdateProfile -> Maybe Text
businessName} -> Maybe Text
businessName) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:businessName:UpdateProfile' :: Maybe Text
businessName = Maybe Text
a} :: UpdateProfile)

-- | The customer’s business phone number.
updateProfile_businessPhoneNumber :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_businessPhoneNumber :: Lens' UpdateProfile (Maybe Text)
updateProfile_businessPhoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
businessPhoneNumber :: Maybe Text
$sel:businessPhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
businessPhoneNumber} -> Maybe Text
businessPhoneNumber) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:businessPhoneNumber:UpdateProfile' :: Maybe Text
businessPhoneNumber = Maybe Text
a} :: UpdateProfile)

-- | The customer’s email address, which has not been specified as a personal
-- or business address.
updateProfile_emailAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_emailAddress :: Lens' UpdateProfile (Maybe Text)
updateProfile_emailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
emailAddress :: Maybe Text
$sel:emailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
emailAddress} -> Maybe Text
emailAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:emailAddress:UpdateProfile' :: Maybe Text
emailAddress = Maybe Text
a} :: UpdateProfile)

-- | The customer’s first name.
updateProfile_firstName :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_firstName :: Lens' UpdateProfile (Maybe Text)
updateProfile_firstName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
firstName :: Maybe Text
$sel:firstName:UpdateProfile' :: UpdateProfile -> Maybe Text
firstName} -> Maybe Text
firstName) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:firstName:UpdateProfile' :: Maybe Text
firstName = Maybe Text
a} :: UpdateProfile)

-- | The gender with which the customer identifies.
updateProfile_gender :: Lens.Lens' UpdateProfile (Prelude.Maybe Gender)
updateProfile_gender :: Lens' UpdateProfile (Maybe Gender)
updateProfile_gender = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Gender
gender :: Maybe Gender
$sel:gender:UpdateProfile' :: UpdateProfile -> Maybe Gender
gender} -> Maybe Gender
gender) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Gender
a -> UpdateProfile
s {$sel:gender:UpdateProfile' :: Maybe Gender
gender = Maybe Gender
a} :: UpdateProfile)

-- | An alternative to @Gender@ which accepts any string as input.
updateProfile_genderString :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_genderString :: Lens' UpdateProfile (Maybe Text)
updateProfile_genderString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
genderString :: Maybe Text
$sel:genderString:UpdateProfile' :: UpdateProfile -> Maybe Text
genderString} -> Maybe Text
genderString) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:genderString:UpdateProfile' :: Maybe Text
genderString = Maybe Text
a} :: UpdateProfile)

-- | The customer’s home phone number.
updateProfile_homePhoneNumber :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_homePhoneNumber :: Lens' UpdateProfile (Maybe Text)
updateProfile_homePhoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
homePhoneNumber :: Maybe Text
$sel:homePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
homePhoneNumber} -> Maybe Text
homePhoneNumber) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:homePhoneNumber:UpdateProfile' :: Maybe Text
homePhoneNumber = Maybe Text
a} :: UpdateProfile)

-- | The customer’s last name.
updateProfile_lastName :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_lastName :: Lens' UpdateProfile (Maybe Text)
updateProfile_lastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
lastName :: Maybe Text
$sel:lastName:UpdateProfile' :: UpdateProfile -> Maybe Text
lastName} -> Maybe Text
lastName) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:lastName:UpdateProfile' :: Maybe Text
lastName = Maybe Text
a} :: UpdateProfile)

-- | The customer’s mailing address.
updateProfile_mailingAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe UpdateAddress)
updateProfile_mailingAddress :: Lens' UpdateProfile (Maybe UpdateAddress)
updateProfile_mailingAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe UpdateAddress
mailingAddress :: Maybe UpdateAddress
$sel:mailingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
mailingAddress} -> Maybe UpdateAddress
mailingAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe UpdateAddress
a -> UpdateProfile
s {$sel:mailingAddress:UpdateProfile' :: Maybe UpdateAddress
mailingAddress = Maybe UpdateAddress
a} :: UpdateProfile)

-- | The customer’s middle name.
updateProfile_middleName :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_middleName :: Lens' UpdateProfile (Maybe Text)
updateProfile_middleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
middleName :: Maybe Text
$sel:middleName:UpdateProfile' :: UpdateProfile -> Maybe Text
middleName} -> Maybe Text
middleName) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:middleName:UpdateProfile' :: Maybe Text
middleName = Maybe Text
a} :: UpdateProfile)

-- | The customer’s mobile phone number.
updateProfile_mobilePhoneNumber :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_mobilePhoneNumber :: Lens' UpdateProfile (Maybe Text)
updateProfile_mobilePhoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
mobilePhoneNumber :: Maybe Text
$sel:mobilePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
mobilePhoneNumber} -> Maybe Text
mobilePhoneNumber) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:mobilePhoneNumber:UpdateProfile' :: Maybe Text
mobilePhoneNumber = Maybe Text
a} :: UpdateProfile)

-- | The type of profile used to describe the customer.
updateProfile_partyType :: Lens.Lens' UpdateProfile (Prelude.Maybe PartyType)
updateProfile_partyType :: Lens' UpdateProfile (Maybe PartyType)
updateProfile_partyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe PartyType
partyType :: Maybe PartyType
$sel:partyType:UpdateProfile' :: UpdateProfile -> Maybe PartyType
partyType} -> Maybe PartyType
partyType) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe PartyType
a -> UpdateProfile
s {$sel:partyType:UpdateProfile' :: Maybe PartyType
partyType = Maybe PartyType
a} :: UpdateProfile)

-- | An alternative to @PartyType@ which accepts any string as input.
updateProfile_partyTypeString :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_partyTypeString :: Lens' UpdateProfile (Maybe Text)
updateProfile_partyTypeString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
partyTypeString :: Maybe Text
$sel:partyTypeString:UpdateProfile' :: UpdateProfile -> Maybe Text
partyTypeString} -> Maybe Text
partyTypeString) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:partyTypeString:UpdateProfile' :: Maybe Text
partyTypeString = Maybe Text
a} :: UpdateProfile)

-- | The customer’s personal email address.
updateProfile_personalEmailAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_personalEmailAddress :: Lens' UpdateProfile (Maybe Text)
updateProfile_personalEmailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
personalEmailAddress :: Maybe Text
$sel:personalEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
personalEmailAddress} -> Maybe Text
personalEmailAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:personalEmailAddress:UpdateProfile' :: Maybe Text
personalEmailAddress = Maybe Text
a} :: UpdateProfile)

-- | The customer’s phone number, which has not been specified as a mobile,
-- home, or business number.
updateProfile_phoneNumber :: Lens.Lens' UpdateProfile (Prelude.Maybe Prelude.Text)
updateProfile_phoneNumber :: Lens' UpdateProfile (Maybe Text)
updateProfile_phoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe Text
phoneNumber :: Maybe Text
$sel:phoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
phoneNumber} -> Maybe Text
phoneNumber) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe Text
a -> UpdateProfile
s {$sel:phoneNumber:UpdateProfile' :: Maybe Text
phoneNumber = Maybe Text
a} :: UpdateProfile)

-- | The customer’s shipping address.
updateProfile_shippingAddress :: Lens.Lens' UpdateProfile (Prelude.Maybe UpdateAddress)
updateProfile_shippingAddress :: Lens' UpdateProfile (Maybe UpdateAddress)
updateProfile_shippingAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Maybe UpdateAddress
shippingAddress :: Maybe UpdateAddress
$sel:shippingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
shippingAddress} -> Maybe UpdateAddress
shippingAddress) (\s :: UpdateProfile
s@UpdateProfile' {} Maybe UpdateAddress
a -> UpdateProfile
s {$sel:shippingAddress:UpdateProfile' :: Maybe UpdateAddress
shippingAddress = Maybe UpdateAddress
a} :: UpdateProfile)

-- | The unique name of the domain.
updateProfile_domainName :: Lens.Lens' UpdateProfile Prelude.Text
updateProfile_domainName :: Lens' UpdateProfile Text
updateProfile_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Text
domainName :: Text
$sel:domainName:UpdateProfile' :: UpdateProfile -> Text
domainName} -> Text
domainName) (\s :: UpdateProfile
s@UpdateProfile' {} Text
a -> UpdateProfile
s {$sel:domainName:UpdateProfile' :: Text
domainName = Text
a} :: UpdateProfile)

-- | The unique identifier of a customer profile.
updateProfile_profileId :: Lens.Lens' UpdateProfile Prelude.Text
updateProfile_profileId :: Lens' UpdateProfile Text
updateProfile_profileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfile' {Text
profileId :: Text
$sel:profileId:UpdateProfile' :: UpdateProfile -> Text
profileId} -> Text
profileId) (\s :: UpdateProfile
s@UpdateProfile' {} Text
a -> UpdateProfile
s {$sel:profileId:UpdateProfile' :: Text
profileId = Text
a} :: UpdateProfile)

instance Core.AWSRequest UpdateProfile where
  type
    AWSResponse UpdateProfile =
      UpdateProfileResponse
  request :: (Service -> Service) -> UpdateProfile -> Request UpdateProfile
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 UpdateProfile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateProfile)))
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 ->
          Int -> Text -> UpdateProfileResponse
UpdateProfileResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ProfileId")
      )

instance Prelude.Hashable UpdateProfile where
  hashWithSalt :: Int -> UpdateProfile -> Int
hashWithSalt Int
_salt UpdateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Gender
Maybe PartyType
Maybe UpdateAddress
Text
profileId :: Text
domainName :: Text
shippingAddress :: Maybe UpdateAddress
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe UpdateAddress
lastName :: Maybe Text
homePhoneNumber :: Maybe Text
genderString :: Maybe Text
gender :: Maybe Gender
firstName :: Maybe Text
emailAddress :: Maybe Text
businessPhoneNumber :: Maybe Text
businessName :: Maybe Text
businessEmailAddress :: Maybe Text
birthDate :: Maybe Text
billingAddress :: Maybe UpdateAddress
attributes :: Maybe (HashMap Text Text)
address :: Maybe UpdateAddress
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:profileId:UpdateProfile' :: UpdateProfile -> Text
$sel:domainName:UpdateProfile' :: UpdateProfile -> Text
$sel:shippingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:phoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:personalEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyTypeString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyType:UpdateProfile' :: UpdateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:middleName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:mailingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:lastName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:homePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:genderString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:gender:UpdateProfile' :: UpdateProfile -> Maybe Gender
$sel:firstName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:emailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessPhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:birthDate:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:billingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:attributes:UpdateProfile' :: UpdateProfile -> Maybe (HashMap Text Text)
$sel:address:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:additionalInformation:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:accountNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
additionalInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateAddress
address
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateAddress
billingAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
birthDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
businessEmailAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
businessName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
businessPhoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
emailAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
firstName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Gender
gender
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
genderString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
homePhoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lastName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateAddress
mailingAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
middleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mobilePhoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PartyType
partyType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
partyTypeString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
personalEmailAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
phoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateAddress
shippingAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileId

instance Prelude.NFData UpdateProfile where
  rnf :: UpdateProfile -> ()
rnf UpdateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Gender
Maybe PartyType
Maybe UpdateAddress
Text
profileId :: Text
domainName :: Text
shippingAddress :: Maybe UpdateAddress
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe UpdateAddress
lastName :: Maybe Text
homePhoneNumber :: Maybe Text
genderString :: Maybe Text
gender :: Maybe Gender
firstName :: Maybe Text
emailAddress :: Maybe Text
businessPhoneNumber :: Maybe Text
businessName :: Maybe Text
businessEmailAddress :: Maybe Text
birthDate :: Maybe Text
billingAddress :: Maybe UpdateAddress
attributes :: Maybe (HashMap Text Text)
address :: Maybe UpdateAddress
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:profileId:UpdateProfile' :: UpdateProfile -> Text
$sel:domainName:UpdateProfile' :: UpdateProfile -> Text
$sel:shippingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:phoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:personalEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyTypeString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyType:UpdateProfile' :: UpdateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:middleName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:mailingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:lastName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:homePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:genderString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:gender:UpdateProfile' :: UpdateProfile -> Maybe Gender
$sel:firstName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:emailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessPhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:birthDate:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:billingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:attributes:UpdateProfile' :: UpdateProfile -> Maybe (HashMap Text Text)
$sel:address:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:additionalInformation:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:accountNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
additionalInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateAddress
address
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateAddress
billingAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
birthDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
businessEmailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
businessName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
businessPhoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
emailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
firstName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Gender
gender
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
genderString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
homePhoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateAddress
mailingAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
middleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mobilePhoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PartyType
partyType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
partyTypeString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
personalEmailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
phoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe UpdateAddress
shippingAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
profileId

instance Data.ToHeaders UpdateProfile where
  toHeaders :: UpdateProfile -> 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 UpdateProfile where
  toJSON :: UpdateProfile -> Value
toJSON UpdateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Gender
Maybe PartyType
Maybe UpdateAddress
Text
profileId :: Text
domainName :: Text
shippingAddress :: Maybe UpdateAddress
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe UpdateAddress
lastName :: Maybe Text
homePhoneNumber :: Maybe Text
genderString :: Maybe Text
gender :: Maybe Gender
firstName :: Maybe Text
emailAddress :: Maybe Text
businessPhoneNumber :: Maybe Text
businessName :: Maybe Text
businessEmailAddress :: Maybe Text
birthDate :: Maybe Text
billingAddress :: Maybe UpdateAddress
attributes :: Maybe (HashMap Text Text)
address :: Maybe UpdateAddress
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:profileId:UpdateProfile' :: UpdateProfile -> Text
$sel:domainName:UpdateProfile' :: UpdateProfile -> Text
$sel:shippingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:phoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:personalEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyTypeString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyType:UpdateProfile' :: UpdateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:middleName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:mailingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:lastName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:homePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:genderString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:gender:UpdateProfile' :: UpdateProfile -> Maybe Gender
$sel:firstName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:emailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessPhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:birthDate:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:billingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:attributes:UpdateProfile' :: UpdateProfile -> Maybe (HashMap Text Text)
$sel:address:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:additionalInformation:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:accountNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountNumber" 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
accountNumber,
            (Key
"AdditionalInformation" 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
additionalInformation,
            (Key
"Address" 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 UpdateAddress
address,
            (Key
"Attributes" 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 (HashMap Text Text)
attributes,
            (Key
"BillingAddress" 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 UpdateAddress
billingAddress,
            (Key
"BirthDate" 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
birthDate,
            (Key
"BusinessEmailAddress" 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
businessEmailAddress,
            (Key
"BusinessName" 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
businessName,
            (Key
"BusinessPhoneNumber" 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
businessPhoneNumber,
            (Key
"EmailAddress" 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
emailAddress,
            (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 Text
firstName,
            (Key
"Gender" 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 Gender
gender,
            (Key
"GenderString" 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
genderString,
            (Key
"HomePhoneNumber" 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
homePhoneNumber,
            (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 Text
lastName,
            (Key
"MailingAddress" 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 UpdateAddress
mailingAddress,
            (Key
"MiddleName" 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
middleName,
            (Key
"MobilePhoneNumber" 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
mobilePhoneNumber,
            (Key
"PartyType" 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 PartyType
partyType,
            (Key
"PartyTypeString" 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
partyTypeString,
            (Key
"PersonalEmailAddress" 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
personalEmailAddress,
            (Key
"PhoneNumber" 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
phoneNumber,
            (Key
"ShippingAddress" 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 UpdateAddress
shippingAddress,
            forall a. a -> Maybe a
Prelude.Just (Key
"ProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
profileId)
          ]
      )

instance Data.ToPath UpdateProfile where
  toPath :: UpdateProfile -> ByteString
toPath UpdateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Gender
Maybe PartyType
Maybe UpdateAddress
Text
profileId :: Text
domainName :: Text
shippingAddress :: Maybe UpdateAddress
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe UpdateAddress
lastName :: Maybe Text
homePhoneNumber :: Maybe Text
genderString :: Maybe Text
gender :: Maybe Gender
firstName :: Maybe Text
emailAddress :: Maybe Text
businessPhoneNumber :: Maybe Text
businessName :: Maybe Text
businessEmailAddress :: Maybe Text
birthDate :: Maybe Text
billingAddress :: Maybe UpdateAddress
attributes :: Maybe (HashMap Text Text)
address :: Maybe UpdateAddress
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:profileId:UpdateProfile' :: UpdateProfile -> Text
$sel:domainName:UpdateProfile' :: UpdateProfile -> Text
$sel:shippingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:phoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:personalEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyTypeString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:partyType:UpdateProfile' :: UpdateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:middleName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:mailingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:lastName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:homePhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:genderString:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:gender:UpdateProfile' :: UpdateProfile -> Maybe Gender
$sel:firstName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:emailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessPhoneNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessName:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:businessEmailAddress:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:birthDate:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:billingAddress:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:attributes:UpdateProfile' :: UpdateProfile -> Maybe (HashMap Text Text)
$sel:address:UpdateProfile' :: UpdateProfile -> Maybe UpdateAddress
$sel:additionalInformation:UpdateProfile' :: UpdateProfile -> Maybe Text
$sel:accountNumber:UpdateProfile' :: UpdateProfile -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName, ByteString
"/profiles"]

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

-- | /See:/ 'newUpdateProfileResponse' smart constructor.
data UpdateProfileResponse = UpdateProfileResponse'
  { -- | The response's http status code.
    UpdateProfileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique identifier of a customer profile.
    UpdateProfileResponse -> Text
profileId :: Prelude.Text
  }
  deriving (UpdateProfileResponse -> UpdateProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProfileResponse -> UpdateProfileResponse -> Bool
$c/= :: UpdateProfileResponse -> UpdateProfileResponse -> Bool
== :: UpdateProfileResponse -> UpdateProfileResponse -> Bool
$c== :: UpdateProfileResponse -> UpdateProfileResponse -> Bool
Prelude.Eq, ReadPrec [UpdateProfileResponse]
ReadPrec UpdateProfileResponse
Int -> ReadS UpdateProfileResponse
ReadS [UpdateProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProfileResponse]
$creadListPrec :: ReadPrec [UpdateProfileResponse]
readPrec :: ReadPrec UpdateProfileResponse
$creadPrec :: ReadPrec UpdateProfileResponse
readList :: ReadS [UpdateProfileResponse]
$creadList :: ReadS [UpdateProfileResponse]
readsPrec :: Int -> ReadS UpdateProfileResponse
$creadsPrec :: Int -> ReadS UpdateProfileResponse
Prelude.Read, Int -> UpdateProfileResponse -> ShowS
[UpdateProfileResponse] -> ShowS
UpdateProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProfileResponse] -> ShowS
$cshowList :: [UpdateProfileResponse] -> ShowS
show :: UpdateProfileResponse -> String
$cshow :: UpdateProfileResponse -> String
showsPrec :: Int -> UpdateProfileResponse -> ShowS
$cshowsPrec :: Int -> UpdateProfileResponse -> ShowS
Prelude.Show, forall x. Rep UpdateProfileResponse x -> UpdateProfileResponse
forall x. UpdateProfileResponse -> Rep UpdateProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateProfileResponse x -> UpdateProfileResponse
$cfrom :: forall x. UpdateProfileResponse -> Rep UpdateProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProfileResponse' 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:
--
-- 'httpStatus', 'updateProfileResponse_httpStatus' - The response's http status code.
--
-- 'profileId', 'updateProfileResponse_profileId' - The unique identifier of a customer profile.
newUpdateProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'profileId'
  Prelude.Text ->
  UpdateProfileResponse
newUpdateProfileResponse :: Int -> Text -> UpdateProfileResponse
newUpdateProfileResponse Int
pHttpStatus_ Text
pProfileId_ =
  UpdateProfileResponse'
    { $sel:httpStatus:UpdateProfileResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:profileId:UpdateProfileResponse' :: Text
profileId = Text
pProfileId_
    }

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

-- | The unique identifier of a customer profile.
updateProfileResponse_profileId :: Lens.Lens' UpdateProfileResponse Prelude.Text
updateProfileResponse_profileId :: Lens' UpdateProfileResponse Text
updateProfileResponse_profileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProfileResponse' {Text
profileId :: Text
$sel:profileId:UpdateProfileResponse' :: UpdateProfileResponse -> Text
profileId} -> Text
profileId) (\s :: UpdateProfileResponse
s@UpdateProfileResponse' {} Text
a -> UpdateProfileResponse
s {$sel:profileId:UpdateProfileResponse' :: Text
profileId = Text
a} :: UpdateProfileResponse)

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