diff --git a/test/SpecStuff.hs b/test/SpecStuff.hs
new file mode 100644
index 0000000000000000000000000000000000000000..fe8f26e1ced8c4530e70da9c21c2a7e4650f63b9
--- /dev/null
+++ b/test/SpecStuff.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module SpecStuff where
+
+import Test.Tasty
+  ( TestTree
+  , testGroup
+  )
+import Test.Tasty.Wai
+  ( assertBody
+  , assertStatus
+  , assertStatus'
+  , get
+  , post
+  , testWai
+  )
+import Test.Tasty.QuickCheck
+  ( testProperty
+  )
+import PaymentServer.Persistence
+  ( Voucher
+  )
+import PaymentServer.Redemption
+  ( RedemptionAPI
+  , Result(Failed, Succeeded)
+  )
+import PaymentServer.Issuer
+  ( BlindedToken
+  )
+import Data.ByteString
+  ( ByteString
+  )
+import Text.Printf
+  ( printf
+  )
+import Data.Aeson
+ ( decode
+ , encode
+ )
+import Servant
+  ( Application
+  , Proxy(Proxy)
+  , serve
+  )
+import Test.Hspec
+  ( Spec
+  , parallel
+  , describe
+  , it
+  , runIO
+  )
+import Network.HTTP.Types
+  ( Header
+  )
+import Test.Hspec.Wai
+  ( ResponseMatcher(matchBody, matchHeaders)
+  , (<:>)
+  , WaiExpectation
+  , Body
+  , MatchBody(MatchBody)
+  , with
+  , shouldRespondWith
+  , liftIO
+  )
+import Test.QuickCheck
+  ( ioProperty
+  )
+import Test.Hspec.Wai.QuickCheck
+  ( Testable(toProperty)
+  , WaiProperty(unWaiProperty)
+  , property
+  )
+import Test.QuickCheck.Instances.Text ()
+import Util.Spec
+  ( wrongMethodNotAllowed
+  , nonJSONUnsupportedMediaType
+  , wrongJSONInvalidRequest
+  )
+import Util.WAI
+  ( postJSON
+  )
+import PaymentServer.Issuer
+  ( BlindedToken
+  , ChallengeBypass(ChallengeBypass)
+  , Issuer
+  , trivialIssue
+  )
+import PaymentServer.Redemption
+  ( RedemptionAPI
+  , Redeem(Redeem)
+  , Result(Failed, Succeeded)
+  , redemptionServer
+  )
+import PaymentServer.Persistence
+  ( RedeemError(NotPaid)
+  , Voucher
+  , VoucherDatabase(payForVoucher, redeemVoucher)
+  , memory
+  )
+
+redemptionAPI :: Proxy RedemptionAPI
+redemptionAPI = Proxy
+
+app :: VoucherDatabase d => Issuer -> d -> Application
+app issue = serve redemptionAPI . redemptionServer issue
+
+path = "/"
+
+propertyRedeem :: ByteString -> Voucher -> [BlindedToken] -> ResponseMatcher -> WaiExpectation
+propertyRedeem path voucher tokens matcher =
+  postJSON path (encode $ Redeem voucher tokens) `shouldRespondWith` matcher
+
+-- | A VoucherDatabaseTestDouble has a VoucherDatabase instance which provides
+-- a number of different behaviors which are useful to be able to directly
+-- test against.
+data VoucherDatabaseTestDouble
+  -- | A RefuseRedemption database always refuses redemption with a given error.
+  = RefuseRedemption RedeemError
+  -- | A PermitRedemption database always permits redemption.
+  | PermitRedemption
+  deriving (Show)
+
+instance VoucherDatabase VoucherDatabaseTestDouble where
+  payForVoucher _ voucher = return ()
+  redeemVoucher (RefuseRedemption err) _ _ = return $ Left err
+  redeemVoucher PermitRedemption _ _ = return $ Right ()
+
+test_foo :: TestTree
+test_foo = testGroup "Foo" redemption
+
+redemption :: [TestTree]
+redemption =
+  [ testProperty "fails when the voucher is not paid" $
+    \(voucher :: Voucher) (tokens :: [BlindedToken]) ->
+      propertyRedeem path voucher tokens 400
+      { matchBody = matchJSONBody Failed
+      -- major/minor, fine.  charset=utf-8... okay.  but really this is
+      -- overspecified by encoding the exact byte sequence.  I'd rather
+      -- assert semantic equality.
+      , matchHeaders = ["Content-Type" <:> "application/json;charset=utf-8"]
+      }
+  ]
+
+matchJSONBody :: Result -> MatchBody
+matchJSONBody expected =
+  let
+    bodyMatcher :: [Header] -> Body -> Maybe String
+    bodyMatcher headers actualBody =
+      case decode actualBody of
+        Nothing ->
+          Just $ "failed to decode body as value of expected type: " ++ show actualBody
+        Just actual ->
+          if actual == expected then
+            Nothing
+          else
+            Just $ "decoded body does not equal expected value: " ++ show actual ++ show expected
+  in
+    MatchBody bodyMatcher