Skip to content
Snippets Groups Projects
SpecRedemption.hs 1.95 KiB
Newer Older
  • Learn to ignore specific revisions
  • {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    
    -- | Test suite related to voucher redemption.
    
    module SpecRedemption where
    
    import Text.Printf
      ( printf
      )
    import Control.Exception
      ( bracket
      )
    
    import Servant
      ( Application
      , Proxy(Proxy)
      , serve
      )
    import Test.Hspec
      ( Spec
      , parallel
      , describe
      , it
      , before
      , around
      , shouldReturn
      , shouldBe
      )
    import Test.Hspec.Wai
      ( with
      , post
      , shouldRespondWith
      , liftIO
      )
    import Test.Hspec.Wai.QuickCheck
      ( property
      )
    
    import Test.QuickCheck.Monadic
      ( assert
      )
    import Test.QuickCheck.Instances.Text ()
    
    import Util.Spec
      ( wrongMethodNotAllowed
      , nonJSONUnsupportedMediaType
      , wrongJSONInvalidRequest
      )
    import PaymentServer.Redemption
      ( RedemptionAPI
    
      , redemptionServer
      )
    import PaymentServer.Persistence
      ( Voucher
      , Fingerprint
      , VoucherDatabase(payForVoucher, redeemVoucher)
      , MemoryVoucherDatabase
      , memory
      )
    
    redemptionAPI :: Proxy RedemptionAPI
    redemptionAPI = Proxy
    
    app :: VoucherDatabase d => d -> Application
    app = serve redemptionAPI . redemptionServer
    
    path = "/"
    
    spec_simple :: Spec
    spec_simple = with (app <$> memory) $ parallel $ do
      describe (printf "error behavior of POST %s" (show path)) $ do
        wrongMethodNotAllowed "GET" path
        nonJSONUnsupportedMediaType path
        wrongJSONInvalidRequest path "{}"
    
    withConnection :: VoucherDatabase d => IO d -> ((d -> IO ()) -> IO ())
    withConnection getDB = bracket getDB (\db -> return ())
    
    
    make_spec_db :: VoucherDatabase d => IO d -> Spec
    make_spec_db getDatabase =
      before (getDatabase >>= return . app) $
      describe "redemptionServer" $
      it "responds to redemption of an unpaid voucher with 400 (Invalid Request)" $
      property $ \(voucher :: Voucher) (tokens :: [BlindedToken]) ->
      do
        post path (encode $ Redeem voucher tokens) `shouldRespondWith` 400
    
    spec_memory_db :: Spec
    spec_memory_db =
      make_spec_db memory