mangopay 1.7.0 → 1.8.0
raw patch · 25 files changed
+416/−416 lines, 25 filesnew-uploader
Files
- mangopay.cabal +1/−1
- src/Web/MangoPay.hs +18/−12
- src/Web/MangoPay/Access.hs +4/−4
- src/Web/MangoPay/Accounts.hs +30/−35
- src/Web/MangoPay/Cards.hs +26/−35
- src/Web/MangoPay/Documents.hs +14/−17
- src/Web/MangoPay/Events.hs +10/−19
- src/Web/MangoPay/Monad.hs +55/−1
- src/Web/MangoPay/Payins.hs +29/−40
- src/Web/MangoPay/Payouts.hs +9/−15
- src/Web/MangoPay/Refunds.hs +9/−13
- src/Web/MangoPay/Types.hs +49/−25
- src/Web/MangoPay/Users.hs +22/−38
- src/Web/MangoPay/Wallets.hs +52/−73
- test/Web/MangoPay/AccessTest.hs +1/−1
- test/Web/MangoPay/AccountsTest.hs +2/−2
- test/Web/MangoPay/CardsTest.hs +12/−12
- test/Web/MangoPay/DocumentsTest.hs +4/−4
- test/Web/MangoPay/PayinsTest.hs +13/−13
- test/Web/MangoPay/PayoutsTest.hs +9/−9
- test/Web/MangoPay/RefundsTest.hs +21/−21
- test/Web/MangoPay/SimpleTest.hs +2/−2
- test/Web/MangoPay/TestUtils.hs +5/−5
- test/Web/MangoPay/UsersTest.hs +4/−4
- test/Web/MangoPay/WalletsTest.hs +15/−15
mangopay.cabal view
@@ -1,5 +1,5 @@ name: mangopay-version: 1.7.0+version: 1.8.0 cabal-version: >= 1.8 build-type: Simple author: JP Moresmau <jpmoresmau@gmail.com>
src/Web/MangoPay.hs view
@@ -38,9 +38,11 @@ ,UserRef(..) ,PersonType(..) ,AnyUserID- ,storeNaturalUser+ ,createNaturalUser+ ,modifyNaturalUser ,fetchNaturalUser- ,storeLegalUser+ ,createLegalUser+ ,modifyLegalUser ,fetchLegalUser ,getUser ,listUsers@@ -51,7 +53,8 @@ ,Amount(..) ,WalletID ,Currency- ,storeWallet+ ,createWallet+ ,modifyWallet ,fetchWallet ,listWallets ,Transfer(..)@@ -77,7 +80,8 @@ ,HookValidity(..) ,HookID ,Hook(..)- ,storeHook+ ,createHook+ ,modifyHook ,fetchHook ,listHooks ,eventFromQueryString@@ -88,9 +92,10 @@ ,DocumentID ,DocumentType(..) ,DocumentStatus(..)- ,storeDocument+ ,createDocument+ ,modifyDocument ,fetchDocument- ,storePage+ ,createPage ,getKindOfAuthentication ,getRequiredDocumentTypes @@ -99,7 +104,7 @@ ,BankAccountID ,BankAccountDetails(..) ,PaymentType(..)- ,storeAccount+ ,createAccount ,fetchAccount ,listAccounts @@ -107,12 +112,12 @@ ,PaymentExecution(..) ,BankWireID ,BankWire(..)- ,storeBankWire- ,fetchBankWire+ ,createBankWirePayIn+ ,fetchBankWirePayIn ,mkBankWire ,CardPayinID ,CardPayin(..)- ,storeCardPayin+ ,createCardPayin ,fetchCardPayin ,mkCardPayin @@ -120,7 +125,7 @@ ,PayoutID ,Payout(..) ,mkPayout- ,storePayout+ ,createPayout ,fetchPayout -- Cards@@ -131,7 +136,8 @@ ,Card(..) ,CardValidity(..) ,mkCardRegistration- ,storeCardRegistration+ ,createCardRegistration+ ,modifyCardRegistration ,fetchCard ,listCards
src/Web/MangoPay/Access.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings, ConstraintKinds #-} -- | access methods for login, creating clients...-module Web.MangoPay.Access +module Web.MangoPay.Access ( createCredentialsSecret ,oauthLogin@@ -21,9 +21,9 @@ -- | populate the passphrase for our clientId IFF we don't have one createCredentialsSecret :: (MPUsableMonad m) => MangoPayT m Credentials createCredentialsSecret =do- creds<- getCreds - if isNothing $ cClientSecret creds - then postExchange "/v2/clients" Nothing creds + creds<- getCreds+ if isNothing $ cClientSecret creds+ then postExchange "/v2/clients" Nothing creds else return creds -- | login with given user name and password
src/Web/MangoPay/Accounts.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings, FlexibleContexts, FlexibleInstances, PatternGuards, ConstraintKinds #-}--- | handle bank accounts +-- | handle bank accounts module Web.MangoPay.Accounts where import Web.MangoPay.Monad@@ -7,36 +7,31 @@ import Web.MangoPay.Users import Data.Text+import Data.Text.Encoding (encodeUtf8) import Data.Typeable (Typeable) import Data.Aeson import Data.Aeson.Types+import Data.Maybe (fromMaybe) import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT+import qualified Data.ByteString as BS import Data.CountryCodes (CountryCode) -- | create an account-storeAccount :: (MPUsableMonad m) => BankAccount -> AccessToken -> MangoPayT m BankAccount-storeAccount ba at- | Just uid<-baUserId ba= do- url<-getClientURLMultiple ["/users/",uid,"/bankaccounts/",typeName $ baDetails ba]- postExchange url (Just at) ba- | otherwise=error "no user provided for account" +createAccount :: (MPUsableMonad m) => BankAccount -> AccessToken -> MangoPayT m BankAccount+createAccount ba = createGeneric path ba+ where path = BS.concat ["/users/",encodeUtf8 uid,"/bankaccounts/",encodeUtf8 $ typeName $ baDetails ba]+ uid = fromMaybe (error "no user provided for account") $ baUserId ba -- | fetch an account from its ID fetchAccount :: (MPUsableMonad m) => AnyUserID -> BankAccountID -> AccessToken -> MangoPayT m BankAccount-fetchAccount uid aid at=do- url<-getClientURLMultiple ["/users/",uid,"/bankaccounts/",aid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchAccount uid = fetchGeneric path+ where path = Data.Text.concat ["/users/",uid,"/bankaccounts/"] --- | list all accounts for a given user +-- | list all accounts for a given user listAccounts :: (MPUsableMonad m) => AnyUserID -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList BankAccount)-listAccounts uid mp at=do- url<-getClientURLMultiple ["/users/",uid,"/bankaccounts/"]- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req +listAccounts uid = genericList ["/users/",uid,"/bankaccounts/"] -- | account details, depending on the type data BankAccountDetails=IBAN {@@ -58,18 +53,18 @@ ,atBIC :: Text ,atCountry :: CountryCode } deriving (Show,Read,Eq,Ord,Typeable)- --- | from json as per MangoPay format ++-- | from json as per MangoPay format instance FromJSON BankAccountDetails where- parseJSON (Object v) =do + parseJSON (Object v) =do typ<-v .: "Type" case typ of "IBAN"->IBAN <$> v .: "IBAN" <*>- v .: "BIC" + v .: "BIC" "GB"->GB <$> v .: "AccountNumber" <*>- v .: "SortCode" + v .: "SortCode" "US"->US <$> v .: "AccountNumber" <*> v .: "ABA"@@ -81,10 +76,10 @@ "OTHER"->Other <$> v .: "AccountNumber" <*> v .: "BIC" <*>- v .: "Country" + v .: "Country" _->fail $ "BankAccountDetails: unknown type:" ++ typ- parseJSON _=fail "BankAccountDetails" - + parseJSON _=fail "BankAccountDetails"+ -- | type name for details typeName :: BankAccountDetails -> Text typeName (IBAN {})="IBAN"@@ -92,18 +87,18 @@ typeName (US {})="US" typeName (CA {})="CA" typeName (Other {})="OTHER"- --- | the details attribute to be added to the account object ++-- | the details attribute to be added to the account object toJSONPairs :: BankAccountDetails -> [Pair] toJSONPairs (IBAN iban bic)=["IBAN" .= iban,"BIC" .= bic]-toJSONPairs (GB nb sc)=["AccountNumber" .= nb,"SortCode" .= sc] +toJSONPairs (GB nb sc)=["AccountNumber" .= nb,"SortCode" .= sc] toJSONPairs (US nb aba)=["AccountNumber" .= nb,"ABA" .= aba] toJSONPairs (CA nb bn inb bc)=["AccountNumber" .= nb,"BankName" .= bn,"InstitutionNumber" .= inb, "BranchCode" .= bc]-toJSONPairs (Other nb bic c)=["AccountNumber" .= nb,"BIC" .= bic,"Country" .= c] - --- | ID of a bank account +toJSONPairs (Other nb bic c)=["AccountNumber" .= nb,"BIC" .= bic,"Country" .= c]++-- | ID of a bank account type BankAccountID = Text- + -- | bank account details data BankAccount = BankAccount { baId :: Maybe BankAccountID@@ -115,15 +110,15 @@ ,baOwnerAddress :: Maybe Text } deriving (Show,Eq,Ord,Typeable) --- | to json as per MangoPay format +-- | to json as per MangoPay format instance ToJSON BankAccount where toJSON ba=object $ ["OwnerName" .= baOwnerName ba,"Type" .= typeName (baDetails ba) ,"OwnerAddress" .= baOwnerAddress ba, "UserId" .= baUserId ba, "Tag" .= baTag ba] ++ toJSONPairs (baDetails ba) --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON BankAccount where- parseJSON o@(Object v) = + parseJSON o@(Object v) = BankAccount <$> v .:? "Id" <*> v .:? "CreationDate" <*>
src/Web/MangoPay/Cards.hs view
@@ -12,26 +12,23 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT import qualified Data.HashMap.Lazy as HM -- | card registration ID type CardRegistrationID=Text - --- | create or edit a card registration-storeCardRegistration :: (MPUsableMonad m) => CardRegistration -> AccessToken -> MangoPayT m CardRegistration-storeCardRegistration cr at= - case crId cr of- Nothing-> do- url<-getClientURL "/cardregistrations"- postExchange url (Just at) cr- Just i-> do- url<-getClientURLMultiple ["/cardregistrations/",i]- let Object m=toJSON cr- putExchange url (Just at) $ Object $ HM.filterWithKey (\k _->k=="RegistrationData") m +-- | create a card registration+createCardRegistration :: (MPUsableMonad m) => CardRegistration -> AccessToken -> MangoPayT m CardRegistration+createCardRegistration = createGeneric "/cardregistrations"+++-- | modify a card registration+modifyCardRegistration :: (MPUsableMonad m) => CardRegistration -> AccessToken -> MangoPayT m CardRegistration+modifyCardRegistration cr = modifyGGeneric+ (Just $ HM.filterWithKey (\k _->k=="RegistrationData")) "/cardregistrations/" cr crId+ -- | credit card information data CardInfo = CardInfo { ciNumber :: Text@@ -63,14 +60,14 @@ } deriving (Show,Eq,Ord,Typeable) --- | to json as per MangoPay format +-- | 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! , "Tag" .= crTag cr,"UserId" .= crUserId cr ,"Currency" .= crCurrency cr,"RegistrationData" .= crRegistrationData cr ,"CardRegistrationURL" .= crCardRegistrationURL cr] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON CardRegistration where parseJSON (Object v) =CardRegistration <$> v .: "Id" <*>@@ -86,22 +83,16 @@ v .:? "CardId" <*> v .:? "ResultCode" <*> v .:? "ResultMessage" <*>- v .:? "Status" - parseJSON _=fail "CardRegistration" + v .:? "Status"+ parseJSON _=fail "CardRegistration" -- | fetch a card from its ID fetchCard :: (MPUsableMonad m) => CardID -> AccessToken -> MangoPayT m Card-fetchCard cid at=do- url<-getClientURLMultiple ["/cards/",cid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchCard = fetchGeneric "/cards/" --- | list all cards for a given user +-- | list all cards for a given user listCards :: (MPUsableMonad m) => AnyUserID -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Card)-listCards uid mp at=do- url<-getClientURLMultiple ["/users/",uid,"/cards"]- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req +listCards uid = genericList ["/users/",uid,"/cards"] -- | validity of a card data CardValidity=UNKNOWN | VALID | INVALID@@ -121,22 +112,22 @@ -- | a registered card data Card=Card { cId :: CardID- ,cCreationDate :: POSIXTime - ,cTag :: Maybe Text + ,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 + ,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 ++-- | from json as per MangoPay format instance FromJSON Card where parseJSON (Object v) =Card <$> v .: "Id" <*>@@ -152,6 +143,6 @@ v .: "Currency" <*> v .: "Validity" <*> v .: "Country" <*>- v .: "UserId" - parseJSON _=fail "Card" - + v .: "UserId"+ parseJSON _=fail "Card"+
src/Web/MangoPay/Documents.hs view
@@ -13,37 +13,34 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 +import qualified Data.Text as T import qualified Data.Text.Encoding as TE --- | create or edit a document-storeDocument :: (MPUsableMonad m) => AnyUserID -> Document -> AccessToken -> MangoPayT m Document-storeDocument uid d at=- case dId d of- Nothing-> do- url<-getClientURLMultiple ["/users/",uid,"/KYC/documents/"]- postExchange url (Just at) d- Just i-> do- url<-getClientURLMultiple ["/users/",uid,"/KYC/documents/",i]- putExchange url (Just at) d+-- | create a document+createDocument :: (MPUsableMonad m) => AnyUserID -> Document -> AccessToken -> MangoPayT m Document+createDocument uid d = createGeneric path d+ where path = BS.concat ["/users/",TE.encodeUtf8 uid,"/KYC/documents/"] +modifyDocument :: (MPUsableMonad m) => AnyUserID -> Document -> AccessToken -> MangoPayT m Document+modifyDocument uid d = modifyGeneric path d dId+ where path = T.concat ["/users/", uid, "/KYC/documents/"]++ -- | fetch a document from its ID fetchDocument :: (MPUsableMonad m) => AnyUserID -> DocumentID -> AccessToken -> MangoPayT m Document-fetchDocument uid did at=do- url<-getClientURLMultiple ["/users/",uid,"/KYC/documents/",did]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req+fetchDocument uid = fetchGeneric path+ where path = T.concat ["/users/",uid,"/KYC/documents/"] -- | 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...-storePage :: (MPUsableMonad m) => AnyUserID -> DocumentID -> BS.ByteString -> AccessToken -> MangoPayT m ()-storePage uid did contents at=do+createPage :: (MPUsableMonad m) => AnyUserID -> DocumentID -> BS.ByteString -> AccessToken -> MangoPayT m ()+createPage uid did contents at=do let val=object ["File" .= TE.decodeUtf8 (B64.encode contents)] url<-getClientURLMultiple ["/users/",uid,"/KYC/documents/",did,"/pages"] postNoReply url (Just at) val
src/Web/MangoPay/Events.hs view
@@ -45,31 +45,22 @@ return $ evt `elem` evts --- | create or edit a hook-storeHook :: (MPUsableMonad m) => Hook -> AccessToken -> MangoPayT m Hook-storeHook h at=- case hId h of- Nothing-> do- url<-getClientURL "/hooks"- postExchange url (Just at) h- Just i-> do- url<-getClientURLMultiple ["/hooks/",i]- let Object m=toJSON h- putExchange url (Just at) (Object $ HM.delete "EventType" m)+-- | create a hook+createHook :: (MPUsableMonad m) => Hook -> AccessToken -> MangoPayT m Hook+createHook = createGeneric "/hooks" ++-- | modify a hook+modifyHook :: (MPUsableMonad m) => Hook -> AccessToken -> MangoPayT m Hook+modifyHook h = modifyGGeneric (Just $ HM.delete "EventType") "/hooks/" h hId+ -- | fetch a wallet from its ID fetchHook :: (MPUsableMonad m) => HookID -> AccessToken -> MangoPayT m Hook-fetchHook wid at=do- url<-getClientURLMultiple ["/hooks/",wid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req+fetchHook = fetchGeneric "/hooks/" -- | list all wallets for a given user listHooks :: (MPUsableMonad m) => Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Hook)-listHooks mp at=do- url<-getClientURL "/hooks"- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req+listHooks = genericList ["/hooks"] -- | Event type data EventType=
src/Web/MangoPay/Monad.hs view
@@ -17,6 +17,7 @@ , ComposeSt, defaultLiftBaseWith , defaultRestoreM ) import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT)+import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Data.Default import qualified Control.Monad.Trans.Resource as R@@ -28,7 +29,8 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC-import Data.Aeson (json,fromJSON,Result(..),FromJSON, ToJSON,encode)+import Data.Aeson (json, fromJSON, toJSON, Result(..)+ ,FromJSON, ToJSON,encode, Object, Value(..)) import Data.Conduit.Attoparsec (sinkParser, ParseError) import qualified Data.Text.Encoding as TE import qualified Data.Text as T (Text)@@ -192,6 +194,8 @@ err=H.StatusCodeException status headers cookies mpres<-L.catch (do #if DEBUG+ liftIO $ BSC.putStrLn ""+ liftIO $ print $ show req' (value,_)<-H.responseBody res C.$$+- zipSinks (sinkParser json) (sinkHandle stdout) liftIO $ BSC.putStrLn "" liftIO $ print headers@@ -358,3 +362,53 @@ isOkay status = let sc = HT.statusCode status in 200 <= sc && sc < 300+++-- | helper function to create an entity using POST+createGeneric :: (MPUsableMonad m, FromJSON a, ToJSON a) =>+ ByteString -> a -> AccessToken -> MangoPayT m a+createGeneric path x at = do+ url<-getClientURL path+ postExchange url (Just at) x+++-- | helper function to create an entity using PUT+modifyGeneric :: (MPUsableMonad m, FromJSON a, ToJSON a) =>+ T.Text -> a -> (a -> Maybe T.Text) -> AccessToken -> MangoPayT m a+modifyGeneric = modifyGGeneric Nothing+++-- | even more generic version of 'modifyGeneric' that can put an+-- arbitrary json value+modifyGGeneric :: (MPUsableMonad m, FromJSON a, ToJSON a) =>+ Maybe (Object -> Object) -> T.Text -> a -> (a -> Maybe T.Text) ->+ AccessToken -> MangoPayT m a+modifyGGeneric mf path x fid at =+ case fid x of+ Nothing -> error $ show $+ "Web.MangoPay.Users.modifyGGeneric : Nothing (" <> path <> ")"+ Just i -> do+ url<-getClientURLMultiple [path ,i]+ case mf of+ Nothing -> putExchange url (Just at) x+ Just f -> do+ let Object o = toJSON x+ putExchange url (Just at) $ f o+++-- | helper function to fetch an entity from its id+fetchGeneric :: (MPUsableMonad m, FromJSON a) =>+ T.Text -> T.Text -> AccessToken -> MangoPayT m a+fetchGeneric path xid at = do+ url<-getClientURLMultiple [path ,xid]+ req<-getGetRequest url (Just at) ([]::HT.Query)+ getJSONResponse req+++-- | 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+ url <- getClientURLMultiple path+ req <- getGetRequest url (Just at) (paginationAttributes mp)+ getJSONList req
src/Web/MangoPay/Payins.hs view
@@ -13,34 +13,23 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT --- | create or edit a bankwire-storeBankWire :: (MPUsableMonad m) => BankWire -> AccessToken -> MangoPayT m BankWire-storeBankWire bw at= do- url<-getClientURL "/payins/bankwire/direct" - postExchange url (Just at) bw- --- | fetch a bank wire from its ID-fetchBankWire :: (MPUsableMonad m) => BankWireID -> AccessToken -> MangoPayT m BankWire-fetchBankWire bwid at=do- url<-getClientURLMultiple ["/payins/",bwid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +-- | create a bankwire pay-in+createBankWirePayIn :: (MPUsableMonad m) => BankWire -> AccessToken -> MangoPayT m BankWire+createBankWirePayIn = createGeneric "/payins/bankwire/direct" --- | create or edit a direct card pay in-storeCardPayin :: (MPUsableMonad m) => CardPayin -> AccessToken -> MangoPayT m CardPayin-storeCardPayin cp at= do- url<-getClientURL "/payins/card/direct" - postExchange url (Just at) cp- --- | fetch a direct pay in from its ID+-- | fetch a bank wire pay-in from its ID+fetchBankWirePayIn :: (MPUsableMonad m) => BankWireID -> AccessToken -> MangoPayT m BankWire+fetchBankWirePayIn = fetchGeneric "/payins/"++-- | create a direct card pay in+createCardPayin :: (MPUsableMonad m) => CardPayin -> AccessToken -> MangoPayT m CardPayin+createCardPayin = createGeneric "/payins/card/direct"++-- | fetch a direct card pay in from its ID fetchCardPayin :: (MPUsableMonad m) => CardPayinID -> AccessToken -> MangoPayT m CardPayin-fetchCardPayin cpid at=do- url<-getClientURLMultiple ["/payins/",cpid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req - +fetchCardPayin = fetchGeneric "/payins/"+ data PaymentExecution = WEB -- ^ through a web interface | DIRECT -- ^ with a tokenized card deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)@@ -93,13 +82,13 @@ ,bwExecutionType :: Maybe PaymentExecution -- ^ How the payment has been executed: } deriving (Show,Eq,Ord,Typeable) --- | to json as per MangoPay format +-- | to json as per MangoPay format instance ToJSON BankWire where toJSON bw=object ["Tag" .= bwTag bw,"AuthorId" .= bwAuthorId bw ,"CreditedUserId" .= bwCreditedUserId bw,"CreditedWalletId" .= bwCreditedWalletId bw ,"DeclaredDebitedFunds" .= bwDeclaredDebitedFunds bw,"DeclaredFees" .= bwDeclaredFees bw] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON BankWire where parseJSON (Object v) =BankWire <$> v .: "Id" <*>@@ -123,19 +112,19 @@ v .:? "Type" <*> v .:? "Nature" <*> v .:? "PaymentType" <*>- v .:? "ExecutionType" - parseJSON _=fail "BankWire" - + v .:? "ExecutionType"+ parseJSON _=fail "BankWire"+ -- | ID of a direct pay in-type CardPayinID=Text - +type CardPayinID=Text+ -- | 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 mkCardPayin :: AnyUserID -> AnyUserID -> WalletID -> Amount -> Amount -> Text -> CardID -> CardPayin mkCardPayin aid uid wid amount fees url cid= CardPayin Nothing Nothing Nothing aid uid fees wid Nothing amount Nothing (Just url) Nothing Nothing cid Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing- - ++ -- | direct pay in via registered card data CardPayin=CardPayin { cpId :: Maybe CardPayinID@@ -161,8 +150,8 @@ ,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: } deriving (Show,Eq,Ord,Typeable)- --- | to json as per MangoPay format ++-- | to json as per MangoPay format instance ToJSON CardPayin where toJSON cp=object ["Tag" .= cpTag cp,"AuthorId" .= cpAuthorId cp ,"CreditedUserId" .= cpCreditedUserId cp,"CreditedWalletId" .= cpCreditedWalletId cp@@ -170,7 +159,7 @@ ,"SecureModeReturnURL" .= cpSecureModeReturnURL cp ,"SecureMode" .= cpSecureMode cp] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON CardPayin where parseJSON (Object v) =CardPayin <$> v .: "Id" <*>@@ -194,6 +183,6 @@ v .:? "Type" <*> v .:? "Nature" <*> v .:? "PaymentType" <*>- v .:? "ExecutionType" - parseJSON _=fail "CardPayin" - + v .:? "ExecutionType"+ parseJSON _=fail "CardPayin"+
src/Web/MangoPay/Payouts.hs view
@@ -13,20 +13,14 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT -- | create a payout-storePayout :: (MPUsableMonad m) => Payout -> AccessToken -> MangoPayT m Payout-storePayout pt at= do- url<-getClientURL "/payouts/bankwire"- postExchange url (Just at) pt+createPayout :: (MPUsableMonad m) => Payout -> AccessToken -> MangoPayT m Payout+createPayout = createGeneric "/payouts/bankwire" -- | fetch an payout from its ID fetchPayout :: (MPUsableMonad m) => PayoutID -> AccessToken -> MangoPayT m Payout-fetchPayout ptid at=do- url<-getClientURLMultiple ["/payouts/",ptid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchPayout = fetchGeneric "/payouts/" -- | make a simplep payout for creation mkPayout :: AnyUserID -> WalletID -> Amount -> Amount -> BankAccountID -> Payout@@ -57,15 +51,15 @@ ,ptPaymentType :: Maybe PaymentType ,ptMeanOfPaymentType :: Maybe PaymentType -- ^ « BANK_WIRE », } deriving (Show,Eq,Ord,Typeable)- --- | to json as per MangoPay format ++-- | to json as per MangoPay format instance ToJSON Payout where toJSON pt=object ["Tag" .= ptTag pt,"AuthorId" .= ptAuthorId pt ,"DebitedWalletId" .= ptDebitedWalletId pt ,"DebitedFunds" .= ptDebitedFunds pt,"Fees" .= ptFees pt,"BankAccountId" .= ptBankAccountId pt] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON Payout where parseJSON (Object v) =Payout <$> v .: "Id" <*>@@ -85,7 +79,7 @@ v .:? "Type" <*> v .:? "Nature" <*> v .:? "PaymentType" <*>- v .:? "MeanOfPaymentType" - parseJSON _=fail "Payout" - + v .:? "MeanOfPaymentType"+ parseJSON _=fail "Payout"+
src/Web/MangoPay/Refunds.hs view
@@ -13,7 +13,6 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT -- | refund a transfer refundTransfer :: (MPUsableMonad m) => TransferID -> AnyUserID -> AccessToken -> MangoPayT m Refund@@ -29,10 +28,7 @@ -- | fetch a refund from its ID fetchRefund :: (MPUsableMonad m) => RefundID -> AccessToken -> MangoPayT m Refund-fetchRefund rid at=do- url<-getClientURLMultiple ["/refunds/",rid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchRefund = fetchGeneric "/refunds/" -- | refund request data RefundRequest=RefundRequest{@@ -44,7 +40,7 @@ -- | to json as per MangoPay format instance ToJSON RefundRequest where toJSON rr=object ["AuthorId" .= rrAuthorId rr,"DebitedFunds" .= rrDebitedFunds rr,- "Fees" .= rrFees rr] + "Fees" .= rrFees rr] -- | id of a refund@@ -59,10 +55,10 @@ ,rDebitedFunds :: Amount -- ^ Strictly positive amount. In cents. ,rFees :: Amount -- ^ In cents ,rCreditedFunds :: Amount -- ^ In cents- ,rStatus :: TransferStatus + ,rStatus :: TransferStatus ,rResultCode :: Text -- ^ The transaction result code ,rResultMessage :: Maybe Text -- ^ The transaction result Message- ,rExecutionDate :: POSIXTime + ,rExecutionDate :: POSIXTime ,rType :: TransactionType ,rNature :: TransactionNature ,rCreditedUserId :: Maybe AnyUserID -- ^ Id of the user owner of the credited wallet@@ -71,8 +67,8 @@ ,rDebitedWalletId :: WalletID -- ^ The Id of the debited Wallet ,rCreditedWalletID :: Maybe WalletID -- ^ The Id of the credited Wallet } deriving (Show,Eq,Ord,Typeable)- --- | from json as per MangoPay format ++-- | from json as per MangoPay format instance FromJSON Refund where parseJSON (Object v) =Refund <$> v .: "Id" <*>@@ -81,8 +77,8 @@ v .: "AuthorId" <*> v .: "DebitedFunds" <*> v .: "Fees" <*>- v .: "CreditedFunds" <*> - v .: "Status" <*> + v .: "CreditedFunds" <*>+ v .: "Status" <*> v .: "ResultCode" <*> v .:? "ResultMessage" <*> v .: "ExecutionDate" <*>@@ -93,4 +89,4 @@ v .: "InitialTransactionType" <*> v .: "DebitedWalletId" <*> v .:? "CreditedWalletID"- parseJSON _=fail "Refund" + parseJSON _=fail "Refund"
src/Web/MangoPay/Types.hs view
@@ -102,12 +102,32 @@ data MpException = MpJSONException String -- ^ JSON parsingError | MpAppException MpError -- ^ application exception | MpHttpException H.HttpException (Maybe Value) -- ^ HTTP level exception, maybe with some JSON payload+ | MpHttpExceptionS String (Maybe Value) -- ^ HTTP level exception for which we only have a string (no Read instance)+ -- , maybe with some JSON payload deriving (Show,Typeable) -- | make our exception type a normal exception instance Exception MpException +-- | 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] ++instance FromJSON MpException where+ parseJSON (Object v) = do+ typ::String <- v .: "Type"+ case typ of+ "MpJSONException" -> MpJSONException <$> v .: "Error"+ "MpAppException" -> MpAppException <$> v .: "Error"+ "MpHttpException" -> MpHttpExceptionS <$> v .: "Error" <*> v .:? "Value"+ _ -> fail $ "MpException:" ++ typ+ parseJSON _= fail "MpException"++ -- | an error returned to us by MangoPay data MpError = MpError { igeID :: Text@@ -118,7 +138,11 @@ deriving (Show,Eq,Ord,Typeable) +-- | 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] + -- | from json as per MangoPay format instance FromJSON MpError where parseJSON (Object v) = MpError <$>@@ -176,27 +200,27 @@ deriving (Show,Read,Eq,Ord,Typeable) --- | currency amount +-- | currency amount data Amount=Amount { aCurrency :: Currency ,aAmount :: Integer -- ^ all amounts should be in cents! } deriving (Show,Read,Eq,Ord,Typeable)- --- | to json as per MangoPay format ++-- | to json as per MangoPay format instance ToJSON Amount where toJSON b=object ["Currency" .= aCurrency b,"Amount" .= aAmount b] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON Amount where parseJSON (Object v) =Amount <$> v .: "Currency" <*>- v .: "Amount" + v .: "Amount" parseJSON _=fail "Amount"- + -- | supported income ranges data IncomeRange=IncomeRange1 | IncomeRange2 | IncomeRange3 | IncomeRange4 | IncomeRange5 | IncomeRange6- deriving (Show,Read,Eq,Ord,Bounded, Enum, Typeable) + deriving (Show,Read,Eq,Ord,Bounded, Enum, Typeable) -- | to json as per MangoPay format@@ -208,23 +232,23 @@ toJSON IncomeRange4="4" toJSON IncomeRange5="5" toJSON IncomeRange6="6"- + -- | from json as per MangoPay format -- the samples do show string format when writing, integer format when reading... instance FromJSON IncomeRange where- parseJSON (String "1") =pure IncomeRange1 - parseJSON (String "2") =pure IncomeRange2 - parseJSON (String "3") =pure IncomeRange3 - parseJSON (String "4") =pure IncomeRange4 - parseJSON (String "5") =pure IncomeRange5 - parseJSON (String "6") =pure IncomeRange6 - parseJSON (Number 1) =pure IncomeRange1 - parseJSON (Number 2) =pure IncomeRange2 - parseJSON (Number 3) =pure IncomeRange3 - parseJSON (Number 4) =pure IncomeRange4 - parseJSON (Number 5) =pure IncomeRange5 - parseJSON (Number 6) =pure IncomeRange6 - parseJSON _= fail "IncomeRange" + parseJSON (String "1") =pure IncomeRange1+ parseJSON (String "2") =pure IncomeRange2+ parseJSON (String "3") =pure IncomeRange3+ parseJSON (String "4") =pure IncomeRange4+ parseJSON (String "5") =pure IncomeRange5+ parseJSON (String "6") =pure IncomeRange6+ parseJSON (Number 1) =pure IncomeRange1+ parseJSON (Number 2) =pure IncomeRange2+ parseJSON (Number 3) =pure IncomeRange3+ parseJSON (Number 4) =pure IncomeRange4+ parseJSON (Number 5) =pure IncomeRange5+ parseJSON (Number 6) =pure IncomeRange6+ parseJSON _= fail "IncomeRange" -- | bounds in euros for income range incomeBounds :: IncomeRange -> (Amount,Amount)@@ -234,11 +258,11 @@ incomeBounds IncomeRange4 = (kEuros 50,kEuros 80) incomeBounds IncomeRange5 = (kEuros 80,kEuros 120) incomeBounds IncomeRange6 = (kEuros 120,kEuros (-1))- + -- | get Income Range for given Euro amount incomeRange :: Amount -> IncomeRange-incomeRange (Amount "EUR" cents) +incomeRange (Amount "EUR" cents) | cents < kCents 18 = IncomeRange1 | cents < kCents 30 = IncomeRange2 | cents < kCents 50 = IncomeRange3@@ -290,7 +314,7 @@ -- | the kind of authentication data the user has provided-data KindOfAuthentication = +data KindOfAuthentication = Light | Regular | Strong@@ -326,7 +350,7 @@ pathB=fromText $ TE.decodeUtf8 $ H.path req -- log the query string if any qsB=fromText $ TE.decodeUtf8 $ H.queryString req- postB=if H.method req==HT.methodPost + postB=if H.method req==HT.methodPost then case H.requestBody req of (H.RequestBodyBS b)->fromText (TE.decodeUtf8 b) <> " -> " (H.RequestBodyLBS b)->fromText $ TE.decodeUtf8 $ BS.toStrict b <> " -> "
src/Web/MangoPay/Users.hs view
@@ -13,63 +13,47 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT --- | create or edit a natural user-storeNaturalUser :: (MPUsableMonad m) => NaturalUser -> AccessToken -> MangoPayT m NaturalUser-storeNaturalUser u at=- case uId u of- Nothing-> do- url<-getClientURL "/users/natural"- postExchange url (Just at) u- Just i-> do- url<-getClientURLMultiple ["/users/natural/",i]- putExchange url (Just at) u{uProofOfIdentity=Nothing,uProofOfAddress=Nothing}+-- | create a natural user+createNaturalUser :: (MPUsableMonad m) => NaturalUser -> AccessToken -> MangoPayT m NaturalUser+createNaturalUser = createGeneric "/users/natural" +-- | modify a natural user+modifyNaturalUser :: (MPUsableMonad m) => NaturalUser -> AccessToken -> MangoPayT m NaturalUser+modifyNaturalUser u = modifyGeneric "/users/natural/" u' uId+ where u' = u{uProofOfIdentity = Nothing, uProofOfAddress = Nothing}++ -- | fetch a natural user from her ID fetchNaturalUser :: (MPUsableMonad m) => NaturalUserID -> AccessToken -> MangoPayT m NaturalUser-fetchNaturalUser uid at=do- url<-getClientURLMultiple ["/users/natural/",uid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req+fetchNaturalUser = fetchGeneric "/users/natural/" --- | create or edit a natural user-storeLegalUser :: (MPUsableMonad m) => LegalUser -> AccessToken -> MangoPayT m LegalUser-storeLegalUser u at =- case lId u of- Nothing-> do- url<-getClientURL "/users/legal"- postExchange url (Just at) u- Just i-> do- url<-getClientURLMultiple ["/users/legal/",i]- putExchange url (Just at) u+-- | create a legal user+createLegalUser :: (MPUsableMonad m) => LegalUser -> AccessToken -> MangoPayT m LegalUser+createLegalUser = createGeneric "/users/legal" +-- | modify a legal user+modifyLegalUser :: (MPUsableMonad m) => LegalUser -> AccessToken -> MangoPayT m LegalUser+modifyLegalUser u = modifyGeneric "/users/legal/" u lId++ -- | fetch a natural user from her ID fetchLegalUser :: (MPUsableMonad m) => LegalUserID -> AccessToken -> MangoPayT m LegalUser-fetchLegalUser uid at = do- url <- getClientURLMultiple ["/users/legal/",uid]- req <- getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req+fetchLegalUser = fetchGeneric "/users/legal/" -- | get a user, natural or legal getUser :: (MPUsableMonad m) => AnyUserID -> AccessToken -> MangoPayT m (Either NaturalUser LegalUser)-getUser uid at = do- url <- getClientURLMultiple ["/users/",uid]- req <- getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req+getUser = fetchGeneric "/users/" -- | list all user references listUsers :: (MPUsableMonad m) => Maybe Pagination -> AccessToken -> MangoPayT m (PagedList UserRef)-listUsers mp at = do- url <- getClientURL "/users/"- req <- getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req+listUsers = genericList ["/users/"] -- | Convenience function to extract the user ID of an EXISTING user (one with an id).@@ -77,7 +61,7 @@ :: Either NaturalUser LegalUser -> AnyUserID getExistingUserID u | Just uid <- either uId lId u = uid-getExistingUserID _ = error $ "Web.MangoPay.Users.getExistingUserID: Nothing"+getExistingUserID _ = error "Web.MangoPay.Users.getExistingUserID: Nothing" instance FromJSON (Either NaturalUser LegalUser) where
src/Web/MangoPay/Wallets.hs view
@@ -12,68 +12,47 @@ import Data.Aeson import Data.Time.Clock.POSIX (POSIXTime) import Control.Applicative-import qualified Network.HTTP.Types as HT import qualified Data.HashMap.Lazy as HM (delete) --- | create or edit a wallet-storeWallet :: (MPUsableMonad m) => Wallet -> AccessToken -> MangoPayT m Wallet-storeWallet w at= - case wId w of- Nothing-> do- url<-getClientURL "/wallets"- postExchange url (Just at) w- Just i-> do- url<-getClientURLMultiple ["/wallets/",i]- let Object m=toJSON w- putExchange url (Just at) (Object $ HM.delete "Currency" m)- +-- | create a wallet+createWallet :: (MPUsableMonad m) => Wallet -> AccessToken -> MangoPayT m Wallet+createWallet = createGeneric "/wallets" ++-- | modify a wallet+modifyWallet :: (MPUsableMonad m) => Wallet -> AccessToken -> MangoPayT m Wallet+modifyWallet w = modifyGGeneric (Just $ HM.delete "Currency") "/wallets/" w wId++ -- | fetch a wallet from its ID fetchWallet :: (MPUsableMonad m) => WalletID -> AccessToken -> MangoPayT m Wallet-fetchWallet wid at=do- url<-getClientURLMultiple ["/wallets/",wid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchWallet = fetchGeneric "/wallets/" --- | list all wallets for a given user +-- | list all wallets for a given user listWallets :: (MPUsableMonad m) => AnyUserID -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Wallet)-listWallets uid mp at=do- url<-getClientURLMultiple ["/users/",uid,"/wallets"]- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req +listWallets uid = genericList ["/users/",uid,"/wallets"] --- | create a new fund transfer +-- | create a new fund transfer createTransfer :: (MPUsableMonad m) => Transfer -> AccessToken -> MangoPayT m Transfer-createTransfer t at= do- url<-getClientURL "/transfers"- postExchange url (Just at) t - +createTransfer = createGeneric "/transfers"+ -- | fetch a transfer from its ID fetchTransfer :: (MPUsableMonad m) => TransferID -> AccessToken -> MangoPayT m Transfer-fetchTransfer wid at=do- url<-getClientURLMultiple ["/transfers/",wid]- req<-getGetRequest url (Just at) ([]::HT.Query)- getJSONResponse req +fetchTransfer = fetchGeneric "/transfers/" --- | list transfers for a given wallet +-- | list transfers for a given wallet listTransactions :: (MPUsableMonad m) => WalletID -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction)-listTransactions wid mp at=do- url<-getClientURLMultiple ["/wallets/",wid,"/transactions"]- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req +listTransactions wid = genericList ["/wallets/",wid,"/transactions"] -- | list transfer for a given user listTransactionsForUser :: (MPUsableMonad m) => AnyUserID -> Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Transaction)-listTransactionsForUser uid mp at=do- url<-getClientURLMultiple ["/users/",uid,"/transactions"]- req<-getGetRequest url (Just at) (paginationAttributes mp)- getJSONList req +listTransactionsForUser uid = genericList ["/users/",uid,"/transactions"] -- | ID of a wallet-type WalletID=Text +type WalletID=Text --- | a wallet +-- | a wallet data Wallet = Wallet { wId:: Maybe WalletID -- ^ The Id of the wallet ,wCreationDate :: Maybe POSIXTime -- ^ The creation date of the object@@ -85,11 +64,11 @@ } deriving (Show,Eq,Ord,Typeable) --- | to json as per MangoPay format +-- | 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] --- | from json as per MangoPay format +-- | from json as per MangoPay format instance FromJSON Wallet where parseJSON (Object v) =Wallet <$> v .: "Id" <*>@@ -98,30 +77,30 @@ v .: "Owners" <*> v .: "Description" <*> v .: "Currency" <*>- v .: "Balance" + v .: "Balance" parseJSON _=fail "Wallet"- - ++ -- | ID of a transfer-type TransferID=Text - --- | status of a transfer -data TransferStatus= Created | Succeeded | Failed +type TransferID=Text++-- | status of a transfer+data TransferStatus= Created | Succeeded | Failed deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)- + -- | to json as per MangoPay format instance ToJSON TransferStatus where toJSON Created="CREATED" toJSON Succeeded="SUCCEEDED" toJSON Failed="FAILED"- + -- | from json as per MangoPay format instance FromJSON TransferStatus where- parseJSON (String "CREATED") =pure Created + parseJSON (String "CREATED") =pure Created parseJSON (String "SUCCEEDED") =pure Succeeded- parseJSON (String "FAILED") =pure Failed - parseJSON _= fail "TransferStatus" - + parseJSON (String "FAILED") =pure Failed+ parseJSON _= fail "TransferStatus"+ -- | transfer between wallets data Transfer = Transfer{ tId :: Maybe TransferID -- ^ Id of the transfer@@ -140,14 +119,14 @@ ,tExecutionDate :: Maybe POSIXTime -- ^ The execution date of the transfer } deriving (Show,Eq,Ord,Typeable)- + -- | to json as per MangoPay format instance ToJSON Transfer where toJSON t=object ["AuthorId" .= tAuthorId t,"CreditedUserId" .= tCreditedUserId t,"DebitedFunds" .= tDebitedFunds t, "Fees" .= tFees t,"DebitedWalletID" .= tDebitedWalletID t,"CreditedWalletID" .= tCreditedWalletID t, "Tag" .= tTag t]- --- | from json as per MangoPay format ++-- | from json as per MangoPay format instance FromJSON Transfer where parseJSON (Object v) =Transfer <$> v .: "Id" <*>@@ -163,13 +142,13 @@ v .:? "Status" <*> v .:? "ResultCode" <*> v .:? "ResultMessage" <*>- v .:? "ExecutionDate" - parseJSON _=fail "Transfer" - + v .:? "ExecutionDate"+ parseJSON _=fail "Transfer"+ -- | type of transaction-data TransactionType = PAYIN +data TransactionType = PAYIN | PAYOUT- | TRANSFER + | TRANSFER deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable) -- | to json as per MangoPay format@@ -196,10 +175,10 @@ parseJSON (String s) | ((a,_):_)<-reads $ unpack s=pure a parseJSON _ =fail "TransactionNature"- - ++ type TransactionID = Text- + -- | any transaction data Transaction = Transaction{ txId :: Maybe TransactionID -- ^ Id of the transfer@@ -220,14 +199,14 @@ ,txNature :: TransactionNature -- ^ The nature of the transaction: } deriving (Show,Eq,Ord,Typeable)- + -- | to json as per MangoPay format instance ToJSON Transaction where toJSON t=object ["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]- --- | from json as per MangoPay format ++-- | from json as per MangoPay format instance FromJSON Transaction where parseJSON (Object v) =Transaction <$> v .: "Id" <*>@@ -245,5 +224,5 @@ v .:? "ResultMessage" <*> v .:? "ExecutionDate" <*> v .: "Type" <*>- v .: "Nature" - parseJSON _=fail "Transfer" + v .: "Nature"+ parseJSON _=fail "Transfer"
test/Web/MangoPay/AccessTest.hs view
@@ -4,7 +4,7 @@ module Web.MangoPay.AccessTest where -import Web.MangoPay+import Web.MangoPay hiding (createHook) import Web.MangoPay.TestUtils import Test.Framework
test/Web/MangoPay/AccountsTest.hs view
@@ -18,7 +18,7 @@ let uid=urId $ head $ plData usL let details=IBAN "FR3020041010124530725S03383" "CRLYFRPP" let acc1=BankAccount Nothing Nothing (Just uid) Nothing details "JP Moresmau" (Just "Earth")- acc2<-testMP $ storeAccount acc1+ acc2<-testMP $ createAccount acc1 assertBool $ isJust $ baId acc2 assertBool $ isJust $ baCreationDate acc2 assertEqual details $ baDetails acc2@@ -26,4 +26,4 @@ assertEqual details $ baDetails acc3 accs<-testMP $ listAccounts uid Nothing assertBool $ acc3 `elem` (plData accs)- +
test/Web/MangoPay/CardsTest.hs view
@@ -28,22 +28,22 @@ assertEqual 1 (length $ plData usL) let uid=urId $ head $ plData usL let cr1=mkCardRegistration uid curr- cr2<-testMP $ storeCardRegistration cr1+ cr2<-testMP $ createCardRegistration cr1 assertBool (isJust $ crId cr2) assertBool (isJust $ crCreationDate cr2) assertBool (isJust $ crCardRegistrationURL cr2) assertBool (isJust $ crAccessKey cr2)- assertBool (isJust $ crPreregistrationData cr2) - assertBool (isNothing $ crRegistrationData cr2) - assertBool (isNothing $ crCardId cr2) + assertBool (isJust $ crPreregistrationData cr2)+ assertBool (isNothing $ crRegistrationData cr2)+ assertBool (isNothing $ crCardId cr2) cr3<-unsafeRegisterCard testCardInfo1 cr2- assertBool (isJust $ crRegistrationData cr3) - cr4<-testMP $ storeCardRegistration cr3- assertBool (isJust $ crCardId cr4) + assertBool (isJust $ crRegistrationData cr3)+ cr4<-testMP $ modifyCardRegistration cr3+ assertBool (isJust $ crCardId cr4) let cid=fromJust $ crCardId cr4 c<-testMP $ fetchCard cid assertEqual cid $ cId c- assertBool $ not $ T.null $ cAlias c + assertBool $ not $ T.null $ cAlias c assertBool $ not $ T.null $ cCardProvider c assertEqual (ciExpire testCardInfo1) (cExpirationDate c) --assertBool $ not $ T.null $ cExpirationDate c@@ -54,7 +54,7 @@ cs<-testMP $ getAll $ listCards uid assertBool $ not $ null cs assertBool $ any (\ c1 -> cId c1 == cid) cs- - - - ++++
test/Web/MangoPay/DocumentsTest.hs view
@@ -20,21 +20,21 @@ euser <- testMP $ getUser uid let d=Document Nothing Nothing Nothing IDENTITY_PROOF (Just CREATED) Nothing Nothing testEventTypes [KYC_CREATED,KYC_VALIDATION_ASKED] $ do- d2<-testMP $ storeDocument uid d+ d2<-testMP $ createDocument uid d assertBool (isJust $ dId d2) assertBool (isJust $ dCreationDate d2) assertEqual IDENTITY_PROOF (dType d2) assertEqual Light $ getKindOfAuthentication euser [d2] tf<-BS.readFile "data/test.jpg" -- document has to be in CREATED status- testMP $ storePage uid (fromJust $ dId d2) tf- d3<-testMP $ storeDocument uid d2{dStatus=Just VALIDATION_ASKED}+ testMP $ createPage uid (fromJust $ dId d2) tf+ d3<-testMP $ modifyDocument uid d2{dStatus=Just VALIDATION_ASKED} assertEqual (Just VALIDATION_ASKED) (dStatus d3) assertEqual (dId d2) (dId d3) d4<-testMP $ fetchDocument uid (fromJust $ dId d2) assertEqual (Just VALIDATION_ASKED) (dStatus d4) return $ dId d2- + -- | test type of authentication test_KindOfAuthentication :: Assertion
test/Web/MangoPay/PayinsTest.hs view
@@ -16,19 +16,19 @@ usL<-testMP $ listUsers (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 - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) -- bank wire does not succeed since the real transfer needs to be performed afterwards testEventTypes [PAYIN_NORMAL_CREATED] $ do let bw1=mkBankWire uid uid (fromJust $ wId w2) (Amount "EUR" 100) (Amount "EUR" 1)- bw2<-testMP $ storeBankWire bw1+ bw2<-testMP $ createBankWirePayIn bw1 assertBool (isJust $ bwId bw2) assertBool (isJust $ bwBankAccount bw2)- bw3<-testMP $ fetchBankWire (fromJust $ bwId bw2)+ bw3<-testMP $ fetchBankWirePayIn (fromJust $ bwId bw2) assertEqual (bwId bw2) (bwId bw3) return $ bwId bw2- + -- | test a successful card pay in test_CardOK :: Assertion test_CardOK = do@@ -38,13 +38,13 @@ cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr- let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) let wid=fromJust $ wId w2 testEventTypes [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_SUCCEEDED] $ do let cp=mkCardPayin uid uid wid (Amount "EUR" 333) (Amount "EUR" 1) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertBool (isJust $ cpId cp2) assertEqual (Just Succeeded) (cpStatus cp2) w3<-testMP $ fetchWallet wid@@ -52,7 +52,7 @@ ts1 <- testMP $ listTransactions wid Nothing assertEqual 1 (length $ filter ((cpId cp2==) . txId) $ plData ts1) return $ cpId cp2- + -- | test a failed card pay in -- according to <http://docs.mangopay.com/api-references/test-payment/> test_CardKO :: Assertion@@ -63,13 +63,13 @@ cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr- let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) let wid=fromJust $ wId w2 testEventTypes [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_FAILED] $ do let cp=mkCardPayin uid uid wid (Amount "EUR" 33394) (Amount "EUR" 0) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertBool (isJust $ cpId cp2) assertEqual (Just Failed) (cpStatus cp2) assertEqual (Just "009199") (cpResultCode cp2)@@ -77,4 +77,4 @@ w3<-testMP $ fetchWallet wid assertEqual (Just $ Amount "EUR" 0) (wBalance w3) return $ cpId cp2- +
test/Web/MangoPay/PayoutsTest.hs view
@@ -18,23 +18,23 @@ let uid=urId $ head $ plData usL accs<-testMP $ listAccounts uid Nothing assertBool $ not $ null $ plData accs- let aid=fromJust $ baId $ head $ plData accs + let aid=fromJust $ baId $ head $ plData accs ws<- testMP $ listWallets uid Nothing assertBool $ not $ null $ plData ws- let wid=fromJust $ wId $ head $ 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 $ storePayout pt1+ 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- + -- | test failing payout test_PayoutKO :: Assertion test_PayoutKO=do@@ -43,13 +43,13 @@ let uid=urId $ head $ plData usL accs<-testMP $ listAccounts uid Nothing assertBool $ not $ null $ plData accs- let aid=fromJust $ baId $ head $ plData accs + let aid=fromJust $ baId $ head $ plData accs ws<- testMP $ listWallets uid Nothing assertBool $ not $ null $ plData ws- let wid=fromJust $ wId $ head $ plData ws + let wid=fromJust $ wId $ head $ plData ws testEventTypes [PAYOUT_NORMAL_FAILED] $ do let pt1=mkPayout uid wid (Amount "EUR" 100000) (Amount "EUR" 0) aid- pt2<-testMP $ storePayout pt1+ pt2<-testMP $ createPayout pt1 assertBool $ isJust $ ptId pt2 assertEqual (Just Failed) (ptStatus pt2) pt3 <- testMP $ fetchPayout $ fromJust $ ptId pt2@@ -57,5 +57,5 @@ assertEqual (Just "001001") (ptResultCode pt3) assertEqual (Just "Unsufficient wallet balance") (ptResultMessage pt3) return $ ptId pt2- - ++
test/Web/MangoPay/RefundsTest.hs view
@@ -19,13 +19,13 @@ cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr- let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) let wid=fromJust $ wId w2 (Just cp)<-testEventTypes' [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_SUCCEEDED] $ do let cp=mkCardPayin uid uid wid (Amount "EUR" 333) (Amount "EUR" 1) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertBool (isJust $ cpId cp2) assertEqual (Just Succeeded) (cpStatus cp2) w3<-testMP $ fetchWallet wid@@ -40,7 +40,7 @@ assertEqual cp $ rInitialTransactionId r2 assertEqual (Amount "EUR" 333) $ rCreditedFunds r2 return $ Just $ rId r- + -- | test a successful card pay in + partial refund test_AdvancedCardRefund :: Assertion test_AdvancedCardRefund = do@@ -50,28 +50,28 @@ cr<-testMP $ unsafeFullRegistration uid "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr- let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) let wid=fromJust $ wId w2 (Just cp)<-testEventTypes' [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_SUCCEEDED] $ do let cp=mkCardPayin uid uid wid (Amount "EUR" 333) (Amount "EUR" 1) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertBool (isJust $ cpId cp2) assertEqual (Just Succeeded) (cpStatus cp2) w3<-testMP $ fetchWallet wid assertEqual (Just $ Amount "EUR" 332) (wBalance w3) return $ cpId cp2- -- PAYIN_REFUND_CREATED not received ??? + -- PAYIN_REFUND_CREATED not received ??? testEventTypes [PAYIN_REFUND_SUCCEEDED] $ do- let rr=RefundRequest uid (Just $ Amount "EUR" 100) (Just $ Amount "EUR" 1) + let rr=RefundRequest uid (Just $ Amount "EUR" 100) (Just $ Amount "EUR" 1) r<-testMP $ refundPayin cp rr assertEqual PAYIN (rInitialTransactionType r) r2<-testMP $ fetchRefund (rId r) assertEqual cp $ rInitialTransactionId r2 assertEqual (Amount "EUR" 99) $ rCreditedFunds r2- return $ Just $ rId r - + return $ Just $ rId r+ -- | test transfer + full refund test_TransferRefund :: Assertion test_TransferRefund = do@@ -79,20 +79,20 @@ assertEqual 2 (length $ plData usL) let [uid1,uid2] = map urId $ plData usL assertBool (uid1 /= uid2)- let w1=Wallet Nothing Nothing (Just "custom") [uid1] "my wallet" "EUR" Nothing - w1'<-testMP $ storeWallet w1+ let w1=Wallet Nothing Nothing (Just "custom") [uid1] "my wallet" "EUR" Nothing+ w1'<-testMP $ createWallet w1 let uw1=fromJust $ wId w1'- let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing - w2'<-testMP $ storeWallet w2+ let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing+ w2'<-testMP $ createWallet w2 let uw2=fromJust $ wId w2' assertBool (uw1 /= uw2)- + cr<-testMP $ unsafeFullRegistration uid1 "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr testEventTypes [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_SUCCEEDED] $ do let cp=mkCardPayin uid1 uid1 uw1 (Amount "EUR" 333) (Amount "EUR" 1) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertEqual (Just Succeeded) (cpStatus cp2) return $ cpId cp2 @@ -109,13 +109,13 @@ ts2 <- testMP $ listTransactions uw2 Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts2) uts1 <- testMP $ listTransactionsForUser uid1 (Just $ Pagination 1 50)- assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) - return $ tId t1' - + assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1)+ return $ tId t1'+ testEventTypes [TRANSFER_REFUND_CREATED,TRANSFER_REFUND_SUCCEEDED] $ do r<-testMP $ refundTransfer tr uid1 assertEqual TRANSFER (rInitialTransactionType r) r2<-testMP $ fetchRefund (rId r) assertEqual tr $ rInitialTransactionId r2 assertEqual (Amount "EUR" 100) $ rCreditedFunds r2- return $ Just $ rId r + return $ Just $ rId r
test/Web/MangoPay/SimpleTest.hs view
@@ -27,7 +27,7 @@ let ce3 = CardExpiration 10 2034 assertEqual "1034" $ writeCardExpiration ce3 - + -- | test income ranges test_IncomeRanges :: Assertion test_IncomeRanges = mapM_ testIncomeRange [minBound .. maxBound]@@ -39,7 +39,7 @@ assertEqual "EUR" c1 assertEqual "EUR" c2 if a2 > (-1)- then do + then do let mid = div (a1+a2) 2 assertEqual ir $ incomeRange (Amount c1 mid) else do
test/Web/MangoPay/TestUtils.hs view
@@ -132,7 +132,7 @@ res<-liftM tsReceivedEvents $ readIORef testState a<-ops mapM_ (testSearchEvent a) evtTs- er<-waitForEvent res (map (testEvent a) evtTs) 30+ er<-waitForEvent res (map (testEvent a) evtTs) 5 assertEqual EventsOK er return a @@ -147,7 +147,7 @@ createHook :: EventType -> Assertion createHook evtT= do hook<-liftM tsHookEndPoint $ readIORef testState- h<-testMP $ storeHook (Hook Nothing Nothing Nothing (hepUrl hook <> "/mphook") Enabled Nothing evtT)+ h<-testMP $ Web.MangoPay.createHook (Hook Nothing Nothing Nothing (hepUrl hook <> "/mphook") Enabled Nothing evtT) assertBool (isJust $ hId h) h2<-testMP $ fetchHook (fromJust $ hId h) assertEqual (hId h) (hId h2)@@ -160,7 +160,7 @@ testEvents ops tests=do res<-liftM tsReceivedEvents $ readIORef testState a<-ops- er<-waitForEvent res (map ($ a) tests) 30+ er<-waitForEvent res (map ($ a) tests) 5 assertEqual EventsOK er -- | result of waiting for event@@ -253,11 +253,11 @@ unsafeFullRegistration uid currency cardInfo at=do -- create registration let cr1=mkCardRegistration uid currency- cr2<-storeCardRegistration cr1 at+ cr2<-createCardRegistration cr1 at -- register it cr3<-liftIO $ unsafeRegisterCard cardInfo cr2 -- save registered version- storeCardRegistration cr3 at+ modifyCardRegistration cr3 at -- | register a card with the registration URL -- this function is UNSAFE, because if you use this, YOU manage the user's credit card details
test/Web/MangoPay/UsersTest.hs view
@@ -17,13 +17,13 @@ test_NaturalUser :: Assertion test_NaturalUser = do- u<-testMP $ storeNaturalUser testNaturalUser+ u<-testMP $ createNaturalUser testNaturalUser assertBool (isJust $ uId u) assertBool (isJust $ uCreationDate u) uf<-testMP $ fetchNaturalUser (fromJust $ uId u) assertEqual (uEmail testNaturalUser) (uEmail uf) assertEqual Nothing (uAddress uf)- ue<-testMP $ storeNaturalUser (uf{uAddress=Just "St Guilhem"})+ ue<-testMP $ modifyNaturalUser (uf{uAddress=Just "St Guilhem"}) assertEqual (Just "St Guilhem") (uAddress ue) assertEqual (Just IncomeRange2) (uIncomeRange ue) eu<-testMP $ getUser (fromJust $ uId u)@@ -38,13 +38,13 @@ test_LegalUser :: Assertion test_LegalUser = do- l<-testMP $ storeLegalUser testLegalUser+ l<-testMP $ createLegalUser testLegalUser assertBool (isJust $ lId l) assertBool (isJust $ lCreationDate l) lf<-testMP $ fetchLegalUser (fromJust $ lId l) assertEqual (lEmail testLegalUser) (lEmail lf) assertEqual Nothing (lHeadquartersAddress lf)- le<-testMP $ storeLegalUser (lf{lHeadquartersAddress=Just "St Guilhem"})+ 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
test/Web/MangoPay/WalletsTest.hs view
@@ -16,11 +16,11 @@ usL<-testMP $ listUsers (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 - w2<-testMP $ storeWallet w+ let w=Wallet Nothing Nothing (Just "custom") [uid] "my wallet" "EUR" Nothing+ w2<-testMP $ createWallet w assertBool (isJust $ wId w2) assertBool (isJust $ wCreationDate w2)- w3<-testMP $ storeWallet w2{wTag=Just "custom2"}+ w3<-testMP $ modifyWallet w2{wTag=Just "custom2"} assertEqual (Just "custom2") (wTag w3) assertEqual (wId w2) (wId w3) w4<-testMP $ fetchWallet (fromJust $ wId w2)@@ -31,7 +31,7 @@ assertBool (not (null $ plData ws)) assertEqual 1 (length $ filter ((wId w3 ==) . wId) $ plData ws) --- | test transfer API + notifications on failure +-- | test transfer API + notifications on failure test_FailedTransfer :: Assertion test_FailedTransfer = do usL<-testMP $ listUsers (Just $ Pagination 1 2)@@ -40,9 +40,9 @@ assertBool (uid1 /= uid2) ws<- testMP $ listWallets uid1 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 - w2'<-testMP $ storeWallet w2+ let uw1=fromJust $ wId $ head $ plData ws+ let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing+ w2'<-testMP $ createWallet w2 let uw2=fromJust $ wId w2' assertBool (uw1 /= uw2) -- transfer will fail since I have no money@@ -61,8 +61,8 @@ uts1 <- testMP $ listTransactionsForUser uid1 Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) return $ tId t1'- --- | test transfer API + notifications on success ++-- | test transfer API + notifications on success test_SuccessfulTransfer :: Assertion test_SuccessfulTransfer = do usL<-testMP $ listUsers (Just $ Pagination 1 2)@@ -71,18 +71,18 @@ assertBool (uid1 /= uid2) ws<- testMP $ listWallets uid1 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 - w2'<-testMP $ storeWallet w2+ let uw1=fromJust $ wId $ head $ plData ws+ let w2=Wallet Nothing Nothing (Just "custom") [uid2] "my wallet" "EUR" Nothing+ w2'<-testMP $ createWallet w2 let uw2=fromJust $ wId w2' assertBool (uw1 /= uw2)- + cr<-testMP $ unsafeFullRegistration uid1 "EUR" testCardInfo1 assertBool (isJust $ crCardId cr) let cid=fromJust $ crCardId cr testEventTypes [PAYIN_NORMAL_CREATED,PAYIN_NORMAL_SUCCEEDED] $ do let cp=mkCardPayin uid1 uid1 uw1 (Amount "EUR" 333) (Amount "EUR" 1) "http://dummy" cid- cp2<-testMP $ storeCardPayin cp+ cp2<-testMP $ createCardPayin cp assertEqual (Just Succeeded) (cpStatus cp2) return $ cpId cp2 @@ -99,5 +99,5 @@ ts2 <- testMP $ listTransactions uw2 Nothing assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData ts2) uts1 <- testMP $ listTransactionsForUser uid1 Nothing- assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) + assertEqual 1 (length $ filter ((tId t1'==) . txId) $ plData uts1) return $ tId t1'