{-# 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 postAccountPersonsPerson
module StripeAPI.Operations.PostAccountPersonsPerson 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/{person}
--
-- \<p>Updates an existing person.\<\/p>
postAccountPersonsPerson ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | person | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountPersonsPersonRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostAccountPersonsPersonResponse)
postAccountPersonsPerson :: Text
-> Maybe PostAccountPersonsPersonRequestBody
-> StripeT m (Response PostAccountPersonsPersonResponse)
postAccountPersonsPerson
  Text
person
  Maybe PostAccountPersonsPersonRequestBody
body =
    (Response ByteString -> Response PostAccountPersonsPersonResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostAccountPersonsPersonResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostAccountPersonsPersonResponse)
-> Response ByteString -> Response PostAccountPersonsPersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostAccountPersonsPersonResponse)
-> (PostAccountPersonsPersonResponse
    -> PostAccountPersonsPersonResponse)
-> Either String PostAccountPersonsPersonResponse
-> PostAccountPersonsPersonResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountPersonsPersonResponse
PostAccountPersonsPersonResponseError PostAccountPersonsPersonResponse
-> PostAccountPersonsPersonResponse
forall a. a -> a
GHC.Base.id
                (Either String PostAccountPersonsPersonResponse
 -> PostAccountPersonsPersonResponse)
-> (ByteString -> Either String PostAccountPersonsPersonResponse)
-> ByteString
-> PostAccountPersonsPersonResponse
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 -> PostAccountPersonsPersonResponse
PostAccountPersonsPersonResponse200
                                       (Person -> PostAccountPersonsPersonResponse)
-> Either String Person
-> Either String PostAccountPersonsPersonResponse
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 -> PostAccountPersonsPersonResponse
PostAccountPersonsPersonResponseDefault
                                       (Error -> PostAccountPersonsPersonResponse)
-> Either String Error
-> Either String PostAccountPersonsPersonResponse
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 PostAccountPersonsPersonResponse
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 PostAccountPersonsPersonRequestBody
-> 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/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel Text
person)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountPersonsPersonRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/account\/persons\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountPersonsPersonRequestBody = PostAccountPersonsPersonRequestBody
  { -- | account
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address: The person\'s address.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddress'
postAccountPersonsPersonRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
postAccountPersonsPersonRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
postAccountPersonsPersonRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
postAccountPersonsPersonRequestBodyDob :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'
postAccountPersonsPersonRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountPersonsPersonRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstName :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKana :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyGender :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastName :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKana :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyMaidenName :: (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\`.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
postAccountPersonsPersonRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyMetadata'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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyNationality :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPhone :: (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
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyRelationship'
postAccountPersonsPersonRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyVerification'
postAccountPersonsPersonRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyVerification')
  }
  deriving
    ( Int -> PostAccountPersonsPersonRequestBody -> String -> String
[PostAccountPersonsPersonRequestBody] -> String -> String
PostAccountPersonsPersonRequestBody -> String
(Int -> PostAccountPersonsPersonRequestBody -> String -> String)
-> (PostAccountPersonsPersonRequestBody -> String)
-> ([PostAccountPersonsPersonRequestBody] -> String -> String)
-> Show PostAccountPersonsPersonRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPersonsPersonRequestBody] -> String -> String
$cshowList :: [PostAccountPersonsPersonRequestBody] -> String -> String
show :: PostAccountPersonsPersonRequestBody -> String
$cshow :: PostAccountPersonsPersonRequestBody -> String
showsPrec :: Int -> PostAccountPersonsPersonRequestBody -> String -> String
$cshowsPrec :: Int -> PostAccountPersonsPersonRequestBody -> String -> String
GHC.Show.Show,
      PostAccountPersonsPersonRequestBody
-> PostAccountPersonsPersonRequestBody -> Bool
(PostAccountPersonsPersonRequestBody
 -> PostAccountPersonsPersonRequestBody -> Bool)
-> (PostAccountPersonsPersonRequestBody
    -> PostAccountPersonsPersonRequestBody -> Bool)
-> Eq PostAccountPersonsPersonRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPersonsPersonRequestBody
-> PostAccountPersonsPersonRequestBody -> Bool
$c/= :: PostAccountPersonsPersonRequestBody
-> PostAccountPersonsPersonRequestBody -> Bool
== :: PostAccountPersonsPersonRequestBody
-> PostAccountPersonsPersonRequestBody -> Bool
$c== :: PostAccountPersonsPersonRequestBody
-> PostAccountPersonsPersonRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountPersonsPersonRequestBody where
  toJSON :: PostAccountPersonsPersonRequestBody -> Value
toJSON PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyAccount PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address" Text -> Maybe PostAccountPersonsPersonRequestBodyAddress' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddress'
postAccountPersonsPersonRequestBodyAddress PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
postAccountPersonsPersonRequestBodyAddressKana PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
postAccountPersonsPersonRequestBodyAddressKanji PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
postAccountPersonsPersonRequestBodyDob PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text -> Maybe PostAccountPersonsPersonRequestBodyDocuments' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'
postAccountPersonsPersonRequestBodyDocuments PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyEmail PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountPersonsPersonRequestBodyExpand PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstName PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKana PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKanji PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyGender PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyIdNumber PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastName PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKana PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKanji PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyMaidenName PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
postAccountPersonsPersonRequestBodyMetadata PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyNationality PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPersonToken PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPhone PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPoliticalExposure PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text
-> Maybe PostAccountPersonsPersonRequestBodyRelationship' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyRelationship'
postAccountPersonsPersonRequestBodyRelationship PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodySsnLast_4 PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text
-> Maybe PostAccountPersonsPersonRequestBodyVerification' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyVerification'
postAccountPersonsPersonRequestBodyVerification PostAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountPersonsPersonRequestBody -> Encoding
toEncoding PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyAccount PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address" Text -> Maybe PostAccountPersonsPersonRequestBodyAddress' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddress'
postAccountPersonsPersonRequestBodyAddress PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
postAccountPersonsPersonRequestBodyAddressKana PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
postAccountPersonsPersonRequestBodyAddressKanji PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
postAccountPersonsPersonRequestBodyDob PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text
-> Maybe PostAccountPersonsPersonRequestBodyDocuments' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'
postAccountPersonsPersonRequestBodyDocuments PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyEmail PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountPersonsPersonRequestBodyExpand PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstName PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKana PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKanji PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyGender PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyIdNumber PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastName PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKana PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyLastNameKanji PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyMaidenName PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
postAccountPersonsPersonRequestBodyMetadata PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyNationality PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPersonToken PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPhone PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodyPoliticalExposure PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text
-> Maybe PostAccountPersonsPersonRequestBodyRelationship' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyRelationship'
postAccountPersonsPersonRequestBodyRelationship PostAccountPersonsPersonRequestBody
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..= PostAccountPersonsPersonRequestBody -> Maybe Text
postAccountPersonsPersonRequestBodySsnLast_4 PostAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text
-> Maybe PostAccountPersonsPersonRequestBodyVerification' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountPersonsPersonRequestBody
-> Maybe PostAccountPersonsPersonRequestBodyVerification'
postAccountPersonsPersonRequestBodyVerification PostAccountPersonsPersonRequestBody
obj)))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPersonsPersonRequestBody where
  parseJSON :: Value -> Parser PostAccountPersonsPersonRequestBody
parseJSON = String
-> (Object -> Parser PostAccountPersonsPersonRequestBody)
-> Value
-> Parser PostAccountPersonsPersonRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountPersonsPersonRequestBody" (\Object
obj -> (((((((((((((((((((((((((Maybe Text
 -> Maybe PostAccountPersonsPersonRequestBodyAddress'
 -> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
 -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
 -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
 -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountPersonsPersonRequestBodyVerification'
 -> PostAccountPersonsPersonRequestBody)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyAddress'
      -> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
      -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyAddress'
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyVerification'
-> PostAccountPersonsPersonRequestBody
PostAccountPersonsPersonRequestBody Parser
  (Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyAddress'
   -> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
   -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyAddress'
      -> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
      -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyAddress'
   -> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
   -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddress')
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyAddressKana'
      -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountPersonsPersonRequestBodyAddressKana'
   -> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyDocuments')
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> 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 PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyMetadata'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 PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountPersonsPersonRequestBodyVerification'
      -> PostAccountPersonsPersonRequestBody)
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 PostAccountPersonsPersonRequestBodyVerification'
   -> PostAccountPersonsPersonRequestBody)
-> Parser (Maybe PostAccountPersonsPersonRequestBodyVerification')
-> Parser PostAccountPersonsPersonRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostAccountPersonsPersonRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountPersonsPersonRequestBody' with all required fields.
mkPostAccountPersonsPersonRequestBody :: PostAccountPersonsPersonRequestBody
mkPostAccountPersonsPersonRequestBody :: PostAccountPersonsPersonRequestBody
mkPostAccountPersonsPersonRequestBody =
  PostAccountPersonsPersonRequestBody :: Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyAddress'
-> Maybe PostAccountPersonsPersonRequestBodyAddressKana'
-> Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
-> Maybe PostAccountPersonsPersonRequestBodyDob'Variants
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountPersonsPersonRequestBodyVerification'
-> PostAccountPersonsPersonRequestBody
PostAccountPersonsPersonRequestBody
    { postAccountPersonsPersonRequestBodyAccount :: Maybe Text
postAccountPersonsPersonRequestBodyAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyAddress :: Maybe PostAccountPersonsPersonRequestBodyAddress'
postAccountPersonsPersonRequestBodyAddress = Maybe PostAccountPersonsPersonRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyAddressKana :: Maybe PostAccountPersonsPersonRequestBodyAddressKana'
postAccountPersonsPersonRequestBodyAddressKana = Maybe PostAccountPersonsPersonRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyAddressKanji :: Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
postAccountPersonsPersonRequestBodyAddressKanji = Maybe PostAccountPersonsPersonRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyDob :: Maybe PostAccountPersonsPersonRequestBodyDob'Variants
postAccountPersonsPersonRequestBodyDob = Maybe PostAccountPersonsPersonRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyDocuments :: Maybe PostAccountPersonsPersonRequestBodyDocuments'
postAccountPersonsPersonRequestBodyDocuments = Maybe PostAccountPersonsPersonRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyEmail :: Maybe Text
postAccountPersonsPersonRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyExpand :: Maybe [Text]
postAccountPersonsPersonRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyFirstName :: Maybe Text
postAccountPersonsPersonRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyFirstNameKana :: Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyFirstNameKanji :: Maybe Text
postAccountPersonsPersonRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyGender :: Maybe Text
postAccountPersonsPersonRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyIdNumber :: Maybe Text
postAccountPersonsPersonRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyLastName :: Maybe Text
postAccountPersonsPersonRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyLastNameKana :: Maybe Text
postAccountPersonsPersonRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyLastNameKanji :: Maybe Text
postAccountPersonsPersonRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyMaidenName :: Maybe Text
postAccountPersonsPersonRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyMetadata :: Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
postAccountPersonsPersonRequestBodyMetadata = Maybe PostAccountPersonsPersonRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyNationality :: Maybe Text
postAccountPersonsPersonRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyPersonToken :: Maybe Text
postAccountPersonsPersonRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyPhone :: Maybe Text
postAccountPersonsPersonRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyPoliticalExposure :: Maybe Text
postAccountPersonsPersonRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyRelationship :: Maybe PostAccountPersonsPersonRequestBodyRelationship'
postAccountPersonsPersonRequestBodyRelationship = Maybe PostAccountPersonsPersonRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodySsnLast_4 :: Maybe Text
postAccountPersonsPersonRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyVerification :: Maybe PostAccountPersonsPersonRequestBodyVerification'
postAccountPersonsPersonRequestBodyVerification = Maybe PostAccountPersonsPersonRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPersonsPersonRequestBodyDob'Variants where
  parseJSON :: Value -> Parser PostAccountPersonsPersonRequestBodyDob'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountPersonsPersonRequestBodyDob'Variants
-> Parser PostAccountPersonsPersonRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPersonsPersonRequestBodyDob'Variants
PostAccountPersonsPersonRequestBodyDob'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostAccountPersonsPersonRequestBodyDob'OneOf1
-> PostAccountPersonsPersonRequestBodyDob'Variants
PostAccountPersonsPersonRequestBodyDob'PostAccountPersonsPersonRequestBodyDob'OneOf1 (PostAccountPersonsPersonRequestBodyDob'OneOf1
 -> PostAccountPersonsPersonRequestBodyDob'Variants)
-> Result PostAccountPersonsPersonRequestBodyDob'OneOf1
-> Result PostAccountPersonsPersonRequestBodyDob'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostAccountPersonsPersonRequestBodyDob'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostAccountPersonsPersonRequestBodyDob'Variants
-> Result PostAccountPersonsPersonRequestBodyDob'Variants
-> Result PostAccountPersonsPersonRequestBodyDob'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostAccountPersonsPersonRequestBodyDob'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountPersonsPersonRequestBodyDob'Variants
a -> PostAccountPersonsPersonRequestBodyDob'Variants
-> Parser PostAccountPersonsPersonRequestBodyDob'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPersonsPersonRequestBodyDob'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostAccountPersonsPersonRequestBodyDob'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\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.documents@ in the specification.
--
-- Documents that may be submitted to satisfy various informational requests.
data PostAccountPersonsPersonRequestBodyDocuments' = PostAccountPersonsPersonRequestBodyDocuments'
  { -- | company_authorization
    PostAccountPersonsPersonRequestBodyDocuments'
-> Maybe
     PostAccountPersonsPersonRequestBodyDocuments'CompanyAuthorization'
postAccountPersonsPersonRequestBodyDocuments'CompanyAuthorization :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyDocuments'CompanyAuthorization'),
    -- | passport
    PostAccountPersonsPersonRequestBodyDocuments'
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'Passport'
postAccountPersonsPersonRequestBodyDocuments'Passport :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyDocuments'Passport'),
    -- | visa
    PostAccountPersonsPersonRequestBodyDocuments'
-> Maybe PostAccountPersonsPersonRequestBodyDocuments'Visa'
postAccountPersonsPersonRequestBodyDocuments'Visa :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyDocuments'Visa')
  }
  deriving
    ( Int
-> PostAccountPersonsPersonRequestBodyDocuments'
-> String
-> String
[PostAccountPersonsPersonRequestBodyDocuments'] -> String -> String
PostAccountPersonsPersonRequestBodyDocuments' -> String
(Int
 -> PostAccountPersonsPersonRequestBodyDocuments'
 -> String
 -> String)
-> (PostAccountPersonsPersonRequestBodyDocuments' -> String)
-> ([PostAccountPersonsPersonRequestBodyDocuments']
    -> String -> String)
-> Show PostAccountPersonsPersonRequestBodyDocuments'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPersonsPersonRequestBodyDocuments'] -> String -> String
$cshowList :: [PostAccountPersonsPersonRequestBodyDocuments'] -> String -> String
show :: PostAccountPersonsPersonRequestBodyDocuments' -> String
$cshow :: PostAccountPersonsPersonRequestBodyDocuments' -> String
showsPrec :: Int
-> PostAccountPersonsPersonRequestBodyDocuments'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPersonsPersonRequestBodyDocuments'
-> String
-> String
GHC.Show.Show,
      PostAccountPersonsPersonRequestBodyDocuments'
-> PostAccountPersonsPersonRequestBodyDocuments' -> Bool
(PostAccountPersonsPersonRequestBodyDocuments'
 -> PostAccountPersonsPersonRequestBodyDocuments' -> Bool)
-> (PostAccountPersonsPersonRequestBodyDocuments'
    -> PostAccountPersonsPersonRequestBodyDocuments' -> Bool)
-> Eq PostAccountPersonsPersonRequestBodyDocuments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPersonsPersonRequestBodyDocuments'
-> PostAccountPersonsPersonRequestBodyDocuments' -> Bool
$c/= :: PostAccountPersonsPersonRequestBodyDocuments'
-> PostAccountPersonsPersonRequestBodyDocuments' -> Bool
== :: PostAccountPersonsPersonRequestBodyDocuments'
-> PostAccountPersonsPersonRequestBodyDocuments' -> Bool
$c== :: PostAccountPersonsPersonRequestBodyDocuments'
-> PostAccountPersonsPersonRequestBodyDocuments' -> Bool
GHC.Classes.Eq
    )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountPersonsPersonRequestBodyMetadata'Variants where
  parseJSON :: Value
-> Parser PostAccountPersonsPersonRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Parser PostAccountPersonsPersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPersonsPersonRequestBodyMetadata'Variants
PostAccountPersonsPersonRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object -> PostAccountPersonsPersonRequestBodyMetadata'Variants
PostAccountPersonsPersonRequestBodyMetadata'Object (Object -> PostAccountPersonsPersonRequestBodyMetadata'Variants)
-> Result Object
-> Result PostAccountPersonsPersonRequestBodyMetadata'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 PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Result PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Result PostAccountPersonsPersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostAccountPersonsPersonRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostAccountPersonsPersonRequestBodyMetadata'Variants
a -> PostAccountPersonsPersonRequestBodyMetadata'Variants
-> Parser PostAccountPersonsPersonRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostAccountPersonsPersonRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostAccountPersonsPersonRequestBodyMetadata'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\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.relationship@ in the specification.
--
-- The relationship that this person has with the account\'s legal entity.
data PostAccountPersonsPersonRequestBodyRelationship' = PostAccountPersonsPersonRequestBodyRelationship'
  { -- | director
    PostAccountPersonsPersonRequestBodyRelationship' -> Maybe Bool
postAccountPersonsPersonRequestBodyRelationship'Director :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | executive
    PostAccountPersonsPersonRequestBodyRelationship' -> Maybe Bool
postAccountPersonsPersonRequestBodyRelationship'Executive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | owner
    PostAccountPersonsPersonRequestBodyRelationship' -> Maybe Bool
postAccountPersonsPersonRequestBodyRelationship'Owner :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | percent_ownership
    PostAccountPersonsPersonRequestBodyRelationship'
-> Maybe
     PostAccountPersonsPersonRequestBodyRelationship'PercentOwnership'Variants
postAccountPersonsPersonRequestBodyRelationship'PercentOwnership :: (GHC.Maybe.Maybe PostAccountPersonsPersonRequestBodyRelationship'PercentOwnership'Variants),
    -- | representative
    PostAccountPersonsPersonRequestBodyRelationship' -> Maybe Bool
postAccountPersonsPersonRequestBodyRelationship'Representative :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | title
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountPersonsPersonRequestBodyRelationship' -> Maybe Text
postAccountPersonsPersonRequestBodyRelationship'Title :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostAccountPersonsPersonRequestBodyRelationship'
-> String
-> String
[PostAccountPersonsPersonRequestBodyRelationship']
-> String -> String
PostAccountPersonsPersonRequestBodyRelationship' -> String
(Int
 -> PostAccountPersonsPersonRequestBodyRelationship'
 -> String
 -> String)
-> (PostAccountPersonsPersonRequestBodyRelationship' -> String)
-> ([PostAccountPersonsPersonRequestBodyRelationship']
    -> String -> String)
-> Show PostAccountPersonsPersonRequestBodyRelationship'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountPersonsPersonRequestBodyRelationship']
-> String -> String
$cshowList :: [PostAccountPersonsPersonRequestBodyRelationship']
-> String -> String
show :: PostAccountPersonsPersonRequestBodyRelationship' -> String
$cshow :: PostAccountPersonsPersonRequestBodyRelationship' -> String
showsPrec :: Int
-> PostAccountPersonsPersonRequestBodyRelationship'
-> String
-> String
$cshowsPrec :: Int
-> PostAccountPersonsPersonRequestBodyRelationship'
-> String
-> String
GHC.Show.Show,
      PostAccountPersonsPersonRequestBodyRelationship'
-> PostAccountPersonsPersonRequestBodyRelationship' -> Bool
(PostAccountPersonsPersonRequestBodyRelationship'
 -> PostAccountPersonsPersonRequestBodyRelationship' -> Bool)
-> (PostAccountPersonsPersonRequestBodyRelationship'
    -> PostAccountPersonsPersonRequestBodyRelationship' -> Bool)
-> Eq PostAccountPersonsPersonRequestBodyRelationship'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountPersonsPersonRequestBodyRelationship'
-> PostAccountPersonsPersonRequestBodyRelationship' -> Bool
$c/= :: PostAccountPersonsPersonRequestBodyRelationship'
-> PostAccountPersonsPersonRequestBodyRelationship' -> Bool
== :: PostAccountPersonsPersonRequestBodyRelationship'
-> PostAccountPersonsPersonRequestBodyRelationship' -> Bool
$c== :: PostAccountPersonsPersonRequestBodyRelationship'
-> PostAccountPersonsPersonRequestBodyRelationship' -> Bool
GHC.Classes.Eq
    )

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

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

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

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

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

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

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

-- | Create a new 'PostAccountPersonsPersonRequestBodyVerification'' with all required fields.
mkPostAccountPersonsPersonRequestBodyVerification' :: PostAccountPersonsPersonRequestBodyVerification'
mkPostAccountPersonsPersonRequestBodyVerification' :: PostAccountPersonsPersonRequestBodyVerification'
mkPostAccountPersonsPersonRequestBodyVerification' =
  PostAccountPersonsPersonRequestBodyVerification' :: Maybe
  PostAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
-> Maybe PostAccountPersonsPersonRequestBodyVerification'Document'
-> PostAccountPersonsPersonRequestBodyVerification'
PostAccountPersonsPersonRequestBodyVerification'
    { postAccountPersonsPersonRequestBodyVerification'AdditionalDocument :: Maybe
  PostAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
postAccountPersonsPersonRequestBodyVerification'AdditionalDocument = Maybe
  PostAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountPersonsPersonRequestBodyVerification'Document :: Maybe PostAccountPersonsPersonRequestBodyVerification'Document'
postAccountPersonsPersonRequestBodyVerification'Document = Maybe PostAccountPersonsPersonRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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