{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator.
{-# LANGUAGE OverloadedStrings #-}

-- | Contains the different functions to run the operation postAccountsAccountPeoplePerson
module StripeAPI.Operations.PostAccountsAccountPeoplePerson where

import qualified Control.Monad.Fail
import qualified Control.Monad.Trans.Reader
import qualified Data.Aeson
import qualified Data.Aeson as Data.Aeson.Encoding.Internal
import qualified Data.Aeson as Data.Aeson.Types
import qualified Data.Aeson as Data.Aeson.Types.FromJSON
import qualified Data.Aeson as Data.Aeson.Types.Internal
import qualified Data.Aeson as Data.Aeson.Types.ToJSON
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Char8 as Data.ByteString.Internal
import qualified Data.Either
import qualified Data.Functor
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text.Internal
import qualified Data.Time.Calendar as Data.Time.Calendar.Days
import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime
import qualified Data.Vector
import qualified GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client as Network.HTTP.Client.Request
import qualified Network.HTTP.Client as Network.HTTP.Client.Types
import qualified Network.HTTP.Simple
import qualified Network.HTTP.Types
import qualified Network.HTTP.Types as Network.HTTP.Types.Status
import qualified Network.HTTP.Types as Network.HTTP.Types.URI
import qualified StripeAPI.Common
import StripeAPI.Types
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | > POST /v1/accounts/{account}/people/{person}
--
-- \<p>Updates an existing person.\<\/p>
postAccountsAccountPeoplePerson ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  PostAccountsAccountPeoplePersonParameters ->
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostAccountsAccountPeoplePersonResponse)
postAccountsAccountPeoplePerson :: PostAccountsAccountPeoplePersonParameters
-> Maybe PostAccountsAccountPeoplePersonRequestBody
-> StripeT m (Response PostAccountsAccountPeoplePersonResponse)
postAccountsAccountPeoplePerson
  PostAccountsAccountPeoplePersonParameters
parameters
  Maybe PostAccountsAccountPeoplePersonRequestBody
body =
    (Response ByteString
 -> Response PostAccountsAccountPeoplePersonResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostAccountsAccountPeoplePersonResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostAccountsAccountPeoplePersonResponse)
-> Response ByteString
-> Response PostAccountsAccountPeoplePersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostAccountsAccountPeoplePersonResponse)
-> (PostAccountsAccountPeoplePersonResponse
    -> PostAccountsAccountPeoplePersonResponse)
-> Either String PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountsAccountPeoplePersonResponse
PostAccountsAccountPeoplePersonResponseError PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse
forall a. a -> a
GHC.Base.id
                (Either String PostAccountsAccountPeoplePersonResponse
 -> PostAccountsAccountPeoplePersonResponse)
-> (ByteString
    -> Either String PostAccountsAccountPeoplePersonResponse)
-> ByteString
-> PostAccountsAccountPeoplePersonResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. ( \Response ByteString
response ByteString
body ->
                               if
                                   | (\Status
status_1 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
200) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                     Person -> PostAccountsAccountPeoplePersonResponse
PostAccountsAccountPeoplePersonResponse200
                                       (Person -> PostAccountsAccountPeoplePersonResponse)
-> Either String Person
-> Either String PostAccountsAccountPeoplePersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Person
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              Person
                                                        )
                                   | Bool -> Status -> Bool
forall a b. a -> b -> a
GHC.Base.const Bool
GHC.Types.True (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
                                     Error -> PostAccountsAccountPeoplePersonResponse
PostAccountsAccountPeoplePersonResponseDefault
                                       (Error -> PostAccountsAccountPeoplePersonResponse)
-> Either String Error
-> Either String PostAccountsAccountPeoplePersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              Error
                                                        )
                                   | Bool
GHC.Base.otherwise -> String -> Either String PostAccountsAccountPeoplePersonResponse
forall a b. a -> Either a b
Data.Either.Left String
"Missing default response type"
                           )
                  Response ByteString
response_0
            )
            Response ByteString
response_0
      )
      (Text
-> Text
-> [QueryParameter]
-> Maybe PostAccountsAccountPeoplePersonRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack (String
"/v1/accounts/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel (PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathAccount PostAccountsAccountPeoplePersonParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (String
"/people/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel (PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathPerson PostAccountsAccountPeoplePersonParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountsAccountPeoplePersonRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.parameters@ in the specification.
data PostAccountsAccountPeoplePersonParameters = PostAccountsAccountPeoplePersonParameters
  { -- | pathAccount: Represents the parameter named \'account\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathAccount :: Data.Text.Internal.Text,
    -- | pathPerson: Represents the parameter named \'person\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathPerson :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonParameters -> String -> String
[PostAccountsAccountPeoplePersonParameters] -> String -> String
PostAccountsAccountPeoplePersonParameters -> String
(Int
 -> PostAccountsAccountPeoplePersonParameters -> String -> String)
-> (PostAccountsAccountPeoplePersonParameters -> String)
-> ([PostAccountsAccountPeoplePersonParameters]
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonParameters
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonParameters] -> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonParameters] -> String -> String
show :: PostAccountsAccountPeoplePersonParameters -> String
$cshow :: PostAccountsAccountPeoplePersonParameters -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonParameters -> String -> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonParameters -> String -> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonParameters
-> PostAccountsAccountPeoplePersonParameters -> Bool
(PostAccountsAccountPeoplePersonParameters
 -> PostAccountsAccountPeoplePersonParameters -> Bool)
-> (PostAccountsAccountPeoplePersonParameters
    -> PostAccountsAccountPeoplePersonParameters -> Bool)
-> Eq PostAccountsAccountPeoplePersonParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonParameters
-> PostAccountsAccountPeoplePersonParameters -> Bool
$c/= :: PostAccountsAccountPeoplePersonParameters
-> PostAccountsAccountPeoplePersonParameters -> Bool
== :: PostAccountsAccountPeoplePersonParameters
-> PostAccountsAccountPeoplePersonParameters -> Bool
$c== :: PostAccountsAccountPeoplePersonParameters
-> PostAccountsAccountPeoplePersonParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonParameters where
  toJSON :: PostAccountsAccountPeoplePersonParameters -> Value
toJSON PostAccountsAccountPeoplePersonParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"pathAccount" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathAccount PostAccountsAccountPeoplePersonParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"pathPerson" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathPerson PostAccountsAccountPeoplePersonParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonParameters -> Encoding
toEncoding PostAccountsAccountPeoplePersonParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"pathAccount" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathAccount PostAccountsAccountPeoplePersonParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"pathPerson" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonParameters -> Text
postAccountsAccountPeoplePersonParametersPathPerson PostAccountsAccountPeoplePersonParameters
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonParameters where
  parseJSON :: Value -> Parser PostAccountsAccountPeoplePersonParameters
parseJSON = String
-> (Object -> Parser PostAccountsAccountPeoplePersonParameters)
-> Value
-> Parser PostAccountsAccountPeoplePersonParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonParameters" (\Object
obj -> ((Text -> Text -> PostAccountsAccountPeoplePersonParameters)
-> Parser
     (Text -> Text -> PostAccountsAccountPeoplePersonParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text -> Text -> PostAccountsAccountPeoplePersonParameters
PostAccountsAccountPeoplePersonParameters Parser (Text -> Text -> PostAccountsAccountPeoplePersonParameters)
-> Parser Text
-> Parser (Text -> PostAccountsAccountPeoplePersonParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"pathAccount")) Parser (Text -> PostAccountsAccountPeoplePersonParameters)
-> Parser Text -> Parser PostAccountsAccountPeoplePersonParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"pathPerson"))

-- | Create a new 'PostAccountsAccountPeoplePersonParameters' with all required fields.
mkPostAccountsAccountPeoplePersonParameters ::
  -- | 'postAccountsAccountPeoplePersonParametersPathAccount'
  Data.Text.Internal.Text ->
  -- | 'postAccountsAccountPeoplePersonParametersPathPerson'
  Data.Text.Internal.Text ->
  PostAccountsAccountPeoplePersonParameters
mkPostAccountsAccountPeoplePersonParameters :: Text -> Text -> PostAccountsAccountPeoplePersonParameters
mkPostAccountsAccountPeoplePersonParameters Text
postAccountsAccountPeoplePersonParametersPathAccount Text
postAccountsAccountPeoplePersonParametersPathPerson =
  PostAccountsAccountPeoplePersonParameters :: Text -> Text -> PostAccountsAccountPeoplePersonParameters
PostAccountsAccountPeoplePersonParameters
    { postAccountsAccountPeoplePersonParametersPathAccount :: Text
postAccountsAccountPeoplePersonParametersPathAccount = Text
postAccountsAccountPeoplePersonParametersPathAccount,
      postAccountsAccountPeoplePersonParametersPathPerson :: Text
postAccountsAccountPeoplePersonParametersPathPerson = Text
postAccountsAccountPeoplePersonParametersPathPerson
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountsAccountPeoplePersonRequestBody = PostAccountsAccountPeoplePersonRequestBody
  { -- | address: The person\'s address.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
postAccountsAccountPeoplePersonRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
postAccountsAccountPeoplePersonRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
postAccountsAccountPeoplePersonRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
postAccountsAccountPeoplePersonRequestBodyDob :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
postAccountsAccountPeoplePersonRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountsAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | first_name_kana: The Kana variation of the person\'s first name (Japan only).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKana :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | first_name_kanji: The Kanji variation of the person\'s first name (Japan only).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyGender :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | id_number: The person\'s ID number, as appropriate for their country. For example, a social security number in the U.S., social insurance number in Canada, etc. Instead of the number itself, you can also provide a [PII token provided by Stripe.js](https:\/\/stripe.com\/docs\/stripe.js\#collecting-pii-data).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name_kana: The Kana variation of the person\'s last name (Japan only).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKana :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name_kanji: The Kanji variation of the person\'s last name (Japan only).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyMaidenName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | metadata: Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
postAccountsAccountPeoplePersonRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants),
    -- | nationality: The country where the person is a national. Two-letter country code ([ISO 3166-1 alpha-2](https:\/\/en.wikipedia.org\/wiki\/ISO_3166-1_alpha-2)), or \"XX\" if unavailable.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyNationality :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | person_token: A [person token](https:\/\/stripe.com\/docs\/connect\/account-tokens), used to securely provide details to the person.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPhone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | political_exposure: Indicates if the person or any of their representatives, family members, or other closely related persons, declares that they hold or have held an important public job or function, in any jurisdiction.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
postAccountsAccountPeoplePersonRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
postAccountsAccountPeoplePersonRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyVerification')
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBody -> String -> String
[PostAccountsAccountPeoplePersonRequestBody] -> String -> String
PostAccountsAccountPeoplePersonRequestBody -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBody -> String -> String)
-> (PostAccountsAccountPeoplePersonRequestBody -> String)
-> ([PostAccountsAccountPeoplePersonRequestBody]
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBody] -> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBody] -> String -> String
show :: PostAccountsAccountPeoplePersonRequestBody -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBody -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBody -> String -> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBody -> String -> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBody
-> PostAccountsAccountPeoplePersonRequestBody -> Bool
(PostAccountsAccountPeoplePersonRequestBody
 -> PostAccountsAccountPeoplePersonRequestBody -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBody
    -> PostAccountsAccountPeoplePersonRequestBody -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBody
-> PostAccountsAccountPeoplePersonRequestBody -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBody
-> PostAccountsAccountPeoplePersonRequestBody -> Bool
== :: PostAccountsAccountPeoplePersonRequestBody
-> PostAccountsAccountPeoplePersonRequestBody -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBody
-> PostAccountsAccountPeoplePersonRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBody where
  toJSON :: PostAccountsAccountPeoplePersonRequestBody -> Value
toJSON PostAccountsAccountPeoplePersonRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
postAccountsAccountPeoplePersonRequestBodyAddress PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
postAccountsAccountPeoplePersonRequestBodyAddressKana PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
postAccountsAccountPeoplePersonRequestBodyAddressKanji PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
postAccountsAccountPeoplePersonRequestBodyDob PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
postAccountsAccountPeoplePersonRequestBodyDocuments PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"email" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyEmail PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"expand" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyExpand PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"first_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstName PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"first_name_kana" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKana PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"first_name_kanji" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKanji PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"gender" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyGender PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"id_number" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyIdNumber PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"last_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastName PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"last_name_kana" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKana PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"last_name_kanji" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKanji PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"maiden_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyMaidenName PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
postAccountsAccountPeoplePersonRequestBodyMetadata PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"nationality" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyNationality PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"person_token" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPersonToken PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"phone" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPhone PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"political_exposure" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPoliticalExposure PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
postAccountsAccountPeoplePersonRequestBodyRelationship PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ssn_last_4" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodySsnLast_4 PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
postAccountsAccountPeoplePersonRequestBodyVerification PostAccountsAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBody -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
postAccountsAccountPeoplePersonRequestBodyAddress PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
postAccountsAccountPeoplePersonRequestBodyAddressKana PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
postAccountsAccountPeoplePersonRequestBodyAddressKanji PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
postAccountsAccountPeoplePersonRequestBodyDob PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
postAccountsAccountPeoplePersonRequestBodyDocuments PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"email" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyEmail PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"expand" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyExpand PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"first_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstName PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"first_name_kana" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKana PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"first_name_kanji" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKanji PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"gender" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyGender PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"id_number" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyIdNumber PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"last_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastName PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"last_name_kana" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKana PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"last_name_kanji" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKanji PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"maiden_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyMaidenName PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
postAccountsAccountPeoplePersonRequestBodyMetadata PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"nationality" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyNationality PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"person_token" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPersonToken PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"phone" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPhone PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"political_exposure" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyPoliticalExposure PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
postAccountsAccountPeoplePersonRequestBodyRelationship PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ssn_last_4" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody -> Maybe Text
postAccountsAccountPeoplePersonRequestBodySsnLast_4 PostAccountsAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBody
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
postAccountsAccountPeoplePersonRequestBodyVerification PostAccountsAccountPeoplePersonRequestBody
obj))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBody where
  parseJSON :: Value -> Parser PostAccountsAccountPeoplePersonRequestBody
parseJSON = String
-> (Object -> Parser PostAccountsAccountPeoplePersonRequestBody)
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBody" (\Object
obj -> ((((((((((((((((((((((((Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe
      PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
 -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBody
PostAccountsAccountPeoplePersonRequestBody Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"documents")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"email")) Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expand")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"first_name")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"first_name_kana")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"first_name_kanji")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"gender")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"id_number")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"last_name")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"last_name_kana")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"last_name_kanji")) Parser
  (Maybe Text
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"maiden_name")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"nationality")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"person_token")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"phone")) Parser
  (Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"political_exposure")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
      -> PostAccountsAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ssn_last_4")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
   -> PostAccountsAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyVerification')
-> Parser PostAccountsAccountPeoplePersonRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBody' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBody :: PostAccountsAccountPeoplePersonRequestBody
mkPostAccountsAccountPeoplePersonRequestBody :: PostAccountsAccountPeoplePersonRequestBody
mkPostAccountsAccountPeoplePersonRequestBody =
  PostAccountsAccountPeoplePersonRequestBody :: Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBody
PostAccountsAccountPeoplePersonRequestBody
    { postAccountsAccountPeoplePersonRequestBodyAddress :: Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
postAccountsAccountPeoplePersonRequestBodyAddress = Maybe PostAccountsAccountPeoplePersonRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana :: Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
postAccountsAccountPeoplePersonRequestBodyAddressKana = Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji :: Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
postAccountsAccountPeoplePersonRequestBodyAddressKanji = Maybe PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyDob :: Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
postAccountsAccountPeoplePersonRequestBodyDob = Maybe PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyDocuments :: Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
postAccountsAccountPeoplePersonRequestBodyDocuments = Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyEmail :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyExpand :: Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyFirstName :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyFirstNameKana :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyFirstNameKanji :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyGender :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyIdNumber :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyLastName :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyLastNameKana :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyLastNameKanji :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyMaidenName :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyMetadata :: Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
postAccountsAccountPeoplePersonRequestBodyMetadata = Maybe PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyNationality :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyPersonToken :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyPhone :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyPoliticalExposure :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship :: Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
postAccountsAccountPeoplePersonRequestBodyRelationship = Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodySsnLast_4 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyVerification :: Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
postAccountsAccountPeoplePersonRequestBodyVerification = Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.address@ in the specification.
--
-- The person\'s address.
data PostAccountsAccountPeoplePersonRequestBodyAddress' = PostAccountsAccountPeoplePersonRequestBodyAddress'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 100
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 200
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 200
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyAddress'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyAddress']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyAddress' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyAddress'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyAddress' -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyAddress']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyAddress'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyAddress']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyAddress']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyAddress' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyAddress' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddress'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddress'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyAddress'
-> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyAddress'
 -> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyAddress'
    -> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyAddress'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyAddress'
-> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyAddress'
-> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyAddress'
-> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyAddress'
-> PostAccountsAccountPeoplePersonRequestBodyAddress' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyAddress' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyAddress' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyAddress'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'City PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Country PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line1 PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line2 PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'State PostAccountsAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyAddress' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyAddress'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'City PostAccountsAccountPeoplePersonRequestBodyAddress'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Country PostAccountsAccountPeoplePersonRequestBodyAddress'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line1 PostAccountsAccountPeoplePersonRequestBodyAddress'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line2 PostAccountsAccountPeoplePersonRequestBodyAddress'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddress'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'State PostAccountsAccountPeoplePersonRequestBodyAddress'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyAddress' where
  parseJSON :: Value -> Parser PostAccountsAccountPeoplePersonRequestBodyAddress'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddress'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyAddress'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddress'
PostAccountsAccountPeoplePersonRequestBodyAddress' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostAccountsAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
  (Maybe Text -> PostAccountsAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddress'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyAddress'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyAddress' :: PostAccountsAccountPeoplePersonRequestBodyAddress'
mkPostAccountsAccountPeoplePersonRequestBodyAddress' :: PostAccountsAccountPeoplePersonRequestBodyAddress'
mkPostAccountsAccountPeoplePersonRequestBodyAddress' =
  PostAccountsAccountPeoplePersonRequestBodyAddress' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddress'
PostAccountsAccountPeoplePersonRequestBodyAddress'
    { postAccountsAccountPeoplePersonRequestBodyAddress'City :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddress'Country :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddress'Line1 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddress'Line2 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddress'PostalCode :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddress'State :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddress'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.address_kana@ in the specification.
--
-- The Kana variation of the person\'s address (Japan only).
data PostAccountsAccountPeoplePersonRequestBodyAddressKana' = PostAccountsAccountPeoplePersonRequestBodyAddressKana'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | town
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Town :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyAddressKana'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyAddressKana']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyAddressKana'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyAddressKana'
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyAddressKana'
    -> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyAddressKana'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyAddressKana' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'City PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Country PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line1 PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line2 PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'State PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"town" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Town PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyAddressKana' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'City PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Country PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line1 PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line2 PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'State PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"town" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKana'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Town PostAccountsAccountPeoplePersonRequestBodyAddressKana'
obj)))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyAddressKana' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKana'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKana'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyAddressKana'" (\Object
obj -> (((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
PostAccountsAccountPeoplePersonRequestBodyAddressKana' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state")) Parser
  (Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKana'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"town"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyAddressKana'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyAddressKana' :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
mkPostAccountsAccountPeoplePersonRequestBodyAddressKana' :: PostAccountsAccountPeoplePersonRequestBodyAddressKana'
mkPostAccountsAccountPeoplePersonRequestBodyAddressKana' =
  PostAccountsAccountPeoplePersonRequestBodyAddressKana' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddressKana'
PostAccountsAccountPeoplePersonRequestBodyAddressKana'
    { postAccountsAccountPeoplePersonRequestBodyAddressKana'City :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'Country :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'Line1 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'Line2 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'PostalCode :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'State :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKana'Town :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKana'Town = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.address_kanji@ in the specification.
--
-- The Kanji variation of the person\'s address (Japan only).
data PostAccountsAccountPeoplePersonRequestBodyAddressKanji' = PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | town
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Town :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyAddressKanji']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
    -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyAddressKanji' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'City PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Country PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line1 PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line2 PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'State PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"town" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Town PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'City PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Country PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line1 PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line2 PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'PostalCode PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'State PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"town" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Town PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
obj)))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyAddressKanji' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyAddressKanji'" (\Object
obj -> (((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
PostAccountsAccountPeoplePersonRequestBodyAddressKanji' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state")) Parser
  (Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"town"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyAddressKanji'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyAddressKanji' :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
mkPostAccountsAccountPeoplePersonRequestBodyAddressKanji' :: PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
mkPostAccountsAccountPeoplePersonRequestBodyAddressKanji' =
  PostAccountsAccountPeoplePersonRequestBodyAddressKanji' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
PostAccountsAccountPeoplePersonRequestBodyAddressKanji'
    { postAccountsAccountPeoplePersonRequestBodyAddressKanji'City :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'Country :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line1 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line2 :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'PostalCode :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'State :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyAddressKanji'Town :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyAddressKanji'Town = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.dob.anyOf@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 = PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
  { -- | day
    PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day :: GHC.Types.Int,
    -- | month
    PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month :: GHC.Types.Int,
    -- | year
    PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year :: GHC.Types.Int
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1]
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1]
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1]
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1]
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool
(PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
 -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
    -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"day" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"month" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"year" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"day" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"month" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"year" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1" (\Object
obj -> (((Int
 -> Int
 -> Int
 -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser
     (Int
      -> Int
      -> Int
      -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int
-> Int
-> Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 Parser
  (Int
   -> Int
   -> Int
   -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser
     (Int
      -> Int -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"day")) Parser
  (Int
   -> Int -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser
     (Int -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"month")) Parser
  (Int -> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"year"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 ::
  -- | 'postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day'
  GHC.Types.Int ->
  -- | 'postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month'
  GHC.Types.Int ->
  -- | 'postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year'
  GHC.Types.Int ->
  PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
mkPostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 :: Int
-> Int
-> Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
mkPostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year =
  PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 :: Int
-> Int
-> Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
    { postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day :: Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day = Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Day,
      postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month :: Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month = Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Month,
      postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year :: Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year = Int
postAccountsAccountPeoplePersonRequestBodyDob'OneOf1Year
    }

-- | Defines the oneOf schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.dob.anyOf@ in the specification.
--
-- The person\'s date of birth.
data PostAccountsAccountPeoplePersonRequestBodyDob'Variants
  = -- | Represents the JSON value @""@
    PostAccountsAccountPeoplePersonRequestBodyDob'EmptyString
  | PostAccountsAccountPeoplePersonRequestBodyDob'PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
  deriving (Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDob'Variants
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDob'Variants]
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
GHC.Show.Show, PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool
(PostAccountsAccountPeoplePersonRequestBodyDob'Variants
 -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDob'Variants
    -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDob'Variants where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDob'Variants -> Value
toJSON (PostAccountsAccountPeoplePersonRequestBodyDob'PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
a) = PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
a
  toJSON (PostAccountsAccountPeoplePersonRequestBodyDob'Variants
PostAccountsAccountPeoplePersonRequestBodyDob'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDob'Variants where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyDob'Variants
PostAccountsAccountPeoplePersonRequestBodyDob'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
PostAccountsAccountPeoplePersonRequestBodyDob'PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1 (PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
 -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants)
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountsAccountPeoplePersonRequestBodyDob'Variants
a -> PostAccountsAccountPeoplePersonRequestBodyDob'Variants
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyDob'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostAccountsAccountPeoplePersonRequestBodyDob'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.documents@ in the specification.
--
-- Documents that may be submitted to satisfy various informational requests.
data PostAccountsAccountPeoplePersonRequestBodyDocuments' = PostAccountsAccountPeoplePersonRequestBodyDocuments'
  { -- | company_authorization
    PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'),
    -- | passport
    PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'),
    -- | visa
    PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDocuments']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDocuments' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments' -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDocuments']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyDocuments'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDocuments' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDocuments' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyDocuments'
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'
    -> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyDocuments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDocuments' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"company_authorization" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"passport" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"visa" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyDocuments' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"company_authorization" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"passport" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"visa" Text
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa PostAccountsAccountPeoplePersonRequestBodyDocuments'
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDocuments' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyDocuments'" (\Object
obj -> (((Maybe
   PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
 -> Maybe
      PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
 -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'
PostAccountsAccountPeoplePersonRequestBodyDocuments' Parser
  (Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
      -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"company_authorization")) Parser
  (Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
   -> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"passport")) Parser
  (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"visa"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyDocuments'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyDocuments' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments' =
  PostAccountsAccountPeoplePersonRequestBodyDocuments' :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'
PostAccountsAccountPeoplePersonRequestBodyDocuments'
    { postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization = Maybe
  PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyDocuments'Passport :: Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport = Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyDocuments'Visa :: Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa = Maybe PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.documents.properties.company_authorization@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' = PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
  { -- | files
    PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text]))
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization']
    -> String -> String)
-> Show
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
    -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
    -> Bool)
-> Eq
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"files" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"files" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
parseJSON = String
-> (Object
    -> Parser
         PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'" (\Object
obj -> (Maybe [Text]
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Parser
     (Maybe [Text]
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' Parser
  (Maybe [Text]
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Parser (Maybe [Text])
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"files"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' = PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
PostAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' {postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files :: Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.documents.properties.passport@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' = PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
  { -- | files
    PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport'Files :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text]))
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport']
    -> String -> String)
-> Show
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
    -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
    -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"files" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"files" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
parseJSON = String
-> (Object
    -> Parser
         PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
-> Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'" (\Object
obj -> (Maybe [Text]
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
-> Parser
     (Maybe [Text]
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' Parser
  (Maybe [Text]
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport')
-> Parser (Maybe [Text])
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"files"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' = PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' :: Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport'
PostAccountsAccountPeoplePersonRequestBodyDocuments'Passport' {postAccountsAccountPeoplePersonRequestBodyDocuments'Passport'Files :: Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Passport'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.documents.properties.visa@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' = PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
  { -- | files
    PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa'Files :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text]))
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
    -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
    -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"files" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"files" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
-> Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa'Files PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
parseJSON = String
-> (Object
    -> Parser
         PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'" (\Object
obj -> (Maybe [Text]
 -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
-> Parser
     (Maybe [Text]
      -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' Parser
  (Maybe [Text]
   -> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa')
-> Parser (Maybe [Text])
-> Parser PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"files"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' :: PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
mkPostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' = PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' :: Maybe [Text]
-> PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa'
PostAccountsAccountPeoplePersonRequestBodyDocuments'Visa' {postAccountsAccountPeoplePersonRequestBodyDocuments'Visa'Files :: Maybe [Text]
postAccountsAccountPeoplePersonRequestBodyDocuments'Visa'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.metadata.anyOf@ in the specification.
--
-- Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
data PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostAccountsAccountPeoplePersonRequestBodyMetadata'EmptyString
  | PostAccountsAccountPeoplePersonRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants]
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
GHC.Show.Show, PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
 -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
    -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
    -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Value
toJSON (PostAccountsAccountPeoplePersonRequestBodyMetadata'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
  toJSON (PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
PostAccountsAccountPeoplePersonRequestBodyMetadata'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
PostAccountsAccountPeoplePersonRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object
-> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
PostAccountsAccountPeoplePersonRequestBodyMetadata'Object (Object
 -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants)
-> Result Object
-> Result
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Object
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Result
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Result
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
a -> PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyMetadata'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.relationship@ in the specification.
--
-- The relationship that this person has with the account\'s legal entity.
data PostAccountsAccountPeoplePersonRequestBodyRelationship' = PostAccountsAccountPeoplePersonRequestBodyRelationship'
  { -- | director
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Director :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | executive
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Executive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | owner
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Owner :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | percent_ownership
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants),
    -- | representative
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Representative :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | title
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyRelationship'Title :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyRelationship']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyRelationship' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyRelationship'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyRelationship']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyRelationship'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyRelationship']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyRelationship']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyRelationship' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyRelationship' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyRelationship'
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyRelationship'
    -> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyRelationship'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyRelationship' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"director" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Director PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"executive" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Executive PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"owner" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Owner PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"percent_ownership" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"representative" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Representative PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"title" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyRelationship'Title PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyRelationship' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"director" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Director PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"executive" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Executive PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"owner" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Owner PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"percent_ownership" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"representative" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Representative PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"title" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyRelationship'Title PostAccountsAccountPeoplePersonRequestBodyRelationship'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyRelationship' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyRelationship'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyRelationship'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyRelationship'" (\Object
obj -> ((((((Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe
      PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
 -> Maybe Bool
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Maybe Bool
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'
PostAccountsAccountPeoplePersonRequestBodyRelationship' Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"director")) Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"executive")) Parser
  (Maybe Bool
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"owner")) Parser
  (Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"percent_ownership")) Parser
  (Maybe Bool
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"representative")) Parser
  (Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Text)
-> Parser PostAccountsAccountPeoplePersonRequestBodyRelationship'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"title"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyRelationship'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyRelationship' :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
mkPostAccountsAccountPeoplePersonRequestBodyRelationship' :: PostAccountsAccountPeoplePersonRequestBodyRelationship'
mkPostAccountsAccountPeoplePersonRequestBodyRelationship' =
  PostAccountsAccountPeoplePersonRequestBodyRelationship' :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Maybe Bool
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'
PostAccountsAccountPeoplePersonRequestBodyRelationship'
    { postAccountsAccountPeoplePersonRequestBodyRelationship'Director :: Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Director = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship'Executive :: Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Executive = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship'Owner :: Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Owner = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership = Maybe
  PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship'Representative :: Maybe Bool
postAccountsAccountPeoplePersonRequestBodyRelationship'Representative = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyRelationship'Title :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyRelationship'Title = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.relationship.properties.percent_ownership.anyOf@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
  = -- | Represents the JSON value @""@
    PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'EmptyString
  | PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Double GHC.Types.Double
  deriving (Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants]
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants]
    -> String -> String)
-> Show
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants]
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants]
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> String
-> String
GHC.Show.Show, PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
    -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
    -> Bool)
-> Eq
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Value
toJSON (PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Double Double
a) = Double -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Double
a
  toJSON (PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'EmptyString
        | Bool
GHC.Base.otherwise -> case (Double
-> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Double (Double
 -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants)
-> Result Double
-> Result
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Double
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Result
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Result
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
a -> PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.verification@ in the specification.
--
-- The person\'s verification status.
data PostAccountsAccountPeoplePersonRequestBodyVerification' = PostAccountsAccountPeoplePersonRequestBodyVerification'
  { -- | additional_document
    PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'),
    -- | document
    PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
postAccountsAccountPeoplePersonRequestBodyVerification'Document :: (GHC.Maybe.Maybe PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyVerification']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyVerification' -> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyVerification']
    -> String -> String)
-> Show PostAccountsAccountPeoplePersonRequestBodyVerification'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyVerification']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyVerification']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyVerification' -> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyVerification' -> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool
(PostAccountsAccountPeoplePersonRequestBodyVerification'
 -> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'
    -> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool)
-> Eq PostAccountsAccountPeoplePersonRequestBodyVerification'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyVerification'
-> PostAccountsAccountPeoplePersonRequestBodyVerification' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyVerification' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyVerification' -> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyVerification'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"additional_document" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument PostAccountsAccountPeoplePersonRequestBodyVerification'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"document" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
postAccountsAccountPeoplePersonRequestBodyVerification'Document PostAccountsAccountPeoplePersonRequestBodyVerification'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyVerification' -> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyVerification'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"additional_document" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument PostAccountsAccountPeoplePersonRequestBodyVerification'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"document" Text
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
postAccountsAccountPeoplePersonRequestBodyVerification'Document PostAccountsAccountPeoplePersonRequestBodyVerification'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyVerification' where
  parseJSON :: Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyVerification'
parseJSON = String
-> (Object
    -> Parser PostAccountsAccountPeoplePersonRequestBodyVerification')
-> Value
-> Parser PostAccountsAccountPeoplePersonRequestBodyVerification'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyVerification'" (\Object
obj -> ((Maybe
   PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
 -> Maybe
      PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
 -> PostAccountsAccountPeoplePersonRequestBodyVerification')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
      -> Maybe
           PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
      -> PostAccountsAccountPeoplePersonRequestBodyVerification')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'
PostAccountsAccountPeoplePersonRequestBodyVerification' Parser
  (Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
   -> Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
   -> PostAccountsAccountPeoplePersonRequestBodyVerification')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
      -> PostAccountsAccountPeoplePersonRequestBodyVerification')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"additional_document")) Parser
  (Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
   -> PostAccountsAccountPeoplePersonRequestBodyVerification')
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
-> Parser PostAccountsAccountPeoplePersonRequestBodyVerification'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"document"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyVerification'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyVerification' :: PostAccountsAccountPeoplePersonRequestBodyVerification'
mkPostAccountsAccountPeoplePersonRequestBodyVerification' :: PostAccountsAccountPeoplePersonRequestBodyVerification'
mkPostAccountsAccountPeoplePersonRequestBodyVerification' =
  PostAccountsAccountPeoplePersonRequestBodyVerification' :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'
PostAccountsAccountPeoplePersonRequestBodyVerification'
    { postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument = Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyVerification'Document :: Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
postAccountsAccountPeoplePersonRequestBodyVerification'Document = Maybe
  PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.verification.properties.additional_document@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' = PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
  { -- | back
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | front
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument']
    -> String -> String)
-> Show
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
    -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
    -> Bool)
-> Eq
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"back" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"front" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"back" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"front" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
parseJSON = String
-> (Object
    -> Parser
         PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'" (\Object
obj -> ((Maybe Text
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"back")) Parser
  (Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser (Maybe Text)
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"front"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
mkPostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
mkPostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' =
  PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
PostAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
    { postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.verification.properties.document@ in the specification.
data PostAccountsAccountPeoplePersonRequestBodyVerification'Document' = PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
  { -- | back
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Back :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | front
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Front :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
-> String
[PostAccountsAccountPeoplePersonRequestBodyVerification'Document']
-> String -> String
PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
(Int
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
 -> String
 -> String)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
    -> String)
-> ([PostAccountsAccountPeoplePersonRequestBodyVerification'Document']
    -> String -> String)
-> Show
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonRequestBodyVerification'Document']
-> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonRequestBodyVerification'Document']
-> String -> String
show :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
$cshow :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
showsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> String
-> String
GHC.Show.Show,
      PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Bool
(PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
 -> Bool)
-> (PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
    -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
    -> Bool)
-> Eq
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Bool
$c/= :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Bool
== :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Bool
$c== :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPeoplePersonRequestBodyVerification'Document' where
  toJSON :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Value
toJSON PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"back" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Back PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"front" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Front PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Encoding
toEncoding PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"back" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Back PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"front" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Front PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPeoplePersonRequestBodyVerification'Document' where
  parseJSON :: Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
parseJSON = String
-> (Object
    -> Parser
         PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
-> Value
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPeoplePersonRequestBodyVerification'Document'" (\Object
obj -> ((Maybe Text
 -> Maybe Text
 -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
PostAccountsAccountPeoplePersonRequestBodyVerification'Document' Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"back")) Parser
  (Maybe Text
   -> PostAccountsAccountPeoplePersonRequestBodyVerification'Document')
-> Parser (Maybe Text)
-> Parser
     PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"front"))

-- | Create a new 'PostAccountsAccountPeoplePersonRequestBodyVerification'Document'' with all required fields.
mkPostAccountsAccountPeoplePersonRequestBodyVerification'Document' :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
mkPostAccountsAccountPeoplePersonRequestBodyVerification'Document' :: PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
mkPostAccountsAccountPeoplePersonRequestBodyVerification'Document' =
  PostAccountsAccountPeoplePersonRequestBodyVerification'Document' :: Maybe Text
-> Maybe Text
-> PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
PostAccountsAccountPeoplePersonRequestBodyVerification'Document'
    { postAccountsAccountPeoplePersonRequestBodyVerification'Document'Back :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Back = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPeoplePersonRequestBodyVerification'Document'Front :: Maybe Text
postAccountsAccountPeoplePersonRequestBodyVerification'Document'Front = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Represents a response of the operation 'postAccountsAccountPeoplePerson'.
--
-- The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'PostAccountsAccountPeoplePersonResponseError' is used.
data PostAccountsAccountPeoplePersonResponse
  = -- | Means either no matching case available or a parse error
    PostAccountsAccountPeoplePersonResponseError GHC.Base.String
  | -- | Successful response.
    PostAccountsAccountPeoplePersonResponse200 Person
  | -- | Error response.
    PostAccountsAccountPeoplePersonResponseDefault Error
  deriving (Int -> PostAccountsAccountPeoplePersonResponse -> String -> String
[PostAccountsAccountPeoplePersonResponse] -> String -> String
PostAccountsAccountPeoplePersonResponse -> String
(Int
 -> PostAccountsAccountPeoplePersonResponse -> String -> String)
-> (PostAccountsAccountPeoplePersonResponse -> String)
-> ([PostAccountsAccountPeoplePersonResponse] -> String -> String)
-> Show PostAccountsAccountPeoplePersonResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPeoplePersonResponse] -> String -> String
$cshowList :: [PostAccountsAccountPeoplePersonResponse] -> String -> String
show :: PostAccountsAccountPeoplePersonResponse -> String
$cshow :: PostAccountsAccountPeoplePersonResponse -> String
showsPrec :: Int -> PostAccountsAccountPeoplePersonResponse -> String -> String
$cshowsPrec :: Int -> PostAccountsAccountPeoplePersonResponse -> String -> String
GHC.Show.Show, PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse -> Bool
(PostAccountsAccountPeoplePersonResponse
 -> PostAccountsAccountPeoplePersonResponse -> Bool)
-> (PostAccountsAccountPeoplePersonResponse
    -> PostAccountsAccountPeoplePersonResponse -> Bool)
-> Eq PostAccountsAccountPeoplePersonResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse -> Bool
$c/= :: PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse -> Bool
== :: PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse -> Bool
$c== :: PostAccountsAccountPeoplePersonResponse
-> PostAccountsAccountPeoplePersonResponse -> Bool
GHC.Classes.Eq)