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
  , MatchBody(MatchBody)
  , ResponseMatcher(matchBody)
  , Body
  , with
  , post
  , shouldRespondWith
  , liftIO
  )
import Test.QuickCheck
  ( generate
  )
import Util.WAI
  ( postJSON
  )
import Util.Gen
  ( chargeSucceededEvents
  )
import Util.JSON
  ( -- ToJSON instance for Event
  )
import Network.HTTP.Types
  ( Header
  )
import Servant
  ( Application
  , Proxy(Proxy)
  , serve
  )
import PaymentServer.Processors.Stripe
  ( StripeAPI
  , stripeServer
  )

stripeAPI :: Proxy StripeAPI
stripeAPI = Proxy

app :: Application
app = serve stripeAPI stripeServer

aChargeEvent :: IO LazyBS.ByteString
aChargeEvent = encode <$> generate chargeSucceededEvents

spec_webhook :: Spec
spec_webhook = with (return app) $ do
  -- 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 415 (Unsupported Media Type)" $
      post "/webhook" "xxx" `shouldRespondWith` 415

    it "responds to JSON non-Event body with 400 (Invalid Request)" $
      postJSON "/webhook" "{}" `shouldRespondWith` 400

  describe "success behavior of POST /webhook" $
    it "responds to a JSON Event body with 200 (OK)" $ do
      event <- liftIO aChargeEvent
      postJSON "/webhook" event `shouldRespondWith` 200 { matchBody = MatchBody bodyMatcher }

bodyMatcher :: [Network.HTTP.Types.Header] -> Body -> Maybe String
bodyMatcher _ "{}" = Nothing
bodyMatcher _ body = Just $ show body