diff --git a/paypal-adaptive-hoops.cabal b/paypal-adaptive-hoops.cabal --- a/paypal-adaptive-hoops.cabal +++ b/paypal-adaptive-hoops.cabal @@ -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 diff --git a/src/Web/PayPal/Adaptive/Core.hs b/src/Web/PayPal/Adaptive/Core.hs --- a/src/Web/PayPal/Adaptive/Core.hs +++ b/src/Web/PayPal/Adaptive/Core.hs @@ -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 diff --git a/tests/JSON/parseCreateResp.json b/tests/JSON/parseCreateResp.json new file mode 100644 --- /dev/null +++ b/tests/JSON/parseCreateResp.json @@ -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" +} diff --git a/tests/JSON/parseErrResp.json b/tests/JSON/parseErrResp.json new file mode 100644 --- /dev/null +++ b/tests/JSON/parseErrResp.json @@ -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" + ] + } + ] +} diff --git a/tests/JSON/parseLookupResp.json b/tests/JSON/parseLookupResp.json new file mode 100644 --- /dev/null +++ b/tests/JSON/parseLookupResp.json @@ -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" + } + ] + } +} diff --git a/tests/JSON/parseSendResp.json b/tests/JSON/parseSendResp.json new file mode 100644 --- /dev/null +++ b/tests/JSON/parseSendResp.json @@ -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" + } + ] + } +} diff --git a/tests/JSON/serializeCreatePayment.json b/tests/JSON/serializeCreatePayment.json new file mode 100644 --- /dev/null +++ b/tests/JSON/serializeCreatePayment.json @@ -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" +} diff --git a/tests/JSON/serializeSendPayment.json b/tests/JSON/serializeSendPayment.json new file mode 100644 --- /dev/null +++ b/tests/JSON/serializeSendPayment.json @@ -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" +} diff --git a/tests/Unit/Money.hs b/tests/Unit/Money.hs new file mode 100644 --- /dev/null +++ b/tests/Unit/Money.hs @@ -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" diff --git a/tests/Unit/Parser.hs b/tests/Unit/Parser.hs new file mode 100644 --- /dev/null +++ b/tests/Unit/Parser.hs @@ -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] diff --git a/tests/Unit/Utils.hs b/tests/Unit/Utils.hs new file mode 100644 --- /dev/null +++ b/tests/Unit/Utils.hs @@ -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 ()