mangopay-1.12: Bindings to the MangoPay API

Safe HaskellNone
LanguageHaskell98

Web.MangoPay

Description

API entry point

Synopsis

Documentation

runMangoPayT Source

Arguments

:: Credentials

Your app's credentials.

-> Manager

Connection manager (see withManager).

-> AccessPoint 
-> MangoPayT m a

the action to run

-> m a

the result

Run a computation in the MangoPayT monad transformer with your credentials.

runResourceInMp :: MPUsableMonad m => MangoPayT (ResourceT m) a -> MangoPayT m a Source

Run a ResourceT inside a MangoPayT.

data MpException Source

an exception that a call to MangoPay may throw

Instances

getAll :: (MPUsableMonad m, FromJSON v) => (Maybe Pagination -> AccessToken -> MangoPayT m (PagedList v)) -> AccessToken -> MangoPayT m [v] Source

get all items, hiding the pagination system

data Credentials Source

the app credentials

Constructors

Credentials 

Fields

cClientId :: Text

client id

cName :: Text

the name

cEmail :: Text

the email

cClientSecret :: Maybe Text

client secret, maybe be Nothing if we haven't generated it

Instances

newtype AccessToken Source

the access token is simply a Text

Constructors

AccessToken ByteString 

data OAuthToken Source

the oauth token returned after authentication

Constructors

OAuthToken 

Fields

oaAccessToken :: Text

the access token

oaTokenType :: Text

the token type

oaExpires :: Int

expiration

Instances

Eq OAuthToken Source 
Ord OAuthToken Source 
Read OAuthToken Source 
Show OAuthToken Source 
ToJSON OAuthToken Source

to json as per MangoPay format

FromJSON OAuthToken Source

from json as per MangoPay format

data PagedList a Source

A partial list with pagination information.

Constructors

PagedList 

Instances

newtype MpTime Source

newtype of POSIXTime with MangoPay's JSON format.

Constructors

MpTime 

Fields

unMpTime :: POSIXTime
 

Instances

Eq MpTime Source 
Ord MpTime Source 
Show MpTime Source 
ToJSON MpTime Source

to json as per MangoPay format

FromJSON MpTime Source

from json as per MangoPay format

ToHtQuery (Maybe MpTime) Source 

type MPUsableMonad m = (MonadBaseControl IO m, MonadResource m, MonadLogger m) Source

put our constraints in one synonym

data CardExpiration Source

the expiration date of a card

Constructors

CardExpiration 

Fields

ceMonth :: Int
 
ceYear :: Int
 

Instances

readCardExpiration :: Reader CardExpiration Source

read Card Expiration from text representation (MMYY)

writeCardExpiration :: CardExpiration -> Text Source

write card expiration

createCredentialsSecret :: MPUsableMonad m => MangoPayT m Credentials Source

Populate the passphrase for our clientId IFF we don't have one.

oauthLogin :: MPUsableMonad m => Text -> Text -> MangoPayT m OAuthToken Source

Login with given user name and password. Returns the OAuth token that can be used to generate the opaque AccessToken and carries the expiration delay.

toAccessToken :: OAuthToken -> AccessToken Source

build the access token from the OAuthToken

data NaturalUser Source

Constructors

NaturalUser 

Fields

uId :: Maybe NaturalUserId

The Id of the object

uCreationDate :: Maybe MpTime

The creation date of the user object

uEmail :: Text

User’s e-mail

uFirstName :: Text

User’s firstname

uLastName :: Text

User’s lastname

uAddress :: Maybe Text

User’s address

uBirthday :: MpTime

User’s birthdate

uNationality :: CountryCode

User’s Nationality

uCountryOfResidence :: CountryCode

User’s country of residence

uOccupation :: Maybe Text

User’s occupation (ie. Work)

uIncomeRange :: Maybe IncomeRange

User’s income range

uTag :: Maybe Text

Custom data

uProofOfIdentity :: Maybe Text
 
uProofOfAddress :: Maybe Text
 

data IncomeRange Source

supported income ranges

Instances

Bounded IncomeRange Source 
Enum IncomeRange Source 
Eq IncomeRange Source 
Ord IncomeRange Source 
Read IncomeRange Source 
Show IncomeRange Source 
ToJSON IncomeRange Source

to json as per MangoPay format the samples do show string format when writing, integer format when reading...

FromJSON IncomeRange Source

from json as per MangoPay format the samples do show string format when writing, integer format when reading...

incomeBounds :: IncomeRange -> (Amount, Amount) Source

bounds in euros for income range

incomeRange :: Amount -> IncomeRange Source

get Income Range for given Euro amount

type NaturalUserId = Text Source

User Id

data LegalUser Source

Constructors

LegalUser 

Fields

lId :: Maybe Text

The Id of the object

lCreationDate :: Maybe MpTime

The creation date of the user object

lEmail :: Text

The email of the company or the organization

lName :: Text

The name of the company or the organization

lLegalPersonType :: LegalUserType

The type of the legal user (‘BUSINESS’ or ’ORGANIZATION’)

lHeadquartersAddress :: Maybe Text

The address of the company’s headquarters

lLegalRepresentativeFirstName :: Text

The firstname of the company’s Legal representative person

lLegalRepresentativeLastName :: Text

The lastname of the company’s Legal representative person

lLegalRepresentativeAddress :: Maybe Text

The address of the company’s Legal representative person

lLegalRepresentativeEmail :: Maybe Text

The email of the company’s Legal representative person

lLegalRepresentativeBirthday :: MpTime

The birthdate of the company’s Legal representative person

lLegalRepresentativeNationality :: CountryCode

the nationality of the company’s Legal representative person

lLegalRepresentativeCountryOfResidence :: CountryCode

The country of residence of the company’s Legal representative person

lStatute :: Maybe Text

The business statute of the company

lTag :: Maybe Text

Custom data

lProofOfRegistration :: Maybe Text

The proof of registration of the company

lShareholderDeclaration :: Maybe Text

The shareholder declaration of the company

Instances

type LegalUserId = Text Source

User Id

data UserRef Source

a short user reference

Instances

Eq UserRef Source 
Ord UserRef Source 
Show UserRef Source 
ToJSON UserRef Source

to json as per MangoPay format

FromJSON UserRef Source

from json as per MangoPay format

data PersonType Source

Type of user.

Constructors

Natural 
Legal 

type AnyUserId = Text Source

Id for any kind of user

fetchNaturalUser :: MPUsableMonad m => NaturalUserId -> AccessToken -> MangoPayT m NaturalUser Source

fetch a natural user from her Id

fetchLegalUser :: MPUsableMonad m => LegalUserId -> AccessToken -> MangoPayT m LegalUser Source

fetch a natural user from her Id

getUser :: MPUsableMonad m => AnyUserId -> AccessToken -> MangoPayT m (Either NaturalUser LegalUser) Source

get a user, natural or legal

getExistingUserId :: Either NaturalUser LegalUser -> AnyUserId Source

Convenience function to extract the user Id of an EXISTING user (one with an id).

data Wallet Source

a wallet

Constructors

Wallet 

Fields

wId :: Maybe WalletId

The Id of the wallet

wCreationDate :: Maybe MpTime

The creation date of the object

wTag :: Maybe Text

Custom data

wOwners :: [Text]

The owner of the wallet

wDescription :: Text

A description of the wallet

wCurrency :: Currency

Currency of the wallet

wBalance :: Maybe Amount

The amount held on the wallet

Instances

Eq Wallet Source 
Ord Wallet Source 
Show Wallet Source 
ToJSON Wallet Source

to json as per MangoPay format

FromJSON Wallet Source

from json as per MangoPay format

data Amount Source

currency amount

Constructors

Amount 

Fields

aCurrency :: Currency
 
aAmount :: Integer

all amounts should be in cents!

Instances

Eq Amount Source 
Ord Amount Source 
Read Amount Source 
Show Amount Source 
ToJSON Amount Source

to json as per MangoPay format

FromJSON Amount Source

from json as per MangoPay format

type WalletId = Text Source

Id of a wallet

type Currency = Text Source

alias for Currency

fetchWallet :: MPUsableMonad m => WalletId -> AccessToken -> MangoPayT m Wallet Source

fetch a wallet from its Id

listWallets :: MPUsableMonad m => AnyUserId -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Wallet) Source

list all wallets for a given user

data Transfer Source

transfer between wallets

Constructors

Transfer 

Fields

tId :: Maybe TransferId

Id of the transfer

tCreationDate :: Maybe MpTime

The creation date of the object

tTag :: Maybe Text

Custom data

tAuthorId :: AnyUserId

The Id of the author

tCreditedUserId :: Maybe AnyUserId

The Id of the user owner of the credited wallet

tDebitedFunds :: Amount

The funds debited from the « debited wallet »DebitedFunds – Fees = CreditedFunds (amount received on wallet)

tFees :: Amount

The fees taken on the transfer.DebitedFunds – Fees = CreditedFunds (amount received on wallet)

tDebitedWalletId :: WalletId

The debited wallet (where the funds are held before the transfer)

tCreditedWalletId :: WalletId

The credited wallet (where the funds will be held after the transfer)

tCreditedFunds :: Maybe Amount

The funds credited on the « credited wallet »DebitedFunds – Fees = CreditedFunds (amount received on wallet)

tStatus :: Maybe TransferStatus

The status of the transfer:

tResultCode :: Maybe Text

The transaction result code

tResultMessage :: Maybe Text

The transaction result message

tExecutionDate :: Maybe MpTime

The execution date of the transfer

Instances

Eq Transfer Source 
Ord Transfer Source 
Show Transfer Source 
ToJSON Transfer Source

to json as per MangoPay format

FromJSON Transfer Source

from json as per MangoPay format

type TransferId = Text Source

Id of a transfer

data Transaction Source

any transaction

Constructors

Transaction 

Fields

txId :: Maybe TransactionId

Id of the transfer

txCreationDate :: Maybe MpTime

The creation date of the object

txTag :: Maybe Text

Custom data

txAuthorId :: AnyUserId

The Id of the author

txCreditedUserId :: Maybe AnyUserId

The Id of the user owner of the credited wallet

txDebitedFunds :: Amount

The funds debited from the « debited wallet »DebitedFunds – Fees = CreditedFunds (amount received on wallet)

txFees :: Amount

The fees taken on the transfer.DebitedFunds – Fees = CreditedFunds (amount received on wallet)

txDebitedWalletId :: Maybe WalletId

The debited wallet (where the funds are held before the transfer)

txCreditedWalletId :: Maybe WalletId

The credited wallet (where the funds will be held after the transfer)

txCreditedFunds :: Maybe Amount

The funds credited on the « credited wallet »DebitedFunds – Fees = CreditedFunds (amount received on wallet)

txStatus :: Maybe TransferStatus

The status of the transfer:

txResultCode :: Maybe Text

The transaction result code

txResultMessage :: Maybe Text

The transaction result message

txExecutionDate :: Maybe MpTime

The execution date of the transfer

txType :: TransactionType

The type of the transaction

txNature :: TransactionNature

The nature of the transaction:

Instances

Eq Transaction Source 
Ord Transaction Source 
Show Transaction Source 
ToJSON Transaction Source

to json as per MangoPay format

FromJSON Transaction Source

from json as per MangoPay format

data TransactionNature Source

Constructors

REGULAR

just as you created the object

REFUND

the transaction has been refunded

REPUDIATION

the transaction has been repudiated

createTransfer :: MPUsableMonad m => Transfer -> AccessToken -> MangoPayT m Transfer Source

create a new fund transfer

fetchTransfer :: MPUsableMonad m => TransferId -> AccessToken -> MangoPayT m Transfer Source

fetch a transfer from its Id

data Event Source

a event

Constructors

Event 

Instances

Eq Event Source 
Ord Event Source 
Show Event Source 
ToJSON Event Source

to json as per MangoPay format

FromJSON Event Source

from json as per MangoPay format

searchEvents :: MPUsableMonad m => EventSearchParams -> AccessToken -> MangoPayT m (PagedList Event) Source

search events, returns a paginated list

searchAllEvents :: MPUsableMonad m => EventSearchParams -> AccessToken -> MangoPayT m [Event] Source

search events, returns the full result

checkEvent :: MPUsableMonad m => Event -> AccessToken -> MangoPayT m Bool Source

Check if an event came from MangoPay. Since notifications are not authenticated, you're advised to always check if the event really comes from MangoPay (cf. https://mangopay.desk.com/customer/portal/questions/6493147).

data HookStatus Source

status of notification hook

Constructors

Enabled 
Disabled 

data HookValidity Source

validity of notification hook

Constructors

Valid 
Invalid 

type HookId = Text Source

id for hook

data Hook Source

a notification hook

Constructors

Hook 

Fields

hId :: Maybe HookId

The Id of the hook details

hCreationDate :: Maybe MpTime
 
hTag :: Maybe Text

Custom data

hUrl :: Text

This is the URL where you receive notification for each EventType

hStatus :: HookStatus
 
hValidity :: Maybe HookValidity
 
hEventType :: EventType
 

Instances

Eq Hook Source 
Ord Hook Source 
Show Hook Source 
ToJSON Hook Source

to json as per MangoPay format

FromJSON Hook Source

from json as per MangoPay format

fetchHook :: MPUsableMonad m => HookId -> AccessToken -> MangoPayT m Hook Source

fetch a wallet from its Id

listHooks :: MPUsableMonad m => Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Hook) Source

list all wallets for a given user

eventFromQueryString :: Query -> Maybe Event Source

parse an event from the query string the MangoPay is not very clear on notifications, but see v1 http://docs.mangopay.com/v1-api-references/notifications/ v2 works the same, the event is passed via parameters of the query string

eventFromQueryStringT :: [(Text, Text)] -> Maybe Event Source

parse an event from the query string represented as Text the MangoPay is not very clear on notifications, but see v1 http://docs.mangopay.com/v1-api-references/notifications/ v2 works the same, the event is passed via parameters of the query string

data Document Source

a document

Instances

Eq Document Source 
Ord Document Source 
Show Document Source 
ToJSON Document Source

to json as per MangoPay format

FromJSON Document Source

from json as per MangoPay format

type DocumentId = Text Source

Id of a document

data DocumentType Source

type of the document

Constructors

IDENTITY_PROOF

For legal and natural users

REGISTRATION_PROOF

Only for legal users

ARTICLES_OF_ASSOCIATION

Only for legal users

SHAREHOLDER_DECLARATION

Only for legal users

ADDRESS_PROOF

For legal and natural users

fetchDocument :: MPUsableMonad m => AnyUserId -> DocumentId -> AccessToken -> MangoPayT m Document Source

fetch a document from its Id

createPage :: MPUsableMonad m => AnyUserId -> DocumentId -> ByteString -> AccessToken -> MangoPayT m () Source

create a page note that per the MangoPay API the document HAS to be in CREATED status should we check it here? Since MangoPay returns a 500 Internal Server Error if the document is in another status...

getRequiredDocumentTypes Source

Arguments

:: Either NaturalUser LegalUser

The MangoPay user.

-> [DocumentType] 

Get the document types that may be required from the given user to enhance authorization level.

type BankAccountId = Text Source

Id of a bank account

accountCountry :: BankAccount -> Maybe CountryCode Source

Get the country for a BankAccount

data PaymentExecution Source

Type of payment execution.

Constructors

WEB

through a web interface

DIRECT

with a tokenized card

type BankWireId = Text Source

id of a bankwire

data BankWire Source

a bank wire there are a lot of common fields between all kinds of payments so this could probably become a Payment type

Constructors

BankWire 

Fields

bwId :: Maybe BankWireId
 
bwCreationDate :: Maybe MpTime
 
bwTag :: Maybe Text

custom data

bwAuthorId :: AnyUserId

The user Id of the author

bwCreditedUserId :: AnyUserId

It represents the amount credited on the targeted e-wallet.

bwFees :: Maybe Amount

It represents your fees taken on the DebitedFundsDebitedFunds – Fees = CreditedFunds (amount received on wallet)

bwCreditedWalletId :: WalletId

The Id of the credited wallet

bwDebitedWalletId :: Maybe WalletId

The Id of the debited wallet

bwDebitedFunds :: Maybe Amount

It represents the amount debited from the bank account.

bwCreditedFunds :: Maybe Amount

It represents the amount credited on the targeted e-wallet.

bwDeclaredDebitedFunds :: Amount

It represents the expected amount by the platform before that the user makes the payment.

bwDeclaredFees :: Amount

It represents the expected fees amount by the platform before that the user makes the payment.

bwWireReference :: Maybe Text

It is a reference generated by MANGOPAY and displayed to the user by the platform. The user have to indicate it into the bank wire.

bwBankAccount :: Maybe BankAccount

The bank account is generated by MANGOPAY and displayed to the user.

bwStatus :: Maybe TransferStatus

The status of the payment

bwResultCode :: Maybe Text

The transaction result code

bwResultMessage :: Maybe Text

The transaction result Message

bwExecutionDate :: Maybe MpTime

The date when the payment is processed

bwType :: Maybe TransactionType

The type of the transaction

bwNature :: Maybe TransactionNature

The nature of the transaction:

bwPaymentType :: Maybe PaymentType

The type of the payment (which type of mean of payment is used).

bwExecutionType :: Maybe PaymentExecution

How the payment has been executed:

Instances

Eq BankWire Source 
Ord BankWire Source 
Show BankWire Source 
ToJSON BankWire Source

to json as per MangoPay format

FromJSON BankWire Source

from json as per MangoPay format

fetchBankWirePayIn :: MPUsableMonad m => BankWireId -> AccessToken -> MangoPayT m BankWire Source

fetch a bank wire pay-in from its Id

mkBankWire :: AnyUserId -> AnyUserId -> WalletId -> Amount -> Amount -> BankWire Source

helper function to create a new bank wire with the needed information

type CardPayinId = Text Source

Id of a direct pay in

data CardPayin Source

direct pay in via registered card

Constructors

CardPayin 

Fields

cpId :: Maybe CardPayinId
 
cpCreationDate :: Maybe MpTime
 
cpTag :: Maybe Text

custom data

cpAuthorId :: AnyUserId

The user Id of the author

cpCreditedUserId :: AnyUserId

The user Id of the owner of the credited wallet

cpFees :: Amount

It represents your fees taken on the DebitedFundsDebitedFunds – Fees = CreditedFunds (amount received on wallet)

cpCreditedWalletId :: WalletId

The Id of the credited wallet

cpDebitedWalletId :: Maybe WalletId

The Id of the debited wallet

cpDebitedFunds :: Amount

It represents the amount debited from the bank account.

cpCreditedFunds :: Maybe Amount

It represents the amount credited on the targeted e-wallet.

cpSecureModeReturnURL :: Maybe Text

This URL will be used in case the SecureMode is activated.

cpSecureMode :: Maybe Text

The SecureMode correspond to « 3D secure » for CB Visa and MasterCard or « Amex Safe Key » for American Express. This field lets you activate it manually.

cpSecureModeRedirectURL :: Maybe Text

This URL will be used in case the SecureMode is activated.

cpCardId :: CardId

The Id of the registered card (Got through CardRegistration object)

cpStatus :: Maybe TransferStatus

The status of the payment

cpResultCode :: Maybe Text

The transaction result code

cpResultMessage :: Maybe Text

The transaction result Message

cpExecutionDate :: Maybe MpTime
 
cpType :: Maybe TransactionType

The type of the transaction

cpNature :: Maybe TransactionNature

The nature of the transaction:

cpPaymentType :: Maybe Text

The type of the payment (which type of mean of payment is used).

cpExecutionType :: Maybe PaymentExecution

How the payment has been executed:

Instances

Eq CardPayin Source 
Ord CardPayin Source 
Show CardPayin Source 
ToJSON CardPayin Source

to json as per MangoPay format

FromJSON CardPayin Source

from json as per MangoPay format

createCardPayin :: MPUsableMonad m => CardPayin -> AccessToken -> MangoPayT m CardPayin Source

create a direct card pay in

fetchCardPayin :: MPUsableMonad m => CardPayinId -> AccessToken -> MangoPayT m CardPayin Source

fetch a direct card pay in from its Id

mkCardPayin :: AnyUserId -> AnyUserId -> WalletId -> Amount -> Amount -> Text -> CardId -> CardPayin Source

helper function to create a new direct payin with the needed information | the url is only used in secure mode but is REQUIRED by MangoPay

type PayoutId = Text Source

id of payout

data Payout Source

payout

Constructors

Payout 

Fields

ptId :: Maybe PayoutId
 
ptCreationDate :: Maybe MpTime
 
ptTag :: Maybe Text

custom data for client

ptAuthorId :: AnyUserId

The user Id of the author

ptDebitedWalletId :: WalletId
 
ptDebitedFunds :: Amount
 
ptFees :: Amount
 
ptBankAccountId :: BankAccountId

The ID of the bank account object

ptCreditedUserId :: Maybe AnyUserId
 
ptCreditedFunds :: Maybe Amount
 
ptStatus :: Maybe TransferStatus
 
ptResultCode :: Maybe Text

The transaction result code

ptResultMessage :: Maybe Text

The transaction result code

ptExecutionDate :: Maybe MpTime
 
ptType :: Maybe TransactionType
 
ptNature :: Maybe TransactionNature
 
ptPaymentType :: Maybe PaymentType
 
ptMeanOfPaymentType :: Maybe PaymentType

« BANK_WIRE »,

ptBankWireRef :: Maybe Text

A custom reference you wish to appear on the user’s bank statement (your ClientId is already shown) since http://docs.mangopay.com/release-hamster/

Instances

Eq Payout Source 
Ord Payout Source 
Show Payout Source 
ToJSON Payout Source

to json as per MangoPay format

FromJSON Payout Source

from json as per MangoPay format

mkPayout :: AnyUserId -> WalletId -> Amount -> Amount -> BankAccountId -> Payout Source

make a simple payout for creation

fetchPayout :: MPUsableMonad m => PayoutId -> AccessToken -> MangoPayT m Payout Source

fetch an payout from its Id

data CardRegistration Source

a card registration

Constructors

CardRegistration 

Fields

crId :: Maybe CardRegistrationId

The Id of the object

crCreationDate :: Maybe MpTime

The creation date of the object

crTag :: Maybe Text

Custom data

crUserId :: AnyUserId

The Id of the author

crCurrency :: Currency

The currency of the card registrated

crAccessKey :: Maybe Text

This key has to be sent with the card details and the PreregistrationData

crPreregistrationData :: Maybe Text

This passphrase has to be sent with the card details and the AccessKey

crCardRegistrationURL :: Maybe Text

The URL where to POST the card details, the AccessKey and PreregistrationData

crRegistrationData :: Maybe Text

You get the CardRegistrationData once you posted the card details, the AccessKey and PreregistrationData

crCardType :: Maybe Text

« CB_VISA_MASTERCARD » is the only value available yet

crCardId :: Maybe CardId

You get the CardId (to process payments) once you edited the CardRegistration Object with the RegistrationData

crResultCode :: Maybe Text

The result code of the object

crResultMessage :: Maybe Text

The message explaining the result code

crStatus :: Maybe DocumentStatus

The status of the object.

type CardRegistrationId = Text Source

card registration Id

type CardId = Text Source

Id of a card

data CardInfo Source

credit card information

Constructors

CardInfo 

data Card Source

a registered card

Constructors

Card 

Fields

cId :: CardId
 
cCreationDate :: MpTime
 
cTag :: Maybe Text
 
cExpirationDate :: CardExpiration

MMYY

cAlias :: Text

Example: 497010XXXXXX4414

cCardProvider :: Text

The card provider, it could be « CB », « VISA », « MASTERCARD », etc.

cCardType :: Text

« CB_VISA_MASTERCARD » is the only value available yet

cProduct :: Maybe Text
 
cBankCode :: Maybe Text
 
cActive :: Bool
 
cCurrency :: Currency
 
cValidity :: CardValidity

Once we proceed (or attempted to process) a payment with the card we are able to indicate if it is « valid » or « invalid ». If we didn’t process a payment yet the « Validity » stay at « unknown ».

cCountry :: Text
 
cUserId :: AnyUserId
 

Instances

Eq Card Source 
Ord Card Source 
Show Card Source 
ToJSON Card Source

to json as per MangoPay format

FromJSON Card Source

from json as per MangoPay format

mkCardRegistration :: AnyUserId -> Currency -> CardRegistration Source

helper function to create a new card registration

fetchCard :: MPUsableMonad m => CardId -> AccessToken -> MangoPayT m Card Source

fetch a card from its Id

listCards :: MPUsableMonad m => AnyUserId -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Card) Source

list all cards for a given user

type RefundId = Text Source

id of a refund

data Refund Source

refund of a transfer

Constructors

Refund 

Fields

rId :: RefundId

Id of the refund

rCreationDate :: MpTime
 
rTag :: Maybe Text

Custom data

rAuthorId :: AnyUserId

The user Id of the author

rDebitedFunds :: Amount

Strictly positive amount. In cents.

rFees :: Amount

In cents

rCreditedFunds :: Amount

In cents

rStatus :: TransferStatus
 
rResultCode :: Text

The transaction result code

rResultMessage :: Maybe Text

The transaction result Message

rExecutionDate :: Maybe MpTime
 
rType :: TransactionType
 
rNature :: TransactionNature
 
rCreditedUserId :: Maybe AnyUserId

Id of the user owner of the credited wallet

rInitialTransactionId :: TransactionId

Id of the transaction being refunded

rInitialTransactionType :: TransactionType

The type of the transaction before being refunded (PayIn, Refund)

rDebitedWalletId :: WalletId

The Id of the debited Wallet

rCreditedWalletId :: Maybe WalletId

The Id of the credited Wallet

rReason :: RefundReason

The reason from the refund, since http://docs.mangopay.com/release-lapin/

Instances

Eq Refund Source 
Ord Refund Source 
Show Refund Source 
FromJSON Refund Source

from json as per MangoPay format

data RefundRequest Source

refund request

Constructors

RefundRequest 

Fields

rrAuthorId :: AnyUserId

The user Id of the author

rrDebitedFunds :: Maybe Amount

Strictly positive amount. In cents.

rrFees :: Maybe Amount

In cents

refundPayin :: MPUsableMonad m => AnyPayinId -> RefundRequest -> AccessToken -> MangoPayT m Refund Source

refund a pay-in

fetchRefund :: MPUsableMonad m => RefundId -> AccessToken -> MangoPayT m Refund Source

fetch a refund from its Id