paypal-adaptive-hoops 0.5.0.0 → 0.5.1.0
raw patch · 11 files changed
+332/−3 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- paypal-adaptive-hoops.cabal +6/−2
- src/Web/PayPal/Adaptive/Core.hs +1/−1
- tests/JSON/parseCreateResp.json +10/−0
- tests/JSON/parseErrResp.json +21/−0
- tests/JSON/parseLookupResp.json +41/−0
- tests/JSON/parseSendResp.json +30/−0
- tests/JSON/serializeCreatePayment.json +18/−0
- tests/JSON/serializeSendPayment.json +18/−0
- tests/Unit/Money.hs +48/−0
- tests/Unit/Parser.hs +102/−0
- tests/Unit/Utils.hs +37/−0
paypal-adaptive-hoops.cabal view
@@ -1,15 +1,16 @@ name: paypal-adaptive-hoops-version: 0.5.0.0+version: 0.5.1.0 author: Ian Grant Jeffries maintainer: ian@housejeffries.com category: Web synopsis: Client for a limited part of PayPal's Adaptive Payments API homepage: https://github.com/fanjam/paypal-adaptive-hoops build-type: Simple-extra-source-files: README.md license: MIT license-file: MIT-LICENSE.txt cabal-version: >=1.10+extra-source-files: README.md+ tests/JSON/*.json library hs-source-dirs: src@@ -41,6 +42,9 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Test.hs+ other-modules: Unit.Money+ Unit.Parser+ Unit.Utils default-language: Haskell2010 ghc-options: -Wall other-extensions: OverloadedStrings
src/Web/PayPal/Adaptive/Core.hs view
@@ -391,7 +391,7 @@ data Money = USD { _usdCents :: Int } deriving (Eq, Show) -- NOTE: Once we add more currencies this instance will violate the--- Monad laws.+-- Monoid laws. instance Monoid Money where mempty = USD 0 mappend (USD c1) (USD c2) = USD $ c1 + c2
+ tests/JSON/parseCreateResp.json view
@@ -0,0 +1,10 @@+{+ "responseEnvelope": {+ "correlationId": "caf7d2d1a85aa",+ "build": "13414382",+ "ack": "Success",+ "timestamp": "2015-01-12T13:47:48.819-08:00"+ },+ "paymentExecStatus": "CREATED",+ "payKey": "AP-3NL080742J1818731"+}
+ tests/JSON/parseErrResp.json view
@@ -0,0 +1,21 @@+{+ "responseEnvelope": {+ "correlationId": "8415665a8815f",+ "build": "13414382",+ "ack": "Failure",+ "timestamp": "2014-11-10T16:42:00.311-08:00"+ },+ "error": [+ {+ "subdomain": "Application",+ "category": "Application",+ "domain": "PLATFORM",+ "severity": "Error",+ "errorId": "560022",+ "message": "The X-PAYPAL-APPLICATION-ID header contains an invalid value",+ "parameter": [+ "X-PAYPAL-APPLICATION-ID"+ ]+ }+ ]+}
+ tests/JSON/parseLookupResp.json view
@@ -0,0 +1,41 @@+{+ "status": "COMPLETED",+ "feesPayer": "EACHRECEIVER",+ "currencyCode": "USD",+ "reverseAllParallelPaymentsOnError": "false",+ "cancelUrl": "https://example.com/cancel",+ "responseEnvelope": {+ "correlationId": "db7b90a8b503a",+ "build": "13414382",+ "ack": "Success",+ "timestamp": "2015-01-13T16:09:46.064-08:00"+ },+ "sender": {+ "email": "payments-facilitator@mail.com",+ "accountId": "SQ6CLCESENNDL",+ "useCredentials": "false"+ },+ "returnUrl": "https://example.com/",+ "senderEmail": "payments-facilitator@mail.com",+ "payKey": "AP-5XY65045XE4097324",+ "actionType": "PAY",+ "paymentInfoList": {+ "paymentInfo": [+ {+ "refundedAmount": "0.00",+ "senderTransactionStatus": "COMPLETED",+ "transactionId": "0CL88103PF900230J",+ "receiver": {+ "email": "user@mail.com",+ "amount": "1.00",+ "primary": "false",+ "accountId": "69D9D7KVA6WAN",+ "paymentType": "SERVICE"+ },+ "senderTransactionId": "9U084775U2533540T",+ "transactionStatus": "COMPLETED",+ "pendingRefund": "false"+ }+ ]+ }+}
+ tests/JSON/parseSendResp.json view
@@ -0,0 +1,30 @@+{+ "responseEnvelope": {+ "correlationId": "8d141f13b157e",+ "build": "13414382",+ "ack": "Success",+ "timestamp": "2014-11-10T16:27:18.328-08:00"+ },+ "paymentExecStatus": "COMPLETED",+ "sender": {+ "accountId": "SQ6CLCESENNDL"+ },+ "payKey": "AP-21C62741YR509274N",+ "paymentInfoList": {+ "paymentInfo": [+ {+ "senderTransactionStatus": "COMPLETED",+ "transactionId": "1DG71997KF688883E",+ "receiver": {+ "email": "user@mail.com",+ "amount": "1.00",+ "primary": "false",+ "accountId": "69D9D7KVA6WAN"+ },+ "senderTransactionId": "7TU31598YN877045D",+ "transactionStatus": "COMPLETED",+ "pendingRefund": "false"+ }+ ]+ }+}
+ tests/JSON/serializeCreatePayment.json view
@@ -0,0 +1,18 @@+{+ "currencyCode": "USD",+ "cancelUrl": "https://example.com/cancel",+ "receiverList": {+ "receiver": [+ {+ "email": "payments@mail.com",+ "amount": "1.00"+ }+ ]+ },+ "returnUrl": "https://example.com/",+ "senderEmail": "user@mail.com",+ "requestEnvelope": {+ "errorLanguage": "en_US"+ },+ "actionType": "PAY"+}
+ tests/JSON/serializeSendPayment.json view
@@ -0,0 +1,18 @@+{+ "currencyCode": "USD",+ "cancelUrl": "https://example.com/cancel",+ "receiverList": {+ "receiver": [+ {+ "email": "user@mail.com",+ "amount": "1.00"+ }+ ]+ },+ "returnUrl": "https://example.com/",+ "senderEmail": "payments@mail.com",+ "requestEnvelope": {+ "errorLanguage": "en_US"+ },+ "actionType": "PAY"+}
+ tests/Unit/Money.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Unit.Money (unitMoney) where++import Test.Framework+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit ((@=?), Assertion)+import Web.PayPal.Adaptive++unitMoney :: Test+unitMoney = testGroup "money"+ [ testCase "handle large negative amount correctly" largeNegative+ , testCase "handle negative amount correctly" negative+ , testCase "handle 0 correctly" zero+ , testCase "handle 1 correctly" oneDigit+ , testCase "handle 10 correctly" twoDigitsTrailingZero+ , testCase "show both decimals even if both are zero" threeDigitsTrailingZeros+ , testCase "show both decimals even if the second is zero" threeDigitsTrailingZero+ , testCase "handles large amount correctly" largeAmount+ ]++testM2P :: Int -> String -> Assertion+testM2P input correct =+ correct @=? m2PayPal USD { _usdCents = input }++largeNegative :: Assertion+largeNegative = testM2P (-98783) "-987.83"++negative :: Assertion+negative = testM2P (-1) "-0.01"++zero :: Assertion+zero = testM2P 0 "0.00"++oneDigit :: Assertion+oneDigit = testM2P 1 "0.01"++twoDigitsTrailingZero :: Assertion+twoDigitsTrailingZero = testM2P 10 "0.10"++threeDigitsTrailingZeros :: Assertion+threeDigitsTrailingZeros = testM2P 100 "1.00"++threeDigitsTrailingZero :: Assertion+threeDigitsTrailingZero = testM2P 110 "1.10"++largeAmount :: Assertion+largeAmount = testM2P 792874 "7928.74"
+ tests/Unit/Parser.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Unit.Parser (unitParser) where++import Data.Default+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion)+import Unit.Utils+import Web.PayPal.Adaptive++unitParser :: Test+unitParser = testGroup "parsers"+ [ testCase "correctly encodes a SendPayment" serializeSendPayment+ , testCase "correctly encodes a CreatePayment" serializeCreatePayment+ , testCase "correctly decodes a SendPayment response" parseSendResp+ , testCase "correctly decodes a CreatePayment response" parseCreateResp+ , testCase "correctly decodes a LookupPayment response" parseLookupResp+ , testCase "correctly decodes an error code response" parseErrResp+ ]++serializeSendPayment :: Assertion+serializeSendPayment = "tests/JSON/serializeSendPayment.json" `eqSerialized` a+ where+ a = def+ { _spReceiverList = rl+ , _spSenderEmail = "payments@mail.com"+ }+ rl = ReceiverList+ { _rlAmount = USD 100+ , _rlEmail = "user@mail.com"+ }++serializeCreatePayment :: Assertion+serializeCreatePayment = "tests/JSON/serializeCreatePayment.json" `eqSerialized` a+ where+ a = def+ { _cpReceiverList = rl+ , _cpSenderEmail = "user@mail.com"+ }+ rl = ReceiverList+ { _rlAmount = USD 100+ , _rlEmail = "payments@mail.com"+ }++parseSendResp :: Assertion+parseSendResp = expected `eqParsed` "tests/JSON/parseSendResp.json"+ where+ expected = PayResp+ { _prPayError = Nothing+ , _prPayExecStatus = PeCompleted+ , _prPayKey = PayKey "AP-21C62741YR509274N"+ , _prPayInfo = [p]+ }+ p = PayInfo+ { _piReceiver = r+ , _piSenderTransactionId = Just (TransactionId "7TU31598YN877045D")+ , _piTransactionStatus = Just TsCompleted+ , _piTransactionId = Just (TransactionId "1DG71997KF688883E")+ }+ r = Receiver+ { _reAmount = "1.00"+ , _reEmail = "user@mail.com"+ , _reAccountId = "69D9D7KVA6WAN"+ }++parseCreateResp :: Assertion+parseCreateResp = expected `eqParsed` "tests/JSON/parseCreateResp.json"+ where+ expected = PayResp+ { _prPayError = Nothing+ , _prPayExecStatus = PeCreated+ , _prPayKey = PayKey "AP-3NL080742J1818731"+ , _prPayInfo = []+ }++-- TODO: add tests for lookups of Created payments as well as Completed.+parseLookupResp :: Assertion+parseLookupResp = expected `eqParsed` "tests/JSON/parseLookupResp.json"+ where+ expected = PayResp+ { _prPayError = Nothing+ , _prPayExecStatus = PeCompleted+ , _prPayKey = PayKey "AP-5XY65045XE4097324"+ , _prPayInfo = [p]+ }+ p = PayInfo+ { _piReceiver = r+ , _piSenderTransactionId = Just (TransactionId "9U084775U2533540T")+ , _piTransactionStatus = Just TsCompleted+ , _piTransactionId = Just (TransactionId "0CL88103PF900230J")+ }+ r = Receiver+ { _reAmount = "1.00"+ , _reEmail = "user@mail.com"+ , _reAccountId = "69D9D7KVA6WAN"+ }++parseErrResp :: Assertion+parseErrResp = expected `eqParsed` "tests/JSON/parseErrResp.json"+ where+ expected = AeErrCodes [560022]
+ tests/Unit/Utils.hs view
@@ -0,0 +1,37 @@+module Unit.Utils where++import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as BSC+import Data.Char (isSpace)+import Test.HUnit (Assertion, (@=?), assertFailure)++eqSerialized :: (ToJSON a) => FilePath -> a -> Assertion+eqSerialized x y = do+ expected <- B.readFile x+ let actual = encode y+ filterBS expected @=? filterBS actual++ where+ filterBS :: BSC.ByteString -> BSC.ByteString+ filterBS = BSC.filter (not . isSpace)++eqParsed :: (Show a, Eq a, FromJSON a) => a -> FilePath -> Assertion+eqParsed x y = do+ j <- B.readFile y+ actual <- assertDecode j+ x @=? actual++ where+ assertDecode :: FromJSON a => BSC.ByteString -> IO a+ assertDecode json = do+ let d = eitherDecode json+ assertRight d+ let Right actual = d+ return actual++ where+ assertRight :: Either String b -> Assertion+ assertRight e = case e of+ Left s -> assertFailure s+ Right _ -> return ()