diff --git a/mangopay.cabal b/mangopay.cabal --- a/mangopay.cabal +++ b/mangopay.cabal @@ -1,5 +1,5 @@ name: mangopay -version: 1.7.0 +version: 1.8.0 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 @@ -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 diff --git a/src/Web/MangoPay/Access.hs b/src/Web/MangoPay/Access.hs --- a/src/Web/MangoPay/Access.hs +++ b/src/Web/MangoPay/Access.hs @@ -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 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,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" <*> 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 @@ -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" + 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 @@ -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 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 @@ -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= 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 @@ -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 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 @@ -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" + 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 @@ -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" + 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 @@ -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" 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 @@ -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 <> " -> " 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 @@ -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 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 @@ -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" diff --git a/test/Web/MangoPay/AccessTest.hs b/test/Web/MangoPay/AccessTest.hs --- a/test/Web/MangoPay/AccessTest.hs +++ b/test/Web/MangoPay/AccessTest.hs @@ -4,7 +4,7 @@ module Web.MangoPay.AccessTest where -import Web.MangoPay +import Web.MangoPay hiding (createHook) import Web.MangoPay.TestUtils import Test.Framework 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 @@ -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) - + 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 @@ -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 - - - - + + + + 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 @@ -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 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 @@ -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 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 - + 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 @@ -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 - - + + 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 @@ -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 diff --git a/test/Web/MangoPay/SimpleTest.hs b/test/Web/MangoPay/SimpleTest.hs --- a/test/Web/MangoPay/SimpleTest.hs +++ b/test/Web/MangoPay/SimpleTest.hs @@ -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 diff --git a/test/Web/MangoPay/TestUtils.hs b/test/Web/MangoPay/TestUtils.hs --- a/test/Web/MangoPay/TestUtils.hs +++ b/test/Web/MangoPay/TestUtils.hs @@ -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 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 @@ -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 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 @@ -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'