Try this with Tasty

It's sort of a meaningless change.  Blech.

PaymentServer.cabal

@@ -35,7 +35,11 @@ executable PaymentServer-exe
 test-suite PaymentServer-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
-  main-is:             Spec.hs
+  main-is:             Driver.hs
+  other-modules:       SpecStripe
+                     , Util.WAI
+                     , Util.Gen
+                     , Util.JSON
   build-depends:       base
                      , PaymentServer
                      , hspec
@@ -50,6 +54,13 @@ test-suite PaymentServer-test
                      , bytestring
                      , text
                      , http-types
+                     , tasty
+                     , tasty-th
+                     , tasty-discover
+                     , tasty-hspec
+                     , tasty-hedgehog
+                     , tasty-quickcheck
+                     , hedgehog
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 

test/Driver.hs

+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+
+-- This is a module where we can hang the above preprocessor definition to
+-- direct tasty-discover to find our test suite spread across the rest of the
+-- modules rooted in this directory.
+--
+-- See the test-suite definition in PaymentServer.cabal
+-- See also https://git.coop/decentral1se/tasty-discover

test/SpecStripe.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+--
+-- Test suite for Stripe support in the payment server.
+--
+
+module SpecStripe where
+
+import Data.ByteString as BS
+import Data.ByteString.Lazy as LazyBS
+import Data.Aeson
+  ( encode
+  )
+import Test.Hspec
+  ( Spec
+  , describe
+  , it
+  )
+import Test.Hspec.Wai
+  ( WaiSession
+  , WaiExpectation
+  , with
+  , post
+  , shouldRespondWith
+  , liftIO
+  )
+import Test.Hspec.Wai.QuickCheck
+  ( -- Get Test.QuickCheck.Property.Testable instance for WaiExpectation
+    property
+  )
+import Test.QuickCheck
+  ( generate
+  )
+import Util.WAI
+  ( postJSON
+  )
+import Util.Gen
+  ( chargeSucceededEvents
+  )
+import Util.JSON
+  ( -- ToJSON instance for Event
+  )
+import Lib
+  ( app
+  )
+
+aChargeEvent :: IO LazyBS.ByteString
+aChargeEvent = encode <$> generate chargeSucceededEvents
+
+spec_webhook :: Spec
+spec_webhook = with (return app) $
+  -- I would like to make these property tests but I can't figure out how to
+  -- use QuickCheck (or Hedgehog) to write property tests for web code.
+
+  describe "error behavior of POST /webhook" $ do
+    it "responds to non-JSON Content-Type with 400 (Invalid Request)" $
+      post "/webhook" "xxx" `shouldRespondWith` 400
+
+    it "responds to JSON non-Event body with 400 (Invalid Request)" $
+      postJSON "/webhook" "{}" `shouldRespondWith` 400
+
+spec_webhook' :: Spec
+spec_webhook' = with (return app) $
+  describe "success behavior of POST /webhook" $ do
+    it "responds to a JSON Event body with 200 (OK)" $ do
+      event <- liftIO aChargeEvent
+      postJSON "/webhook" event `shouldRespondWith` 200

test/Spec.hs → test/Util/Gen.hs

-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Main (main) where
 
-import Lib
-  ( app
-  )
-
-import Data.ByteString.Lazy as LazyBS
-import Data.ByteString as BS
+module Util.Gen
+  ( chargeSucceededEvents
+  ) where
 
 import Data.Text
   ( Text
@@ -17,10 +12,6 @@ import Data.Time.Clock
   ( UTCTime
   )
 
-import Data.Aeson
-  ( encode
-  )
-
 import Web.Stripe.Types
   ( Charge(Charge)
   , StatementDescription(StatementDescription)
@@ -42,32 +33,10 @@ import Web.Stripe.Event
   , EventId(EventId)
   )
 
-import Test.Hspec
-  ( Spec
-  , hspec
-  , describe
-  , it
-  )
-import Test.Hspec.Wai
-  ( WaiSession
-  , with
-  , post
-  , request
-  , shouldRespondWith
-  )
-import Network.Wai.Test
-  ( SResponse
-  )
-
-import Network.HTTP.Types.Method
-  ( methodPost
-  )
 
 import Test.QuickCheck
   ( Gen
   , Arbitrary
-  , forAll
-  , property
   , arbitrary
   )
 
@@ -78,19 +47,10 @@ import Test.QuickCheck.Instances.Text
   ( -- Get the `Gen Text` instance
   )
 
-main :: IO ()
-main = hspec spec
-
--- Post some JSON to a path.
--- Return a function from path to a response
-postJSON :: BS.ByteString -> (LazyBS.ByteString -> WaiSession SResponse)
-postJSON path =
-  request methodPost path [("Content-Type", "application/json")]
-
 instance Arbitrary Charge where
   arbitrary = Charge
     <$> arbitrary         --   chargeId :: ChargeId
-    <*> arbitrary         --   chargeObject :: Text
+    <*> (return "charge") --   chargeObject :: Text
     <*> arbitrary         --   chargeCreated :: UTCTime
     <*> arbitrary         --   chargeLiveMode :: Bool
     <*> arbitrary         --   chargePaid :: Bool
@@ -167,20 +127,6 @@ chargeSucceededEvents =
   <*> (ChargeEvent
        <$> arbitrary -- the charge
       ) -- eventData
-  <*> arbitrary -- eventObject
+  <*> (return "event") -- eventObject
   <*> arbitrary -- eventPendingWebHooks
   <*> arbitrary -- eventRequest
-
-spec :: Spec
-spec = with (return app) $ do
-  describe "error behavior of POST /webhook" $ do
-    it "responds to non-JSON Content-Type with 400 (Invalid Request)" $
-      post "/webhook" "{}" `shouldRespondWith` 400
-
-    it "responds to JSON non-Event body with 400 (Invalid Request)" $
-      postJSON "/webhook" "{}" `shouldRespondWith` 400
-
-  describe "success behavior of POST /webhook" $ do
-    it "responds to JSON-encoded Event body with 200 (OK)" $
-      forAll chargeSucceededEvents $ \event ->
-        postJSON "/webhook" (encode event) `shouldRespondWith` 200

test/Util/JSON.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+module Util.JSON where
+
+import Web.Stripe.Types
+  ( Charge(Charge)
+  , ChargeId(ChargeId)
+  , InvoiceId(InvoiceId)
+  , Amount(Amount)
+  , Currency(USD)
+  )
+import Web.Stripe.Event
+  ( Event(Event)
+  , EventData(ChargeEvent)
+  , EventType(ChargeSucceededEvent)
+  , EventId(EventId)
+  )
+
+import Data.Aeson
+  ( ToJSON(toJSON)
+  , Value(String, Number)
+  , object
+  , (.=)
+  )
+
+instance ToJSON Event where
+  toJSON (Event
+           eventId
+           eventCreated
+           eventLiveMode
+           eventType
+           eventData
+           eventObject
+           eventPendingWebHooks
+           eventRequest)
+    = object
+    [ "id" .= eventId
+    , "object" .= eventObject
+    , "api_version" .= String "2018-05-21"
+    , "created" .= eventCreated
+    , "data" .= object [ "object" .= eventData ]
+    , "type" .= eventType
+    , "livemode" .= eventLiveMode
+    , "pending_webhooks" .= eventPendingWebHooks
+    , "request" .= eventRequest
+    ]
+
+instance ToJSON EventId where
+  toJSON (EventId eId) = String eId
+
+instance ToJSON InvoiceId where
+  toJSON (InvoiceId iId) = String iId
+
+instance ToJSON ChargeId where
+  toJSON (ChargeId cId) = String cId
+
+instance ToJSON Currency where
+  toJSON USD = "USD"
+
+instance ToJSON EventType where
+  toJSON ChargeSucceededEvent = "charge.succeeded"
+
+instance ToJSON EventData where
+  toJSON (ChargeEvent charge) = toJSON charge
+
+instance ToJSON Amount where
+  toJSON (Amount a) = Number $ fromIntegral a
+
+instance ToJSON Charge where
+  toJSON (Charge
+           chargeId
+           chargeObject
+           chargeCreated
+           chargeLiveMode
+           chargePaid
+           chargeAmount
+           chargeCurrency
+           chargeRefunded
+           chargeCreditChard
+           chargeCaptured
+           chargeRefunds
+           chargeBalanceTransaction
+           chargeFailureMessage
+           chargeFailureCode
+           chargeAmountRefunded
+           chargeCustomerId
+           chargeInvoice
+           chargeDescription
+           chargeDispute
+           chargeMetaData
+           chargeStatementDescription
+           chargeReceiptEmail
+           chargeNumber
+         )
+    = object
+    [ "id"         .= chargeId
+    , "object"     .= chargeObject
+    , "amount"     .= chargeAmount
+    -- , "amount_refunded" .= chargeAmountRefunded
+    -- , "balance_transaction" .= chargeBalanceTransaction
+    , "captured" .= chargeCaptured
+    , "created"    .= chargeCreated
+    , "currency"   .= chargeCurrency
+    -- , "customer" .= chargeCustomerId
+    -- , "description" .= chargeDescription
+    -- , "dispute" .= chargeDispute
+    -- , "failure_code" .= chargeFailureCode
+    -- , "failure_message" .= chargeFailureMessage
+    -- , "invoice" .= chargeInvoice
+    , "livemode" .= chargeLiveMode
+    ]

test/Util/WAI.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+module Util.WAI
+  ( postJSON
+  ) where
+
+import Data.ByteString.Lazy as LazyBS
+import Data.ByteString as BS
+import Test.Hspec.Wai
+  ( WaiSession
+  , request
+  )
+import Network.HTTP.Types.Method
+  ( methodPost
+  )
+import Network.Wai.Test
+  ( SResponse
+  )
+
+-- Post some JSON to a path.
+-- Return a function from path to a response
+postJSON :: BS.ByteString -> (LazyBS.ByteString -> WaiSession SResponse)
+postJSON path =
+  request methodPost path [("Content-Type", "application/json")]