diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2012-2014 Fujimura Daisuke, Simon Hengel +Copyright (c) 2012-2015 Fujimura Daisuke, Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/hspec-wai.cabal b/hspec-wai.cabal --- a/hspec-wai.cabal +++ b/hspec-wai.cabal @@ -1,37 +1,39 @@ +-- This file has been generated from package.yaml by hpack version 0.8.0. +-- +-- see: https://github.com/sol/hpack + name: hspec-wai -version: 0.6.3 +version: 0.6.4 +homepage: https://github.com/hspec/hspec-wai#readme +bug-reports: https://github.com/hspec/hspec-wai/issues license: MIT license-file: LICENSE copyright: (c) 2012-2014 Fujimura Daisuke, - (c) 2014 Simon Hengel -author: Fujimura Daisuke , Simon Hengel -maintainer: Fujimura Daisuke , Simon Hengel + (c) 2014-2015 Simon Hengel +author: Fujimura Daisuke , + Simon Hengel +maintainer: Fujimura Daisuke , + Simon Hengel build-type: Simple -cabal-version: >= 1.8 +cabal-version: >= 1.10 category: Testing synopsis: Experimental Hspec support for testing WAI applications description: Experimental Hspec support for testing WAI applications extra-source-files: - changelog + changelog source-repository head type: git location: https://github.com/hspec/hspec-wai library - ghc-options: - -Wall hs-source-dirs: src - exposed-modules: - Test.Hspec.Wai - Test.Hspec.Wai.Internal - other-modules: - Test.Hspec.Wai.Util - Test.Hspec.Wai.Matcher + ghc-options: -Wall build-depends: base == 4.* + , base-compat , bytestring >= 0.10 , text , transformers @@ -41,27 +43,45 @@ , wai-extra >= 3 , hspec-core == 2.* , hspec-expectations + , QuickCheck + exposed-modules: + Test.Hspec.Wai + Test.Hspec.Wai.QuickCheck + Test.Hspec.Wai.Internal + other-modules: + Test.Hspec.Wai.Matcher + Test.Hspec.Wai.Util + default-language: Haskell2010 test-suite spec - type: - exitcode-stdio-1.0 - ghc-options: - -Wall + type: exitcode-stdio-1.0 + main-is: Spec.hs hs-source-dirs: - src, test - main-is: - Spec.hs + src + , test + ghc-options: -Wall build-depends: base == 4.* - , bytestring + , base-compat + , bytestring >= 0.10 , text , transformers , case-insensitive , http-types - , wai - , wai-extra - , hspec-core + , wai >= 3 + , wai-extra >= 3 + , hspec-core == 2.* , hspec-expectations - + , QuickCheck , hspec , QuickCheck + other-modules: + Test.Hspec.Wai + Test.Hspec.Wai.Internal + Test.Hspec.Wai.Matcher + Test.Hspec.Wai.QuickCheck + Test.Hspec.Wai.Util + Test.Hspec.Wai.MatcherSpec + Test.Hspec.Wai.UtilSpec + Test.Hspec.WaiSpec + default-language: Haskell2010 diff --git a/src/Test/Hspec/Wai/Internal.hs b/src/Test/Hspec/Wai/Internal.hs --- a/src/Test/Hspec/Wai/Internal.hs +++ b/src/Test/Hspec/Wai/Internal.hs @@ -11,7 +11,9 @@ , formatHeader ) where -import Control.Applicative +import Prelude () +import Prelude.Compat + import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Network.Wai (Application) diff --git a/src/Test/Hspec/Wai/Matcher.hs b/src/Test/Hspec/Wai/Matcher.hs --- a/src/Test/Hspec/Wai/Matcher.hs +++ b/src/Test/Hspec/Wai/Matcher.hs @@ -6,10 +6,11 @@ , match ) where -import Control.Applicative +import Prelude () +import Prelude.Compat + import Control.Monad import Data.Maybe -import Data.Monoid import Data.String import Data.Text.Lazy.Encoding (encodeUtf8) import Data.ByteString (ByteString) diff --git a/src/Test/Hspec/Wai/QuickCheck.hs b/src/Test/Hspec/Wai/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Wai/QuickCheck.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE FlexibleInstances #-} +module Test.Hspec.Wai.QuickCheck ( + property +, (==>) + +-- * Re-exports +, Arbitrary (..) +, module Test.QuickCheck.Gen + +-- * Internals +, Testable (..) +, WaiProperty (..) +) where + +import Test.QuickCheck hiding (Testable, property, (==>)) +import qualified Test.QuickCheck as QuickCheck +import Test.QuickCheck.Gen +import Network.Wai (Application) + +import Test.Hspec.Wai.Internal + +property :: Testable a => a -> Application -> Property +property = unWaiProperty . toProperty + +data WaiProperty = WaiProperty {unWaiProperty :: Application -> Property} + +class Testable a where + toProperty :: a -> WaiProperty + +instance Testable WaiProperty where + toProperty = id + +instance Testable WaiExpectation where + toProperty action = WaiProperty (QuickCheck.property . runWaiSession action) + +instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where + toProperty prop = WaiProperty $ QuickCheck.property . (flip $ unWaiProperty . toProperty . prop) + +infixr 0 ==> +(==>) :: Testable prop => Bool -> prop -> WaiProperty +(==>) = lift (QuickCheck.==>) + +lift :: Testable prop => (a -> Property -> Property) -> a -> prop -> WaiProperty +lift f a prop = WaiProperty $ \app -> f a (unWaiProperty (toProperty prop) app) diff --git a/test/Test/Hspec/Wai/MatcherSpec.hs b/test/Test/Hspec/Wai/MatcherSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/Wai/MatcherSpec.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} +module Test.Hspec.Wai.MatcherSpec (main, spec) where + +import Test.Hspec + +import Network.HTTP.Types +import Network.Wai.Test + +import Test.Hspec.Wai.Matcher + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "match" $ do + context "when both status and body do match" $ do + it "returns Nothing" $ do + SResponse status200 [] "" `match` 200 + `shouldBe` Nothing + + context "when status does not match" $ do + it "returns an error message" $ do + SResponse status404 [] "" `match` 200 + `shouldBe` (Just . unlines) [ + "status mismatch:" + , " expected: 200" + , " but got: 404" + ] + + context "when body does not match" $ do + it "returns an error message" $ do + SResponse status200 [] "foo" `match` "bar" + `shouldBe` (Just . unlines) [ + "body mismatch:" + , " expected: bar" + , " but got: foo" + ] + + context "when one body contains unsafe characters" $ do + it "uses show for both bodies in the error message" $ do + SResponse status200 [] "foo\nbar" `match` "bar" + `shouldBe` (Just . unlines) [ + "body mismatch:" + , " expected: \"bar\"" + , " but got: \"foo\\nbar\"" + ] + + context "when both status and body do not match" $ do + it "combines error messages" $ do + SResponse status404 [] "foo" `match` "bar" + `shouldBe` (Just . unlines) [ + "status mismatch:" + , " expected: 200" + , " but got: 404" + , "body mismatch:" + , " expected: bar" + , " but got: foo" + ] + + context "when matching headers" $ do + context "when header is missing" $ do + it "returns an error message" $ do + SResponse status200 [] "" `match` 200 {matchHeaders = ["Content-Type" <:> "application/json"]} + `shouldBe` (Just . unlines) [ + "missing header:" + , " Content-Type: application/json" + , "the actual headers were:" + ] + + context "when multiple headers are missing" $ do + it "combines error messages" $ do + let expectedHeaders = ["Content-Type" <:> "application/json", "Content-Encoding" <:> "chunked"] + SResponse status200 [(hContentLength, "23")] "" `match` 200 {matchHeaders = expectedHeaders} + `shouldBe` (Just . unlines) [ + "missing header:" + , " Content-Type: application/json" + , "missing header:" + , " Content-Encoding: chunked" + , "the actual headers were:" + , " Content-Length: 23" + ] diff --git a/test/Test/Hspec/Wai/UtilSpec.hs b/test/Test/Hspec/Wai/UtilSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/Wai/UtilSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +module Test.Hspec.Wai.UtilSpec (main, spec) where + +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Test.Hspec.Wai.Util +import Data.Monoid +import Network.HTTP.Types (parseSimpleQuery) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +main :: IO () +main = hspec spec + +decodePair :: (ByteString, ByteString) -> (String, String) +decodePair (a, b) = (decode a, decode b) + where + decode :: ByteString -> String + decode = newlineNormalize . T.unpack . T.decodeUtf8 + + newlineNormalize :: String -> String + newlineNormalize input = case input of + [] -> [] + '\r' : '\n' : xs -> '\n': newlineNormalize xs + x : xs -> x : newlineNormalize xs + +spec :: Spec +spec = do + describe "formUrlEncodeQuery" $ do + it "separates keys from values by =" $ do + formUrlEncodeQuery [("foo", "bar")] `shouldBe` "foo=bar" + + it "separates pairs by &" $ do + formUrlEncodeQuery [("foo", "bar"), ("foo", "baz")] `shouldBe` "foo=bar&foo=baz" + + it "applies newline normalization" $ do + formUrlEncodeQuery [("text", "foo\nbar\nbaz\n")] `shouldBe` "text=foo%0D%0Abar%0D%0Abaz%0D%0A" + + it "handles Unicode characters" $ do + formUrlEncodeQuery [("foo","bar-\955-baz")] `shouldBe` "foo=bar-%CE%BB-baz" + + context "when encoding characters in the printable ASCII range" $ do + let input = " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" + reference = "+%21%22%23%24%25%26%27%28%29*%2B%2C-.%2F0123456789%3A%3B%3C%3D%3E%3F%40ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D%7E" + + it "behaves like Firefox" $ do + formUrlEncodeQuery [("foo", input)] `shouldBe` "foo=" <> reference + + modifyMaxSize (`div` 5) $ do + it "can be reverted by Network.HTTP.Types.parseSimpleQuery" $ do + property $ \xs -> do + (map decodePair . parseSimpleQuery . LB.toStrict . formUrlEncodeQuery) xs `shouldBe` xs + + describe "safeToString" $ do + context "when used on an empty string" $ do + it "returns Nothing" $ do + safeToString "" `shouldBe` Nothing + + describe "formatHeader" $ do + it "formats header" $ do + let header = ("Content-Type", "application/json") + formatHeader header `shouldBe` " Content-Type: application/json" + + describe "when ends with whitespace" $ do + it "uses show" $ do + let header = ("Content-Type", "application/json ") + formatHeader header `shouldBe` " " ++ show header + + describe "when contains non-print characters" $ do + it "uses show" $ do + let header = ("Content-\nType", "application/json") + formatHeader header `shouldBe` " " ++ show header + + describe "when header is not decodable as UTF-8" $ do + it "uses show" $ do + let header = ("Content-Type", "\xc3\x28") + formatHeader header `shouldBe` " " ++ show header diff --git a/test/Test/Hspec/WaiSpec.hs b/test/Test/Hspec/WaiSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/WaiSpec.hs @@ -0,0 +1,62 @@ +{-# 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 + +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 "get" $ with (return $ expectMethod methodGet) $ + it "sends a get request" $ + get "/" `shouldRespondWith` 200 + + describe "post" $ with (return $ expectMethod methodPost) $ + it "sends a post request" $ + post "/" "" `shouldRespondWith` 200 + + describe "put" $ with (return $ expectMethod methodPut) $ + it "sends a put request" $ + put "/" "" `shouldRespondWith` 200 + + describe "options" $ with (return $ expectMethod methodOptions) $ + it "sends an options request" $ + options "/" `shouldRespondWith` 200 + + describe "delete" $ with (return $ expectMethod methodDelete) $ + it "sends a delete request" $ + delete "/" `shouldRespondWith` 200 + + describe "request" $ with (return $ expectRequest methodGet "/foo" body accept) $ + it "sends method, path, headers, and body" $ + request methodGet "/foo" accept (BL.fromChunks [body]) `shouldRespondWith` 200 + + describe "postHtmlForm" $ with (return $ expectRequest methodPost "/foo" "foo=bar" formEncoded) $ + it "sends a post request with form-encoded params" $ + postHtmlForm "/foo" [("foo", "bar")] `shouldRespondWith` 200 + + where + accept = [(hAccept, "application/json")] + body = "{\"foo\": 1}" + formEncoded = [(hContentType, "application/x-www-form-urlencoded")]