Factor some generally useful SpecWith

PaymentServer.cabal

@@ -49,6 +49,7 @@ test-suite PaymentServer-test
                      , Util.WAI
                      , Util.Gen
                      , Util.JSON
+                     , Util.Spec
   build-depends:       base
                      , PaymentServer
                      , hspec

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

test/Util/Spec.hs

+{-# 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