diff --git a/test/FakeStripe.hs b/test/FakeStripe.hs index f1040b584d422074cd06b9e5af2fa411bc02c65f..dec4646c790e1c4a25da6c3b7e696a63b299b7aa 100644 --- a/test/FakeStripe.hs +++ b/test/FakeStripe.hs @@ -4,6 +4,7 @@ module FakeStripe ( withFakeStripe , chargeOkay + , chargeFailed ) where import Text.RawString.QQ @@ -23,6 +24,7 @@ import Data.Time.Calendar import Network.HTTP.Types ( status200 + , status400 ) import Network.Wai @@ -41,6 +43,17 @@ import Web.Stripe.Client , Endpoint(Endpoint) ) +anError :: ByteString +anError = [r| +{ + "error": { + "type": "card_error", + "code": "expired_card", + "message": "Your card is expired." + } +} +|] + aCharge :: ByteString aCharge = [r| { @@ -138,11 +151,17 @@ aCharge = [r| } |] + + -- Accept a charge creation and respond in the affirmative. chargeOkay :: Application chargeOkay req respond = respond . responseLBS status200 [] $ aCharge +chargeFailed :: Application +chargeFailed req respond = + respond . responseLBS status400 [] $ anError + -- 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 diff --git a/test/Stripe.hs b/test/Stripe.hs index 49b2a3457c62d1f32a795add5e82df36bf982577..2325dda61925dc408fd7560b88ef4329b2f8d2aa 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,16 +59,68 @@ import PaymentServer.Processors.Stripe ) +import PaymentServer.Issuer + ( trivialIssue + ) + +import PaymentServer.Server + ( paymentServerApp + ) + import FakeStripe ( withFakeStripe , chargeOkay + , chargeFailed ) 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 chargeOkay "POST" textPlain validChargeBytes + + , testCase "a request without a valid charge in the body receives a CORS-enabled response" $ + assertCORSHeader chargeOkay "POST" applicationJSON invalidChargeBytes + + , testCase "a request with the wrong request method receives a CORS-enabled response" $ + assertCORSHeader chargeOkay "GET" applicationJSON validChargeBytes + + , testCase "a request associated with an error from Stripe receives a CORS-enabled response" $ + assertCORSHeader chargeFailed "POST" applicationJSON validChargeBytes + + , testCase "a request with a valid charge in the body receives a CORS-enabled response" $ + assertCORSHeader chargeOkay "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 stripeResponse method headers body = + withFakeStripe (return stripeResponse) $ + \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 = ("origin", "example.invalid"):headers + } path + let theSRequest = SRequest theRequest body + (flip runSession) app $ do + response <- srequest theSRequest + assertHeader "Access-Control-Allow-Origin" "example.invalid" response + + chargeTests :: TestTree chargeTests = testGroup "Charges"