{-# 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.CreateProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a standard profile.
--
-- A standard profile represents the following attributes for a customer
-- profile in a domain.
module Amazonka.CustomerProfiles.CreateProfile
  ( -- * Creating a Request
    CreateProfile (..),
    newCreateProfile,

    -- * Request Lenses
    createProfile_accountNumber,
    createProfile_additionalInformation,
    createProfile_address,
    createProfile_attributes,
    createProfile_billingAddress,
    createProfile_birthDate,
    createProfile_businessEmailAddress,
    createProfile_businessName,
    createProfile_businessPhoneNumber,
    createProfile_emailAddress,
    createProfile_firstName,
    createProfile_gender,
    createProfile_genderString,
    createProfile_homePhoneNumber,
    createProfile_lastName,
    createProfile_mailingAddress,
    createProfile_middleName,
    createProfile_mobilePhoneNumber,
    createProfile_partyType,
    createProfile_partyTypeString,
    createProfile_personalEmailAddress,
    createProfile_phoneNumber,
    createProfile_shippingAddress,
    createProfile_domainName,

    -- * Destructuring the Response
    CreateProfileResponse (..),
    newCreateProfileResponse,

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

-- |
-- Create a value of 'CreateProfile' 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', 'createProfile_accountNumber' - A unique account number that you have given to the customer.
--
-- 'additionalInformation', 'createProfile_additionalInformation' - Any additional information relevant to the customer’s profile.
--
-- 'address', 'createProfile_address' - A generic address associated with the customer that is not mailing,
-- shipping, or billing.
--
-- 'attributes', 'createProfile_attributes' - A key value pair of attributes of a customer profile.
--
-- 'billingAddress', 'createProfile_billingAddress' - The customer’s billing address.
--
-- 'birthDate', 'createProfile_birthDate' - The customer’s birth date.
--
-- 'businessEmailAddress', 'createProfile_businessEmailAddress' - The customer’s business email address.
--
-- 'businessName', 'createProfile_businessName' - The name of the customer’s business.
--
-- 'businessPhoneNumber', 'createProfile_businessPhoneNumber' - The customer’s business phone number.
--
-- 'emailAddress', 'createProfile_emailAddress' - The customer’s email address, which has not been specified as a personal
-- or business address.
--
-- 'firstName', 'createProfile_firstName' - The customer’s first name.
--
-- 'gender', 'createProfile_gender' - The gender with which the customer identifies.
--
-- 'genderString', 'createProfile_genderString' - An alternative to @Gender@ which accepts any string as input.
--
-- 'homePhoneNumber', 'createProfile_homePhoneNumber' - The customer’s home phone number.
--
-- 'lastName', 'createProfile_lastName' - The customer’s last name.
--
-- 'mailingAddress', 'createProfile_mailingAddress' - The customer’s mailing address.
--
-- 'middleName', 'createProfile_middleName' - The customer’s middle name.
--
-- 'mobilePhoneNumber', 'createProfile_mobilePhoneNumber' - The customer’s mobile phone number.
--
-- 'partyType', 'createProfile_partyType' - The type of profile used to describe the customer.
--
-- 'partyTypeString', 'createProfile_partyTypeString' - An alternative to @PartyType@ which accepts any string as input.
--
-- 'personalEmailAddress', 'createProfile_personalEmailAddress' - The customer’s personal email address.
--
-- 'phoneNumber', 'createProfile_phoneNumber' - The customer’s phone number, which has not been specified as a mobile,
-- home, or business number.
--
-- 'shippingAddress', 'createProfile_shippingAddress' - The customer’s shipping address.
--
-- 'domainName', 'createProfile_domainName' - The unique name of the domain.
newCreateProfile ::
  -- | 'domainName'
  Prelude.Text ->
  CreateProfile
newCreateProfile :: Text -> CreateProfile
newCreateProfile Text
pDomainName_ =
  CreateProfile'
    { $sel:accountNumber:CreateProfile' :: Maybe Text
accountNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:additionalInformation:CreateProfile' :: Maybe Text
additionalInformation = forall a. Maybe a
Prelude.Nothing,
      $sel:address:CreateProfile' :: Maybe Address
address = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:CreateProfile' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:billingAddress:CreateProfile' :: Maybe Address
billingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:birthDate:CreateProfile' :: Maybe Text
birthDate = forall a. Maybe a
Prelude.Nothing,
      $sel:businessEmailAddress:CreateProfile' :: Maybe Text
businessEmailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:businessName:CreateProfile' :: Maybe Text
businessName = forall a. Maybe a
Prelude.Nothing,
      $sel:businessPhoneNumber:CreateProfile' :: Maybe Text
businessPhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:emailAddress:CreateProfile' :: Maybe Text
emailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:CreateProfile' :: Maybe Text
firstName = forall a. Maybe a
Prelude.Nothing,
      $sel:gender:CreateProfile' :: Maybe Gender
gender = forall a. Maybe a
Prelude.Nothing,
      $sel:genderString:CreateProfile' :: Maybe Text
genderString = forall a. Maybe a
Prelude.Nothing,
      $sel:homePhoneNumber:CreateProfile' :: Maybe Text
homePhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:CreateProfile' :: Maybe Text
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:mailingAddress:CreateProfile' :: Maybe Address
mailingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:middleName:CreateProfile' :: Maybe Text
middleName = forall a. Maybe a
Prelude.Nothing,
      $sel:mobilePhoneNumber:CreateProfile' :: Maybe Text
mobilePhoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:partyType:CreateProfile' :: Maybe PartyType
partyType = forall a. Maybe a
Prelude.Nothing,
      $sel:partyTypeString:CreateProfile' :: Maybe Text
partyTypeString = forall a. Maybe a
Prelude.Nothing,
      $sel:personalEmailAddress:CreateProfile' :: Maybe Text
personalEmailAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumber:CreateProfile' :: Maybe Text
phoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:shippingAddress:CreateProfile' :: Maybe Address
shippingAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:CreateProfile' :: Text
domainName = Text
pDomainName_
    }

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

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

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

-- | A key value pair of attributes of a customer profile.
createProfile_attributes :: Lens.Lens' CreateProfile (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createProfile_attributes :: Lens' CreateProfile (Maybe (HashMap Text Text))
createProfile_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:CreateProfile' :: CreateProfile -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: CreateProfile
s@CreateProfile' {} Maybe (HashMap Text Text)
a -> CreateProfile
s {$sel:attributes:CreateProfile' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: CreateProfile) 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.
createProfile_billingAddress :: Lens.Lens' CreateProfile (Prelude.Maybe Address)
createProfile_billingAddress :: Lens' CreateProfile (Maybe Address)
createProfile_billingAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfile' {Maybe Address
billingAddress :: Maybe Address
$sel:billingAddress:CreateProfile' :: CreateProfile -> Maybe Address
billingAddress} -> Maybe Address
billingAddress) (\s :: CreateProfile
s@CreateProfile' {} Maybe Address
a -> CreateProfile
s {$sel:billingAddress:CreateProfile' :: Maybe Address
billingAddress = Maybe Address
a} :: CreateProfile)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Core.AWSRequest CreateProfile where
  type
    AWSResponse CreateProfile =
      CreateProfileResponse
  request :: (Service -> Service) -> CreateProfile -> Request CreateProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateProfile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateProfile)))
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 -> CreateProfileResponse
CreateProfileResponse'
            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 CreateProfile where
  hashWithSalt :: Int -> CreateProfile -> Int
hashWithSalt Int
_salt CreateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Address
Maybe Gender
Maybe PartyType
Text
domainName :: Text
shippingAddress :: Maybe Address
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe Address
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 Address
attributes :: Maybe (HashMap Text Text)
address :: Maybe Address
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:domainName:CreateProfile' :: CreateProfile -> Text
$sel:shippingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:phoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:personalEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyTypeString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyType:CreateProfile' :: CreateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:middleName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:mailingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:lastName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:homePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:genderString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:gender:CreateProfile' :: CreateProfile -> Maybe Gender
$sel:firstName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:emailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessPhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:birthDate:CreateProfile' :: CreateProfile -> Maybe Text
$sel:billingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:attributes:CreateProfile' :: CreateProfile -> Maybe (HashMap Text Text)
$sel:address:CreateProfile' :: CreateProfile -> Maybe Address
$sel:additionalInformation:CreateProfile' :: CreateProfile -> Maybe Text
$sel:accountNumber:CreateProfile' :: CreateProfile -> 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 Address
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 Address
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 Address
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 Address
shippingAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

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

instance Data.ToHeaders CreateProfile where
  toHeaders :: CreateProfile -> 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 CreateProfile where
  toJSON :: CreateProfile -> Value
toJSON CreateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Address
Maybe Gender
Maybe PartyType
Text
domainName :: Text
shippingAddress :: Maybe Address
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe Address
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 Address
attributes :: Maybe (HashMap Text Text)
address :: Maybe Address
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:domainName:CreateProfile' :: CreateProfile -> Text
$sel:shippingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:phoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:personalEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyTypeString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyType:CreateProfile' :: CreateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:middleName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:mailingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:lastName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:homePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:genderString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:gender:CreateProfile' :: CreateProfile -> Maybe Gender
$sel:firstName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:emailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessPhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:birthDate:CreateProfile' :: CreateProfile -> Maybe Text
$sel:billingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:attributes:CreateProfile' :: CreateProfile -> Maybe (HashMap Text Text)
$sel:address:CreateProfile' :: CreateProfile -> Maybe Address
$sel:additionalInformation:CreateProfile' :: CreateProfile -> Maybe Text
$sel:accountNumber:CreateProfile' :: CreateProfile -> 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 Address
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 Address
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 Address
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 Address
shippingAddress
          ]
      )

instance Data.ToPath CreateProfile where
  toPath :: CreateProfile -> ByteString
toPath CreateProfile' {Maybe Text
Maybe (HashMap Text Text)
Maybe Address
Maybe Gender
Maybe PartyType
Text
domainName :: Text
shippingAddress :: Maybe Address
phoneNumber :: Maybe Text
personalEmailAddress :: Maybe Text
partyTypeString :: Maybe Text
partyType :: Maybe PartyType
mobilePhoneNumber :: Maybe Text
middleName :: Maybe Text
mailingAddress :: Maybe Address
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 Address
attributes :: Maybe (HashMap Text Text)
address :: Maybe Address
additionalInformation :: Maybe Text
accountNumber :: Maybe Text
$sel:domainName:CreateProfile' :: CreateProfile -> Text
$sel:shippingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:phoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:personalEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyTypeString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:partyType:CreateProfile' :: CreateProfile -> Maybe PartyType
$sel:mobilePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:middleName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:mailingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:lastName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:homePhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:genderString:CreateProfile' :: CreateProfile -> Maybe Text
$sel:gender:CreateProfile' :: CreateProfile -> Maybe Gender
$sel:firstName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:emailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessPhoneNumber:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessName:CreateProfile' :: CreateProfile -> Maybe Text
$sel:businessEmailAddress:CreateProfile' :: CreateProfile -> Maybe Text
$sel:birthDate:CreateProfile' :: CreateProfile -> Maybe Text
$sel:billingAddress:CreateProfile' :: CreateProfile -> Maybe Address
$sel:attributes:CreateProfile' :: CreateProfile -> Maybe (HashMap Text Text)
$sel:address:CreateProfile' :: CreateProfile -> Maybe Address
$sel:additionalInformation:CreateProfile' :: CreateProfile -> Maybe Text
$sel:accountNumber:CreateProfile' :: CreateProfile -> 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 CreateProfile where
  toQuery :: CreateProfile -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

instance Prelude.NFData CreateProfileResponse where
  rnf :: CreateProfileResponse -> ()
rnf CreateProfileResponse' {Int
Text
profileId :: Text
httpStatus :: Int
$sel:profileId:CreateProfileResponse' :: CreateProfileResponse -> Text
$sel:httpStatus:CreateProfileResponse' :: CreateProfileResponse -> 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