{-# 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 postAccountPersons
module StripeAPI.Operations.PostAccountPersons where

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

-- | > POST /v1/account/persons
--
-- \<p>Creates a new person.\<\/p>
postAccountPersons ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountPersonsRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostAccountPersonsResponse)
postAccountPersons :: Maybe PostAccountPersonsRequestBody
-> StripeT m (Response PostAccountPersonsResponse)
postAccountPersons Maybe PostAccountPersonsRequestBody
body =
  (Response ByteString -> Response PostAccountPersonsResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostAccountPersonsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> PostAccountPersonsResponse)
-> Response ByteString -> Response PostAccountPersonsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> PostAccountPersonsResponse)
-> (PostAccountPersonsResponse -> PostAccountPersonsResponse)
-> Either String PostAccountPersonsResponse
-> PostAccountPersonsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountPersonsResponse
PostAccountPersonsResponseError PostAccountPersonsResponse -> PostAccountPersonsResponse
forall a. a -> a
GHC.Base.id
              (Either String PostAccountPersonsResponse
 -> PostAccountPersonsResponse)
-> (ByteString -> Either String PostAccountPersonsResponse)
-> ByteString
-> PostAccountPersonsResponse
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 -> PostAccountPersonsResponse
PostAccountPersonsResponse200
                                     (Person -> PostAccountPersonsResponse)
-> Either String Person -> Either String PostAccountPersonsResponse
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 -> PostAccountPersonsResponse
PostAccountPersonsResponseDefault
                                     (Error -> PostAccountPersonsResponse)
-> Either String Error -> Either String PostAccountPersonsResponse
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 PostAccountPersonsResponse
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 PostAccountPersonsRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack String
"/v1/account/persons") [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountPersonsRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/account\/persons.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountPersonsRequestBody = PostAccountPersonsRequestBody
  { -- | account
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address: The person\'s address.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddress'
postAccountPersonsRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKana'
postAccountPersonsRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKanji'
postAccountPersonsRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDob'Variants
postAccountPersonsRequestBodyDob :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDocuments'
postAccountPersonsRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountPersonsRequestBody -> Maybe [Text]
postAccountPersonsRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstName :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKana :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyGender :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastName :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKana :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyMaidenName :: (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\`.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants
postAccountPersonsRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyMetadata'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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyNationality :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPhone :: (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
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyRelationship'
postAccountPersonsRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyVerification'
postAccountPersonsRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountPersonsRequestBodyVerification')
  }
  deriving
    ( Int -> PostAccountPersonsRequestBody -> ShowS
[PostAccountPersonsRequestBody] -> ShowS
PostAccountPersonsRequestBody -> String
(Int -> PostAccountPersonsRequestBody -> ShowS)
-> (PostAccountPersonsRequestBody -> String)
-> ([PostAccountPersonsRequestBody] -> ShowS)
-> Show PostAccountPersonsRequestBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostAccountPersonsRequestBody] -> ShowS
$cshowList :: [PostAccountPersonsRequestBody] -> ShowS
show :: PostAccountPersonsRequestBody -> String
$cshow :: PostAccountPersonsRequestBody -> String
showsPrec :: Int -> PostAccountPersonsRequestBody -> ShowS
$cshowsPrec :: Int -> PostAccountPersonsRequestBody -> ShowS
GHC.Show.Show,
      PostAccountPersonsRequestBody
-> PostAccountPersonsRequestBody -> Bool
(PostAccountPersonsRequestBody
 -> PostAccountPersonsRequestBody -> Bool)
-> (PostAccountPersonsRequestBody
    -> PostAccountPersonsRequestBody -> Bool)
-> Eq PostAccountPersonsRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPersonsRequestBody
-> PostAccountPersonsRequestBody -> Bool
$c/= :: PostAccountPersonsRequestBody
-> PostAccountPersonsRequestBody -> Bool
== :: PostAccountPersonsRequestBody
-> PostAccountPersonsRequestBody -> Bool
$c== :: PostAccountPersonsRequestBody
-> PostAccountPersonsRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPersonsRequestBody where
  toJSON :: PostAccountPersonsRequestBody -> Value
toJSON PostAccountPersonsRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyAccount PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address" Text -> Maybe PostAccountPersonsRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddress'
postAccountPersonsRequestBodyAddress PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text -> Maybe PostAccountPersonsRequestBodyAddressKana' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKana'
postAccountPersonsRequestBodyAddressKana PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text -> Maybe PostAccountPersonsRequestBodyAddressKanji' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKanji'
postAccountPersonsRequestBodyAddressKanji PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text -> Maybe PostAccountPersonsRequestBodyDob'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDob'Variants
postAccountPersonsRequestBodyDob PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text -> Maybe PostAccountPersonsRequestBodyDocuments' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDocuments'
postAccountPersonsRequestBodyDocuments PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyEmail PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe [Text]
postAccountPersonsRequestBodyExpand PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstName PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKana PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKanji PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyGender PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyIdNumber PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastName PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKana PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKanji PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyMaidenName PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants
postAccountPersonsRequestBodyMetadata PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyNationality PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPersonToken PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPhone PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPoliticalExposure PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text -> Maybe PostAccountPersonsRequestBodyRelationship' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyRelationship'
postAccountPersonsRequestBodyRelationship PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodySsnLast_4 PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text -> Maybe PostAccountPersonsRequestBodyVerification' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyVerification'
postAccountPersonsRequestBodyVerification PostAccountPersonsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPersonsRequestBody -> Encoding
toEncoding PostAccountPersonsRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyAccount PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address" Text -> Maybe PostAccountPersonsRequestBodyAddress' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddress'
postAccountPersonsRequestBodyAddress PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text -> Maybe PostAccountPersonsRequestBodyAddressKana' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKana'
postAccountPersonsRequestBodyAddressKana PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text -> Maybe PostAccountPersonsRequestBodyAddressKanji' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyAddressKanji'
postAccountPersonsRequestBodyAddressKanji PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text -> Maybe PostAccountPersonsRequestBodyDob'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDob'Variants
postAccountPersonsRequestBodyDob PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text -> Maybe PostAccountPersonsRequestBodyDocuments' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyDocuments'
postAccountPersonsRequestBodyDocuments PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyEmail PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe [Text]
postAccountPersonsRequestBodyExpand PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstName PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKana PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyFirstNameKanji PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyGender PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyIdNumber PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastName PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKana PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyLastNameKanji PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyMaidenName PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants
postAccountPersonsRequestBodyMetadata PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyNationality PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPersonToken PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPhone PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodyPoliticalExposure PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text -> Maybe PostAccountPersonsRequestBodyRelationship' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyRelationship'
postAccountPersonsRequestBodyRelationship PostAccountPersonsRequestBody
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..= PostAccountPersonsRequestBody -> Maybe Text
postAccountPersonsRequestBodySsnLast_4 PostAccountPersonsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text -> Maybe PostAccountPersonsRequestBodyVerification' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsRequestBody
-> Maybe PostAccountPersonsRequestBodyVerification'
postAccountPersonsRequestBodyVerification PostAccountPersonsRequestBody
obj)))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPersonsRequestBody where
  parseJSON :: Value -> Parser PostAccountPersonsRequestBody
parseJSON = String
-> (Object -> Parser PostAccountPersonsRequestBody)
-> Value
-> Parser PostAccountPersonsRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPersonsRequestBody" (\Object
obj -> (((((((((((((((((((((((((Maybe Text
 -> Maybe PostAccountPersonsRequestBodyAddress'
 -> Maybe PostAccountPersonsRequestBodyAddressKana'
 -> Maybe PostAccountPersonsRequestBodyAddressKanji'
 -> Maybe PostAccountPersonsRequestBodyDob'Variants
 -> Maybe PostAccountPersonsRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPersonsRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountPersonsRequestBodyVerification'
 -> PostAccountPersonsRequestBody)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsRequestBodyAddress'
      -> Maybe PostAccountPersonsRequestBodyAddressKana'
      -> Maybe PostAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe PostAccountPersonsRequestBodyAddress'
-> Maybe PostAccountPersonsRequestBodyAddressKana'
-> Maybe PostAccountPersonsRequestBodyAddressKanji'
-> Maybe PostAccountPersonsRequestBodyDob'Variants
-> Maybe PostAccountPersonsRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyVerification'
-> PostAccountPersonsRequestBody
PostAccountPersonsRequestBody Parser
  (Maybe Text
   -> Maybe PostAccountPersonsRequestBodyAddress'
   -> Maybe PostAccountPersonsRequestBodyAddressKana'
   -> Maybe PostAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsRequestBodyAddress'
      -> Maybe PostAccountPersonsRequestBodyAddressKana'
      -> Maybe PostAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account")) Parser
  (Maybe PostAccountPersonsRequestBodyAddress'
   -> Maybe PostAccountPersonsRequestBodyAddressKana'
   -> Maybe PostAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyAddress')
-> Parser
     (Maybe PostAccountPersonsRequestBodyAddressKana'
      -> Maybe PostAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPersonsRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountPersonsRequestBodyAddressKana'
   -> Maybe PostAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountPersonsRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPersonsRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountPersonsRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountPersonsRequestBodyDob'Variants
      -> Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountPersonsRequestBodyDob'Variants
   -> Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountPersonsRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPersonsRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountPersonsRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostAccountPersonsRequestBodyDocuments')
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> 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 PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsRequestBodyMetadata'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 PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsRequestBodyVerification'
      -> PostAccountPersonsRequestBody)
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 PostAccountPersonsRequestBodyVerification'
   -> PostAccountPersonsRequestBody)
-> Parser (Maybe PostAccountPersonsRequestBodyVerification')
-> Parser PostAccountPersonsRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountPersonsRequestBody' with all required fields.
mkPostAccountPersonsRequestBody :: PostAccountPersonsRequestBody
mkPostAccountPersonsRequestBody :: PostAccountPersonsRequestBody
mkPostAccountPersonsRequestBody =
  PostAccountPersonsRequestBody :: Maybe Text
-> Maybe PostAccountPersonsRequestBodyAddress'
-> Maybe PostAccountPersonsRequestBodyAddressKana'
-> Maybe PostAccountPersonsRequestBodyAddressKanji'
-> Maybe PostAccountPersonsRequestBodyDob'Variants
-> Maybe PostAccountPersonsRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPersonsRequestBodyVerification'
-> PostAccountPersonsRequestBody
PostAccountPersonsRequestBody
    { postAccountPersonsRequestBodyAccount :: Maybe Text
postAccountPersonsRequestBodyAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyAddress :: Maybe PostAccountPersonsRequestBodyAddress'
postAccountPersonsRequestBodyAddress = Maybe PostAccountPersonsRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyAddressKana :: Maybe PostAccountPersonsRequestBodyAddressKana'
postAccountPersonsRequestBodyAddressKana = Maybe PostAccountPersonsRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyAddressKanji :: Maybe PostAccountPersonsRequestBodyAddressKanji'
postAccountPersonsRequestBodyAddressKanji = Maybe PostAccountPersonsRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyDob :: Maybe PostAccountPersonsRequestBodyDob'Variants
postAccountPersonsRequestBodyDob = Maybe PostAccountPersonsRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyDocuments :: Maybe PostAccountPersonsRequestBodyDocuments'
postAccountPersonsRequestBodyDocuments = Maybe PostAccountPersonsRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyEmail :: Maybe Text
postAccountPersonsRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyExpand :: Maybe [Text]
postAccountPersonsRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyFirstName :: Maybe Text
postAccountPersonsRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyFirstNameKana :: Maybe Text
postAccountPersonsRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyFirstNameKanji :: Maybe Text
postAccountPersonsRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyGender :: Maybe Text
postAccountPersonsRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyIdNumber :: Maybe Text
postAccountPersonsRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyLastName :: Maybe Text
postAccountPersonsRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyLastNameKana :: Maybe Text
postAccountPersonsRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyLastNameKanji :: Maybe Text
postAccountPersonsRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyMaidenName :: Maybe Text
postAccountPersonsRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyMetadata :: Maybe PostAccountPersonsRequestBodyMetadata'Variants
postAccountPersonsRequestBodyMetadata = Maybe PostAccountPersonsRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyNationality :: Maybe Text
postAccountPersonsRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyPersonToken :: Maybe Text
postAccountPersonsRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyPhone :: Maybe Text
postAccountPersonsRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyPoliticalExposure :: Maybe Text
postAccountPersonsRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyRelationship :: Maybe PostAccountPersonsRequestBodyRelationship'
postAccountPersonsRequestBodyRelationship = Maybe PostAccountPersonsRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodySsnLast_4 :: Maybe Text
postAccountPersonsRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyVerification :: Maybe PostAccountPersonsRequestBodyVerification'
postAccountPersonsRequestBodyVerification = Maybe PostAccountPersonsRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Create a new 'PostAccountPersonsRequestBodyVerification'' with all required fields.
mkPostAccountPersonsRequestBodyVerification' :: PostAccountPersonsRequestBodyVerification'
mkPostAccountPersonsRequestBodyVerification' :: PostAccountPersonsRequestBodyVerification'
mkPostAccountPersonsRequestBodyVerification' =
  PostAccountPersonsRequestBodyVerification' :: Maybe PostAccountPersonsRequestBodyVerification'AdditionalDocument'
-> Maybe PostAccountPersonsRequestBodyVerification'Document'
-> PostAccountPersonsRequestBodyVerification'
PostAccountPersonsRequestBodyVerification'
    { postAccountPersonsRequestBodyVerification'AdditionalDocument :: Maybe PostAccountPersonsRequestBodyVerification'AdditionalDocument'
postAccountPersonsRequestBodyVerification'AdditionalDocument = Maybe PostAccountPersonsRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsRequestBodyVerification'Document :: Maybe PostAccountPersonsRequestBodyVerification'Document'
postAccountPersonsRequestBodyVerification'Document = Maybe PostAccountPersonsRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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