diff --git a/mangopay.cabal b/mangopay.cabal --- a/mangopay.cabal +++ b/mangopay.cabal @@ -1,5 +1,5 @@ name: mangopay -version: 1.9.7 +version: 1.10 cabal-version: >= 1.8 build-type: Simple author: JP Moresmau diff --git a/src/Web/MangoPay.hs b/src/Web/MangoPay.hs --- a/src/Web/MangoPay.hs +++ b/src/Web/MangoPay.hs @@ -20,6 +20,8 @@ ,readCardExpiration ,writeCardExpiration ,KindOfAuthentication(..) + ,SortDirection(..) + ,GenericSort(..) -- access ,createCredentialsSecret @@ -64,6 +66,8 @@ ,TransactionId ,TransactionType(..) ,TransactionNature(..) + ,TransactionFilter(..) + ,TransactionSort(..) ,createTransfer ,fetchTransfer ,listTransactions @@ -92,12 +96,15 @@ ,DocumentId ,DocumentType(..) ,DocumentStatus(..) + ,DocumentFilter(..) ,createDocument ,modifyDocument ,fetchDocument ,createPage ,getKindOfAuthentication ,getRequiredDocumentTypes + ,listDocuments + ,listAllDocuments -- Accounts ,BankAccount(..) @@ -145,6 +152,8 @@ ,RefundId ,Refund(..) ,RefundRequest(..) + ,RefundReason(..) + ,RefundReasonType(..) ,refundTransfer ,refundPayin ,fetchRefund diff --git a/src/Web/MangoPay/Accounts.hs b/src/Web/MangoPay/Accounts.hs --- a/src/Web/MangoPay/Accounts.hs +++ b/src/Web/MangoPay/Accounts.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings, FlexibleContexts, FlexibleInstances, PatternGuards, ConstraintKinds #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, + FlexibleInstances, OverloadedStrings, PatternGuards, + ScopedTypeVariables #-} -- | handle bank accounts module Web.MangoPay.Accounts where @@ -30,28 +32,28 @@ where path = Data.Text.concat ["/users/",uid,"/bankaccounts/"] -- | list all accounts for a given user -listAccounts :: (MPUsableMonad m) => AnyUserId -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList BankAccount) -listAccounts uid = genericList ["/users/",uid,"/bankaccounts/"] +listAccounts :: (MPUsableMonad m) => AnyUserId -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList BankAccount) +listAccounts uid gs = genericListExtra (sortAttributes gs) ["/users/",uid,"/bankaccounts/"] -- | account details, depending on the type data BankAccountDetails=IBAN { atIBAN :: Text - ,atBIC :: Text + ,atBIC :: Maybe Text } | GB { atAccountNumber :: Text - ,atSortCode :: Text + ,atSortCode :: Text } | US { atAccountNumber :: Text - ,atABA :: Text + ,atABA :: Text } | CA { - atAccountNumber :: Text - ,atBankName :: Text + atAccountNumber :: Text + ,atBankName :: Text ,atInstitutionNumber :: Text - ,atBranchCode :: Text + ,atBranchCode :: Text } | Other { atAccountNumber :: Text - ,atBIC :: Text - ,atCountry :: CountryCode + ,atBIC :: Maybe Text + ,atCountry :: CountryCode } deriving (Show,Read,Eq,Ord,Typeable) -- | from json as per MangoPay format @@ -60,8 +62,8 @@ typ<-v .: "Type" case typ of "IBAN"->IBAN <$> - v .: "IBAN" <*> - v .: "BIC" + v .: "IBAN" <*> + v .:? "BIC" "GB"->GB <$> v .: "AccountNumber" <*> v .: "SortCode" @@ -74,9 +76,9 @@ v .: "InstitutionNumber" <*> v .: "BranchCode" "OTHER"->Other <$> - v .: "AccountNumber" <*> - v .: "BIC" <*> - v .: "Country" + v .: "AccountNumber" <*> + v .:? "BIC" <*> + v .: "Country" _->fail $ "BankAccountDetails: unknown type:" ++ typ parseJSON _=fail "BankAccountDetails" @@ -101,18 +103,18 @@ -- | bank account details data BankAccount = BankAccount { - baId :: Maybe BankAccountId + baId :: Maybe BankAccountId ,baCreationDate :: Maybe POSIXTime - ,baUserId :: Maybe AnyUserId - ,baTag :: Maybe Text - ,baDetails :: BankAccountDetails - ,baOwnerName :: Text + ,baUserId :: Maybe AnyUserId + ,baTag :: Maybe Text + ,baDetails :: BankAccountDetails + ,baOwnerName :: Text ,baOwnerAddress :: Maybe Text } deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON BankAccount where - toJSON ba=object $ ["OwnerName" .= baOwnerName ba,"Type" .= typeName (baDetails ba) + toJSON ba=objectSN $ ["OwnerName" .= baOwnerName ba,"Type" .= typeName (baDetails ba) ,"OwnerAddress" .= baOwnerAddress ba, "UserId" .= baUserId ba, "Tag" .= baTag ba] ++ toJSONPairs (baDetails ba) diff --git a/src/Web/MangoPay/Cards.hs b/src/Web/MangoPay/Cards.hs --- a/src/Web/MangoPay/Cards.hs +++ b/src/Web/MangoPay/Cards.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings, FlexibleContexts, FlexibleInstances, ConstraintKinds, RecordWildCards #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, + FlexibleInstances, OverloadedStrings, RecordWildCards, + ScopedTypeVariables #-} -- | handle cards module Web.MangoPay.Cards where @@ -31,9 +33,9 @@ -- | credit card information data CardInfo = CardInfo { - ciNumber :: Text + ciNumber :: Text ,ciExpire :: CardExpiration - ,ciCSC :: Text + ,ciCSC :: Text } deriving (Show,Read,Eq,Ord,Typeable) @@ -43,26 +45,26 @@ -- | a card registration data CardRegistration = CardRegistration { - crId :: Maybe CardRegistrationId -- ^ The Id of the object - ,crCreationDate :: Maybe POSIXTime -- ^ 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. + crId :: Maybe CardRegistrationId -- ^ The Id of the object + ,crCreationDate :: Maybe POSIXTime -- ^ 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. } deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON CardRegistration where - toJSON cr=object ["Id".= crId cr -- we store the Id, because in the registration workflow we may need to hang on to the registration object for a while, so let's use JSON serialization to keep it! + toJSON cr=objectSN ["Id".= crId cr -- we store the Id, because in the registration workflow we may need to hang on to the registration object for a while, so let's use JSON serialization to keep it! , "Tag" .= crTag cr,"UserId" .= crUserId cr ,"Currency" .= crCurrency cr,"RegistrationData" .= crRegistrationData cr ,"CardRegistrationURL" .= crCardRegistrationURL cr] @@ -91,8 +93,8 @@ fetchCard = fetchGeneric "/cards/" -- | list all cards for a given user -listCards :: (MPUsableMonad m) => AnyUserId -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Card) -listCards uid = genericList ["/users/",uid,"/cards"] +listCards :: (MPUsableMonad m) => AnyUserId -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Card) +listCards uid gs = genericListExtra (sortAttributes gs) ["/users/",uid,"/cards"] -- | validity of a card data CardValidity=UNKNOWN | VALID | INVALID @@ -105,26 +107,25 @@ -- | from json as per MangoPay format instance FromJSON CardValidity where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "CardValidity" + parseJSON = jsonRead "CardValidity" -- | a registered card data Card=Card { - cId :: CardId - ,cCreationDate :: POSIXTime - ,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 + cId :: CardId + ,cCreationDate :: POSIXTime + ,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 } deriving (Show,Eq,Ord,Typeable) -- | from json as per MangoPay format @@ -148,7 +149,7 @@ -- | to json as per MangoPay format instance ToJSON Card where - toJSON Card {..} = object + toJSON Card {..} = objectSN [ "Id" .= cId , "CreationDate" .= cCreationDate , "Tag" .= cTag diff --git a/src/Web/MangoPay/Documents.hs b/src/Web/MangoPay/Documents.hs --- a/src/Web/MangoPay/Documents.hs +++ b/src/Web/MangoPay/Documents.hs @@ -8,6 +8,8 @@ import Web.MangoPay.Types import Web.MangoPay.Users +import Data.ByteString (ByteString) +import Data.Default import Data.Text hiding (any) import Data.Typeable (Typeable) import Data.Aeson @@ -45,6 +47,20 @@ url<-getClientURLMultiple ["/users/",uid,"/KYC/documents/",did,"/pages"] postNoReply url (Just at) val + +-- | List all documents uploaded for a user. +-- Since http://docs.mangopay.com/release-hamster/ +listDocuments :: (MPUsableMonad m) => AnyUserId -> DocumentFilter -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Document) +listDocuments uid df gs= genericListExtra (documentFilterAttributes df ++ sortAttributes gs) + ["/users/",uid,"/KYC/documents"] + + +-- | List all documents uploaded. +-- Since http://docs.mangopay.com/release-hamster/ +listAllDocuments :: (MPUsableMonad m) => DocumentFilter -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Document) +listAllDocuments df gs = genericListExtra (documentFilterAttributes df ++ sortAttributes gs) + ["/KYC/documents"] + -- | Id of a document type DocumentId = Text @@ -62,8 +78,7 @@ -- | from json as per MangoPay format instance FromJSON DocumentType where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "DocumentType" + parseJSON = jsonRead "DocumentType" -- | status of a document data DocumentStatus=CREATED @@ -78,8 +93,7 @@ -- | from json as per MangoPay format instance FromJSON DocumentStatus where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "DocumentStatus" + parseJSON = jsonRead "DocumentStatus" -- | a document data Document = Document { @@ -95,7 +109,7 @@ -- | to json as per MangoPay format instance ToJSON Document where - toJSON d=object ["Tag" .= dTag d, + toJSON d=objectSN ["Tag" .= dTag d, "Type" .= dType d,"Status" .= dStatus d] -- | from json as per MangoPay format @@ -150,3 +164,23 @@ -> [DocumentType] getRequiredDocumentTypes (Left _) = [IDENTITY_PROOF, ADDRESS_PROOF] getRequiredDocumentTypes (Right _) = [ARTICLES_OF_ASSOCIATION, REGISTRATION_PROOF, SHAREHOLDER_DECLARATION] + + +-- | A filter for document lists. +data DocumentFilter = DocumentFilter + { + dfBefore :: Maybe POSIXTime + , dfAfter :: Maybe POSIXTime + , dfStatus :: Maybe DocumentStatus + , dfType :: Maybe DocumentType + } deriving (Show,Eq,Ord,Typeable) + +instance Default DocumentFilter where + def = DocumentFilter Nothing Nothing Nothing Nothing + +-- | get filter attributes for transaction query +documentFilterAttributes :: DocumentFilter -> [(ByteString,Maybe ByteString)] +documentFilterAttributes f=[ "BeforeDate" ?+ dfBefore f + , "AfterDate" ?+ dfAfter f + , "Status" ?+ (show <$> (dfStatus f)) + , "Type" ?+ (show <$> (dfType f))] diff --git a/src/Web/MangoPay/Events.hs b/src/Web/MangoPay/Events.hs --- a/src/Web/MangoPay/Events.hs +++ b/src/Web/MangoPay/Events.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings, FlexibleContexts, FlexibleInstances, ConstraintKinds #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, + FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} -- | handle events -- module Web.MangoPay.Events where @@ -6,7 +7,7 @@ import Web.MangoPay.Monad import Web.MangoPay.Types -import Data.Text hiding (filter) +import Data.Text hiding (filter,map,toLower) import Data.Typeable (Typeable) import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) @@ -18,6 +19,7 @@ import qualified Data.Text.Encoding as TE import Control.Monad (join) import qualified Data.ByteString.Char8 as BS +import Data.Char (toLower) -- | search events, returns a paginated list searchEvents :: (MPUsableMonad m) => EventSearchParams -> AccessToken -> MangoPayT m (PagedList Event) @@ -40,7 +42,7 @@ checkEvent evt at= do -- documentation doesn't say it, but tests show dates are inclusive let dt = Just $ eDate evt - let esp = EventSearchParams (Just $ eEventType evt) dt dt Nothing + let esp = EventSearchParams (Just $ eEventType evt) dt dt Nothing Nothing evts <- searchAllEvents esp at return $ evt `elem` evts @@ -97,26 +99,27 @@ -- | from json as per MangoPay format instance FromJSON EventType where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "EventType" + parseJSON = jsonRead "EventType" -- | search parameters for events data EventSearchParams=EventSearchParams{ - espEventType :: Maybe EventType + espEventType :: Maybe EventType ,espBeforeDate :: Maybe POSIXTime - ,espAfterDate :: Maybe POSIXTime + ,espAfterDate :: Maybe POSIXTime ,espPagination :: Maybe Pagination + ,espSortByDate :: Maybe SortDirection } deriving (Show,Eq,Ord,Typeable) instance Default EventSearchParams where - def=EventSearchParams Nothing Nothing Nothing Nothing + def=EventSearchParams Nothing Nothing Nothing Nothing Nothing instance HT.QueryLike EventSearchParams where - toQuery (EventSearchParams et bd ad p)=filter (isJust .snd) + toQuery (EventSearchParams et bd ad p ms)=filter (isJust .snd) ["eventtype" ?+ et ,"beforeDate" ?+ bd ,"afterDate" ?+ ad + ,"Sort" ?+ ((("Date:" ++) . map toLower . show) <$> ms) ] ++ paginationAttributes p --instance ToJSON EventSearchParams where @@ -128,13 +131,13 @@ data Event=Event { eResourceId :: Text ,eEventType :: EventType - ,eDate :: POSIXTime + ,eDate :: POSIXTime } deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON Event where - toJSON e=object ["ResourceId" .= eResourceId e,"EventType" .= eEventType e,"Date" .= eDate e] + toJSON e=objectSN ["ResourceId" .= eResourceId e,"EventType" .= eEventType e,"Date" .= eDate e] -- | from json as per MangoPay format instance FromJSON Event where @@ -200,19 +203,19 @@ -- | a notification hook data Hook=Hook { - hId :: Maybe HookId -- ^ The Id of the hook details + hId :: Maybe HookId -- ^ The Id of the hook details ,hCreationDate :: Maybe POSIXTime - ,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 + ,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 } deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON Hook where - toJSON h=object ["Tag" .= hTag h,"EventType" .= hEventType h,"Url" .= hUrl h,"Status" .= hStatus h] + toJSON h=objectSN ["Tag" .= hTag h,"EventType" .= hEventType h,"Url" .= hUrl h,"Status" .= hStatus h] -- | from json as per MangoPay format instance FromJSON Hook where diff --git a/src/Web/MangoPay/Monad.hs b/src/Web/MangoPay/Monad.hs --- a/src/Web/MangoPay/Monad.hs +++ b/src/Web/MangoPay/Monad.hs @@ -423,7 +423,12 @@ -- | helper function to fetch paginated lists of an entity genericList :: (MPUsableMonad m, FromJSON a) => [T.Text] -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList a) -genericList path mp at = do +genericList = genericListExtra [] + +-- | helper function to fetch paginated lists of an entity, with extra parameters +genericListExtra :: (MPUsableMonad m, FromJSON a) => + [(ByteString,Maybe ByteString)] -> [T.Text] -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList a) +genericListExtra extra path mp at = do url <- getClientURLMultiple path - req <- getGetRequest url (Just at) (paginationAttributes mp) + req <- getGetRequest url (Just at) (extra ++ (paginationAttributes mp)) getJSONList req diff --git a/src/Web/MangoPay/Payins.hs b/src/Web/MangoPay/Payins.hs --- a/src/Web/MangoPay/Payins.hs +++ b/src/Web/MangoPay/Payins.hs @@ -31,19 +31,23 @@ fetchCardPayin :: (MPUsableMonad m) => CardPayinId -> AccessToken -> MangoPayT m CardPayin fetchCardPayin = fetchGeneric "/payins/" + +-- | Type of payment execution. data PaymentExecution = WEB -- ^ through a web interface | DIRECT -- ^ with a tokenized card deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable) + -- | to json as per MangoPay format instance ToJSON PaymentExecution where toJSON =toJSON . show + -- | from json as per MangoPay format instance FromJSON PaymentExecution where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "PaymentExecution" + parseJSON = jsonRead "PaymentExecution" + -- | helper function to create a new bank wire with the needed information mkBankWire :: AnyUserId -> AnyUserId -> WalletId -> Amount -> Amount -> BankWire mkBankWire aid uid wid amount fees= BankWire Nothing Nothing Nothing aid uid Nothing @@ -85,7 +89,7 @@ -- | to json as per MangoPay format instance ToJSON BankWire where - toJSON bw=object ["Tag" .= bwTag bw,"AuthorId" .= bwAuthorId bw + toJSON bw=objectSN ["Tag" .= bwTag bw,"AuthorId" .= bwAuthorId bw ,"CreditedUserId" .= bwCreditedUserId bw,"CreditedWalletId" .= bwCreditedWalletId bw ,"DeclaredDebitedFunds" .= bwDeclaredDebitedFunds bw,"DeclaredFees" .= bwDeclaredFees bw] @@ -154,7 +158,7 @@ -- | to json as per MangoPay format instance ToJSON CardPayin where - toJSON cp=object ["Tag" .= cpTag cp,"AuthorId" .= cpAuthorId cp + toJSON cp=objectSN ["Tag" .= cpTag cp,"AuthorId" .= cpAuthorId cp ,"CreditedUserId" .= cpCreditedUserId cp,"CreditedWalletId" .= cpCreditedWalletId cp ,"DebitedFunds" .= cpDebitedFunds cp,"Fees" .= cpFees cp,"CardId" .= cpCardId cp ,"SecureModeReturnURL" .= cpSecureModeReturnURL cp diff --git a/src/Web/MangoPay/Payouts.hs b/src/Web/MangoPay/Payouts.hs --- a/src/Web/MangoPay/Payouts.hs +++ b/src/Web/MangoPay/Payouts.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings, FlexibleContexts, FlexibleInstances, ConstraintKinds #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, + FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-} -- | handle payouts module Web.MangoPay.Payouts where @@ -22,10 +23,10 @@ fetchPayout :: (MPUsableMonad m) => PayoutId -> AccessToken -> MangoPayT m Payout fetchPayout = fetchGeneric "/payouts/" --- | make a simplep payout for creation +-- | make a simple payout for creation mkPayout :: AnyUserId -> WalletId -> Amount -> Amount -> BankAccountId -> Payout mkPayout aid wid fds fees bid=Payout Nothing Nothing Nothing aid wid fds fees bid Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing -- | id of payout type PayoutId = Text @@ -39,7 +40,7 @@ ,ptDebitedWalletId :: WalletId ,ptDebitedFunds :: Amount ,ptFees :: Amount - ,ptBankAccountId :: BankAccountId + ,ptBankAccountId :: BankAccountId -- ^ The ID of the bank account object ,ptCreditedUserId :: Maybe AnyUserId ,ptCreditedFunds :: Maybe Amount ,ptStatus :: Maybe TransferStatus @@ -50,14 +51,18 @@ ,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 } deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON Payout where - toJSON pt=object ["Tag" .= ptTag pt,"AuthorId" .= ptAuthorId pt + toJSON pt=objectSN ["Tag" .= ptTag pt,"AuthorId" .= ptAuthorId pt ,"DebitedWalletId" .= ptDebitedWalletId pt - ,"DebitedFunds" .= ptDebitedFunds pt,"Fees" .= ptFees pt,"BankAccountId" .= ptBankAccountId pt] + ,"DebitedFunds" .= ptDebitedFunds pt,"Fees" .= ptFees pt,"BankAccountId" .= ptBankAccountId pt + ,"BankWireRef" .= ptBankWireRef pt] -- | from json as per MangoPay format instance FromJSON Payout where @@ -79,5 +84,6 @@ v .:? "Type" <*> v .:? "Nature" <*> v .:? "PaymentType" <*> - v .:? "MeanOfPaymentType" + v .:? "MeanOfPaymentType" <*> + v .:? "BankWireRef" parseJSON _=fail "Payout" diff --git a/src/Web/MangoPay/Refunds.hs b/src/Web/MangoPay/Refunds.hs --- a/src/Web/MangoPay/Refunds.hs +++ b/src/Web/MangoPay/Refunds.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, FlexibleContexts, ConstraintKinds #-} +{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, + OverloadedStrings, PatternGuards #-} -- | refunds on payins and transfers module Web.MangoPay.Refunds where @@ -26,20 +27,21 @@ url<-getClientURLMultiple ["/payins/",pid,"/refunds"] postExchange url (Just at) rr + -- | fetch a refund from its Id fetchRefund :: (MPUsableMonad m) => RefundId -> AccessToken -> MangoPayT m Refund fetchRefund = fetchGeneric "/refunds/" -- | refund request data RefundRequest=RefundRequest{ - rrAuthorId :: AnyUserId -- ^ The user Id of the author + rrAuthorId :: AnyUserId -- ^ The user Id of the author ,rrDebitedFunds :: Maybe Amount -- ^ Strictly positive amount. In cents. - ,rrFees :: Maybe Amount -- ^ In cents + ,rrFees :: Maybe Amount -- ^ In cents }deriving (Show,Eq,Ord,Typeable) -- | to json as per MangoPay format instance ToJSON RefundRequest where - toJSON rr=object ["AuthorId" .= rrAuthorId rr,"DebitedFunds" .= rrDebitedFunds rr, + toJSON rr=objectSN ["AuthorId" .= rrAuthorId rr,"DebitedFunds" .= rrDebitedFunds rr, "Fees" .= rrFees rr] @@ -48,26 +50,28 @@ -- | refund of a transfer data Refund=Refund{ - rId :: RefundId -- ^ Id of the refund - ,rCreationDate :: POSIXTime - ,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 :: POSIXTime - ,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 + rId :: RefundId -- ^ Id of the refund + ,rCreationDate :: POSIXTime + ,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 POSIXTime + ,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 } deriving (Show,Eq,Ord,Typeable) + -- | from json as per MangoPay format instance FromJSON Refund where parseJSON (Object v) =Refund <$> @@ -81,12 +85,46 @@ v .: "Status" <*> v .: "ResultCode" <*> v .:? "ResultMessage" <*> - v .: "ExecutionDate" <*> + v .:? "ExecutionDate" <*> v .: "Type" <*> v .: "Nature" <*> v .:? "CreditedUserId" <*> v .: "InitialTransactionId" <*> v .: "InitialTransactionType" <*> v .: "DebitedWalletId" <*> - v .:? "CreditedWalletID" + v .:? "CreditedWalletID" <*> + v .: "RefundReason" parseJSON _=fail "Refund" + + +-- | Type for redund reason, since . +data RefundReasonType = + BANKACCOUNT_HAS_BEEN_CLOSED + | INITIALIZED_BY_CLIENT + | OTHER + deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable) + + +-- | to json as per MangoPay format +instance ToJSON RefundReasonType where + toJSON =toJSON . show + + +-- | from json as per MangoPay format +instance FromJSON RefundReasonType where + parseJSON = jsonRead "RefundReasonType" + + +-- | Reason for a refund, since . +data RefundReason = RefundReason + { rrMessage :: Maybe Text + , rrType :: RefundReasonType + } deriving (Show,Eq,Ord,Typeable) + + +-- | from json as per MangoPay format +instance FromJSON RefundReason where + parseJSON (Object v) =RefundReason <$> + v .:? "RefundReasonMessage" <*> + v .: "RefundReasonType" + parseJSON _=fail "RefundReason" diff --git a/src/Web/MangoPay/TestUtils.hs b/src/Web/MangoPay/TestUtils.hs --- a/src/Web/MangoPay/TestUtils.hs +++ b/src/Web/MangoPay/TestUtils.hs @@ -87,12 +87,17 @@ testEventTypes evtTs = void . testEventTypes' evtTs +-- | How long to wait for an event, in seconds. +secondsToWaitForEvent :: Integer +secondsToWaitForEvent = 20 + + -- | Same as 'testEventTypes', but also return the resource id. testEventTypes' :: [EventType] -> IO (Maybe Text) -> IO (Maybe Text) testEventTypes' evtTs ops = do res <- liftM tsReceivedEvents $ I.readIORef testState a <- ops - er <- waitForEvent res ((,) a <$> evtTs) 20 + er <- waitForEvent res ((,) a <$> evtTs) secondsToWaitForEvent assertEqual "testEventTypes'" EventsOK er return a diff --git a/src/Web/MangoPay/Types.hs b/src/Web/MangoPay/Types.hs --- a/src/Web/MangoPay/Types.hs +++ b/src/Web/MangoPay/Types.hs @@ -6,12 +6,13 @@ import Control.Applicative import Control.Exception.Lifted (Exception, throwIO) import Control.Monad.Base (MonadBase) -import Data.Text as T hiding (singleton) +import Data.Text as T hiding (singleton, map, toLower) import Data.Text.Read as T import Data.Typeable (Typeable) import Data.ByteString as BS (ByteString) import Data.Time.Clock.POSIX (POSIXTime) import Data.Aeson +import Data.Aeson.Types (Pair,Parser) import Data.Default import qualified Data.Text.Encoding as TE @@ -30,6 +31,7 @@ import Language.Haskell.TH.Syntax (qLocation) import Text.Printf (printf) import qualified Data.ByteString.Lazy as BS (toStrict) +import Data.Char (toLower) -- | the MangoPay access point @@ -53,7 +55,7 @@ -- | to json as per MangoPay format instance ToJSON Credentials where - toJSON c=object ["ClientId" .= cClientId c, "Name" .= cName c , "Email" .= cEmail c,"Passphrase" .= cClientSecret c] + toJSON c=objectSN ["ClientId" .= cClientId c, "Name" .= cName c , "Email" .= cEmail c,"Passphrase" .= cClientSecret c] -- | from json as per MangoPay format instance FromJSON Credentials where @@ -84,7 +86,7 @@ -- | to json as per MangoPay format instance ToJSON OAuthToken where - toJSON oa=object ["access_token" .= oaAccessToken oa, "token_type" .= oaTokenType oa, "expires_in" .= oaExpires oa] + toJSON oa=objectSN ["access_token" .= oaAccessToken oa, "token_type" .= oaTokenType oa, "expires_in" .= oaExpires oa] -- | from json as per MangoPay format instance FromJSON OAuthToken where @@ -111,10 +113,10 @@ -- | to json instance ToJSON MpException where - toJSON (MpJSONException j) = object ["Type" .= ("MpJSONException"::Text), "Error" .= j] - toJSON (MpAppException mpe) = object ["Type" .= ("MpAppException"::Text), "Error" .= toJSON mpe] - toJSON (MpHttpException e v) = object ["Type" .= ("MpHttpException"::Text), "Error" .= (show e), "Value" .= v] - toJSON (MpHttpExceptionS e v) = object ["Type" .= ("MpHttpException"::Text), "Error" .= e, "Value" .= v] + toJSON (MpJSONException j) = objectSN ["Type" .= ("MpJSONException"::Text), "Error" .= j] + toJSON (MpAppException mpe) = objectSN ["Type" .= ("MpAppException"::Text), "Error" .= toJSON mpe] + toJSON (MpHttpException e v) = objectSN ["Type" .= ("MpHttpException"::Text), "Error" .= (show e), "Value" .= v] + toJSON (MpHttpExceptionS e v) = objectSN ["Type" .= ("MpHttpException"::Text), "Error" .= e, "Value" .= v] instance FromJSON MpException where @@ -140,7 +142,7 @@ -- | to json as per MangoPay format instance ToJSON MpError where - toJSON mpe=object ["Id" .= igeId mpe, "Type" .= igeType mpe, "Message" .= igeMessage mpe, "Date" .= igeDate mpe] + toJSON mpe=objectSN ["Id" .= igeId mpe, "Type" .= igeType mpe, "Message" .= igeMessage mpe, "Date" .= igeDate mpe] -- | from json as per MangoPay format @@ -155,7 +157,7 @@ -- | from json as per MangoPay format instance FromJSON POSIXTime where parseJSON n@(Number _)=(fromIntegral . (round::Double -> Integer)) <$> parseJSON n - parseJSON _ = fail "POSIXTime" + parseJSON o = fail $ "POSIXTime: " ++ show o -- | to json as per MangoPay format instance ToJSON POSIXTime where @@ -209,7 +211,7 @@ -- | to json as per MangoPay format instance ToJSON Amount where - toJSON b=object ["Currency" .= aCurrency b,"Amount" .= aAmount b] + toJSON b=objectSN ["Currency" .= aCurrency b,"Amount" .= aAmount b] -- | from json as per MangoPay format instance FromJSON Amount where @@ -329,8 +331,7 @@ toJSON =toJSON . show instance FromJSON KindOfAuthentication where - parseJSON (String s)=pure $ read $ unpack s - parseJSON _ =fail "KindOfAuthentication" + parseJSON = jsonRead "KindOfAuthentication" -- | a structure holding the information of an API call @@ -421,3 +422,44 @@ -- | read an object or return Nothing maybeRead :: Read a => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads + + +-- | Remove pairs whose value is null. +-- +stripNulls :: [Pair] -> [Pair] +stripNulls xs = Prelude.filter (\(_,v) -> v /= Null) xs + + +-- | Same as 'object', but using 'stripNulls' as well. +objectSN :: [Pair] -> Value +objectSN = object . stripNulls + + +-- | Read instance from a JSON string. +-- We use to just call "read" which would cause a Prelude.read: no parse error +-- instead of a proper exception. +jsonRead :: (Read a) => String -> Value -> Parser a +jsonRead name (String s) = do + let ss = unpack s + case maybeRead ss of + Just r -> pure r + _ -> fail $ name ++ ": " ++ ss +jsonRead name _ = fail name + + +-- | Sort direction for list retrieval +data SortDirection = ASC | DESC + deriving (Show,Read,Eq,Ord,Bounded, Enum, Typeable) + +-- | Sort transactions +data GenericSort = NoSort | ByCreationDate SortDirection + deriving (Show,Eq,Ord,Typeable) + +-- | Default sort +instance Default GenericSort where + def = NoSort + +-- | get sort attributes for transaction query +sortAttributes :: GenericSort -> [(ByteString,Maybe ByteString)] +sortAttributes NoSort = [] +sortAttributes (ByCreationDate dir)=["Sort" ?+ ("CreationDate:" ++ (map toLower $ show dir))] diff --git a/src/Web/MangoPay/Users.hs b/src/Web/MangoPay/Users.hs --- a/src/Web/MangoPay/Users.hs +++ b/src/Web/MangoPay/Users.hs @@ -52,8 +52,8 @@ -- | list all user references -listUsers :: (MPUsableMonad m) => Maybe Pagination -> AccessToken -> MangoPayT m (PagedList UserRef) -listUsers = genericList ["/users/"] +listUsers :: (MPUsableMonad m) => GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList UserRef) +listUsers gs = genericListExtra (sortAttributes gs) ["/users/"] -- | Convenience function to extract the user Id of an EXISTING user (one with an id). @@ -109,7 +109,7 @@ -- | to json as per MangoPay format instance ToJSON NaturalUser where - toJSON u=object ["Tag" .= uTag u,"Email" .= uEmail u,"FirstName".= uFirstName u,"LastName" .= uLastName u,"Address" .= uAddress u, "Birthday" .= uBirthday u + toJSON u=objectSN ["Tag" .= uTag u,"Email" .= uEmail u,"FirstName".= uFirstName u,"LastName" .= uLastName u,"Address" .= uAddress u, "Birthday" .= uBirthday u ,"Nationality" .= uNationality u,"CountryOfResidence" .= uCountryOfResidence u,"Occupation" .= uOccupation u, "IncomeRange" .= uIncomeRange u,"ProofOfIdentity" .= uProofOfIdentity u ,"ProofOfAddress" .= uProofOfAddress u,"PersonType" .= Natural] @@ -175,7 +175,7 @@ -- | to json as per MangoPay format instance ToJSON LegalUser where - toJSON u=object ["Tag" .= lTag u,"Email" .= lEmail u,"Name".= lName u,"LegalPersonType" .= lLegalPersonType u,"HeadquartersAddress" .= lHeadquartersAddress u, "LegalRepresentativeFirstName" .= lLegalRepresentativeFirstName u + toJSON u=objectSN ["Tag" .= lTag u,"Email" .= lEmail u,"Name".= lName u,"LegalPersonType" .= lLegalPersonType u,"HeadquartersAddress" .= lHeadquartersAddress u, "LegalRepresentativeFirstName" .= lLegalRepresentativeFirstName u ,"LegalRepresentativeLastName" .= lLegalRepresentativeLastName u,"LegalRepresentativeAddress" .= lLegalRepresentativeAddress u,"LegalRepresentativeEmail" .= lLegalRepresentativeEmail u, "LegalRepresentativeBirthday" .= lLegalRepresentativeBirthday u,"LegalRepresentativeNationality" .= lLegalRepresentativeNationality u ,"LegalRepresentativeCountryOfResidence" .= lLegalRepresentativeCountryOfResidence u,"Statute" .= lStatute u,"ProofOfRegistration" .=lProofOfRegistration u,"ShareholderDeclaration" .=lShareholderDeclaration u,"PersonType" .= Legal] @@ -228,7 +228,7 @@ -- | to json as per MangoPay format instance ToJSON UserRef where - toJSON ur=object [ "PersonType" .= urPersonType ur, "Email" .= urEmail ur,"Id" .= urId ur, + toJSON ur=objectSN [ "PersonType" .= urPersonType ur, "Email" .= urEmail ur,"Id" .= urId ur, "Tag" .= urTag ur,"CreationDate" .= urCreationDate ur] diff --git a/src/Web/MangoPay/Wallets.hs b/src/Web/MangoPay/Wallets.hs --- a/src/Web/MangoPay/Wallets.hs +++ b/src/Web/MangoPay/Wallets.hs @@ -9,12 +9,15 @@ import Web.MangoPay.Types import Web.MangoPay.Users -import Data.Text +import Data.ByteString (ByteString) +import Data.Text hiding (map,toLower) import Data.Typeable (Typeable) import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative import qualified Data.HashMap.Lazy as HM (delete) +import Data.Default (Default(..)) +import Data.Char (toLower) -- | create a wallet createWallet :: (MPUsableMonad m) => Wallet -> AccessToken -> MangoPayT m Wallet @@ -31,8 +34,8 @@ fetchWallet = fetchGeneric "/wallets/" -- | list all wallets for a given user -listWallets :: (MPUsableMonad m) => AnyUserId -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Wallet) -listWallets uid = genericList ["/users/",uid,"/wallets"] +listWallets :: (MPUsableMonad m) => AnyUserId -> GenericSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Wallet) +listWallets uid gs = genericListExtra (sortAttributes gs) ["/users/",uid,"/wallets"] -- | create a new fund transfer createTransfer :: (MPUsableMonad m) => Transfer -> AccessToken -> MangoPayT m Transfer @@ -43,12 +46,14 @@ fetchTransfer = fetchGeneric "/transfers/" -- | list transfers for a given wallet -listTransactions :: (MPUsableMonad m) => WalletId -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction) -listTransactions wid = genericList ["/wallets/",wid,"/transactions"] +listTransactions :: (MPUsableMonad m) => WalletId -> TransactionFilter -> TransactionSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction) +listTransactions wid tf ts = genericListExtra (transactionFilterAttributes tf ++ transactionSortAttributes ts) + ["/wallets/",wid,"/transactions"] -- | list transfer for a given user -listTransactionsForUser :: (MPUsableMonad m) => AnyUserId -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction) -listTransactionsForUser uid = genericList ["/users/",uid,"/transactions"] +listTransactionsForUser :: (MPUsableMonad m) => AnyUserId -> TransactionFilter -> TransactionSort -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction) +listTransactionsForUser uid tf ts = genericListExtra (transactionFilterAttributes tf ++ transactionSortAttributes ts) + ["/users/",uid,"/transactions"] -- | Id of a wallet @@ -68,7 +73,7 @@ -- | to json as per MangoPay format instance ToJSON Wallet where - toJSON w=object ["Tag" .= wTag w,"Owners" .= wOwners w,"Description" .= wDescription w,"Currency" .= wCurrency w] + toJSON w=objectSN ["Tag" .= wTag w,"Owners" .= wOwners w,"Description" .= wDescription w,"Currency" .= wCurrency w] -- | from json as per MangoPay format instance FromJSON Wallet where @@ -124,7 +129,7 @@ -- | to json as per MangoPay format instance ToJSON Transfer where - toJSON t=object ["AuthorId" .= tAuthorId t,"CreditedUserId" .= tCreditedUserId t,"DebitedFunds" .= tDebitedFunds t, + toJSON t=objectSN ["AuthorId" .= tAuthorId t,"CreditedUserId" .= tCreditedUserId t,"DebitedFunds" .= tDebitedFunds t, "Fees" .= tFees t,"DebitedWalletId" .= tDebitedWalletId t,"CreditedWalletId" .= tCreditedWalletId t, "Tag" .= tTag t] @@ -191,7 +196,7 @@ ,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) + ,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 @@ -204,7 +209,7 @@ -- | to json as per MangoPay format instance ToJSON Transaction where - toJSON t=object ["AuthorId" .= txAuthorId t,"CreditedUserId" .= txCreditedUserId t,"DebitedFunds" .= txDebitedFunds t, + toJSON t=objectSN ["AuthorId" .= txAuthorId t,"CreditedUserId" .= txCreditedUserId t,"DebitedFunds" .= txDebitedFunds t, "Fees" .= txFees t,"DebitedWalletID" .= txDebitedWalletId t,"CreditedWalletID" .= txCreditedWalletId t, "Tag" .= txTag t,"Type" .= txType t,"Nature" .= txNature t] @@ -218,8 +223,8 @@ v .: "CreditedUserId" <*> v .: "DebitedFunds" <*> v .: "Fees" <*> - v .:? "DebitedWalletId" <*> -- yes, it's Id one way, Id the other - v .:? "CreditedWalletId" <*> -- yes, it's Id one way, Id the other + v .:? "DebitedWalletId" <*> -- yes, it's Id one way, ID the other + v .:? "CreditedWalletId" <*> -- yes, it's Id one way, ID the other v .:? "CreditedFunds" <*> v .:? "Status" <*> v .:? "ResultCode" <*> @@ -228,3 +233,39 @@ v .: "Type" <*> v .: "Nature" parseJSON _=fail "Transfer" + + +-- | A filter for transaction lists. +data TransactionFilter = TransactionFilter + { tfBefore :: Maybe POSIXTime + , tfAfter :: Maybe POSIXTime + , tfNature :: Maybe TransactionNature + , tfStatus :: Maybe TransferStatus + , tfType :: Maybe TransactionType + } deriving (Show,Eq,Ord,Typeable) + +instance Default TransactionFilter where + def = TransactionFilter Nothing Nothing Nothing Nothing Nothing + +-- | get filter attributes for transaction query +transactionFilterAttributes :: TransactionFilter -> [(ByteString,Maybe ByteString)] +transactionFilterAttributes f=[ "BeforeDate" ?+ tfBefore f + , "AfterDate" ?+ tfAfter f + , "Nature" ?+ (show <$> (tfNature f)) + , "Status" ?+ (show <$> (tfStatus f)) + , "Type" ?+ (show <$> (tfType f))] + +-- | Sort transactions +data TransactionSort = TxNoSort | TxByCreationDate SortDirection | TxByExecutionDate SortDirection + deriving (Show,Eq,Ord,Typeable) + +-- | Default sort +instance Default TransactionSort where + def = TxNoSort + +-- | get sort attributes for transaction query +transactionSortAttributes :: TransactionSort -> [(ByteString,Maybe ByteString)] +transactionSortAttributes TxNoSort = [] +transactionSortAttributes (TxByCreationDate dir)=["Sort" ?+ ("CreationDate:" ++ (map toLower $ show dir))] +transactionSortAttributes (TxByExecutionDate dir)=["Sort" ?+ ("ExecutionDate:" ++ (map toLower $ show dir))] + diff --git a/test/Web/MangoPay/AccountsTest.hs b/test/Web/MangoPay/AccountsTest.hs --- a/test/Web/MangoPay/AccountsTest.hs +++ b/test/Web/MangoPay/AccountsTest.hs @@ -6,24 +6,40 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default +import Control.Monad (guard) import Data.Maybe (isJust, fromJust) import Test.Framework import Test.HUnit (Assertion) --- | test bank account creation -test_BankAccount :: Assertion -test_BankAccount=do - usL<-testMP $ listUsers (Just $ Pagination 1 1) +-- | Test bank account creation using IBAN with BIC. +test_BankAccount_IBAN_BIC :: Assertion +test_BankAccount_IBAN_BIC = doBankAccountTest True + + +-- | Test bank account creation using IBAN without BIC. +test_BankAccount_IBAN_only :: Assertion +test_BankAccount_IBAN_only = doBankAccountTest False + + +-- | Do the bank account test, using the BIC or not. +doBankAccountTest :: Bool -> Assertion +doBankAccountTest useBIC = do + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) - let uid=urId $ head $ plData usL - let details=IBAN "FR3020041010124530725S03383" "CRLYFRPP" - let acc1=BankAccount Nothing Nothing (Just uid) Nothing details "JP Moresmau" (Just "Earth") + let uid = urId $ head $ plData usL + iban = "FR3020041010124530725S03383" + bic = "CRLYFRPP" + details = IBAN iban (guard useBIC >> return bic) + acc1=BankAccount Nothing Nothing (Just uid) Nothing details "JP Moresmau" (Just "Earth") acc2<-testMP $ createAccount acc1 assertBool $ isJust $ baId acc2 assertBool $ isJust $ baCreationDate acc2 - assertEqual details $ baDetails acc2 + assertEqual iban $ atIBAN $ baDetails acc2 + if useBIC + then assertEqual (Just bic) $ atBIC $ baDetails acc2 + else assertBool $ isJust $ atBIC $ baDetails acc2 -- MangoPay fills in the BIC. acc3<-testMP $ fetchAccount uid $ fromJust $ baId acc2 - assertEqual details $ baDetails acc3 - accs<-testMP $ listAccounts uid Nothing + assertEqual (baDetails acc2) (baDetails acc3) + accs<-testMP $ listAccounts uid def Nothing assertBool $ acc3 `elem` (plData accs) - diff --git a/test/Web/MangoPay/CardsTest.hs b/test/Web/MangoPay/CardsTest.hs --- a/test/Web/MangoPay/CardsTest.hs +++ b/test/Web/MangoPay/CardsTest.hs @@ -6,6 +6,7 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default import Data.Maybe (isJust, isNothing, fromJust) import Test.Framework import Test.HUnit (Assertion) @@ -24,7 +25,7 @@ -- | perform the actual test of card registration in the provided currency doTestCard :: T.Text->Assertion doTestCard curr=L.handle (\(e::MpException)->assertFailure (show e)) $ do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL let cr1=mkCardRegistration uid curr @@ -51,10 +52,6 @@ assertBool $ cActive c assertEqual uid $ cUserId c assertEqual "CB_VISA_MASTERCARD" $ cCardType c - cs<-testMP $ getAll $ listCards uid + cs<-testMP $ getAll $ listCards uid def assertBool $ not $ null cs assertBool $ any (\ c1 -> cId c1 == cid) cs - - - - diff --git a/test/Web/MangoPay/DocumentsTest.hs b/test/Web/MangoPay/DocumentsTest.hs --- a/test/Web/MangoPay/DocumentsTest.hs +++ b/test/Web/MangoPay/DocumentsTest.hs @@ -6,6 +6,7 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default import Test.Framework import Test.HUnit (Assertion) import Data.Maybe (isJust, fromJust) @@ -14,7 +15,7 @@ -- | test document API test_Document :: Assertion test_Document = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL euser <- testMP $ getUser uid @@ -33,13 +34,25 @@ assertEqual (dId d2) (dId d3) d4<-testMP $ fetchDocument uid (fromJust $ dId d2) assertEqual (Just VALIDATION_ASKED) (dStatus d4) + docsUser <- testMP $ getAll $ listDocuments uid def def + assertBool $ d3 `elem` docsUser + docsUserI <- testMP $ getAll $ listDocuments uid def{dfType=Just IDENTITY_PROOF} def + assertBool $ d3 `elem` docsUserI + docsUserA <- testMP $ getAll $ listDocuments uid def{dfType=Just ADDRESS_PROOF} def + assertBool $ not $ d3 `elem` docsUserA + docsAll <- testMP $ getAll $ listAllDocuments def def + assertBool $ d3 `elem` docsAll + docsAllI <- testMP $ getAll $ listAllDocuments def{dfType=Just IDENTITY_PROOF} def + assertBool $ d3 `elem` docsAllI + docsAllA <- testMP $ getAll $ listAllDocuments def{dfType=Just ADDRESS_PROOF} def + assertBool $ not $ d3 `elem` docsAllA return $ dId d2 -- | test type of authentication test_KindOfAuthentication :: Assertion test_KindOfAuthentication = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL euser <- testMP $ getUser uid diff --git a/test/Web/MangoPay/PayinsTest.hs b/test/Web/MangoPay/PayinsTest.hs --- a/test/Web/MangoPay/PayinsTest.hs +++ b/test/Web/MangoPay/PayinsTest.hs @@ -6,6 +6,7 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default import Data.Maybe (isJust, fromJust) import Test.Framework import Test.HUnit (Assertion) @@ -13,7 +14,7 @@ -- | test bankwire test_BankWire :: Assertion test_BankWire=do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing @@ -32,7 +33,7 @@ -- | test a successful card pay in test_CardOK :: Assertion test_CardOK = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 @@ -49,15 +50,17 @@ assertEqual (Just Succeeded) (cpStatus cp2) w3<-testMP $ fetchWallet wid assertEqual (Just $ Amount "EUR" 332) (wBalance w3) - ts1 <- testMP $ listTransactions wid Nothing + ts1 <- testMP $ listTransactions wid (def{tfStatus=Just Succeeded,tfType=Just PAYIN}) def Nothing assertEqual 1 (length $ filter ((cpId cp2==) . txId) $ plData ts1) + ts2 <- testMP $ listTransactions wid (def{tfStatus=Just Succeeded,tfType=Just PAYOUT}) def Nothing + assertEqual 0 (length $ filter ((cpId cp2==) . txId) $ plData ts2) return $ cpId cp2 -- | test a failed card pay in -- according to test_CardKO :: Assertion test_CardKO = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 @@ -67,7 +70,7 @@ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) let wid=fromJust $ wId w2 - testEventTypes [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_FAILED] $ do + testEventTypes [PAYIN_NORMAL_CREATED {- ,PAYIN_NORMAL_FAILED not thrown - MangoPay support notified -}] $ do let cp=mkCardPayin uid uid wid (Amount "EUR" 33394) (Amount "EUR" 0) "http://dummy" cid cp2<-testMP $ createCardPayin cp assertBool (isJust $ cpId cp2) diff --git a/test/Web/MangoPay/PayoutsTest.hs b/test/Web/MangoPay/PayoutsTest.hs --- a/test/Web/MangoPay/PayoutsTest.hs +++ b/test/Web/MangoPay/PayoutsTest.hs @@ -6,6 +6,7 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default import Data.Maybe (isJust, fromJust) import Test.Framework import Test.HUnit (Assertion) @@ -13,41 +14,44 @@ -- | test successful payout test_PayoutOK :: Assertion test_PayoutOK=do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL - accs<-testMP $ listAccounts uid Nothing + accs<-testMP $ listAccounts uid def Nothing assertBool $ not $ null $ plData accs let aid=fromJust $ baId $ head $ plData accs - ws<- testMP $ listWallets uid Nothing + ws<- testMP $ listWallets uid def Nothing assertBool $ not $ null $ plData ws let wid=fromJust $ wId $ head $ plData ws let Just (Amount _ nb) =wBalance $ head $ plData ws assertBool $ nb >= 100 - -- no events triggered !!! - --testEventTypes [PAYOUT_NORMAL_SUCCEEDED] $ do - let pt1=mkPayout uid wid (Amount "EUR" 100) (Amount "EUR" 0) aid - pt2<-testMP $ createPayout pt1 - assertBool $ isJust $ ptId pt2 - assertEqual (Just Created) (ptStatus pt2) - assertEqual (Just (Amount "EUR" 100)) (ptCreditedFunds pt2) - pt3 <- testMP $ fetchPayout $ fromJust $ ptId pt2 - assertEqual (Just BANK_WIRE) (ptPaymentType pt3) - -- return $ ptId pt2 + -- Fixed in Okapi + -- IMPORTANT: we don't get the PAYOUT_NORMAL_SUCCESSFUL since the payout needs to be validated + testEventTypes [PAYOUT_NORMAL_CREATED] $ do + let pt1=(mkPayout uid wid (Amount "EUR" 100) (Amount "EUR" 0) aid){ptBankWireRef=Just "ref"} + pt2<-testMP $ createPayout pt1 + assertBool $ isJust $ ptId pt2 + assertEqual (Just Created) (ptStatus pt2) + assertEqual (Just (Amount "EUR" 100)) (ptCreditedFunds pt2) + pt3 <- testMP $ fetchPayout $ fromJust $ ptId pt2 + assertEqual (Just BANK_WIRE) (ptPaymentType pt3) + assertEqual (Just "ref") (ptBankWireRef pt3) + return $ ptId pt2 -- | test failing payout test_PayoutKO :: Assertion test_PayoutKO=do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL - accs<-testMP $ listAccounts uid Nothing + accs<-testMP $ listAccounts uid def Nothing assertBool $ not $ null $ plData accs let aid=fromJust $ baId $ head $ plData accs - ws<- testMP $ listWallets uid Nothing + ws<- testMP $ listWallets uid def Nothing assertBool $ not $ null $ plData ws let wid=fromJust $ wId $ head $ plData ws - testEventTypes [PAYOUT_NORMAL_FAILED] $ do + -- Fixed in Okapi + testEventTypes [PAYOUT_NORMAL_CREATED,PAYOUT_NORMAL_FAILED] $ do let pt1=mkPayout uid wid (Amount "EUR" 100000) (Amount "EUR" 0) aid pt2<-testMP $ createPayout pt1 assertBool $ isJust $ ptId pt2 diff --git a/test/Web/MangoPay/RefundsTest.hs b/test/Web/MangoPay/RefundsTest.hs --- a/test/Web/MangoPay/RefundsTest.hs +++ b/test/Web/MangoPay/RefundsTest.hs @@ -6,6 +6,7 @@ import Web.MangoPay import Web.MangoPay.TestUtils +import Data.Default import Data.Maybe (isJust, fromJust) import Test.Framework import Test.HUnit (Assertion) @@ -13,7 +14,7 @@ -- | test a successful card pay in + full refund test_SimpleCardRefund :: Assertion test_SimpleCardRefund = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 @@ -38,12 +39,13 @@ r2<-testMP $ fetchRefund (rId r) assertEqual cp $ rInitialTransactionId r2 assertEqual (Amount "EUR" 333) $ rCreditedFunds r2 + assertEqual INITIALIZED_BY_CLIENT $ rrType $ rReason r2 return $ Just $ rId r -- | test a successful card pay in + partial refund test_AdvancedCardRefund :: Assertion test_AdvancedCardRefund = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 @@ -68,12 +70,13 @@ r2<-testMP $ fetchRefund (rId r) assertEqual cp $ rInitialTransactionId r2 assertEqual (Amount "EUR" 99) $ rCreditedFunds r2 + assertEqual INITIALIZED_BY_CLIENT $ rrType $ rReason r2 return $ Just $ rId r -- | test transfer + full refund test_TransferRefund :: Assertion test_TransferRefund = do - usL<-testMP $ listUsers (Just $ Pagination 1 2) + usL<-testMP $ listUsers def (Just $ Pagination 1 2) assertEqual 2 (length $ plData usL) let [uid1,uid2] = map urId $ plData usL assertBool (uid1 /= uid2) @@ -94,7 +97,8 @@ assertEqual (Just Succeeded) (cpStatus cp2) return $ cpId cp2 - (Just tr)<-testEventTypes' [{- TRANSFER_NORMAL_CREATED, Not being sent as of 2014-09-19 -} TRANSFER_NORMAL_SUCCEEDED] $ do + (Just tr)<-testEventTypes' [TRANSFER_NORMAL_CREATED {- Fixed in Okapi -} + ,TRANSFER_NORMAL_SUCCEEDED] $ do let t1=Transfer Nothing Nothing Nothing uid1 (Just uid2) (Amount "EUR" 100) (Amount "EUR" 1) uw1 uw2 Nothing Nothing Nothing Nothing Nothing t1'<-testMP $ createTransfer t1 @@ -102,11 +106,15 @@ assertEqual (Just $ Amount "EUR" 99) (tCreditedFunds t1') t2'<-testMP $ fetchTransfer (fromJust $ tId t1') assertEqual t1' t2' - ts1 <- testMP $ listTransactions uw1 Nothing + ts1 <- testMP $ listTransactions uw1 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1) - ts2 <- testMP $ listTransactions uw2 Nothing + ts1t <- testMP $ listTransactions uw1 def{tfType=Just TRANSFER} def Nothing + assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1t) + ts1p <- testMP $ listTransactions uw1 def{tfType=Just PAYOUT} def Nothing + assertEqual 0 (length $ filter ((tId t1'==) . txId) $ plData ts1p) + ts2 <- testMP $ listTransactions uw2 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts2) - uts1 <- testMP $ listTransactionsForUser uid1 (Just $ Pagination 1 50) + uts1 <- testMP $ listTransactionsForUser uid1 def def (Just $ Pagination 1 50) assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) return $ tId t1' @@ -116,4 +124,6 @@ r2<-testMP $ fetchRefund (rId r) assertEqual tr $ rInitialTransactionId r2 assertEqual (Amount "EUR" 100) $ rCreditedFunds r2 + assertEqual OTHER $ rrType $ rReason r2 return $ Just $ rId r + diff --git a/test/Web/MangoPay/UsersTest.hs b/test/Web/MangoPay/UsersTest.hs --- a/test/Web/MangoPay/UsersTest.hs +++ b/test/Web/MangoPay/UsersTest.hs @@ -10,6 +10,7 @@ import Data.Maybe (fromJust, isJust) import Data.CountryCodes (CountryCode(FR)) +import Data.Default testNaturalUser :: NaturalUser testNaturalUser=NaturalUser Nothing Nothing "jpmoresmau@gmail.com" "JP" "Moresmau" Nothing 11111 FR FR @@ -28,7 +29,7 @@ assertEqual (Just IncomeRange2) (uIncomeRange ue) eu<-testMP $ getUser (fromJust $ uId u) assertEqual (Left ue) eu - usL<-testMP $ listUsers (Just $ Pagination 1 100) + usL<-testMP $ listUsers def (Just $ Pagination 1 100) assertEqual 1 (length $ filter (((fromJust $ uId u)==) . urId) $ plData usL) assertEqual (fromJust $ uId u) (getExistingUserId $ Left u) @@ -47,25 +48,35 @@ le<-testMP $ modifyLegalUser (lf{lHeadquartersAddress=Just "St Guilhem"}) assertEqual (Just "St Guilhem") (lHeadquartersAddress le) assertEqual "Moresmau" (lLegalRepresentativeLastName le) - assertEqual (Just "my house") (lLegalRepresentativeAddress le) -- this is lost, see https://mangopay.desk.com/customer/portal/questions/5980417-legalrepresentativeaddress-in-legaluser-api + assertEqual (Just "my house") (lLegalRepresentativeAddress le) -- works since Zebre assertEqual Nothing (lProofOfRegistration le) assertEqual Nothing (lShareholderDeclaration le) el<-testMP $ getUser (fromJust $ lId l) assertEqual (Right le) el - usL<-testMP $ listUsers (Just $ Pagination 1 100) + usL<-testMP $ listUsers def (Just $ Pagination 1 100) assertEqual 1 (length $ filter (((fromJust $ lId l)==) . urId) $ plData usL) assertEqual (fromJust $ lId l) (getExistingUserId $ Right l) test_PaginationUsers :: Assertion test_PaginationUsers = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) --print usL assertEqual 1 (length $ plData usL) assertEqual 2 (plItemCount usL) assertEqual 2 (plPageCount usL) - usL2<-testMP $ listUsers (Just $ Pagination 1 10) + usL2<-testMP $ listUsers def (Just $ Pagination 1 10) assertEqual 2 (length $ plData usL2) assertEqual 2 (plItemCount usL2) assertEqual 1 (plPageCount usL2) - us<-testMP $ getAll listUsers + us<-testMP $ getAll $ listUsers def assertEqual 2 (length us) + +test_OrderUsers :: Assertion +test_OrderUsers = do + usL<-testMP $ listUsers (ByCreationDate ASC) (Just $ Pagination 1 10) + assertEqual 2 (length $ plData usL) + let idsAsc = map urId $ plData usL + usLd<-testMP $ listUsers (ByCreationDate DESC) (Just $ Pagination 1 10) + assertEqual 2 (length $ plData usLd) + let idsDesc = map urId $ plData usLd + assertEqual idsAsc $ reverse idsDesc diff --git a/test/Web/MangoPay/WalletsTest.hs b/test/Web/MangoPay/WalletsTest.hs --- a/test/Web/MangoPay/WalletsTest.hs +++ b/test/Web/MangoPay/WalletsTest.hs @@ -8,12 +8,13 @@ import Test.Framework import Test.HUnit (Assertion) +import Data.Default import Data.Maybe (isJust, fromJust) -- | test wallet API test_Wallet :: Assertion test_Wallet = do - usL<-testMP $ listUsers (Just $ Pagination 1 1) + usL<-testMP $ listUsers def (Just $ Pagination 1 1) assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing @@ -27,18 +28,18 @@ assertEqual (Just "custom2") (wTag w4) assertEqual (wId w2) (wId w4) assertEqual (Just $ Amount "EUR" 0) (wBalance w4) - ws<-testMP $ listWallets uid (Just $ Pagination 1 100) + ws<-testMP $ listWallets uid def (Just $ Pagination 1 100) assertBool (not (null $ plData ws)) assertEqual 1 (length $ filter ((wId w3 ==) . wId) $ plData ws) -- | test transfer API + notifications on failure test_FailedTransfer :: Assertion test_FailedTransfer = do - usL<-testMP $ listUsers (Just $ Pagination 1 2) + usL<-testMP $ listUsers def (Just $ Pagination 1 2) assertEqual 2 (length $ plData usL) let [uid1,uid2] = map urId $ plData usL assertBool (uid1 /= uid2) - ws<- testMP $ listWallets uid1 Nothing + ws<- testMP $ listWallets uid1 def Nothing assertBool $ not $ null $ plData ws let uw1=fromJust $ wId $ head $ plData ws let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing @@ -46,7 +47,8 @@ let uw2=fromJust $ wId w2' assertBool (uw1 /= uw2) -- transfer will fail since I have no money - testEventTypes [{- TRANSFER_NORMAL_CREATED, Not being sent as of 2014-09-19 -} TRANSFER_NORMAL_FAILED] $ do + testEventTypes [TRANSFER_NORMAL_CREATED {- Fixed in Okapi -} + , TRANSFER_NORMAL_FAILED] $ do let t1=Transfer Nothing Nothing Nothing uid1 (Just uid2) (Amount "EUR" 100) (Amount "EUR" 1) uw1 uw2 Nothing Nothing Nothing Nothing Nothing t1'<-testMP $ createTransfer t1 @@ -54,22 +56,28 @@ assertEqual (Just $ Amount "EUR" 99) (tCreditedFunds t1') t2'<-testMP $ fetchTransfer (fromJust $ tId t1') assertEqual t1' t2' - ts1 <- testMP $ listTransactions uw1 Nothing + ts1 <- testMP $ listTransactions uw1 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1) - ts2 <- testMP $ listTransactions uw2 Nothing + ts1f <- testMP $ listTransactions uw1 (def{tfStatus=Just Failed}) def Nothing + assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1f) + ts1ft <- testMP $ listTransactions uw1 (def{tfStatus=Just Failed,tfType=Just TRANSFER}) def Nothing + assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1ft) + ts1st <- testMP $ listTransactions uw1 (def{tfStatus=Just Succeeded,tfType=Just TRANSFER}) def Nothing + assertEqual 0 (length $ filter ((tId t1'==) . txId) $ plData ts1st) + ts2 <- testMP $ listTransactions uw2 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts2) - uts1 <- testMP $ listTransactionsForUser uid1 Nothing + uts1 <- testMP $ listTransactionsForUser uid1 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) return $ tId t1' -- | test transfer API + notifications on success test_SuccessfulTransfer :: Assertion test_SuccessfulTransfer = do - usL<-testMP $ listUsers (Just $ Pagination 1 2) + usL<-testMP $ listUsers def (Just $ Pagination 1 2) assertEqual 2 (length $ plData usL) let [uid1,uid2] = map urId $ plData usL assertBool (uid1 /= uid2) - ws<- testMP $ listWallets uid1 Nothing + ws<- testMP $ listWallets uid1 def Nothing assertBool $ not $ null $ plData ws let uw1=fromJust $ wId $ head $ plData ws let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing @@ -86,7 +94,8 @@ assertEqual (Just Succeeded) (cpStatus cp2) return $ cpId cp2 - testEventTypes [{- TRANSFER_NORMAL_CREATED, Not being sent as of 2014-09-19 -} TRANSFER_NORMAL_SUCCEEDED] $ do + testEventTypes [TRANSFER_NORMAL_CREATED {- Fixed in Okapi -} + , TRANSFER_NORMAL_SUCCEEDED] $ do let t1=Transfer Nothing Nothing Nothing uid1 (Just uid2) (Amount "EUR" 100) (Amount "EUR" 1) uw1 uw2 Nothing Nothing Nothing Nothing Nothing t1'<-testMP $ createTransfer t1 @@ -94,10 +103,31 @@ assertEqual (Just $ Amount "EUR" 99) (tCreditedFunds t1') t2'<-testMP $ fetchTransfer (fromJust $ tId t1') assertEqual t1' t2' - ts1 <- testMP $ listTransactions uw1 Nothing + ts1 <- testMP $ listTransactions uw1 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts1) - ts2 <- testMP $ listTransactions uw2 Nothing + ts2 <- testMP $ listTransactions uw2 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts2) - uts1 <- testMP $ listTransactionsForUser uid1 Nothing + uts1 <- testMP $ listTransactionsForUser uid1 def def Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) return $ tId t1' + + +test_OrderTransactions :: Assertion +test_OrderTransactions = do + usL<-testMP $ listUsers def (Just $ Pagination 1 2) + assertEqual 2 (length $ plData usL) + let uid1 = head $ map urId $ plData usL + uts1 <- testMP $ listTransactionsForUser uid1 def (TxByExecutionDate ASC) Nothing + assertBool $ length (plData uts1) > 1 + uts2 <- testMP $ listTransactionsForUser uid1 def (TxByExecutionDate DESC) Nothing + assertEqual (map txId $ plData uts1) $ reverse $ map txId $ plData uts2 + utsc1 <- testMP $ listTransactionsForUser uid1 def (TxByCreationDate ASC) Nothing + assertBool $ length (plData utsc1) > 1 + utsc2 <- testMP $ listTransactionsForUser uid1 def (TxByCreationDate DESC) Nothing + assertEqual (map txId $ plData utsc1) $ reverse $ map txId $ plData utsc2 + +test_OrderEvents :: Assertion +test_OrderEvents = do + evt1 <- testMP $ searchAllEvents def{espSortByDate=Just ASC} + evt2 <- testMP $ searchAllEvents def{espSortByDate=Just DESC} + assertEqual evt1 $ reverse evt2 diff --git a/test/mangopay-tests.hs b/test/mangopay-tests.hs --- a/test/mangopay-tests.hs +++ b/test/mangopay-tests.hs @@ -13,9 +13,9 @@ import {-@ HTF_TESTS @-} Web.MangoPay.DocumentsTest import {-@ HTF_TESTS @-} Web.MangoPay.PayinsTest import {-@ HTF_TESTS @-} Web.MangoPay.CardsTest -import {-@ HTF_TESTS @-} Web.MangoPay.RefundsTest import {-@ HTF_TESTS @-} Web.MangoPay.AccountsTest import {-@ HTF_TESTS @-} Web.MangoPay.PayoutsTest +import {-@ HTF_TESTS @-} Web.MangoPay.RefundsTest import Web.MangoPay.TestUtils