diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index c80b5951c0f6ad2e78b087a9cff2c9441d4ebaa1..32a86dbf00eca5d150f454aa9f02c6f8b97b77f0 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -73,9 +73,14 @@ test-suite PaymentServer-tests
main-is: Spec.hs
other-modules: Persistence
, Metrics
+ , Stripe
+ , FakeStripe
build-depends: base
, bytestring
, text
+ , transformers
+ , raw-strings-qq
+ , time
, tasty
, tasty-hunit
, directory
@@ -84,6 +89,8 @@ test-suite PaymentServer-tests
, http-types
, wai
, wai-extra
+ , warp
+ , http-types
, servant-server
, prometheus-client
, stripe-core
diff --git a/nix/PaymentServer.nix b/nix/PaymentServer.nix
index a8df27a4643c47274a384d63fc4d6c9d8e99a530..d4e81b551156a4757acea10d7f0b4cea41900f63 100644
--- a/nix/PaymentServer.nix
+++ b/nix/PaymentServer.nix
@@ -57,10 +57,10 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
"library" = {
depends = [
(hsPkgs."base" or (buildDepError "base"))
- (hsPkgs."bytestring" or (buildDepError "bytestring"))
- (hsPkgs."utf8-string" or (buildDepError "utf8-string"))
(hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative"))
(hsPkgs."aeson" or (buildDepError "aeson"))
+ (hsPkgs."bytestring" or (buildDepError "bytestring"))
+ (hsPkgs."utf8-string" or (buildDepError "utf8-string"))
(hsPkgs."servant" or (buildDepError "servant"))
(hsPkgs."servant-server" or (buildDepError "servant-server"))
(hsPkgs."http-types" or (buildDepError "http-types"))
@@ -70,8 +70,8 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
(hsPkgs."data-default" or (buildDepError "data-default"))
(hsPkgs."warp" or (buildDepError "warp"))
(hsPkgs."warp-tls" or (buildDepError "warp-tls"))
- (hsPkgs."stripe-core" or (buildDepError "stripe-core"))
(hsPkgs."stripe-haskell" or (buildDepError "stripe-haskell"))
+ (hsPkgs."stripe-core" or (buildDepError "stripe-core"))
(hsPkgs."text" or (buildDepError "text"))
(hsPkgs."containers" or (buildDepError "containers"))
(hsPkgs."cryptonite" or (buildDepError "cryptonite"))
@@ -105,6 +105,9 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
(hsPkgs."base" or (buildDepError "base"))
(hsPkgs."bytestring" or (buildDepError "bytestring"))
(hsPkgs."text" or (buildDepError "text"))
+ (hsPkgs."transformers" or (buildDepError "transformers"))
+ (hsPkgs."raw-strings-qq" or (buildDepError "raw-strings-qq"))
+ (hsPkgs."time" or (buildDepError "time"))
(hsPkgs."tasty" or (buildDepError "tasty"))
(hsPkgs."tasty-hunit" or (buildDepError "tasty-hunit"))
(hsPkgs."directory" or (buildDepError "directory"))
@@ -113,6 +116,8 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
(hsPkgs."http-types" or (buildDepError "http-types"))
(hsPkgs."wai" or (buildDepError "wai"))
(hsPkgs."wai-extra" or (buildDepError "wai-extra"))
+ (hsPkgs."warp" or (buildDepError "warp"))
+ (hsPkgs."http-types" or (buildDepError "http-types"))
(hsPkgs."servant-server" or (buildDepError "servant-server"))
(hsPkgs."prometheus-client" or (buildDepError "prometheus-client"))
(hsPkgs."stripe-core" or (buildDepError "stripe-core"))
@@ -121,4 +126,4 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
};
};
};
- } // rec { src = (pkgs.lib).mkDefault ../.; }
+ } // rec { src = (pkgs.lib).mkDefault .././.; }
\ No newline at end of file
diff --git a/src/PaymentServer/Processors/Stripe.hs b/src/PaymentServer/Processors/Stripe.hs
index dca6457c5acc3364a4136c6539448068655d0435..2c4c7f89419d9c873e52a3a7008659ffbddfd717 100644
--- a/src/PaymentServer/Processors/Stripe.hs
+++ b/src/PaymentServer/Processors/Stripe.hs
@@ -5,8 +5,11 @@
module PaymentServer.Processors.Stripe
( StripeAPI
+ , Charges(Charges)
+ , Acknowledgement(Ok)
, stripeServer
, getVoucher
+ , charge
) where
import Control.Monad.IO.Class
@@ -50,7 +53,7 @@ import Web.Stripe.Error
import Web.Stripe.Types
( Charge(Charge, chargeId)
, MetaData(MetaData)
- , Currency
+ , Currency(USD)
)
import Web.Stripe.Charge
( createCharge
@@ -74,7 +77,7 @@ import PaymentServer.Persistence
, ProcessorResult
)
-data Acknowledgement = Ok
+data Acknowledgement = Ok deriving (Eq, Show)
instance ToJSON Acknowledgement where
toJSON Ok = object
@@ -149,8 +152,8 @@ withSuccessFailureMetrics attemptCount successCount op = do
-- | call the stripe Charge API (with token, voucher in metadata, amount, currency etc
-- and if the Charge is okay, then set the voucher as "paid" in the database.
charge :: VoucherDatabase d => StripeConfig -> d -> Charges -> Handler Acknowledgement
-charge stripeConfig d (Charges token voucher amount currency) = do
- result <- liftIO ((payForVoucher d voucher (completeStripeCharge currency)) :: IO ProcessorResult)
+charge stripeConfig d (Charges token voucher 650 USD) = do
+ result <- liftIO ((payForVoucher d voucher (completeStripeCharge USD)) :: IO ProcessorResult)
case result of
Left AlreadyPaid ->
throwError voucherAlreadyPaid
@@ -171,7 +174,7 @@ charge stripeConfig d (Charges token voucher amount currency) = do
return . Right $ chargeId
where
charge =
- createCharge (Amount amount) currency
+ createCharge (Amount 650) currency
-&- tokenId
-&- MetaData [("Voucher", voucher)]
@@ -199,13 +202,18 @@ charge stripeConfig d (Charges token voucher amount currency) = do
stripeChargeFailed = jsonErr 400 "Stripe charge didn't succeed"
voucherAlreadyPaid = jsonErr 400 "Payment for voucher already supplied"
- jsonErr httpCode reason = ServerError
- { errHTTPCode = httpCode
- , errReasonPhrase = ""
- , errBody = encode $ Failure reason
- , errHeaders = [("content-type", "application/json")]
- }
-
+-- The wrong currency
+charge _ _ (Charges _ _ 650 _) = throwError (jsonErr 400 "Unsupported currency")
+-- The wrong amount
+charge _ _ (Charges _ _ _ USD) = throwError (jsonErr 400 "Incorrect charge amount")
+
+jsonErr :: Int -> Text -> ServerError
+jsonErr httpCode reason = ServerError
+ { errHTTPCode = httpCode
+ , errReasonPhrase = ""
+ , errBody = encode $ Failure reason
+ , errHeaders = [("content-type", "application/json")]
+ }
data Failure = Failure Text
deriving (Show, Eq)
diff --git a/test/FakeStripe.hs b/test/FakeStripe.hs
new file mode 100644
index 0000000000000000000000000000000000000000..f1040b584d422074cd06b9e5af2fa411bc02c65f
--- /dev/null
+++ b/test/FakeStripe.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module FakeStripe
+ ( withFakeStripe
+ , chargeOkay
+ ) where
+
+import Text.RawString.QQ
+
+import Data.ByteString.Lazy
+ ( ByteString
+ )
+
+import Data.Time.Clock
+ ( UTCTime(UTCTime)
+ , secondsToDiffTime
+ )
+
+import Data.Time.Calendar
+ ( Day(ModifiedJulianDay)
+ )
+
+import Network.HTTP.Types
+ ( status200
+ )
+
+import Network.Wai
+ ( Application
+ , responseLBS
+ )
+
+import Network.Wai.Handler.Warp
+ ( testWithApplication
+ )
+
+import Web.Stripe.Client
+ ( StripeConfig(StripeConfig)
+ , StripeKey(StripeKey)
+ , Protocol(HTTP)
+ , Endpoint(Endpoint)
+ )
+
+aCharge :: ByteString
+aCharge = [r|
+{
+ "id": "ch_1Fwa4NBHXBAMm9bPFRPo6UBt",
+ "object": "charge",
+ "amount": 100,
+ "amount_captured": 0,
+ "amount_refunded": 0,
+ "application": null,
+ "application_fee": null,
+ "application_fee_amount": null,
+ "balance_transaction": "txn_1FrU7mBHXBAMm9bP9WvFFzRG",
+ "billing_details": {
+ "address": {
+ "city": "",
+ "country": "US",
+ "line1": "",
+ "line2": "",
+ "postal_code": "",
+ "state": "Select State"
+ },
+ "email": null,
+ "name": "",
+ "phone": null
+ },
+ "calculated_statement_descriptor": null,
+ "captured": false,
+ "created": 1577996099,
+ "currency": "usd",
+ "customer": null,
+ "description": null,
+ "disputed": false,
+ "failure_code": "card_declined",
+ "failure_message": "Your card was declined.",
+ "fraud_details": {
+ "stripe_report": "fraudulent"
+ },
+ "invoice": null,
+ "livemode": false,
+ "metadata": {
+ "Voucher": "EQwTqWXIjKF5MWMZmDYKJvbtiaVBlDecmk__bytPlK_l"
+ },
+ "on_behalf_of": null,
+ "order": null,
+ "outcome": {
+ "network_status": "not_sent_to_network",
+ "reason": "merchant_blacklist",
+ "risk_level": "highest",
+ "risk_score": 90,
+ "seller_message": "Stripe blocked this payment.",
+ "type": "blocked"
+ },
+ "paid": false,
+ "payment_intent": null,
+ "payment_method": "card_1Fwa4MBHXBAMm9bPyw1fke3O",
+ "payment_method_details": {
+ "card": {
+ "brand": "visa",
+ "checks": {
+ "address_line1_check": null,
+ "address_postal_code_check": null,
+ "cvc_check": "unavailable"
+ },
+ "country": "US",
+ "exp_month": 11,
+ "exp_year": 2022,
+ "fingerprint": "5COYv5EoHE9ZE82J",
+ "funding": "credit",
+ "installments": null,
+ "last4": "0019",
+ "network": "visa",
+ "three_d_secure": null,
+ "wallet": null
+ },
+ "type": "card"
+ },
+ "receipt_email": null,
+ "receipt_number": null,
+ "receipt_url": null,
+ "refunded": false,
+ "refunds": {
+ "object": "list",
+ "data": [],
+ "has_more": false,
+ "url": "/v1/charges/ch_1Fwa4NBHXBAMm9bPFRPo6UBt/refunds"
+ },
+ "review": null,
+ "shipping": null,
+ "source_transfer": null,
+ "statement_descriptor": null,
+ "statement_descriptor_suffix": null,
+ "status": "failed",
+ "transfer_data": null,
+ "transfer_group": null
+}
+|]
+
+-- Accept a charge creation and respond in the affirmative.
+chargeOkay :: Application
+chargeOkay req respond =
+ respond . responseLBS status200 [] $ aCharge
+
+-- Pass a Stripe-flavored configuration for a running Wai application to a
+-- function and evaluate the resulting IO action.
+withFakeStripe :: IO Application -> (StripeConfig -> IO a) -> IO a
+withFakeStripe app f =
+ testWithApplication app $ f . makeConfig
+ where
+ makeConfig = StripeConfig stripeKey . Just . Endpoint "127.0.0.1" HTTP
+ stripeKey = StripeKey "pk_test_aaaaaaaaaaaaaaaaaaaaaa"
diff --git a/test/Spec.hs b/test/Spec.hs
index e52ca131e7af29d3b094334ff21b853fe43701dd..d52d0af47659b4a5ecc4c65fae465d28007f6226 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -12,11 +12,13 @@ import Test.Tasty
import qualified Persistence
import qualified Metrics
+import qualified Stripe
tests :: TestTree
tests = testGroup "Tests"
[ Persistence.tests
, Metrics.tests
+ , Stripe.tests
]
main = defaultMain tests
diff --git a/test/Stripe.hs b/test/Stripe.hs
new file mode 100644
index 0000000000000000000000000000000000000000..49b2a3457c62d1f32a795add5e82df36bf982577
--- /dev/null
+++ b/test/Stripe.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Tests related to PaymentServer.Processors.Stripe.
+
+module Stripe
+ ( tests
+ ) where
+
+import Test.Tasty
+ ( TestTree
+ , testGroup
+ )
+import Test.Tasty.HUnit
+ ( testCase
+ , assertEqual
+ )
+
+
+import Control.Monad.Trans.Except
+ ( runExceptT
+ )
+
+import Servant.Server
+ ( Handler(runHandler')
+ , ServerError(ServerError)
+ )
+
+import Web.Stripe.Types
+ ( Currency(USD, AED)
+ )
+
+import PaymentServer.Persistence
+ ( memory
+ )
+
+import PaymentServer.Processors.Stripe
+ ( Charges(Charges)
+ , Acknowledgement(Ok)
+ , charge
+
+ )
+
+import FakeStripe
+ ( withFakeStripe
+ , chargeOkay
+ )
+
+tests :: TestTree
+tests = testGroup "Stripe"
+ [ chargeTests
+ ]
+
+chargeTests :: TestTree
+chargeTests =
+ testGroup "Charges"
+ [ testCase "non-USD currency is rejected" $
+ withFakeStripe (return chargeOkay) $ \stripeConfig -> do
+ let amount = 650
+ let currency = AED
+ db <- memory
+ (Left (ServerError code _ _ _)) <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
+ assertEqual "The result is an error" 400 code
+ , testCase "incorrect USD amount is rejected" $
+ withFakeStripe (return chargeOkay) $ \stripeConfig -> do
+ let amount = 649
+ let currency = USD
+ db <- memory
+ (Left (ServerError code _ _ _)) <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
+ assertEqual "The result is an error" 400 code
+ , testCase "currect USD amount is accepted" $
+ withFakeStripe (return chargeOkay) $ \stripeConfig -> do
+ let amount = 650
+ let currency = USD
+ db <- memory
+ result <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
+ assertEqual "The result is Ok" (Right Ok) result
+ ]
+ where
+ token = "foo"
+ voucher = "bar"