{-# 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 postAccountsAccountPersonsPerson
module StripeAPI.Operations.PostAccountsAccountPersonsPerson where

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

-- | > POST /v1/accounts/{account}/persons/{person}
--
-- \<p>Updates an existing person.\<\/p>
postAccountsAccountPersonsPerson ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  PostAccountsAccountPersonsPersonParameters ->
  -- | The request body to send
  GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response PostAccountsAccountPersonsPersonResponse)
postAccountsAccountPersonsPerson :: PostAccountsAccountPersonsPersonParameters
-> Maybe PostAccountsAccountPersonsPersonRequestBody
-> ClientT m (Response PostAccountsAccountPersonsPersonResponse)
postAccountsAccountPersonsPerson
  PostAccountsAccountPersonsPersonParameters
parameters
  Maybe PostAccountsAccountPersonsPersonRequestBody
body =
    (Response ByteString
 -> Response PostAccountsAccountPersonsPersonResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response PostAccountsAccountPersonsPersonResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostAccountsAccountPersonsPersonResponse)
-> Response ByteString
-> Response PostAccountsAccountPersonsPersonResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostAccountsAccountPersonsPersonResponse)
-> (PostAccountsAccountPersonsPersonResponse
    -> PostAccountsAccountPersonsPersonResponse)
-> Either String PostAccountsAccountPersonsPersonResponse
-> PostAccountsAccountPersonsPersonResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostAccountsAccountPersonsPersonResponse
PostAccountsAccountPersonsPersonResponseError PostAccountsAccountPersonsPersonResponse
-> PostAccountsAccountPersonsPersonResponse
forall a. a -> a
GHC.Base.id
                (Either String PostAccountsAccountPersonsPersonResponse
 -> PostAccountsAccountPersonsPersonResponse)
-> (ByteString
    -> Either String PostAccountsAccountPersonsPersonResponse)
-> ByteString
-> PostAccountsAccountPersonsPersonResponse
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 -> PostAccountsAccountPersonsPersonResponse
PostAccountsAccountPersonsPersonResponse200
                                       (Person -> PostAccountsAccountPersonsPersonResponse)
-> Either String Person
-> Either String PostAccountsAccountPersonsPersonResponse
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 -> PostAccountsAccountPersonsPersonResponse
PostAccountsAccountPersonsPersonResponseDefault
                                       (Error -> PostAccountsAccountPersonsPersonResponse)
-> Either String Error
-> Either String PostAccountsAccountPersonsPersonResponse
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 PostAccountsAccountPersonsPersonResponse
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 PostAccountsAccountPersonsPersonRequestBody
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack (String
"/v1/accounts/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel (PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathAccount PostAccountsAccountPersonsPersonParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (String
"/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 (PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathPerson PostAccountsAccountPersonsPersonParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostAccountsAccountPersonsPersonRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/persons\/{person}.POST.parameters@ in the specification.
data PostAccountsAccountPersonsPersonParameters = PostAccountsAccountPersonsPersonParameters
  { -- | pathAccount: Represents the parameter named \'account\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathAccount :: Data.Text.Internal.Text,
    -- | pathPerson: Represents the parameter named \'person\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathPerson :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostAccountsAccountPersonsPersonParameters -> String -> String
[PostAccountsAccountPersonsPersonParameters] -> String -> String
PostAccountsAccountPersonsPersonParameters -> String
(Int
 -> PostAccountsAccountPersonsPersonParameters -> String -> String)
-> (PostAccountsAccountPersonsPersonParameters -> String)
-> ([PostAccountsAccountPersonsPersonParameters]
    -> String -> String)
-> Show PostAccountsAccountPersonsPersonParameters
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPersonsPersonParameters] -> String -> String
$cshowList :: [PostAccountsAccountPersonsPersonParameters] -> String -> String
show :: PostAccountsAccountPersonsPersonParameters -> String
$cshow :: PostAccountsAccountPersonsPersonParameters -> String
showsPrec :: Int
-> PostAccountsAccountPersonsPersonParameters -> String -> String
$cshowsPrec :: Int
-> PostAccountsAccountPersonsPersonParameters -> String -> String
GHC.Show.Show,
      PostAccountsAccountPersonsPersonParameters
-> PostAccountsAccountPersonsPersonParameters -> Bool
(PostAccountsAccountPersonsPersonParameters
 -> PostAccountsAccountPersonsPersonParameters -> Bool)
-> (PostAccountsAccountPersonsPersonParameters
    -> PostAccountsAccountPersonsPersonParameters -> Bool)
-> Eq PostAccountsAccountPersonsPersonParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPersonsPersonParameters
-> PostAccountsAccountPersonsPersonParameters -> Bool
$c/= :: PostAccountsAccountPersonsPersonParameters
-> PostAccountsAccountPersonsPersonParameters -> Bool
== :: PostAccountsAccountPersonsPersonParameters
-> PostAccountsAccountPersonsPersonParameters -> Bool
$c== :: PostAccountsAccountPersonsPersonParameters
-> PostAccountsAccountPersonsPersonParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPersonsPersonParameters where
  toJSON :: PostAccountsAccountPersonsPersonParameters -> Value
toJSON PostAccountsAccountPersonsPersonParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"pathAccount" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathAccount PostAccountsAccountPersonsPersonParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"pathPerson" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathPerson PostAccountsAccountPersonsPersonParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPersonsPersonParameters -> Encoding
toEncoding PostAccountsAccountPersonsPersonParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"pathAccount" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathAccount PostAccountsAccountPersonsPersonParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"pathPerson" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonParameters -> Text
postAccountsAccountPersonsPersonParametersPathPerson PostAccountsAccountPersonsPersonParameters
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPersonsPersonParameters where
  parseJSON :: Value -> Parser PostAccountsAccountPersonsPersonParameters
parseJSON = String
-> (Object -> Parser PostAccountsAccountPersonsPersonParameters)
-> Value
-> Parser PostAccountsAccountPersonsPersonParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPersonsPersonParameters" (\Object
obj -> ((Text -> Text -> PostAccountsAccountPersonsPersonParameters)
-> Parser
     (Text -> Text -> PostAccountsAccountPersonsPersonParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text -> Text -> PostAccountsAccountPersonsPersonParameters
PostAccountsAccountPersonsPersonParameters Parser (Text -> Text -> PostAccountsAccountPersonsPersonParameters)
-> Parser Text
-> Parser (Text -> PostAccountsAccountPersonsPersonParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"pathAccount")) Parser (Text -> PostAccountsAccountPersonsPersonParameters)
-> Parser Text -> Parser PostAccountsAccountPersonsPersonParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"pathPerson"))

-- | Create a new 'PostAccountsAccountPersonsPersonParameters' with all required fields.
mkPostAccountsAccountPersonsPersonParameters ::
  -- | 'postAccountsAccountPersonsPersonParametersPathAccount'
  Data.Text.Internal.Text ->
  -- | 'postAccountsAccountPersonsPersonParametersPathPerson'
  Data.Text.Internal.Text ->
  PostAccountsAccountPersonsPersonParameters
mkPostAccountsAccountPersonsPersonParameters :: Text -> Text -> PostAccountsAccountPersonsPersonParameters
mkPostAccountsAccountPersonsPersonParameters Text
postAccountsAccountPersonsPersonParametersPathAccount Text
postAccountsAccountPersonsPersonParametersPathPerson =
  PostAccountsAccountPersonsPersonParameters :: Text -> Text -> PostAccountsAccountPersonsPersonParameters
PostAccountsAccountPersonsPersonParameters
    { postAccountsAccountPersonsPersonParametersPathAccount :: Text
postAccountsAccountPersonsPersonParametersPathAccount = Text
postAccountsAccountPersonsPersonParametersPathAccount,
      postAccountsAccountPersonsPersonParametersPathPerson :: Text
postAccountsAccountPersonsPersonParametersPathPerson = Text
postAccountsAccountPersonsPersonParametersPathPerson
    }

-- | Defines the object schema located at @paths.\/v1\/accounts\/{account}\/persons\/{person}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostAccountsAccountPersonsPersonRequestBody = PostAccountsAccountPersonsPersonRequestBody
  { -- | address: The person\'s address.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
postAccountsAccountPersonsPersonRequestBodyAddress :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'),
    -- | address_kana: The Kana variation of the person\'s address (Japan only).
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
postAccountsAccountPersonsPersonRequestBodyAddressKana :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'),
    -- | address_kanji: The Kanji variation of the person\'s address (Japan only).
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
postAccountsAccountPersonsPersonRequestBodyAddressKanji :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'),
    -- | dob: The person\'s date of birth.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
postAccountsAccountPersonsPersonRequestBodyDob :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants),
    -- | documents: Documents that may be submitted to satisfy various informational requests.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
postAccountsAccountPersonsPersonRequestBodyDocuments :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'),
    -- | email: The person\'s email address.
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostAccountsAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountsAccountPersonsPersonRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | first_name: The person\'s first name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstName :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKana :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | gender: The person\'s gender (International regulations require either \"male\" or \"female\").
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyGender :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyIdNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | last_name: The person\'s last name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastName :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKana :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKanji :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | maiden_name: The person\'s maiden name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyMaidenName :: (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\`.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
postAccountsAccountPersonsPersonRequestBodyMetadata :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyMetadata'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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyNationality :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPersonToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The person\'s phone number.
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPhone :: (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
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPoliticalExposure :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | relationship: The relationship that this person has with the account\'s legal entity.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
postAccountsAccountPersonsPersonRequestBodyRelationship :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'),
    -- | ssn_last_4: The last four digits of the person\'s Social Security number (U.S. only).
    PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodySsnLast_4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verification: The person\'s verification status.
    PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
postAccountsAccountPersonsPersonRequestBodyVerification :: (GHC.Maybe.Maybe PostAccountsAccountPersonsPersonRequestBodyVerification')
  }
  deriving
    ( Int
-> PostAccountsAccountPersonsPersonRequestBody -> String -> String
[PostAccountsAccountPersonsPersonRequestBody] -> String -> String
PostAccountsAccountPersonsPersonRequestBody -> String
(Int
 -> PostAccountsAccountPersonsPersonRequestBody -> String -> String)
-> (PostAccountsAccountPersonsPersonRequestBody -> String)
-> ([PostAccountsAccountPersonsPersonRequestBody]
    -> String -> String)
-> Show PostAccountsAccountPersonsPersonRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostAccountsAccountPersonsPersonRequestBody] -> String -> String
$cshowList :: [PostAccountsAccountPersonsPersonRequestBody] -> String -> String
show :: PostAccountsAccountPersonsPersonRequestBody -> String
$cshow :: PostAccountsAccountPersonsPersonRequestBody -> String
showsPrec :: Int
-> PostAccountsAccountPersonsPersonRequestBody -> String -> String
$cshowsPrec :: Int
-> PostAccountsAccountPersonsPersonRequestBody -> String -> String
GHC.Show.Show,
      PostAccountsAccountPersonsPersonRequestBody
-> PostAccountsAccountPersonsPersonRequestBody -> Bool
(PostAccountsAccountPersonsPersonRequestBody
 -> PostAccountsAccountPersonsPersonRequestBody -> Bool)
-> (PostAccountsAccountPersonsPersonRequestBody
    -> PostAccountsAccountPersonsPersonRequestBody -> Bool)
-> Eq PostAccountsAccountPersonsPersonRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostAccountsAccountPersonsPersonRequestBody
-> PostAccountsAccountPersonsPersonRequestBody -> Bool
$c/= :: PostAccountsAccountPersonsPersonRequestBody
-> PostAccountsAccountPersonsPersonRequestBody -> Bool
== :: PostAccountsAccountPersonsPersonRequestBody
-> PostAccountsAccountPersonsPersonRequestBody -> Bool
$c== :: PostAccountsAccountPersonsPersonRequestBody
-> PostAccountsAccountPersonsPersonRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostAccountsAccountPersonsPersonRequestBody where
  toJSON :: PostAccountsAccountPersonsPersonRequestBody -> Value
toJSON PostAccountsAccountPersonsPersonRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
postAccountsAccountPersonsPersonRequestBodyAddress PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kana" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
postAccountsAccountPersonsPersonRequestBodyAddressKana PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_kanji" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
postAccountsAccountPersonsPersonRequestBodyAddressKanji PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dob" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
postAccountsAccountPersonsPersonRequestBodyDob PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"documents" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
postAccountsAccountPersonsPersonRequestBodyDocuments PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyEmail PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountsAccountPersonsPersonRequestBodyExpand PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstName PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKana PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKanji PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyGender PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyIdNumber PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastName PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKana PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKanji PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyMaidenName PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
postAccountsAccountPersonsPersonRequestBodyMetadata PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyNationality PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPersonToken PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPhone PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPoliticalExposure PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"relationship" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
postAccountsAccountPersonsPersonRequestBodyRelationship PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodySsnLast_4 PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
postAccountsAccountPersonsPersonRequestBodyVerification PostAccountsAccountPersonsPersonRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostAccountsAccountPersonsPersonRequestBody -> Encoding
toEncoding PostAccountsAccountPersonsPersonRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
postAccountsAccountPersonsPersonRequestBodyAddress PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kana" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
postAccountsAccountPersonsPersonRequestBodyAddressKana PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_kanji" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
postAccountsAccountPersonsPersonRequestBodyAddressKanji PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dob" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
postAccountsAccountPersonsPersonRequestBodyDob PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"documents" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
postAccountsAccountPersonsPersonRequestBodyDocuments PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyEmail PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe [Text]
postAccountsAccountPersonsPersonRequestBodyExpand PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstName PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKana PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKanji PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyGender PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyIdNumber PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastName PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKana PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKanji PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyMaidenName PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
postAccountsAccountPersonsPersonRequestBodyMetadata PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyNationality PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPersonToken PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPhone PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodyPoliticalExposure PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"relationship" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
postAccountsAccountPersonsPersonRequestBodyRelationship PostAccountsAccountPersonsPersonRequestBody
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..= PostAccountsAccountPersonsPersonRequestBody -> Maybe Text
postAccountsAccountPersonsPersonRequestBodySsnLast_4 PostAccountsAccountPersonsPersonRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification" Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostAccountsAccountPersonsPersonRequestBody
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
postAccountsAccountPersonsPersonRequestBodyVerification PostAccountsAccountPersonsPersonRequestBody
obj))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostAccountsAccountPersonsPersonRequestBody where
  parseJSON :: Value -> Parser PostAccountsAccountPersonsPersonRequestBody
parseJSON = String
-> (Object -> Parser PostAccountsAccountPersonsPersonRequestBody)
-> Value
-> Parser PostAccountsAccountPersonsPersonRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostAccountsAccountPersonsPersonRequestBody" (\Object
obj -> ((((((((((((((((((((((((Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe
      PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
 -> Maybe Text
 -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
 -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
-> PostAccountsAccountPersonsPersonRequestBody
PostAccountsAccountPersonsPersonRequestBody Parser
  (Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddress')
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddress')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana')
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kana")) Parser
  (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji')
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_kanji")) Parser
  (Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"dob")) Parser
  (Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments')
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments')
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> 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
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe
           PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostAccountsAccountPersonsPersonRequestBodyMetadata'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 PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
      -> Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyRelationship'
   -> Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship')
-> Parser
     (Maybe Text
      -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"relationship")) Parser
  (Maybe Text
   -> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
      -> PostAccountsAccountPersonsPersonRequestBody)
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 PostAccountsAccountPersonsPersonRequestBodyVerification'
   -> PostAccountsAccountPersonsPersonRequestBody)
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyVerification')
-> Parser PostAccountsAccountPersonsPersonRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostAccountsAccountPersonsPersonRequestBodyVerification')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification"))

-- | Create a new 'PostAccountsAccountPersonsPersonRequestBody' with all required fields.
mkPostAccountsAccountPersonsPersonRequestBody :: PostAccountsAccountPersonsPersonRequestBody
mkPostAccountsAccountPersonsPersonRequestBody :: PostAccountsAccountPersonsPersonRequestBody
mkPostAccountsAccountPersonsPersonRequestBody =
  PostAccountsAccountPersonsPersonRequestBody :: Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
-> Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
-> Maybe Text
-> Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
-> PostAccountsAccountPersonsPersonRequestBody
PostAccountsAccountPersonsPersonRequestBody
    { postAccountsAccountPersonsPersonRequestBodyAddress :: Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
postAccountsAccountPersonsPersonRequestBodyAddress = Maybe PostAccountsAccountPersonsPersonRequestBodyAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyAddressKana :: Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
postAccountsAccountPersonsPersonRequestBodyAddressKana = Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKana'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyAddressKanji :: Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
postAccountsAccountPersonsPersonRequestBodyAddressKanji = Maybe PostAccountsAccountPersonsPersonRequestBodyAddressKanji'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyDob :: Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
postAccountsAccountPersonsPersonRequestBodyDob = Maybe PostAccountsAccountPersonsPersonRequestBodyDob'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyDocuments :: Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
postAccountsAccountPersonsPersonRequestBodyDocuments = Maybe PostAccountsAccountPersonsPersonRequestBodyDocuments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyEmail :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyExpand :: Maybe [Text]
postAccountsAccountPersonsPersonRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyFirstName :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyFirstNameKana :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyFirstNameKanji :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyFirstNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyGender :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyGender = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyIdNumber :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyIdNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyLastName :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyLastNameKana :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKana = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyLastNameKanji :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyLastNameKanji = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyMaidenName :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyMaidenName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyMetadata :: Maybe PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
postAccountsAccountPersonsPersonRequestBodyMetadata = Maybe PostAccountsAccountPersonsPersonRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyNationality :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyNationality = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyPersonToken :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyPersonToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyPhone :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyPoliticalExposure :: Maybe Text
postAccountsAccountPersonsPersonRequestBodyPoliticalExposure = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyRelationship :: Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
postAccountsAccountPersonsPersonRequestBodyRelationship = Maybe PostAccountsAccountPersonsPersonRequestBodyRelationship'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodySsnLast_4 :: Maybe Text
postAccountsAccountPersonsPersonRequestBodySsnLast_4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyVerification :: Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
postAccountsAccountPersonsPersonRequestBodyVerification = Maybe PostAccountsAccountPersonsPersonRequestBodyVerification'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Create a new 'PostAccountsAccountPersonsPersonRequestBodyVerification'' with all required fields.
mkPostAccountsAccountPersonsPersonRequestBodyVerification' :: PostAccountsAccountPersonsPersonRequestBodyVerification'
mkPostAccountsAccountPersonsPersonRequestBodyVerification' :: PostAccountsAccountPersonsPersonRequestBodyVerification'
mkPostAccountsAccountPersonsPersonRequestBodyVerification' =
  PostAccountsAccountPersonsPersonRequestBodyVerification' :: Maybe
  PostAccountsAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
-> Maybe
     PostAccountsAccountPersonsPersonRequestBodyVerification'Document'
-> PostAccountsAccountPersonsPersonRequestBodyVerification'
PostAccountsAccountPersonsPersonRequestBodyVerification'
    { postAccountsAccountPersonsPersonRequestBodyVerification'AdditionalDocument :: Maybe
  PostAccountsAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
postAccountsAccountPersonsPersonRequestBodyVerification'AdditionalDocument = Maybe
  PostAccountsAccountPersonsPersonRequestBodyVerification'AdditionalDocument'
forall a. Maybe a
GHC.Maybe.Nothing,
      postAccountsAccountPersonsPersonRequestBodyVerification'Document :: Maybe
  PostAccountsAccountPersonsPersonRequestBodyVerification'Document'
postAccountsAccountPersonsPersonRequestBodyVerification'Document = Maybe
  PostAccountsAccountPersonsPersonRequestBodyVerification'Document'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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