{-# 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 postAccountPeople
module StripeAPI.Operations.PostAccountPeople 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
--
-- \<p>Creates a new person.\<\/p>
postAccountPeople ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountPeopleRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response PostAccountPeopleResponse)
postAccountPeople :: Maybe PostAccountPeopleRequestBody
-> ClientT m (Response PostAccountPeopleResponse)
postAccountPeople Maybe PostAccountPeopleRequestBody
body =
  (Response ByteString -> Response PostAccountPeopleResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response PostAccountPeopleResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> PostAccountPeopleResponse)
-> Response ByteString -> Response PostAccountPeopleResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> PostAccountPeopleResponse)
-> (PostAccountPeopleResponse -> PostAccountPeopleResponse)
-> Either String PostAccountPeopleResponse
-> PostAccountPeopleResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountPeopleResponse
PostAccountPeopleResponseError PostAccountPeopleResponse -> PostAccountPeopleResponse
forall a. a -> a
GHC.Base.id
              (Either String PostAccountPeopleResponse
 -> PostAccountPeopleResponse)
-> (ByteString -> Either String PostAccountPeopleResponse)
-> ByteString
-> PostAccountPeopleResponse
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 -> PostAccountPeopleResponse
PostAccountPeopleResponse200
                                     (Person -> PostAccountPeopleResponse)
-> Either String Person -> Either String PostAccountPeopleResponse
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 -> PostAccountPeopleResponse
PostAccountPeopleResponseDefault
                                     (Error -> PostAccountPeopleResponse)
-> Either String Error -> Either String PostAccountPeopleResponse
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 PostAccountPeopleResponse
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 PostAccountPeopleRequestBody
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> ClientT 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") [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountPeopleRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/account\/people.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountPeopleRequestBody = PostAccountPeopleRequestBody
  { -- | account
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address: The person\'s address.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddress'
postAccountPeopleRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKana'
postAccountPeopleRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKanji'
postAccountPeopleRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDob'Variants
postAccountPeopleRequestBodyDob :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDocuments'
postAccountPeopleRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountPeopleRequestBody -> Maybe [Text]
postAccountPeopleRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstName :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKana :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyGender :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastName :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKana :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyMaidenName :: (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\`.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants
postAccountPeopleRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyMetadata'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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyNationality :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPhone :: (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
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyRelationship'
postAccountPeopleRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyVerification'
postAccountPeopleRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyVerification')
  }
  deriving
    ( Int -> PostAccountPeopleRequestBody -> ShowS
[PostAccountPeopleRequestBody] -> ShowS
PostAccountPeopleRequestBody -> String
(Int -> PostAccountPeopleRequestBody -> ShowS)
-> (PostAccountPeopleRequestBody -> String)
-> ([PostAccountPeopleRequestBody] -> ShowS)
-> Show PostAccountPeopleRequestBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAccountPeopleRequestBody] -> ShowS
$cshowList :: [PostAccountPeopleRequestBody] -> ShowS
show :: PostAccountPeopleRequestBody -> String
$cshow :: PostAccountPeopleRequestBody -> String
showsPrec :: Int -> PostAccountPeopleRequestBody -> ShowS
$cshowsPrec :: Int -> PostAccountPeopleRequestBody -> ShowS
GHC.Show.Show,
      PostAccountPeopleRequestBody
-> PostAccountPeopleRequestBody -> Bool
(PostAccountPeopleRequestBody
 -> PostAccountPeopleRequestBody -> Bool)
-> (PostAccountPeopleRequestBody
    -> PostAccountPeopleRequestBody -> Bool)
-> Eq PostAccountPeopleRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeopleRequestBody
-> PostAccountPeopleRequestBody -> Bool
$c/= :: PostAccountPeopleRequestBody
-> PostAccountPeopleRequestBody -> Bool
== :: PostAccountPeopleRequestBody
-> PostAccountPeopleRequestBody -> Bool
$c== :: PostAccountPeopleRequestBody
-> PostAccountPeopleRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPeopleRequestBody where
  toJSON :: PostAccountPeopleRequestBody -> Value
toJSON PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyAccount PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address" Text -> Maybe PostAccountPeopleRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddress'
postAccountPeopleRequestBodyAddress PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text -> Maybe PostAccountPeopleRequestBodyAddressKana' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKana'
postAccountPeopleRequestBodyAddressKana PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text -> Maybe PostAccountPeopleRequestBodyAddressKanji' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKanji'
postAccountPeopleRequestBodyAddressKanji PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text -> Maybe PostAccountPeopleRequestBodyDob'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDob'Variants
postAccountPeopleRequestBodyDob PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text -> Maybe PostAccountPeopleRequestBodyDocuments' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDocuments'
postAccountPeopleRequestBodyDocuments PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyEmail PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe [Text]
postAccountPeopleRequestBodyExpand PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstName PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKana PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKanji PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyGender PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyIdNumber PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastName PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKana PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKanji PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyMaidenName PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe PostAccountPeopleRequestBodyMetadata'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants
postAccountPeopleRequestBodyMetadata PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyNationality PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPersonToken PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPhone PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPoliticalExposure PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text -> Maybe PostAccountPeopleRequestBodyRelationship' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyRelationship'
postAccountPeopleRequestBodyRelationship PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodySsnLast_4 PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text -> Maybe PostAccountPeopleRequestBodyVerification' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyVerification'
postAccountPeopleRequestBodyVerification PostAccountPeopleRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPeopleRequestBody -> Encoding
toEncoding PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyAccount PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address" Text -> Maybe PostAccountPeopleRequestBodyAddress' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddress'
postAccountPeopleRequestBodyAddress PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text -> Maybe PostAccountPeopleRequestBodyAddressKana' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKana'
postAccountPeopleRequestBodyAddressKana PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text -> Maybe PostAccountPeopleRequestBodyAddressKanji' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyAddressKanji'
postAccountPeopleRequestBodyAddressKanji PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text -> Maybe PostAccountPeopleRequestBodyDob'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDob'Variants
postAccountPeopleRequestBodyDob PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text -> Maybe PostAccountPeopleRequestBodyDocuments' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyDocuments'
postAccountPeopleRequestBodyDocuments PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyEmail PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe [Text]
postAccountPeopleRequestBodyExpand PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstName PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKana PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyFirstNameKanji PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyGender PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyIdNumber PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastName PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKana PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyLastNameKanji PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyMaidenName PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants
postAccountPeopleRequestBodyMetadata PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyNationality PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPersonToken PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPhone PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodyPoliticalExposure PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text -> Maybe PostAccountPeopleRequestBodyRelationship' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyRelationship'
postAccountPeopleRequestBodyRelationship PostAccountPeopleRequestBody
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..= PostAccountPeopleRequestBody -> Maybe Text
postAccountPeopleRequestBodySsnLast_4 PostAccountPeopleRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text -> Maybe PostAccountPeopleRequestBodyVerification' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPeopleRequestBody
-> Maybe PostAccountPeopleRequestBodyVerification'
postAccountPeopleRequestBodyVerification PostAccountPeopleRequestBody
obj)))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeopleRequestBody where
  parseJSON :: Value -> Parser PostAccountPeopleRequestBody
parseJSON = String
-> (Object -> Parser PostAccountPeopleRequestBody)
-> Value
-> Parser PostAccountPeopleRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPeopleRequestBody" (\Object
obj -> (((((((((((((((((((((((((Maybe Text
 -> Maybe PostAccountPeopleRequestBodyAddress'
 -> Maybe PostAccountPeopleRequestBodyAddressKana'
 -> Maybe PostAccountPeopleRequestBodyAddressKanji'
 -> Maybe PostAccountPeopleRequestBodyDob'Variants
 -> Maybe PostAccountPeopleRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPeopleRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountPeopleRequestBodyVerification'
 -> PostAccountPeopleRequestBody)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeopleRequestBodyAddress'
      -> Maybe PostAccountPeopleRequestBodyAddressKana'
      -> Maybe PostAccountPeopleRequestBodyAddressKanji'
      -> Maybe PostAccountPeopleRequestBodyDob'Variants
      -> Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe PostAccountPeopleRequestBodyAddress'
-> Maybe PostAccountPeopleRequestBodyAddressKana'
-> Maybe PostAccountPeopleRequestBodyAddressKanji'
-> Maybe PostAccountPeopleRequestBodyDob'Variants
-> Maybe PostAccountPeopleRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBody
PostAccountPeopleRequestBody Parser
  (Maybe Text
   -> Maybe PostAccountPeopleRequestBodyAddress'
   -> Maybe PostAccountPeopleRequestBodyAddressKana'
   -> Maybe PostAccountPeopleRequestBodyAddressKanji'
   -> Maybe PostAccountPeopleRequestBodyDob'Variants
   -> Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeopleRequestBodyAddress'
      -> Maybe PostAccountPeopleRequestBodyAddressKana'
      -> Maybe PostAccountPeopleRequestBodyAddressKanji'
      -> Maybe PostAccountPeopleRequestBodyDob'Variants
      -> Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyAddress'
   -> Maybe PostAccountPeopleRequestBodyAddressKana'
   -> Maybe PostAccountPeopleRequestBodyAddressKanji'
   -> Maybe PostAccountPeopleRequestBodyDob'Variants
   -> Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyAddress')
-> Parser
     (Maybe PostAccountPeopleRequestBodyAddressKana'
      -> Maybe PostAccountPeopleRequestBodyAddressKanji'
      -> Maybe PostAccountPeopleRequestBodyDob'Variants
      -> Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountPeopleRequestBodyAddressKana'
   -> Maybe PostAccountPeopleRequestBodyAddressKanji'
   -> Maybe PostAccountPeopleRequestBodyDob'Variants
   -> Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountPeopleRequestBodyAddressKanji'
      -> Maybe PostAccountPeopleRequestBodyDob'Variants
      -> Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountPeopleRequestBodyAddressKanji'
   -> Maybe PostAccountPeopleRequestBodyDob'Variants
   -> Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountPeopleRequestBodyDob'Variants
      -> Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountPeopleRequestBodyDob'Variants
   -> Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountPeopleRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountPeopleRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyDocuments')
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> 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 PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeopleRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPeopleRequestBodyMetadata'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 PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeopleRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPeopleRequestBodyVerification'
      -> PostAccountPeopleRequestBody)
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 PostAccountPeopleRequestBodyVerification'
   -> PostAccountPeopleRequestBody)
-> Parser (Maybe PostAccountPeopleRequestBodyVerification')
-> Parser PostAccountPeopleRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPeopleRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountPeopleRequestBody' with all required fields.
mkPostAccountPeopleRequestBody :: PostAccountPeopleRequestBody
mkPostAccountPeopleRequestBody :: PostAccountPeopleRequestBody
mkPostAccountPeopleRequestBody =
  PostAccountPeopleRequestBody :: Maybe Text
-> Maybe PostAccountPeopleRequestBodyAddress'
-> Maybe PostAccountPeopleRequestBodyAddressKana'
-> Maybe PostAccountPeopleRequestBodyAddressKanji'
-> Maybe PostAccountPeopleRequestBodyDob'Variants
-> Maybe PostAccountPeopleRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBody
PostAccountPeopleRequestBody
    { postAccountPeopleRequestBodyAccount :: Maybe Text
postAccountPeopleRequestBodyAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyAddress :: Maybe PostAccountPeopleRequestBodyAddress'
postAccountPeopleRequestBodyAddress = Maybe PostAccountPeopleRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyAddressKana :: Maybe PostAccountPeopleRequestBodyAddressKana'
postAccountPeopleRequestBodyAddressKana = Maybe PostAccountPeopleRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyAddressKanji :: Maybe PostAccountPeopleRequestBodyAddressKanji'
postAccountPeopleRequestBodyAddressKanji = Maybe PostAccountPeopleRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyDob :: Maybe PostAccountPeopleRequestBodyDob'Variants
postAccountPeopleRequestBodyDob = Maybe PostAccountPeopleRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyDocuments :: Maybe PostAccountPeopleRequestBodyDocuments'
postAccountPeopleRequestBodyDocuments = Maybe PostAccountPeopleRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyEmail :: Maybe Text
postAccountPeopleRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyExpand :: Maybe [Text]
postAccountPeopleRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyFirstName :: Maybe Text
postAccountPeopleRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyFirstNameKana :: Maybe Text
postAccountPeopleRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyFirstNameKanji :: Maybe Text
postAccountPeopleRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyGender :: Maybe Text
postAccountPeopleRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyIdNumber :: Maybe Text
postAccountPeopleRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyLastName :: Maybe Text
postAccountPeopleRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyLastNameKana :: Maybe Text
postAccountPeopleRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyLastNameKanji :: Maybe Text
postAccountPeopleRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyMaidenName :: Maybe Text
postAccountPeopleRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyMetadata :: Maybe PostAccountPeopleRequestBodyMetadata'Variants
postAccountPeopleRequestBodyMetadata = Maybe PostAccountPeopleRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyNationality :: Maybe Text
postAccountPeopleRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyPersonToken :: Maybe Text
postAccountPeopleRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyPhone :: Maybe Text
postAccountPeopleRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyPoliticalExposure :: Maybe Text
postAccountPeopleRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyRelationship :: Maybe PostAccountPeopleRequestBodyRelationship'
postAccountPeopleRequestBodyRelationship = Maybe PostAccountPeopleRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodySsnLast_4 :: Maybe Text
postAccountPeopleRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyVerification :: Maybe PostAccountPeopleRequestBodyVerification'
postAccountPeopleRequestBodyVerification = Maybe PostAccountPeopleRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeopleRequestBodyDob'Variants where
  parseJSON :: Value -> Parser PostAccountPeopleRequestBodyDob'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountPeopleRequestBodyDob'Variants
-> Parser PostAccountPeopleRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyDob'Variants
PostAccountPeopleRequestBodyDob'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostAccountPeopleRequestBodyDob'OneOf1
-> PostAccountPeopleRequestBodyDob'Variants
PostAccountPeopleRequestBodyDob'PostAccountPeopleRequestBodyDob'OneOf1 (PostAccountPeopleRequestBodyDob'OneOf1
 -> PostAccountPeopleRequestBodyDob'Variants)
-> Result PostAccountPeopleRequestBodyDob'OneOf1
-> Result PostAccountPeopleRequestBodyDob'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostAccountPeopleRequestBodyDob'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostAccountPeopleRequestBodyDob'Variants
-> Result PostAccountPeopleRequestBodyDob'Variants
-> Result PostAccountPeopleRequestBodyDob'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostAccountPeopleRequestBodyDob'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountPeopleRequestBodyDob'Variants
a -> PostAccountPeopleRequestBodyDob'Variants
-> Parser PostAccountPeopleRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyDob'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostAccountPeopleRequestBodyDob'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.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 PostAccountPeopleRequestBodyDocuments' = PostAccountPeopleRequestBodyDocuments'
  { -- | company_authorization
    PostAccountPeopleRequestBodyDocuments'
-> Maybe
     PostAccountPeopleRequestBodyDocuments'CompanyAuthorization'
postAccountPeopleRequestBodyDocuments'CompanyAuthorization :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyDocuments'CompanyAuthorization'),
    -- | passport
    PostAccountPeopleRequestBodyDocuments'
-> Maybe PostAccountPeopleRequestBodyDocuments'Passport'
postAccountPeopleRequestBodyDocuments'Passport :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyDocuments'Passport'),
    -- | visa
    PostAccountPeopleRequestBodyDocuments'
-> Maybe PostAccountPeopleRequestBodyDocuments'Visa'
postAccountPeopleRequestBodyDocuments'Visa :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyDocuments'Visa')
  }
  deriving
    ( Int -> PostAccountPeopleRequestBodyDocuments' -> ShowS
[PostAccountPeopleRequestBodyDocuments'] -> ShowS
PostAccountPeopleRequestBodyDocuments' -> String
(Int -> PostAccountPeopleRequestBodyDocuments' -> ShowS)
-> (PostAccountPeopleRequestBodyDocuments' -> String)
-> ([PostAccountPeopleRequestBodyDocuments'] -> ShowS)
-> Show PostAccountPeopleRequestBodyDocuments'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAccountPeopleRequestBodyDocuments'] -> ShowS
$cshowList :: [PostAccountPeopleRequestBodyDocuments'] -> ShowS
show :: PostAccountPeopleRequestBodyDocuments' -> String
$cshow :: PostAccountPeopleRequestBodyDocuments' -> String
showsPrec :: Int -> PostAccountPeopleRequestBodyDocuments' -> ShowS
$cshowsPrec :: Int -> PostAccountPeopleRequestBodyDocuments' -> ShowS
GHC.Show.Show,
      PostAccountPeopleRequestBodyDocuments'
-> PostAccountPeopleRequestBodyDocuments' -> Bool
(PostAccountPeopleRequestBodyDocuments'
 -> PostAccountPeopleRequestBodyDocuments' -> Bool)
-> (PostAccountPeopleRequestBodyDocuments'
    -> PostAccountPeopleRequestBodyDocuments' -> Bool)
-> Eq PostAccountPeopleRequestBodyDocuments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeopleRequestBodyDocuments'
-> PostAccountPeopleRequestBodyDocuments' -> Bool
$c/= :: PostAccountPeopleRequestBodyDocuments'
-> PostAccountPeopleRequestBodyDocuments' -> Bool
== :: PostAccountPeopleRequestBodyDocuments'
-> PostAccountPeopleRequestBodyDocuments' -> Bool
$c== :: PostAccountPeopleRequestBodyDocuments'
-> PostAccountPeopleRequestBodyDocuments' -> Bool
GHC.Classes.Eq
    )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeopleRequestBodyMetadata'Variants where
  parseJSON :: Value -> Parser PostAccountPeopleRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountPeopleRequestBodyMetadata'Variants
-> Parser PostAccountPeopleRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyMetadata'Variants
PostAccountPeopleRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object -> PostAccountPeopleRequestBodyMetadata'Variants
PostAccountPeopleRequestBodyMetadata'Object (Object -> PostAccountPeopleRequestBodyMetadata'Variants)
-> Result Object
-> Result PostAccountPeopleRequestBodyMetadata'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 PostAccountPeopleRequestBodyMetadata'Variants
-> Result PostAccountPeopleRequestBodyMetadata'Variants
-> Result PostAccountPeopleRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostAccountPeopleRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountPeopleRequestBodyMetadata'Variants
a -> PostAccountPeopleRequestBodyMetadata'Variants
-> Parser PostAccountPeopleRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostAccountPeopleRequestBodyMetadata'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.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 PostAccountPeopleRequestBodyRelationship' = PostAccountPeopleRequestBodyRelationship'
  { -- | director
    PostAccountPeopleRequestBodyRelationship' -> Maybe Bool
postAccountPeopleRequestBodyRelationship'Director :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | executive
    PostAccountPeopleRequestBodyRelationship' -> Maybe Bool
postAccountPeopleRequestBodyRelationship'Executive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | owner
    PostAccountPeopleRequestBodyRelationship' -> Maybe Bool
postAccountPeopleRequestBodyRelationship'Owner :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | percent_ownership
    PostAccountPeopleRequestBodyRelationship'
-> Maybe
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
postAccountPeopleRequestBodyRelationship'PercentOwnership :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants),
    -- | representative
    PostAccountPeopleRequestBodyRelationship' -> Maybe Bool
postAccountPeopleRequestBodyRelationship'Representative :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | title
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPeopleRequestBodyRelationship' -> Maybe Text
postAccountPeopleRequestBodyRelationship'Title :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostAccountPeopleRequestBodyRelationship' -> ShowS
[PostAccountPeopleRequestBodyRelationship'] -> ShowS
PostAccountPeopleRequestBodyRelationship' -> String
(Int -> PostAccountPeopleRequestBodyRelationship' -> ShowS)
-> (PostAccountPeopleRequestBodyRelationship' -> String)
-> ([PostAccountPeopleRequestBodyRelationship'] -> ShowS)
-> Show PostAccountPeopleRequestBodyRelationship'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAccountPeopleRequestBodyRelationship'] -> ShowS
$cshowList :: [PostAccountPeopleRequestBodyRelationship'] -> ShowS
show :: PostAccountPeopleRequestBodyRelationship' -> String
$cshow :: PostAccountPeopleRequestBodyRelationship' -> String
showsPrec :: Int -> PostAccountPeopleRequestBodyRelationship' -> ShowS
$cshowsPrec :: Int -> PostAccountPeopleRequestBodyRelationship' -> ShowS
GHC.Show.Show,
      PostAccountPeopleRequestBodyRelationship'
-> PostAccountPeopleRequestBodyRelationship' -> Bool
(PostAccountPeopleRequestBodyRelationship'
 -> PostAccountPeopleRequestBodyRelationship' -> Bool)
-> (PostAccountPeopleRequestBodyRelationship'
    -> PostAccountPeopleRequestBodyRelationship' -> Bool)
-> Eq PostAccountPeopleRequestBodyRelationship'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeopleRequestBodyRelationship'
-> PostAccountPeopleRequestBodyRelationship' -> Bool
$c/= :: PostAccountPeopleRequestBodyRelationship'
-> PostAccountPeopleRequestBodyRelationship' -> Bool
== :: PostAccountPeopleRequestBodyRelationship'
-> PostAccountPeopleRequestBodyRelationship' -> Bool
$c== :: PostAccountPeopleRequestBodyRelationship'
-> PostAccountPeopleRequestBodyRelationship' -> Bool
GHC.Classes.Eq
    )

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants where
  parseJSON :: Value
-> Parser
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
-> Parser
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
PostAccountPeopleRequestBodyRelationship'PercentOwnership'EmptyString
        | Bool
GHC.Base.otherwise -> case (Double
-> PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
PostAccountPeopleRequestBodyRelationship'PercentOwnership'Double (Double
 -> PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants)
-> Result Double
-> Result
     PostAccountPeopleRequestBodyRelationship'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
  PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
-> Result
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
-> Result
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
a -> PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
-> Parser
     PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPeopleRequestBodyRelationship'PercentOwnership'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostAccountPeopleRequestBodyRelationship'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.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.verification@ in the specification.
--
-- The person\'s verification status.
data PostAccountPeopleRequestBodyVerification' = PostAccountPeopleRequestBodyVerification'
  { -- | additional_document
    PostAccountPeopleRequestBodyVerification'
-> Maybe
     PostAccountPeopleRequestBodyVerification'AdditionalDocument'
postAccountPeopleRequestBodyVerification'AdditionalDocument :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyVerification'AdditionalDocument'),
    -- | document
    PostAccountPeopleRequestBodyVerification'
-> Maybe PostAccountPeopleRequestBodyVerification'Document'
postAccountPeopleRequestBodyVerification'Document :: (GHC.Maybe.Maybe PostAccountPeopleRequestBodyVerification'Document')
  }
  deriving
    ( Int -> PostAccountPeopleRequestBodyVerification' -> ShowS
[PostAccountPeopleRequestBodyVerification'] -> ShowS
PostAccountPeopleRequestBodyVerification' -> String
(Int -> PostAccountPeopleRequestBodyVerification' -> ShowS)
-> (PostAccountPeopleRequestBodyVerification' -> String)
-> ([PostAccountPeopleRequestBodyVerification'] -> ShowS)
-> Show PostAccountPeopleRequestBodyVerification'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAccountPeopleRequestBodyVerification'] -> ShowS
$cshowList :: [PostAccountPeopleRequestBodyVerification'] -> ShowS
show :: PostAccountPeopleRequestBodyVerification' -> String
$cshow :: PostAccountPeopleRequestBodyVerification' -> String
showsPrec :: Int -> PostAccountPeopleRequestBodyVerification' -> ShowS
$cshowsPrec :: Int -> PostAccountPeopleRequestBodyVerification' -> ShowS
GHC.Show.Show,
      PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBodyVerification' -> Bool
(PostAccountPeopleRequestBodyVerification'
 -> PostAccountPeopleRequestBodyVerification' -> Bool)
-> (PostAccountPeopleRequestBodyVerification'
    -> PostAccountPeopleRequestBodyVerification' -> Bool)
-> Eq PostAccountPeopleRequestBodyVerification'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBodyVerification' -> Bool
$c/= :: PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBodyVerification' -> Bool
== :: PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBodyVerification' -> Bool
$c== :: PostAccountPeopleRequestBodyVerification'
-> PostAccountPeopleRequestBodyVerification' -> Bool
GHC.Classes.Eq
    )

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

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

-- | Create a new 'PostAccountPeopleRequestBodyVerification'' with all required fields.
mkPostAccountPeopleRequestBodyVerification' :: PostAccountPeopleRequestBodyVerification'
mkPostAccountPeopleRequestBodyVerification' :: PostAccountPeopleRequestBodyVerification'
mkPostAccountPeopleRequestBodyVerification' =
  PostAccountPeopleRequestBodyVerification' :: Maybe PostAccountPeopleRequestBodyVerification'AdditionalDocument'
-> Maybe PostAccountPeopleRequestBodyVerification'Document'
-> PostAccountPeopleRequestBodyVerification'
PostAccountPeopleRequestBodyVerification'
    { postAccountPeopleRequestBodyVerification'AdditionalDocument :: Maybe PostAccountPeopleRequestBodyVerification'AdditionalDocument'
postAccountPeopleRequestBodyVerification'AdditionalDocument = Maybe PostAccountPeopleRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPeopleRequestBodyVerification'Document :: Maybe PostAccountPeopleRequestBodyVerification'Document'
postAccountPeopleRequestBodyVerification'Document = Maybe PostAccountPeopleRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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