From 3414de673f249be9f0c507632ce6bce9f3618503 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 11 Jun 2021 13:28:26 -0400
Subject: [PATCH] Attempt to test the CORS behavior
---
test/Stripe.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 62 insertions(+)
diff --git a/test/Stripe.hs b/test/Stripe.hs
index 49b2a34..ab66823 100644
--- a/test/Stripe.hs
+++ b/test/Stripe.hs
@@ -16,6 +16,10 @@ import Test.Tasty.HUnit
)
+import Control.Monad.IO.Class
+ ( liftIO
+ )
+
import Control.Monad.Trans.Except
( runExceptT
)
@@ -29,6 +33,21 @@ import Web.Stripe.Types
( Currency(USD, AED)
)
+import Network.Wai.Test
+ ( SRequest(SRequest)
+ , runSession
+ , request
+ , srequest
+ , defaultRequest
+ , assertHeader
+ , setPath
+ )
+
+import Network.Wai
+ ( requestMethod
+ , requestHeaders
+ )
+
import PaymentServer.Persistence
( memory
)
@@ -40,6 +59,14 @@ import PaymentServer.Processors.Stripe
)
+import PaymentServer.Issuer
+ ( trivialIssue
+ )
+
+import PaymentServer.Server
+ ( paymentServerApp
+ )
+
import FakeStripe
( withFakeStripe
, chargeOkay
@@ -48,7 +75,42 @@ import FakeStripe
tests :: TestTree
tests = testGroup "Stripe"
[ chargeTests
+ , corsTests
+ ]
+
+corsTests :: TestTree
+corsTests =
+ testGroup "CORS"
+ [ testCase "a request with the wrong content-type receives a CORS-enabled response" $
+ assertCORSHeader "POST" textPlain validChargeBytes
+ , testCase "a request without a valid charge in the body receives a CORS-enabled response" $
+ assertCORSHeader "POST" applicationJSON invalidChargeBytes
+ , testCase "a request with the wrong request method receives a CORS-enabled response" $
+ assertCORSHeader "GET" applicationJSON validChargeBytes
+ , testCase "a request with a valid charge in the body receives a CORS-enabled response" $
+ assertCORSHeader "POST" applicationJSON validChargeBytes
]
+ where
+ textPlain = [("content-type", "text/plain")]
+ applicationJSON = [("content-type", "application/json")]
+ validChargeBytes = "{\"token\": \"abcdef\", \"voucher\": \"lmnopqrst\", \"amount\": \"650\", \"currency\": \"USD\"}"
+ invalidChargeBytes = "[1, 2, 3]"
+
+ assertCORSHeader method headers body =
+ withFakeStripe (return chargeOkay) $
+ \stripeConfig -> do
+ db <- memory
+ let origins = ["example.invalid"]
+ let app = paymentServerApp origins stripeConfig trivialIssue db
+
+ let path = "/v1/stripe/charge"
+ let theRequest = setPath defaultRequest { requestMethod = method, requestHeaders = headers} path
+ let theSRequest = SRequest theRequest body
+ (flip runSession) app $ do
+ response <- srequest theSRequest
+ liftIO $ print response
+ assertHeader "Access-Control-Allow-Origin" "example.invalid" response
+
chargeTests :: TestTree
chargeTests =
--
GitLab