WaiSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Test.Hspec.WaiSpec (main, spec) where

import           Test.Hspec
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import           Network.HTTP.Types
import           Network.Wai

import           Test.Hspec.Wai
import           Test.Hspec.Wai.Internal (withApplication)

main :: IO ()
main = hspec spec

expectMethod :: Method -> Application
expectMethod method req respond = do
  requestMethod req `shouldBe` method
  respond $ responseLBS status200 [] ""

expectRequest :: Method -> ByteString -> ByteString -> [Header] -> Application
expectRequest method path body headers req respond = do
  requestMethod req `shouldBe` method
  rawPathInfo req `shouldBe` path
  requestHeaders req `shouldBe` headers
  rawBody <- requestBody req
  rawBody `shouldBe` body
  respond $ responseLBS status200 [] ""

spec :: Spec
spec = do
  describe "WaiSession" $ do
    it "has a MonadFail instance" $ do
      withApplication undefined $ do
        23 <- return (42 :: Int)
        return ()
      `shouldThrow` anyIOException

  describe "get" $ with (return $ expectMethod methodGet) $ do
    it "sends a get request" $ do
      get "/" `shouldRespondWith` 200

  describe "post" $ with (return $ expectMethod methodPost) $ do
    it "sends a post request" $ do
      post "/" "" `shouldRespondWith` 200

  describe "put" $ with (return $ expectMethod methodPut) $ do
    it "sends a put request" $ do
      put "/" "" `shouldRespondWith` 200

  describe "options" $ with (return $ expectMethod methodOptions) $ do
    it "sends an options request" $ do
      options "/" `shouldRespondWith` 200

  describe "delete" $ with (return $ expectMethod methodDelete) $ do
    it "sends a delete request" $ do
      delete "/" `shouldRespondWith` 200

  describe "request" $ with (return $ expectRequest methodGet "/foo" body accept) $ do
    it "sends method, path, headers, and body" $ do
      request methodGet "/foo" accept (BL.fromChunks [body]) `shouldRespondWith` 200

  describe "postHtmlForm" $ with (return $ expectRequest methodPost "/foo" "foo=bar" formEncoded) $ do
    it "sends a post request with form-encoded params" $ do
      postHtmlForm "/foo" [("foo", "bar")] `shouldRespondWith` 200

  where
    accept = [(hAccept, "application/json")]
    body = "{\"foo\": 1}"
    formEncoded = [(hContentType, "application/x-www-form-urlencoded")]