{-# 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 postAccountPeoplePerson
module StripeAPI.Operations.PostAccountPeoplePerson 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/account/people/{person}
--
-- \<p>Updates an existing person.\<\/p>
postAccountPeoplePerson ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | person | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountPeoplePersonRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostAccountPeoplePersonResponse)
postAccountPeoplePerson :: Text
-> Maybe PostAccountPeoplePersonRequestBody
-> StripeT m (Response PostAccountPeoplePersonResponse)
postAccountPeoplePerson
  Text
person
  Maybe PostAccountPeoplePersonRequestBody
body =
    (Response ByteString -> Response PostAccountPeoplePersonResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostAccountPeoplePersonResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostAccountPeoplePersonResponse)
-> Response ByteString -> Response PostAccountPeoplePersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostAccountPeoplePersonResponse)
-> (PostAccountPeoplePersonResponse
    -> PostAccountPeoplePersonResponse)
-> Either String PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountPeoplePersonResponse
PostAccountPeoplePersonResponseError PostAccountPeoplePersonResponse -> PostAccountPeoplePersonResponse
forall a. a -> a
GHC.Base.id
                (Either String PostAccountPeoplePersonResponse
 -> PostAccountPeoplePersonResponse)
-> (ByteString -> Either String PostAccountPeoplePersonResponse)
-> ByteString
-> PostAccountPeoplePersonResponse
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 -> PostAccountPeoplePersonResponse
PostAccountPeoplePersonResponse200
                                       (Person -> PostAccountPeoplePersonResponse)
-> Either String Person
-> Either String PostAccountPeoplePersonResponse
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 -> PostAccountPeoplePersonResponse
PostAccountPeoplePersonResponseDefault
                                       (Error -> PostAccountPeoplePersonResponse)
-> Either String Error
-> Either String PostAccountPeoplePersonResponse
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 PostAccountPeoplePersonResponse
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 PostAccountPeoplePersonRequestBody
-> 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/account/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 Text
person)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountPeoplePersonRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/account\/people\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountPeoplePersonRequestBody = PostAccountPeoplePersonRequestBody
  { -- | account
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address: The person\'s address.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddress'
postAccountPeoplePersonRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
postAccountPeoplePersonRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
postAccountPeoplePersonRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
postAccountPeoplePersonRequestBodyDob :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'
postAccountPeoplePersonRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountPeoplePersonRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstName :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKana :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyGender :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastName :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKana :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyMaidenName :: (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\`.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
postAccountPeoplePersonRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyMetadata'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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyNationality :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPhone :: (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
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyRelationship'
postAccountPeoplePersonRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyVerification'
postAccountPeoplePersonRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyVerification')
  }
  deriving
    ( Int -> PostAccountPeoplePersonRequestBody -> String -> String
[PostAccountPeoplePersonRequestBody] -> String -> String
PostAccountPeoplePersonRequestBody -> String
(Int -> PostAccountPeoplePersonRequestBody -> String -> String)
-> (PostAccountPeoplePersonRequestBody -> String)
-> ([PostAccountPeoplePersonRequestBody] -> String -> String)
-> Show PostAccountPeoplePersonRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBody] -> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBody] -> String -> String
show :: PostAccountPeoplePersonRequestBody -> String
$cshow :: PostAccountPeoplePersonRequestBody -> String
showsPrec :: Int -> PostAccountPeoplePersonRequestBody -> String -> String
$cshowsPrec :: Int -> PostAccountPeoplePersonRequestBody -> String -> String
GHC.Show.Show,
      PostAccountPeoplePersonRequestBody
-> PostAccountPeoplePersonRequestBody -> Bool
(PostAccountPeoplePersonRequestBody
 -> PostAccountPeoplePersonRequestBody -> Bool)
-> (PostAccountPeoplePersonRequestBody
    -> PostAccountPeoplePersonRequestBody -> Bool)
-> Eq PostAccountPeoplePersonRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBody
-> PostAccountPeoplePersonRequestBody -> Bool
$c/= :: PostAccountPeoplePersonRequestBody
-> PostAccountPeoplePersonRequestBody -> Bool
== :: PostAccountPeoplePersonRequestBody
-> PostAccountPeoplePersonRequestBody -> Bool
$c== :: PostAccountPeoplePersonRequestBody
-> PostAccountPeoplePersonRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBody where
  toJSON :: PostAccountPeoplePersonRequestBody -> Value
toJSON PostAccountPeoplePersonRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyAccount PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address" Text -> Maybe PostAccountPeoplePersonRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddress'
postAccountPeoplePersonRequestBodyAddress PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
postAccountPeoplePersonRequestBodyAddressKana PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
postAccountPeoplePersonRequestBodyAddressKanji PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
postAccountPeoplePersonRequestBodyDob PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text -> Maybe PostAccountPeoplePersonRequestBodyDocuments' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'
postAccountPeoplePersonRequestBodyDocuments PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyEmail PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountPeoplePersonRequestBodyExpand PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstName PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKana PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKanji PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyGender PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyIdNumber PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastName PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKana PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKanji PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyMaidenName PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
postAccountPeoplePersonRequestBodyMetadata PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyNationality PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPersonToken PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPhone PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPoliticalExposure PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text
-> Maybe PostAccountPeoplePersonRequestBodyRelationship' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyRelationship'
postAccountPeoplePersonRequestBodyRelationship PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodySsnLast_4 PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text
-> Maybe PostAccountPeoplePersonRequestBodyVerification' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyVerification'
postAccountPeoplePersonRequestBodyVerification PostAccountPeoplePersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBody -> Encoding
toEncoding PostAccountPeoplePersonRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyAccount PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address" Text -> Maybe PostAccountPeoplePersonRequestBodyAddress' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddress'
postAccountPeoplePersonRequestBodyAddress PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
postAccountPeoplePersonRequestBodyAddressKana PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
postAccountPeoplePersonRequestBodyAddressKanji PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
postAccountPeoplePersonRequestBodyDob PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text
-> Maybe PostAccountPeoplePersonRequestBodyDocuments' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'
postAccountPeoplePersonRequestBodyDocuments PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyEmail PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe [Text]
postAccountPeoplePersonRequestBodyExpand PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstName PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKana PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKanji PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyGender PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyIdNumber PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastName PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKana PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyLastNameKanji PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyMaidenName PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
postAccountPeoplePersonRequestBodyMetadata PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyNationality PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPersonToken PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPhone PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodyPoliticalExposure PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text
-> Maybe PostAccountPeoplePersonRequestBodyRelationship' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyRelationship'
postAccountPeoplePersonRequestBodyRelationship PostAccountPeoplePersonRequestBody
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..= PostAccountPeoplePersonRequestBody -> Maybe Text
postAccountPeoplePersonRequestBodySsnLast_4 PostAccountPeoplePersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text
-> Maybe PostAccountPeoplePersonRequestBodyVerification' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBody
-> Maybe PostAccountPeoplePersonRequestBodyVerification'
postAccountPeoplePersonRequestBodyVerification PostAccountPeoplePersonRequestBody
obj)))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBody where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBody
parseJSON = String
-> (Object -> Parser PostAccountPeoplePersonRequestBody)
-> Value
-> Parser PostAccountPeoplePersonRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBody" (\Object
obj -> (((((((((((((((((((((((((Maybe Text
 -> Maybe PostAccountPeoplePersonRequestBodyAddress'
 -> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
 -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
 -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
 -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountPeoplePersonRequestBodyVerification'
 -> PostAccountPeoplePersonRequestBody)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyAddress'
      -> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
      -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyAddress'
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyVerification'
-> PostAccountPeoplePersonRequestBody
PostAccountPeoplePersonRequestBody Parser
  (Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyAddress'
   -> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
   -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyAddress'
      -> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
      -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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
"account")) Parser
  (Maybe PostAccountPeoplePersonRequestBodyAddress'
   -> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
   -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddress')
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyAddressKana'
      -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountPeoplePersonRequestBodyAddressKana'
   -> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
      -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
   -> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyDob'Variants
      -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountPeoplePersonRequestBodyDob'Variants
   -> Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountPeoplePersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyDocuments')
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> 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 PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyMetadata'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 PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeoplePersonRequestBodyVerification'
      -> PostAccountPeoplePersonRequestBody)
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 PostAccountPeoplePersonRequestBodyVerification'
   -> PostAccountPeoplePersonRequestBody)
-> Parser (Maybe PostAccountPeoplePersonRequestBodyVerification')
-> Parser PostAccountPeoplePersonRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeoplePersonRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountPeoplePersonRequestBody' with all required fields.
mkPostAccountPeoplePersonRequestBody :: PostAccountPeoplePersonRequestBody
mkPostAccountPeoplePersonRequestBody :: PostAccountPeoplePersonRequestBody
mkPostAccountPeoplePersonRequestBody =
  PostAccountPeoplePersonRequestBody :: Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyAddress'
-> Maybe PostAccountPeoplePersonRequestBodyAddressKana'
-> Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
-> Maybe PostAccountPeoplePersonRequestBodyDob'Variants
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPeoplePersonRequestBodyVerification'
-> PostAccountPeoplePersonRequestBody
PostAccountPeoplePersonRequestBody
    { postAccountPeoplePersonRequestBodyAccount :: Maybe Text
postAccountPeoplePersonRequestBodyAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress :: Maybe PostAccountPeoplePersonRequestBodyAddress'
postAccountPeoplePersonRequestBodyAddress = Maybe PostAccountPeoplePersonRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana :: Maybe PostAccountPeoplePersonRequestBodyAddressKana'
postAccountPeoplePersonRequestBodyAddressKana = Maybe PostAccountPeoplePersonRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji :: Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
postAccountPeoplePersonRequestBodyAddressKanji = Maybe PostAccountPeoplePersonRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyDob :: Maybe PostAccountPeoplePersonRequestBodyDob'Variants
postAccountPeoplePersonRequestBodyDob = Maybe PostAccountPeoplePersonRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyDocuments :: Maybe PostAccountPeoplePersonRequestBodyDocuments'
postAccountPeoplePersonRequestBodyDocuments = Maybe PostAccountPeoplePersonRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyEmail :: Maybe Text
postAccountPeoplePersonRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyExpand :: Maybe [Text]
postAccountPeoplePersonRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyFirstName :: Maybe Text
postAccountPeoplePersonRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyFirstNameKana :: Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyFirstNameKanji :: Maybe Text
postAccountPeoplePersonRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyGender :: Maybe Text
postAccountPeoplePersonRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyIdNumber :: Maybe Text
postAccountPeoplePersonRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyLastName :: Maybe Text
postAccountPeoplePersonRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyLastNameKana :: Maybe Text
postAccountPeoplePersonRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyLastNameKanji :: Maybe Text
postAccountPeoplePersonRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyMaidenName :: Maybe Text
postAccountPeoplePersonRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyMetadata :: Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
postAccountPeoplePersonRequestBodyMetadata = Maybe PostAccountPeoplePersonRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyNationality :: Maybe Text
postAccountPeoplePersonRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyPersonToken :: Maybe Text
postAccountPeoplePersonRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyPhone :: Maybe Text
postAccountPeoplePersonRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyPoliticalExposure :: Maybe Text
postAccountPeoplePersonRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship :: Maybe PostAccountPeoplePersonRequestBodyRelationship'
postAccountPeoplePersonRequestBodyRelationship = Maybe PostAccountPeoplePersonRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodySsnLast_4 :: Maybe Text
postAccountPeoplePersonRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyVerification :: Maybe PostAccountPeoplePersonRequestBodyVerification'
postAccountPeoplePersonRequestBodyVerification = Maybe PostAccountPeoplePersonRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyAddress' where
  toJSON :: PostAccountPeoplePersonRequestBodyAddress' -> Value
toJSON PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'City PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Country PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line1 PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line2 PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'PostalCode PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'State PostAccountPeoplePersonRequestBodyAddress'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyAddress' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'City PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Country PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line1 PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line2 PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'PostalCode PostAccountPeoplePersonRequestBodyAddress'
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..= PostAccountPeoplePersonRequestBodyAddress' -> Maybe Text
postAccountPeoplePersonRequestBodyAddress'State PostAccountPeoplePersonRequestBodyAddress'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyAddress' where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyAddress'
parseJSON = String
-> (Object -> Parser PostAccountPeoplePersonRequestBodyAddress')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyAddress'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyAddress'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddress')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyAddress'
PostAccountPeoplePersonRequestBodyAddress' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddress')
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
   -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddress')
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
   -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddress')
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
   -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostAccountPeoplePersonRequestBodyAddress')
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 -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostAccountPeoplePersonRequestBodyAddress')
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 -> PostAccountPeoplePersonRequestBodyAddress')
-> Parser (Maybe Text)
-> Parser PostAccountPeoplePersonRequestBodyAddress'
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 'PostAccountPeoplePersonRequestBodyAddress'' with all required fields.
mkPostAccountPeoplePersonRequestBodyAddress' :: PostAccountPeoplePersonRequestBodyAddress'
mkPostAccountPeoplePersonRequestBodyAddress' :: PostAccountPeoplePersonRequestBodyAddress'
mkPostAccountPeoplePersonRequestBodyAddress' =
  PostAccountPeoplePersonRequestBodyAddress' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyAddress'
PostAccountPeoplePersonRequestBodyAddress'
    { postAccountPeoplePersonRequestBodyAddress'City :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress'Country :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress'Line1 :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress'Line2 :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress'PostalCode :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddress'State :: Maybe Text
postAccountPeoplePersonRequestBodyAddress'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyAddressKana' = PostAccountPeoplePersonRequestBodyAddressKana'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | town
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Town :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
[PostAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
PostAccountPeoplePersonRequestBodyAddressKana' -> String
(Int
 -> PostAccountPeoplePersonRequestBodyAddressKana'
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyAddressKana' -> String)
-> ([PostAccountPeoplePersonRequestBodyAddressKana']
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyAddressKana'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyAddressKana']
-> String -> String
show :: PostAccountPeoplePersonRequestBodyAddressKana' -> String
$cshow :: PostAccountPeoplePersonRequestBodyAddressKana' -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyAddressKana'
-> String
-> String
GHC.Show.Show,
      PostAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool
(PostAccountPeoplePersonRequestBodyAddressKana'
 -> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool)
-> (PostAccountPeoplePersonRequestBodyAddressKana'
    -> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyAddressKana'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool
== :: PostAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool
$c== :: PostAccountPeoplePersonRequestBodyAddressKana'
-> PostAccountPeoplePersonRequestBodyAddressKana' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyAddressKana' where
  toJSON :: PostAccountPeoplePersonRequestBodyAddressKana' -> Value
toJSON PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'City PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Country PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line1 PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line2 PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'PostalCode PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'State PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Town PostAccountPeoplePersonRequestBodyAddressKana'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyAddressKana' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'City PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Country PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line1 PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line2 PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'PostalCode PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'State PostAccountPeoplePersonRequestBodyAddressKana'
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..= PostAccountPeoplePersonRequestBodyAddressKana' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Town PostAccountPeoplePersonRequestBodyAddressKana'
obj)))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyAddressKana' where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyAddressKana'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyAddressKana')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyAddressKana'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyAddressKana'" (\Object
obj -> (((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKana')
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
-> PostAccountPeoplePersonRequestBodyAddressKana'
PostAccountPeoplePersonRequestBodyAddressKana' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKana')
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
   -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKana')
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
   -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKana')
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
   -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKana')
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
   -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostAccountPeoplePersonRequestBodyAddressKana')
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 -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostAccountPeoplePersonRequestBodyAddressKana')
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 -> PostAccountPeoplePersonRequestBodyAddressKana')
-> Parser (Maybe Text)
-> Parser PostAccountPeoplePersonRequestBodyAddressKana'
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 'PostAccountPeoplePersonRequestBodyAddressKana'' with all required fields.
mkPostAccountPeoplePersonRequestBodyAddressKana' :: PostAccountPeoplePersonRequestBodyAddressKana'
mkPostAccountPeoplePersonRequestBodyAddressKana' :: PostAccountPeoplePersonRequestBodyAddressKana'
mkPostAccountPeoplePersonRequestBodyAddressKana' =
  PostAccountPeoplePersonRequestBodyAddressKana' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyAddressKana'
PostAccountPeoplePersonRequestBodyAddressKana'
    { postAccountPeoplePersonRequestBodyAddressKana'City :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'Country :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'Line1 :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'Line2 :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'PostalCode :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'State :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKana'Town :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKana'Town = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyAddressKanji' = PostAccountPeoplePersonRequestBodyAddressKanji'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | town
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Town :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
[PostAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
PostAccountPeoplePersonRequestBodyAddressKanji' -> String
(Int
 -> PostAccountPeoplePersonRequestBodyAddressKanji'
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyAddressKanji' -> String)
-> ([PostAccountPeoplePersonRequestBodyAddressKanji']
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyAddressKanji'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyAddressKanji']
-> String -> String
show :: PostAccountPeoplePersonRequestBodyAddressKanji' -> String
$cshow :: PostAccountPeoplePersonRequestBodyAddressKanji' -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyAddressKanji'
-> String
-> String
GHC.Show.Show,
      PostAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool
(PostAccountPeoplePersonRequestBodyAddressKanji'
 -> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool)
-> (PostAccountPeoplePersonRequestBodyAddressKanji'
    -> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyAddressKanji'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool
== :: PostAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool
$c== :: PostAccountPeoplePersonRequestBodyAddressKanji'
-> PostAccountPeoplePersonRequestBodyAddressKanji' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyAddressKanji' where
  toJSON :: PostAccountPeoplePersonRequestBodyAddressKanji' -> Value
toJSON PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'City PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Country PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line1 PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line2 PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'PostalCode PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'State PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Town PostAccountPeoplePersonRequestBodyAddressKanji'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyAddressKanji' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'City PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Country PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line1 PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line2 PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'PostalCode PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'State PostAccountPeoplePersonRequestBodyAddressKanji'
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..= PostAccountPeoplePersonRequestBodyAddressKanji' -> Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Town PostAccountPeoplePersonRequestBodyAddressKanji'
obj)))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyAddressKanji' where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyAddressKanji'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyAddressKanji')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyAddressKanji'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyAddressKanji'" (\Object
obj -> (((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKanji')
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
-> PostAccountPeoplePersonRequestBodyAddressKanji'
PostAccountPeoplePersonRequestBodyAddressKanji' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKanji')
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
   -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKanji')
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
   -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKanji')
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
   -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyAddressKanji')
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
   -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostAccountPeoplePersonRequestBodyAddressKanji')
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 -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostAccountPeoplePersonRequestBodyAddressKanji')
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 -> PostAccountPeoplePersonRequestBodyAddressKanji')
-> Parser (Maybe Text)
-> Parser PostAccountPeoplePersonRequestBodyAddressKanji'
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 'PostAccountPeoplePersonRequestBodyAddressKanji'' with all required fields.
mkPostAccountPeoplePersonRequestBodyAddressKanji' :: PostAccountPeoplePersonRequestBodyAddressKanji'
mkPostAccountPeoplePersonRequestBodyAddressKanji' :: PostAccountPeoplePersonRequestBodyAddressKanji'
mkPostAccountPeoplePersonRequestBodyAddressKanji' =
  PostAccountPeoplePersonRequestBodyAddressKanji' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyAddressKanji'
PostAccountPeoplePersonRequestBodyAddressKanji'
    { postAccountPeoplePersonRequestBodyAddressKanji'City :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'Country :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'Line1 :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'Line2 :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'PostalCode :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'State :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyAddressKanji'Town :: Maybe Text
postAccountPeoplePersonRequestBodyAddressKanji'Town = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyDob'OneOf1 where
  toJSON :: PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Value
toJSON PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Day PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Month PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Year PostAccountPeoplePersonRequestBodyDob'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Day PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Month PostAccountPeoplePersonRequestBodyDob'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..= PostAccountPeoplePersonRequestBodyDob'OneOf1 -> Int
postAccountPeoplePersonRequestBodyDob'OneOf1Year PostAccountPeoplePersonRequestBodyDob'OneOf1
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyDob'OneOf1 where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyDob'OneOf1
parseJSON = String
-> (Object -> Parser PostAccountPeoplePersonRequestBodyDob'OneOf1)
-> Value
-> Parser PostAccountPeoplePersonRequestBodyDob'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyDob'OneOf1" (\Object
obj -> (((Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser
     (Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1
PostAccountPeoplePersonRequestBodyDob'OneOf1 Parser
  (Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser
     (Int -> Int -> PostAccountPeoplePersonRequestBodyDob'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 -> PostAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser (Int -> PostAccountPeoplePersonRequestBodyDob'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 -> PostAccountPeoplePersonRequestBodyDob'OneOf1)
-> Parser Int
-> Parser PostAccountPeoplePersonRequestBodyDob'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 'PostAccountPeoplePersonRequestBodyDob'OneOf1' with all required fields.
mkPostAccountPeoplePersonRequestBodyDob'OneOf1 ::
  -- | 'postAccountPeoplePersonRequestBodyDob'OneOf1Day'
  GHC.Types.Int ->
  -- | 'postAccountPeoplePersonRequestBodyDob'OneOf1Month'
  GHC.Types.Int ->
  -- | 'postAccountPeoplePersonRequestBodyDob'OneOf1Year'
  GHC.Types.Int ->
  PostAccountPeoplePersonRequestBodyDob'OneOf1
mkPostAccountPeoplePersonRequestBodyDob'OneOf1 :: Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1
mkPostAccountPeoplePersonRequestBodyDob'OneOf1 Int
postAccountPeoplePersonRequestBodyDob'OneOf1Day Int
postAccountPeoplePersonRequestBodyDob'OneOf1Month Int
postAccountPeoplePersonRequestBodyDob'OneOf1Year =
  PostAccountPeoplePersonRequestBodyDob'OneOf1 :: Int -> Int -> Int -> PostAccountPeoplePersonRequestBodyDob'OneOf1
PostAccountPeoplePersonRequestBodyDob'OneOf1
    { postAccountPeoplePersonRequestBodyDob'OneOf1Day :: Int
postAccountPeoplePersonRequestBodyDob'OneOf1Day = Int
postAccountPeoplePersonRequestBodyDob'OneOf1Day,
      postAccountPeoplePersonRequestBodyDob'OneOf1Month :: Int
postAccountPeoplePersonRequestBodyDob'OneOf1Month = Int
postAccountPeoplePersonRequestBodyDob'OneOf1Month,
      postAccountPeoplePersonRequestBodyDob'OneOf1Year :: Int
postAccountPeoplePersonRequestBodyDob'OneOf1Year = Int
postAccountPeoplePersonRequestBodyDob'OneOf1Year
    }

-- | Defines the oneOf schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyDob'Variants
  = -- | Represents the JSON value @""@
    PostAccountPeoplePersonRequestBodyDob'EmptyString
  | PostAccountPeoplePersonRequestBodyDob'PostAccountPeoplePersonRequestBodyDob'OneOf1 PostAccountPeoplePersonRequestBodyDob'OneOf1
  deriving (Int
-> PostAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
[PostAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
PostAccountPeoplePersonRequestBodyDob'Variants -> String
(Int
 -> PostAccountPeoplePersonRequestBodyDob'Variants
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyDob'Variants -> String)
-> ([PostAccountPeoplePersonRequestBodyDob'Variants]
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyDob'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyDob'Variants]
-> String -> String
show :: PostAccountPeoplePersonRequestBodyDob'Variants -> String
$cshow :: PostAccountPeoplePersonRequestBodyDob'Variants -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyDob'Variants
-> String
-> String
GHC.Show.Show, PostAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool
(PostAccountPeoplePersonRequestBodyDob'Variants
 -> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool)
-> (PostAccountPeoplePersonRequestBodyDob'Variants
    -> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyDob'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool
== :: PostAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool
$c== :: PostAccountPeoplePersonRequestBodyDob'Variants
-> PostAccountPeoplePersonRequestBodyDob'Variants -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the object schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyDocuments' = PostAccountPeoplePersonRequestBodyDocuments'
  { -- | company_authorization
    PostAccountPeoplePersonRequestBodyDocuments'
-> Maybe
     PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
postAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'),
    -- | passport
    PostAccountPeoplePersonRequestBodyDocuments'
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'Passport'
postAccountPeoplePersonRequestBodyDocuments'Passport :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyDocuments'Passport'),
    -- | visa
    PostAccountPeoplePersonRequestBodyDocuments'
-> Maybe PostAccountPeoplePersonRequestBodyDocuments'Visa'
postAccountPeoplePersonRequestBodyDocuments'Visa :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyDocuments'Visa')
  }
  deriving
    ( Int
-> PostAccountPeoplePersonRequestBodyDocuments' -> String -> String
[PostAccountPeoplePersonRequestBodyDocuments'] -> String -> String
PostAccountPeoplePersonRequestBodyDocuments' -> String
(Int
 -> PostAccountPeoplePersonRequestBodyDocuments'
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyDocuments' -> String)
-> ([PostAccountPeoplePersonRequestBodyDocuments']
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyDocuments'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyDocuments'] -> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyDocuments'] -> String -> String
show :: PostAccountPeoplePersonRequestBodyDocuments' -> String
$cshow :: PostAccountPeoplePersonRequestBodyDocuments' -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyDocuments' -> String -> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyDocuments' -> String -> String
GHC.Show.Show,
      PostAccountPeoplePersonRequestBodyDocuments'
-> PostAccountPeoplePersonRequestBodyDocuments' -> Bool
(PostAccountPeoplePersonRequestBodyDocuments'
 -> PostAccountPeoplePersonRequestBodyDocuments' -> Bool)
-> (PostAccountPeoplePersonRequestBodyDocuments'
    -> PostAccountPeoplePersonRequestBodyDocuments' -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyDocuments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyDocuments'
-> PostAccountPeoplePersonRequestBodyDocuments' -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyDocuments'
-> PostAccountPeoplePersonRequestBodyDocuments' -> Bool
== :: PostAccountPeoplePersonRequestBodyDocuments'
-> PostAccountPeoplePersonRequestBodyDocuments' -> Bool
$c== :: PostAccountPeoplePersonRequestBodyDocuments'
-> PostAccountPeoplePersonRequestBodyDocuments' -> Bool
GHC.Classes.Eq
    )

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

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

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

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' where
  toJSON :: PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Value
toJSON PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Encoding
toEncoding PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
-> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' where
  parseJSON :: Value
-> Parser
     PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
parseJSON = String
-> (Object
    -> Parser
         PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Value
-> Parser
     PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'" (\Object
obj -> (Maybe [Text]
 -> PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Parser
     (Maybe [Text]
      -> PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text]
-> PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' Parser
  (Maybe [Text]
   -> PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization')
-> Parser (Maybe [Text])
-> Parser
     PostAccountPeoplePersonRequestBodyDocuments'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 'PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'' with all required fields.
mkPostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
mkPostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
mkPostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' = PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' :: Maybe [Text]
-> PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'
PostAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization' {postAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files :: Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'CompanyAuthorization'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyDocuments'Passport' where
  toJSON :: PostAccountPeoplePersonRequestBodyDocuments'Passport' -> Value
toJSON PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Passport'Files PostAccountPeoplePersonRequestBodyDocuments'Passport'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyDocuments'Passport' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'Passport'
-> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Passport'Files PostAccountPeoplePersonRequestBodyDocuments'Passport'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyDocuments'Passport' where
  parseJSON :: Value
-> Parser PostAccountPeoplePersonRequestBodyDocuments'Passport'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyDocuments'Passport')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyDocuments'Passport'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyDocuments'Passport'" (\Object
obj -> (Maybe [Text]
 -> PostAccountPeoplePersonRequestBodyDocuments'Passport')
-> Parser
     (Maybe [Text]
      -> PostAccountPeoplePersonRequestBodyDocuments'Passport')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text]
-> PostAccountPeoplePersonRequestBodyDocuments'Passport'
PostAccountPeoplePersonRequestBodyDocuments'Passport' Parser
  (Maybe [Text]
   -> PostAccountPeoplePersonRequestBodyDocuments'Passport')
-> Parser (Maybe [Text])
-> Parser PostAccountPeoplePersonRequestBodyDocuments'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 'PostAccountPeoplePersonRequestBodyDocuments'Passport'' with all required fields.
mkPostAccountPeoplePersonRequestBodyDocuments'Passport' :: PostAccountPeoplePersonRequestBodyDocuments'Passport'
mkPostAccountPeoplePersonRequestBodyDocuments'Passport' :: PostAccountPeoplePersonRequestBodyDocuments'Passport'
mkPostAccountPeoplePersonRequestBodyDocuments'Passport' = PostAccountPeoplePersonRequestBodyDocuments'Passport' :: Maybe [Text]
-> PostAccountPeoplePersonRequestBodyDocuments'Passport'
PostAccountPeoplePersonRequestBodyDocuments'Passport' {postAccountPeoplePersonRequestBodyDocuments'Passport'Files :: Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Passport'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyDocuments'Visa' where
  toJSON :: PostAccountPeoplePersonRequestBodyDocuments'Visa' -> Value
toJSON PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'Visa' -> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Visa'Files PostAccountPeoplePersonRequestBodyDocuments'Visa'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyDocuments'Visa' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyDocuments'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..= PostAccountPeoplePersonRequestBodyDocuments'Visa' -> Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Visa'Files PostAccountPeoplePersonRequestBodyDocuments'Visa'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyDocuments'Visa' where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyDocuments'Visa'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyDocuments'Visa')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyDocuments'Visa'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyDocuments'Visa'" (\Object
obj -> (Maybe [Text] -> PostAccountPeoplePersonRequestBodyDocuments'Visa')
-> Parser
     (Maybe [Text] -> PostAccountPeoplePersonRequestBodyDocuments'Visa')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe [Text] -> PostAccountPeoplePersonRequestBodyDocuments'Visa'
PostAccountPeoplePersonRequestBodyDocuments'Visa' Parser
  (Maybe [Text] -> PostAccountPeoplePersonRequestBodyDocuments'Visa')
-> Parser (Maybe [Text])
-> Parser PostAccountPeoplePersonRequestBodyDocuments'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 'PostAccountPeoplePersonRequestBodyDocuments'Visa'' with all required fields.
mkPostAccountPeoplePersonRequestBodyDocuments'Visa' :: PostAccountPeoplePersonRequestBodyDocuments'Visa'
mkPostAccountPeoplePersonRequestBodyDocuments'Visa' :: PostAccountPeoplePersonRequestBodyDocuments'Visa'
mkPostAccountPeoplePersonRequestBodyDocuments'Visa' = PostAccountPeoplePersonRequestBodyDocuments'Visa' :: Maybe [Text] -> PostAccountPeoplePersonRequestBodyDocuments'Visa'
PostAccountPeoplePersonRequestBodyDocuments'Visa' {postAccountPeoplePersonRequestBodyDocuments'Visa'Files :: Maybe [Text]
postAccountPeoplePersonRequestBodyDocuments'Visa'Files = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostAccountPeoplePersonRequestBodyMetadata'EmptyString
  | PostAccountPeoplePersonRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
[PostAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
PostAccountPeoplePersonRequestBodyMetadata'Variants -> String
(Int
 -> PostAccountPeoplePersonRequestBodyMetadata'Variants
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyMetadata'Variants -> String)
-> ([PostAccountPeoplePersonRequestBodyMetadata'Variants]
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyMetadata'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyMetadata'Variants]
-> String -> String
show :: PostAccountPeoplePersonRequestBodyMetadata'Variants -> String
$cshow :: PostAccountPeoplePersonRequestBodyMetadata'Variants -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyMetadata'Variants
-> String
-> String
GHC.Show.Show, PostAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool
(PostAccountPeoplePersonRequestBodyMetadata'Variants
 -> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool)
-> (PostAccountPeoplePersonRequestBodyMetadata'Variants
    -> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool
== :: PostAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool
$c== :: PostAccountPeoplePersonRequestBodyMetadata'Variants
-> PostAccountPeoplePersonRequestBodyMetadata'Variants -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the object schema located at @paths.\/v1\/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 PostAccountPeoplePersonRequestBodyRelationship' = PostAccountPeoplePersonRequestBodyRelationship'
  { -- | director
    PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Director :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | executive
    PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Executive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | owner
    PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Owner :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | percent_ownership
    PostAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountPeoplePersonRequestBodyRelationship'PercentOwnership :: (GHC.Maybe.Maybe PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants),
    -- | representative
    PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Representative :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | title
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Text
postAccountPeoplePersonRequestBodyRelationship'Title :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
[PostAccountPeoplePersonRequestBodyRelationship']
-> String -> String
PostAccountPeoplePersonRequestBodyRelationship' -> String
(Int
 -> PostAccountPeoplePersonRequestBodyRelationship'
 -> String
 -> String)
-> (PostAccountPeoplePersonRequestBodyRelationship' -> String)
-> ([PostAccountPeoplePersonRequestBodyRelationship']
    -> String -> String)
-> Show PostAccountPeoplePersonRequestBodyRelationship'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonRequestBodyRelationship']
-> String -> String
$cshowList :: [PostAccountPeoplePersonRequestBodyRelationship']
-> String -> String
show :: PostAccountPeoplePersonRequestBodyRelationship' -> String
$cshow :: PostAccountPeoplePersonRequestBodyRelationship' -> String
showsPrec :: Int
-> PostAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPeoplePersonRequestBodyRelationship'
-> String
-> String
GHC.Show.Show,
      PostAccountPeoplePersonRequestBodyRelationship'
-> PostAccountPeoplePersonRequestBodyRelationship' -> Bool
(PostAccountPeoplePersonRequestBodyRelationship'
 -> PostAccountPeoplePersonRequestBodyRelationship' -> Bool)
-> (PostAccountPeoplePersonRequestBodyRelationship'
    -> PostAccountPeoplePersonRequestBodyRelationship' -> Bool)
-> Eq PostAccountPeoplePersonRequestBodyRelationship'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonRequestBodyRelationship'
-> PostAccountPeoplePersonRequestBodyRelationship' -> Bool
$c/= :: PostAccountPeoplePersonRequestBodyRelationship'
-> PostAccountPeoplePersonRequestBodyRelationship' -> Bool
== :: PostAccountPeoplePersonRequestBodyRelationship'
-> PostAccountPeoplePersonRequestBodyRelationship' -> Bool
$c== :: PostAccountPeoplePersonRequestBodyRelationship'
-> PostAccountPeoplePersonRequestBodyRelationship' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyRelationship' where
  toJSON :: PostAccountPeoplePersonRequestBodyRelationship' -> Value
toJSON PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Director PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Executive PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Owner PostAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"percent_ownership" Text
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountPeoplePersonRequestBodyRelationship'PercentOwnership PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Representative PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Text
postAccountPeoplePersonRequestBodyRelationship'Title PostAccountPeoplePersonRequestBodyRelationship'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyRelationship' -> Encoding
toEncoding PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Director PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Executive PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Owner PostAccountPeoplePersonRequestBodyRelationship'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"percent_ownership" Text
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeoplePersonRequestBodyRelationship'
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountPeoplePersonRequestBodyRelationship'PercentOwnership PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Representative PostAccountPeoplePersonRequestBodyRelationship'
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..= PostAccountPeoplePersonRequestBodyRelationship' -> Maybe Text
postAccountPeoplePersonRequestBodyRelationship'Title PostAccountPeoplePersonRequestBodyRelationship'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyRelationship' where
  parseJSON :: Value -> Parser PostAccountPeoplePersonRequestBodyRelationship'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyRelationship')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyRelationship'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyRelationship'" (\Object
obj -> ((((((Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe
      PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
 -> Maybe Bool
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe
           PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Maybe Bool
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyRelationship'
PostAccountPeoplePersonRequestBodyRelationship' Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe
           PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyRelationship')
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
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe
           PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyRelationship')
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
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
      -> Maybe Bool
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyRelationship')
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
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
   -> Maybe Bool
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser
     (Maybe
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants)
-> Parser
     (Maybe Bool
      -> Maybe Text -> PostAccountPeoplePersonRequestBodyRelationship')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"percent_ownership")) Parser
  (Maybe Bool
   -> Maybe Text -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text -> PostAccountPeoplePersonRequestBodyRelationship')
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 -> PostAccountPeoplePersonRequestBodyRelationship')
-> Parser (Maybe Text)
-> Parser PostAccountPeoplePersonRequestBodyRelationship'
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 'PostAccountPeoplePersonRequestBodyRelationship'' with all required fields.
mkPostAccountPeoplePersonRequestBodyRelationship' :: PostAccountPeoplePersonRequestBodyRelationship'
mkPostAccountPeoplePersonRequestBodyRelationship' :: PostAccountPeoplePersonRequestBodyRelationship'
mkPostAccountPeoplePersonRequestBodyRelationship' =
  PostAccountPeoplePersonRequestBodyRelationship' :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe
     PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
-> Maybe Bool
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyRelationship'
PostAccountPeoplePersonRequestBodyRelationship'
    { postAccountPeoplePersonRequestBodyRelationship'Director :: Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Director = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship'Executive :: Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Executive = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship'Owner :: Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Owner = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship'PercentOwnership :: Maybe
  PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
postAccountPeoplePersonRequestBodyRelationship'PercentOwnership = Maybe
  PostAccountPeoplePersonRequestBodyRelationship'PercentOwnership'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship'Representative :: Maybe Bool
postAccountPeoplePersonRequestBodyRelationship'Representative = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyRelationship'Title :: Maybe Text
postAccountPeoplePersonRequestBodyRelationship'Title = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

-- | Create a new 'PostAccountPeoplePersonRequestBodyVerification'' with all required fields.
mkPostAccountPeoplePersonRequestBodyVerification' :: PostAccountPeoplePersonRequestBodyVerification'
mkPostAccountPeoplePersonRequestBodyVerification' :: PostAccountPeoplePersonRequestBodyVerification'
mkPostAccountPeoplePersonRequestBodyVerification' =
  PostAccountPeoplePersonRequestBodyVerification' :: Maybe
  PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe PostAccountPeoplePersonRequestBodyVerification'Document'
-> PostAccountPeoplePersonRequestBodyVerification'
PostAccountPeoplePersonRequestBodyVerification'
    { postAccountPeoplePersonRequestBodyVerification'AdditionalDocument :: Maybe
  PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument = Maybe
  PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyVerification'Document :: Maybe PostAccountPeoplePersonRequestBodyVerification'Document'
postAccountPeoplePersonRequestBodyVerification'Document = Maybe PostAccountPeoplePersonRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' where
  toJSON :: PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Value
toJSON PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Encoding
toEncoding PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' where
  parseJSON :: Value
-> Parser
     PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
parseJSON = String
-> (Object
    -> Parser
         PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Value
-> Parser
     PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'" (\Object
obj -> ((Maybe Text
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountPeoplePersonRequestBodyVerification'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
   -> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument')
-> Parser (Maybe Text)
-> Parser
     PostAccountPeoplePersonRequestBodyVerification'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 'PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'' with all required fields.
mkPostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
mkPostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
mkPostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' =
  PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument' :: Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
PostAccountPeoplePersonRequestBodyVerification'AdditionalDocument'
    { postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back :: Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Back = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front :: Maybe Text
postAccountPeoplePersonRequestBodyVerification'AdditionalDocument'Front = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeoplePersonRequestBodyVerification'Document' where
  toJSON :: PostAccountPeoplePersonRequestBodyVerification'Document' -> Value
toJSON PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Back PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Front PostAccountPeoplePersonRequestBodyVerification'Document'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeoplePersonRequestBodyVerification'Document'
-> Encoding
toEncoding PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Back PostAccountPeoplePersonRequestBodyVerification'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..= PostAccountPeoplePersonRequestBodyVerification'Document'
-> Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Front PostAccountPeoplePersonRequestBodyVerification'Document'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeoplePersonRequestBodyVerification'Document' where
  parseJSON :: Value
-> Parser PostAccountPeoplePersonRequestBodyVerification'Document'
parseJSON = String
-> (Object
    -> Parser PostAccountPeoplePersonRequestBodyVerification'Document')
-> Value
-> Parser PostAccountPeoplePersonRequestBodyVerification'Document'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeoplePersonRequestBodyVerification'Document'" (\Object
obj -> ((Maybe Text
 -> Maybe Text
 -> PostAccountPeoplePersonRequestBodyVerification'Document')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostAccountPeoplePersonRequestBodyVerification'Document')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyVerification'Document'
PostAccountPeoplePersonRequestBodyVerification'Document' Parser
  (Maybe Text
   -> Maybe Text
   -> PostAccountPeoplePersonRequestBodyVerification'Document')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostAccountPeoplePersonRequestBodyVerification'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
   -> PostAccountPeoplePersonRequestBodyVerification'Document')
-> Parser (Maybe Text)
-> Parser PostAccountPeoplePersonRequestBodyVerification'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 'PostAccountPeoplePersonRequestBodyVerification'Document'' with all required fields.
mkPostAccountPeoplePersonRequestBodyVerification'Document' :: PostAccountPeoplePersonRequestBodyVerification'Document'
mkPostAccountPeoplePersonRequestBodyVerification'Document' :: PostAccountPeoplePersonRequestBodyVerification'Document'
mkPostAccountPeoplePersonRequestBodyVerification'Document' =
  PostAccountPeoplePersonRequestBodyVerification'Document' :: Maybe Text
-> Maybe Text
-> PostAccountPeoplePersonRequestBodyVerification'Document'
PostAccountPeoplePersonRequestBodyVerification'Document'
    { postAccountPeoplePersonRequestBodyVerification'Document'Back :: Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Back = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeoplePersonRequestBodyVerification'Document'Front :: Maybe Text
postAccountPeoplePersonRequestBodyVerification'Document'Front = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Represents a response of the operation 'postAccountPeoplePerson'.
--
-- 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), 'PostAccountPeoplePersonResponseError' is used.
data PostAccountPeoplePersonResponse
  = -- | Means either no matching case available or a parse error
    PostAccountPeoplePersonResponseError GHC.Base.String
  | -- | Successful response.
    PostAccountPeoplePersonResponse200 Person
  | -- | Error response.
    PostAccountPeoplePersonResponseDefault Error
  deriving (Int -> PostAccountPeoplePersonResponse -> String -> String
[PostAccountPeoplePersonResponse] -> String -> String
PostAccountPeoplePersonResponse -> String
(Int -> PostAccountPeoplePersonResponse -> String -> String)
-> (PostAccountPeoplePersonResponse -> String)
-> ([PostAccountPeoplePersonResponse] -> String -> String)
-> Show PostAccountPeoplePersonResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPeoplePersonResponse] -> String -> String
$cshowList :: [PostAccountPeoplePersonResponse] -> String -> String
show :: PostAccountPeoplePersonResponse -> String
$cshow :: PostAccountPeoplePersonResponse -> String
showsPrec :: Int -> PostAccountPeoplePersonResponse -> String -> String
$cshowsPrec :: Int -> PostAccountPeoplePersonResponse -> String -> String
GHC.Show.Show, PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse -> Bool
(PostAccountPeoplePersonResponse
 -> PostAccountPeoplePersonResponse -> Bool)
-> (PostAccountPeoplePersonResponse
    -> PostAccountPeoplePersonResponse -> Bool)
-> Eq PostAccountPeoplePersonResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse -> Bool
$c/= :: PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse -> Bool
== :: PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse -> Bool
$c== :: PostAccountPeoplePersonResponse
-> PostAccountPeoplePersonResponse -> Bool
GHC.Classes.Eq)