diff --git a/PaymentServer.cabal b/PaymentServer.cabal index 4bba8eea5a2d1bc944ac946fb030c539a3bc978e..3e5ad7d4fb763f6948396bf2ed2646404847758d 100644 --- a/PaymentServer.cabal +++ b/PaymentServer.cabal @@ -49,6 +49,7 @@ test-suite PaymentServer-test , Util.WAI , Util.Gen , Util.JSON + , Util.Spec build-depends: base , PaymentServer , hspec diff --git a/test/SpecStripe.hs b/test/SpecStripe.hs index 23ad2932d4368416880b5383a23f9d947017eea8..d2a281b1f5eadef91c4fee31e2f73b387f11e17a 100644 --- a/test/SpecStripe.hs +++ b/test/SpecStripe.hs @@ -14,6 +14,7 @@ import Data.Aeson ) import Test.Hspec ( Spec + , parallel , describe , it ) @@ -72,6 +73,11 @@ import PaymentServer.Persistence ( Voucher , memory ) +import Util.Spec + ( wrongMethodNotAllowed + , nonJSONUnsupportedMediaType + , wrongJSONInvalidRequest + ) stripeAPI :: Proxy StripeAPI stripeAPI = Proxy @@ -80,13 +86,11 @@ app :: IO Application app = serve stripeAPI . stripeServer <$> memory spec_webhook :: Spec -spec_webhook = with app $ do +spec_webhook = with app $ parallel $ do describe "error behavior of POST /webhook" $ do - it "responds to non-JSON Content-Type with 415 (Unsupported Media Type)" $ - post "/webhook" "xxx" `shouldRespondWith` 415 - - it "responds to JSON non-Event body with 400 (Invalid Request)" $ - postJSON "/webhook" "{}" `shouldRespondWith` 400 + wrongMethodNotAllowed "GET" "/webhook" + nonJSONUnsupportedMediaType "/webhook" + wrongJSONInvalidRequest "/webhook" "{}" -- I would like to make most or all of these into property tests. *This* -- test shows how you can do it. Yay. The main thing (for me, anyway) to @@ -109,7 +113,6 @@ spec_webhook = with app $ do property xtest_postWithEventBody - bodyMatcher :: [Network.HTTP.Types.Header] -> Body -> Maybe String bodyMatcher _ "{}" = Nothing bodyMatcher _ body = Just $ show body diff --git a/test/Util/Spec.hs b/test/Util/Spec.hs new file mode 100644 index 0000000000000000000000000000000000000000..9ce6f8de4f85163cc5e050c03511d95aac801083 --- /dev/null +++ b/test/Util/Spec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Util.Spec + ( wrongMethodNotAllowed + , nonJSONUnsupportedMediaType + , wrongJSONInvalidRequest + ) where + +import Test.Hspec + ( it + ) +import Test.Hspec.Wai + ( post + , request + , shouldRespondWith + ) + +import Util.WAI + ( postJSON + ) + +wrongMethodNotAllowed method path = + it "responds to an unsupported method with 405 (Method Not Allowed)" $ + request method path [] "" `shouldRespondWith` 405 + +nonJSONUnsupportedMediaType path = + it "responds to non-JSON Content-Type with 415 (Unsupported Media Type)" $ + post path "xxx" `shouldRespondWith` 415 + +wrongJSONInvalidRequest path json = + it "responds to JSON body representing the wrong data with 400 (Invalid Request)" $ + postJSON path json `shouldRespondWith` 400