{-# 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 postAccountsAccountPersons
module StripeAPI.Operations.PostAccountsAccountPersons where

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

-- | > POST /v1/accounts/{account}/persons
--
-- \<p>Creates a new person.\<\/p>
postAccountsAccountPersons ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | account | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostAccountsAccountPersonsResponse)
postAccountsAccountPersons :: Text
-> Maybe PostAccountsAccountPersonsRequestBody
-> StripeT m (Response PostAccountsAccountPersonsResponse)
postAccountsAccountPersons
  Text
account
  Maybe PostAccountsAccountPersonsRequestBody
body =
    (Response ByteString
 -> Response PostAccountsAccountPersonsResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostAccountsAccountPersonsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostAccountsAccountPersonsResponse)
-> Response ByteString
-> Response PostAccountsAccountPersonsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostAccountsAccountPersonsResponse)
-> (PostAccountsAccountPersonsResponse
    -> PostAccountsAccountPersonsResponse)
-> Either String PostAccountsAccountPersonsResponse
-> PostAccountsAccountPersonsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountsAccountPersonsResponse
PostAccountsAccountPersonsResponseError PostAccountsAccountPersonsResponse
-> PostAccountsAccountPersonsResponse
forall a. a -> a
GHC.Base.id
                (Either String PostAccountsAccountPersonsResponse
 -> PostAccountsAccountPersonsResponse)
-> (ByteString -> Either String PostAccountsAccountPersonsResponse)
-> ByteString
-> PostAccountsAccountPersonsResponse
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 -> PostAccountsAccountPersonsResponse
PostAccountsAccountPersonsResponse200
                                       (Person -> PostAccountsAccountPersonsResponse)
-> Either String Person
-> Either String PostAccountsAccountPersonsResponse
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 -> PostAccountsAccountPersonsResponse
PostAccountsAccountPersonsResponseDefault
                                       (Error -> PostAccountsAccountPersonsResponse)
-> Either String Error
-> Either String PostAccountsAccountPersonsResponse
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 PostAccountsAccountPersonsResponse
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 PostAccountsAccountPersonsRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack (String
"/v1/accounts/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel Text
account)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
"/persons"))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountsAccountPersonsRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/persons.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountsAccountPersonsRequestBody = PostAccountsAccountPersonsRequestBody
  { -- | address: The person\'s address.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddress'
postAccountsAccountPersonsRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
postAccountsAccountPersonsRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
postAccountsAccountPersonsRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
postAccountsAccountPersonsRequestBodyDob :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
postAccountsAccountPersonsRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountsAccountPersonsRequestBody -> Maybe [Text]
postAccountsAccountPersonsRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstName :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKana :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyGender :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastName :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKana :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyMaidenName :: (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\`.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
postAccountsAccountPersonsRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyMetadata'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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyNationality :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPhone :: (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
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
postAccountsAccountPersonsRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
postAccountsAccountPersonsRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountsAccountPersonsRequestBodyVerification')
  }
  deriving
    ( Int -> PostAccountsAccountPersonsRequestBody -> String -> String
[PostAccountsAccountPersonsRequestBody] -> String -> String
PostAccountsAccountPersonsRequestBody -> String
(Int -> PostAccountsAccountPersonsRequestBody -> String -> String)
-> (PostAccountsAccountPersonsRequestBody -> String)
-> ([PostAccountsAccountPersonsRequestBody] -> String -> String)
-> Show PostAccountsAccountPersonsRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPersonsRequestBody] -> String -> String
$cshowList :: [PostAccountsAccountPersonsRequestBody] -> String -> String
show :: PostAccountsAccountPersonsRequestBody -> String
$cshow :: PostAccountsAccountPersonsRequestBody -> String
showsPrec :: Int -> PostAccountsAccountPersonsRequestBody -> String -> String
$cshowsPrec :: Int -> PostAccountsAccountPersonsRequestBody -> String -> String
GHC.Show.Show,
      PostAccountsAccountPersonsRequestBody
-> PostAccountsAccountPersonsRequestBody -> Bool
(PostAccountsAccountPersonsRequestBody
 -> PostAccountsAccountPersonsRequestBody -> Bool)
-> (PostAccountsAccountPersonsRequestBody
    -> PostAccountsAccountPersonsRequestBody -> Bool)
-> Eq PostAccountsAccountPersonsRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPersonsRequestBody
-> PostAccountsAccountPersonsRequestBody -> Bool
$c/= :: PostAccountsAccountPersonsRequestBody
-> PostAccountsAccountPersonsRequestBody -> Bool
== :: PostAccountsAccountPersonsRequestBody
-> PostAccountsAccountPersonsRequestBody -> Bool
$c== :: PostAccountsAccountPersonsRequestBody
-> PostAccountsAccountPersonsRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPersonsRequestBody where
  toJSON :: PostAccountsAccountPersonsRequestBody -> Value
toJSON PostAccountsAccountPersonsRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text -> Maybe PostAccountsAccountPersonsRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddress'
postAccountsAccountPersonsRequestBodyAddress PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
postAccountsAccountPersonsRequestBodyAddressKana PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
postAccountsAccountPersonsRequestBodyAddressKanji PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
postAccountsAccountPersonsRequestBodyDob PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
postAccountsAccountPersonsRequestBodyDocuments PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyEmail PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe [Text]
postAccountsAccountPersonsRequestBodyExpand PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstName PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKana PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKanji PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyGender PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyIdNumber PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastName PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKana PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKanji PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyMaidenName PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
postAccountsAccountPersonsRequestBodyMetadata PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyNationality PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPersonToken PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPhone PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPoliticalExposure PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
postAccountsAccountPersonsRequestBodyRelationship PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodySsnLast_4 PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text
-> Maybe PostAccountsAccountPersonsRequestBodyVerification' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
postAccountsAccountPersonsRequestBodyVerification PostAccountsAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPersonsRequestBody -> Encoding
toEncoding PostAccountsAccountPersonsRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe PostAccountsAccountPersonsRequestBodyAddress' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddress'
postAccountsAccountPersonsRequestBodyAddress PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
postAccountsAccountPersonsRequestBodyAddressKana PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
postAccountsAccountPersonsRequestBodyAddressKanji PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
postAccountsAccountPersonsRequestBodyDob PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
postAccountsAccountPersonsRequestBodyDocuments PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyEmail PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe [Text]
postAccountsAccountPersonsRequestBodyExpand PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstName PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKana PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKanji PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyGender PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyIdNumber PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastName PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKana PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKanji PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyMaidenName PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
postAccountsAccountPersonsRequestBodyMetadata PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyNationality PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPersonToken PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPhone PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodyPoliticalExposure PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
postAccountsAccountPersonsRequestBodyRelationship PostAccountsAccountPersonsRequestBody
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..= PostAccountsAccountPersonsRequestBody -> Maybe Text
postAccountsAccountPersonsRequestBodySsnLast_4 PostAccountsAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsRequestBody
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
postAccountsAccountPersonsRequestBodyVerification PostAccountsAccountPersonsRequestBody
obj))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPersonsRequestBody where
  parseJSON :: Value -> Parser PostAccountsAccountPersonsRequestBody
parseJSON = String
-> (Object -> Parser PostAccountsAccountPersonsRequestBody)
-> Value
-> Parser PostAccountsAccountPersonsRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPersonsRequestBody" (\Object
obj -> ((((((((((((((((((((((((Maybe PostAccountsAccountPersonsRequestBodyAddress'
 -> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
 -> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
 -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
 -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
 -> PostAccountsAccountPersonsRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyAddress'
      -> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostAccountsAccountPersonsRequestBodyAddress'
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
-> PostAccountsAccountPersonsRequestBody
PostAccountsAccountPersonsRequestBody Parser
  (Maybe PostAccountsAccountPersonsRequestBodyAddress'
   -> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyAddress')
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountsAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountsAccountPersonsRequestBodyDocuments')
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> 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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyMetadata'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 PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyVerification'
      -> PostAccountsAccountPersonsRequestBody)
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 PostAccountsAccountPersonsRequestBodyVerification'
   -> PostAccountsAccountPersonsRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyVerification')
-> Parser PostAccountsAccountPersonsRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountsAccountPersonsRequestBody' with all required fields.
mkPostAccountsAccountPersonsRequestBody :: PostAccountsAccountPersonsRequestBody
mkPostAccountsAccountPersonsRequestBody :: PostAccountsAccountPersonsRequestBody
mkPostAccountsAccountPersonsRequestBody =
  PostAccountsAccountPersonsRequestBody :: Maybe PostAccountsAccountPersonsRequestBodyAddress'
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
-> Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
-> Maybe PostAccountsAccountPersonsRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPersonsRequestBodyVerification'
-> PostAccountsAccountPersonsRequestBody
PostAccountsAccountPersonsRequestBody
    { postAccountsAccountPersonsRequestBodyAddress :: Maybe PostAccountsAccountPersonsRequestBodyAddress'
postAccountsAccountPersonsRequestBodyAddress = Maybe PostAccountsAccountPersonsRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyAddressKana :: Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
postAccountsAccountPersonsRequestBodyAddressKana = Maybe PostAccountsAccountPersonsRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyAddressKanji :: Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
postAccountsAccountPersonsRequestBodyAddressKanji = Maybe PostAccountsAccountPersonsRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyDob :: Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
postAccountsAccountPersonsRequestBodyDob = Maybe PostAccountsAccountPersonsRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyDocuments :: Maybe PostAccountsAccountPersonsRequestBodyDocuments'
postAccountsAccountPersonsRequestBodyDocuments = Maybe PostAccountsAccountPersonsRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyEmail :: Maybe Text
postAccountsAccountPersonsRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyExpand :: Maybe [Text]
postAccountsAccountPersonsRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyFirstName :: Maybe Text
postAccountsAccountPersonsRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyFirstNameKana :: Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyFirstNameKanji :: Maybe Text
postAccountsAccountPersonsRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyGender :: Maybe Text
postAccountsAccountPersonsRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyIdNumber :: Maybe Text
postAccountsAccountPersonsRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyLastName :: Maybe Text
postAccountsAccountPersonsRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyLastNameKana :: Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyLastNameKanji :: Maybe Text
postAccountsAccountPersonsRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyMaidenName :: Maybe Text
postAccountsAccountPersonsRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyMetadata :: Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
postAccountsAccountPersonsRequestBodyMetadata = Maybe PostAccountsAccountPersonsRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyNationality :: Maybe Text
postAccountsAccountPersonsRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyPersonToken :: Maybe Text
postAccountsAccountPersonsRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyPhone :: Maybe Text
postAccountsAccountPersonsRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyPoliticalExposure :: Maybe Text
postAccountsAccountPersonsRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyRelationship :: Maybe PostAccountsAccountPersonsRequestBodyRelationship'
postAccountsAccountPersonsRequestBodyRelationship = Maybe PostAccountsAccountPersonsRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodySsnLast_4 :: Maybe Text
postAccountsAccountPersonsRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyVerification :: Maybe PostAccountsAccountPersonsRequestBodyVerification'
postAccountsAccountPersonsRequestBodyVerification = Maybe PostAccountsAccountPersonsRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Create a new 'PostAccountsAccountPersonsRequestBodyVerification'' with all required fields.
mkPostAccountsAccountPersonsRequestBodyVerification' :: PostAccountsAccountPersonsRequestBodyVerification'
mkPostAccountsAccountPersonsRequestBodyVerification' :: PostAccountsAccountPersonsRequestBodyVerification'
mkPostAccountsAccountPersonsRequestBodyVerification' =
  PostAccountsAccountPersonsRequestBodyVerification' :: Maybe
  PostAccountsAccountPersonsRequestBodyVerification'AdditionalDocument'
-> Maybe
     PostAccountsAccountPersonsRequestBodyVerification'Document'
-> PostAccountsAccountPersonsRequestBodyVerification'
PostAccountsAccountPersonsRequestBodyVerification'
    { postAccountsAccountPersonsRequestBodyVerification'AdditionalDocument :: Maybe
  PostAccountsAccountPersonsRequestBodyVerification'AdditionalDocument'
postAccountsAccountPersonsRequestBodyVerification'AdditionalDocument = Maybe
  PostAccountsAccountPersonsRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsRequestBodyVerification'Document :: Maybe PostAccountsAccountPersonsRequestBodyVerification'Document'
postAccountsAccountPersonsRequestBodyVerification'Document = Maybe PostAccountsAccountPersonsRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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