diff --git a/test/SpecPersistence.hs b/test/SpecPersistence.hs
index 3fdca1b54537631d8a9d207e52cbbfd6df6977c2..db6d8a5be3f33853454c11bb95f3439b71766128 100644
--- a/test/SpecPersistence.hs
+++ b/test/SpecPersistence.hs
@@ -7,10 +7,6 @@
 
 module SpecPersistence where
 
-import Test.QuickCheck
-  ( Property
-  , (==>)
-  )
 import Control.Monad.IO.Class
   ( liftIO
   )
@@ -23,7 +19,9 @@ import Test.Hspec.Expectations
   ( shouldReturn
   )
 import Test.QuickCheck
-  ( property
+  ( Property
+  , property
+  , (==>)
   )
 import Test.QuickCheck.Monadic
   ( monadicIO
@@ -77,8 +75,9 @@ paidVoucherMismatchFingerprint getDB = property $ \voucher fingerprint fingerpri
   redeem fingerprint' `shouldReturn` Left AlreadyRedeemed
 
 makeSpec :: VoucherDatabase d => IO d -> Spec
-makeSpec getDB = do
-  describe "voucher interactions" $ do
+makeSpec getDB =
+  describe "voucher interactions" $
+  do
     it "denies redemption of a not-paid-for voucher" $ unpaidVoucherNotRedeemable getDB
     it "allows redemption of paid-for vouchers" $ paidVoucherRedeemable getDB
     it "allows multiple redemption as long as the same fingerprint is used" $ paidVoucherMultiRedeemable getDB
diff --git a/test/SpecStripe.hs b/test/SpecStripe.hs
index 0576c8b7642ae702a97f94a99fa1affda8d6cb46..23ad2932d4368416880b5383a23f9d947017eea8 100644
--- a/test/SpecStripe.hs
+++ b/test/SpecStripe.hs
@@ -77,7 +77,7 @@ stripeAPI :: Proxy StripeAPI
 stripeAPI = Proxy
 
 app :: IO Application
-app = memory >>= return . stripeServer >>= return . serve stripeAPI
+app = serve stripeAPI . stripeServer <$> memory
 
 spec_webhook :: Spec
 spec_webhook = with app $ do
diff --git a/test/Util/Gen.hs b/test/Util/Gen.hs
index e74de2bb53fc30e2dba3c98b9422598c30cb83ca..ffba41237a591d05a7834df9663564f46d7b5d2b 100644
--- a/test/Util/Gen.hs
+++ b/test/Util/Gen.hs
@@ -163,7 +163,7 @@ charges withVoucher =
   if withVoucher then
     metaDatasWithVoucher
   else
-    metaDatasWithVoucher
+    metaDatasWithoutVoucher
   )                     --   chargeMetaData :: MetaData
   <*> arbitrary         --   chargeStatementDescription :: Maybe StatementDescription
   <*> arbitrary         --   chargeReceiptEmail :: Maybe Text
@@ -184,4 +184,4 @@ posixTimes :: Gen UTCTime
 posixTimes = (arbitrary :: Gen Integer) `suchThatMap` (Just . posixSecondsToUTCTime . fromIntegral . abs)
 
 hasVoucher :: MetaData -> Bool
-hasVoucher (MetaData items) = any (== "Voucher") . (map fst) $ items
+hasVoucher (MetaData items) = elem "Voucher" . map fst $ items