hspec-wai-0.11.1/0000755000000000000000000000000007346545000011643 5ustar0000000000000000hspec-wai-0.11.1/LICENSE0000644000000000000000000000206707346545000012655 0ustar0000000000000000Copyright (c) 2012-2018 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 in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hspec-wai-0.11.1/Setup.lhs0000644000000000000000000000011407346545000013447 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-wai-0.11.1/changelog0000755000000000000000000000007607346545000013523 0ustar0000000000000000See https://github.com/hspec/hspec-wai/blob/master/CHANGES.md hspec-wai-0.11.1/hspec-wai.cabal0000644000000000000000000000427507346545000014517 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.3. -- -- see: https://github.com/sol/hpack name: hspec-wai version: 0.11.1 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-2018 Simon Hengel author: Fujimura Daisuke , Simon Hengel maintainer: Fujimura Daisuke , Simon Hengel build-type: Simple category: Testing synopsis: Experimental Hspec support for testing WAI applications description: Experimental Hspec support for testing WAI applications extra-source-files: changelog source-repository head type: git location: https://github.com/hspec/hspec-wai library hs-source-dirs: src ghc-options: -Wall build-depends: QuickCheck , base >=4.9.1.0 && <5 , base-compat , bytestring >=0.10 , case-insensitive , hspec-core ==2.* , hspec-expectations >=0.8.0 , http-types , text , transformers , wai >=3 , wai-extra >=3 exposed-modules: Test.Hspec.Wai Test.Hspec.Wai.QuickCheck Test.Hspec.Wai.Internal Test.Hspec.Wai.Matcher other-modules: Test.Hspec.Wai.Util Paths_hspec_wai default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: src test ghc-options: -Wall build-depends: QuickCheck , base >=4.9.1.0 && <5 , base-compat , bytestring >=0.10 , case-insensitive , hspec , hspec-core ==2.* , hspec-expectations >=0.8.0 , http-types , text , transformers , wai >=3.2.2 , wai-extra >=3 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 Paths_hspec_wai default-language: Haskell2010 hspec-wai-0.11.1/src/Test/Hspec/0000755000000000000000000000000007346545000014413 5ustar0000000000000000hspec-wai-0.11.1/src/Test/Hspec/Wai.hs0000644000000000000000000001204507346545000015471 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} -- | Have a look at the for -- an example of how to use this library. module Test.Hspec.Wai ( -- * Types WaiSession , WaiExpectation -- * Performing requests , get , post , put , patch , options , delete , request -- ** Posting HTML forms , postHtmlForm -- * Matching on the response , shouldRespondWith , ResponseMatcher(..) , MatchHeader(..) , MatchBody(..) , Body , (<:>) -- * Helpers and re-exports , liftIO , with , withState , getState , pending , pendingWith ) where import Prelude () import Prelude.Compat import Data.Foldable import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Network.Wai (Request(..)) import Network.HTTP.Types import Network.Wai.Test hiding (request) import qualified Network.Wai.Test as Wai import Test.Hspec.Expectations import Test.Hspec.Core.Spec hiding (pending, pendingWith) import qualified Test.Hspec.Core.Spec as Core import Test.Hspec.Core.Hooks import Test.Hspec.Wai.Util import Test.Hspec.Wai.Internal import Test.Hspec.Wai.Matcher import Network.Wai (Application) with :: IO Application -> SpecWith ((), Application) -> Spec with action = before ((,) () <$> action) withState :: IO (st, Application) -> SpecWith (st, Application) -> Spec withState = before -- | A lifted version of `Core.pending`. pending :: WaiSession st () pending = liftIO Core.pending -- | A lifted version of `Core.pendingWith`. pendingWith :: String -> WaiSession st () pendingWith = liftIO . Core.pendingWith -- | Set the expectation that a response matches a specified `ResponseMatcher`. -- -- A @ResponseMatcher@ matches a response if: -- -- * the specified status matches the HTTP response status code -- -- * the specified body (if any) matches the response body -- -- * the response has all of the specified `Header` fields -- (the response may have arbitrary additional `Header` fields) -- -- You can use @ResponseMatcher@'s (broken) `Num` instance to match for a HTTP -- status code: -- -- > get "/" `shouldRespondWith` 200 -- > -- matches if status is 200 -- -- You can use @ResponseMatcher@'s `IsString` instance to match for a HTTP -- status @200@ and a body: -- -- > get "/" `shouldRespondWith` "foo" -- > -- matches if body is "foo" and status is 200 -- -- If you want to match for a different HTTP status, you can use record update -- notation to specify `matchStatus` explicitly: -- -- > get "/" `shouldRespondWith` "foo" {matchStatus = 404} -- > -- matches if body is "foo" and status is 404 -- -- If you want to require a specific header field you can specify -- `matchHeaders`: -- -- > get "/" `shouldRespondWith` "foo" {matchHeaders = ["Content-Type" <:> "text/plain"]} -- > -- matches if body is "foo", status is 200 and there is a header field "Content-Type: text/plain" shouldRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st shouldRespondWith action matcher = do r <- action forM_ (match r matcher) (liftIO . expectationFailure) -- | Perform a @GET@ request to the application under test. get :: ByteString -> WaiSession st SResponse get path = request methodGet path [] "" -- | Perform a @POST@ request to the application under test. post :: ByteString -> LB.ByteString -> WaiSession st SResponse post path = request methodPost path [] -- | Perform a @PUT@ request to the application under test. put :: ByteString -> LB.ByteString -> WaiSession st SResponse put path = request methodPut path [] -- | Perform a @PATCH@ request to the application under test. patch :: ByteString -> LB.ByteString -> WaiSession st SResponse patch path = request methodPatch path [] -- | Perform an @OPTIONS@ request to the application under test. options :: ByteString -> WaiSession st SResponse options path = request methodOptions path [] "" -- | Perform a @DELETE@ request to the application under test. delete :: ByteString -> WaiSession st SResponse delete path = request methodDelete path [] "" -- | Perform a request to the application under test, with specified HTTP -- method, request path, headers and body. request :: Method -> ByteString -> [Header] -> LB.ByteString -> WaiSession st SResponse request method path headers = WaiSession . lift . Wai.srequest . SRequest req where req = setPath defaultRequest {requestMethod = method, requestHeaders = headers} path -- | Perform a @POST@ request to the application under test. -- -- The specified list of key-value pairs is encoded as -- @application/x-www-form-urlencoded@ and used as request body. -- -- In addition the @Content-Type@ is set to @application/x-www-form-urlencoded@. postHtmlForm :: ByteString -> [(String, String)] -> WaiSession st SResponse postHtmlForm path = request methodPost path [(hContentType, "application/x-www-form-urlencoded")] . formUrlEncodeQuery hspec-wai-0.11.1/src/Test/Hspec/Wai/0000755000000000000000000000000007346545000015133 5ustar0000000000000000hspec-wai-0.11.1/src/Test/Hspec/Wai/Internal.hs0000644000000000000000000000362107346545000017245 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} module Test.Hspec.Wai.Internal ( WaiExpectation , WaiSession(..) , runWaiSession , runWithState , withApplication , getApp , getState , formatHeader ) where import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Network.Wai (Application) import Network.Wai.Test hiding (request) import Test.Hspec.Core.Spec import Test.Hspec.Wai.Util (formatHeader) #if MIN_VERSION_base(4,9,0) import Control.Monad.Fail #endif -- | An expectation in the `WaiSession` monad. Failing expectations are -- communicated through exceptions (similar to `Test.Hspec.Expectations.Expectation` and -- `Test.HUnit.Base.Assertion`). type WaiExpectation st = WaiSession st () -- | A test -- session that carries the `Application` under test and some client state. newtype WaiSession st a = WaiSession {unWaiSession :: ReaderT st Session a} deriving (Functor, Applicative, Monad, MonadIO #if MIN_VERSION_base(4,9,0) , MonadFail #endif ) runWaiSession :: WaiSession () a -> Application -> IO a runWaiSession action app = runWithState action ((), app) runWithState :: WaiSession st a -> (st, Application) -> IO a runWithState action (st, app) = runSession (flip runReaderT st $ unWaiSession action) app withApplication :: Application -> WaiSession () a -> IO a withApplication = flip runWaiSession instance Example (WaiExpectation st) where type Arg (WaiExpectation st) = (st, Application) evaluateExample e p action = evaluateExample (action $ runWithState e) p ($ ()) getApp :: WaiSession st Application getApp = WaiSession (lift ask) getState :: WaiSession st st getState = WaiSession ask hspec-wai-0.11.1/src/Test/Hspec/Wai/Matcher.hs0000644000000000000000000000602007346545000017050 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} module Test.Hspec.Wai.Matcher ( ResponseMatcher(..) , MatchHeader(..) , MatchBody(..) , Body , (<:>) , bodyEquals , match , formatHeader ) where import Prelude () import Prelude.Compat import Control.Monad import Data.Maybe import Data.String import Data.Text.Lazy.Encoding (encodeUtf8) import qualified Data.Text.Lazy as T import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import Network.HTTP.Types import Network.Wai.Test import Test.Hspec.Wai.Util type Body = LB.ByteString data ResponseMatcher = ResponseMatcher { matchStatus :: Int , matchHeaders :: [MatchHeader] , matchBody :: MatchBody } data MatchHeader = MatchHeader ([Header] -> Body -> Maybe String) data MatchBody = MatchBody ([Header] -> Body -> Maybe String) bodyEquals :: Body -> MatchBody bodyEquals body = MatchBody (\_ actual -> bodyMatcher actual body) where bodyMatcher :: Body -> Body -> Maybe String bodyMatcher (toStrict -> actual) (toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected) where (actual_, expected_) = case (safeToString actual, safeToString expected) of (Just x, Just y) -> (x, y) _ -> (show actual, show expected) matchAny :: MatchBody matchAny = MatchBody (\_ _ -> Nothing) instance IsString MatchBody where fromString = bodyEquals . encodeUtf8 . T.pack instance IsString ResponseMatcher where fromString = ResponseMatcher 200 [] . fromString instance Num ResponseMatcher where fromInteger n = ResponseMatcher (fromInteger n) [] matchAny (+) = error "ResponseMatcher does not support (+)" (-) = error "ResponseMatcher does not support (-)" (*) = error "ResponseMatcher does not support (*)" abs = error "ResponseMatcher does not support `abs`" signum = error "ResponseMatcher does not support `signum`" match :: SResponse -> ResponseMatcher -> Maybe String match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders (MatchBody bodyMatcher)) = mconcat [ actualExpected "status mismatch:" (show status) (show expectedStatus) <$ guard (status /= expectedStatus) , checkHeaders headers body expectedHeaders , bodyMatcher headers body ] actualExpected :: String -> String -> String -> String actualExpected message actual expected = unlines [ message , " expected: " ++ expected , " but got: " ++ actual ] checkHeaders :: [Header] -> Body -> [MatchHeader] -> Maybe String checkHeaders headers body m = case go m of [] -> Nothing xs -> Just (mconcat xs ++ "the actual headers were:\n" ++ unlines (map formatHeader headers)) where go = catMaybes . map (\(MatchHeader p) -> p headers body) (<:>) :: HeaderName -> ByteString -> MatchHeader name <:> value = MatchHeader $ \headers _body -> guard (header `notElem` headers) >> (Just . unlines) [ "missing header:" , formatHeader header ] where header = (name, value) hspec-wai-0.11.1/src/Test/Hspec/Wai/QuickCheck.hs0000644000000000000000000000274207346545000017506 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} 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 -> (State a, Application) -> Property property = unWaiProperty . toProperty data WaiProperty st = WaiProperty {unWaiProperty :: (st, Application) -> Property} class Testable a where type State a toProperty :: a -> WaiProperty (State a) instance Testable (WaiProperty st) where type State (WaiProperty st) = st toProperty = id instance Testable (WaiExpectation st) where type State (WaiExpectation st) = st toProperty action = WaiProperty (QuickCheck.property . runWithState action) instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where type State (a -> prop) = State prop toProperty prop = WaiProperty $ QuickCheck.property . (flip $ unWaiProperty . toProperty . prop) infixr 0 ==> (==>) :: Testable prop => Bool -> prop -> WaiProperty (State prop) (==>) = lift (QuickCheck.==>) lift :: Testable prop => (a -> Property -> Property) -> a -> prop -> WaiProperty (State prop) lift f a prop = WaiProperty $ \app -> f a (unWaiProperty (toProperty prop) app) hspec-wai-0.11.1/src/Test/Hspec/Wai/Util.hs0000644000000000000000000000552107346545000016407 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Test.Hspec.Wai.Util where import Control.Monad import Data.Maybe import Data.List import Data.Word import Data.Char hiding (ord) import qualified Data.Char as Char import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as LB import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as Builder import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.CaseInsensitive as CI import Network.HTTP.Types #if !MIN_VERSION_base(4,11,0) import Data.Monoid #endif formatHeader :: Header -> String formatHeader header@(name, value) = " " ++ fromMaybe (show header) (safeToString $ B8.concat [CI.original name, ": ", value]) safeToString :: ByteString -> Maybe String safeToString bs = do str <- either (const Nothing) (Just . T.unpack) (T.decodeUtf8' bs) let isSafe = not $ case str of [] -> True _ -> isSpace (last str) || any (not . isPrint) str guard isSafe >> return str -- for compatibility with older versions of `bytestring` toStrict :: LB.ByteString -> ByteString toStrict = mconcat . LB.toChunks formUrlEncodeQuery :: [(String, String)] -> LB.ByteString formUrlEncodeQuery = Builder.toLazyByteString . mconcat . intersperse amp . map encodePair where equals = Builder.word8 (ord '=') amp = Builder.word8 (ord '&') percent = Builder.word8 (ord '%') plus = Builder.word8 (ord '+') encodePair :: (String, String) -> Builder encodePair (key, value) = encode key <> equals <> encode value encode :: String -> Builder encode = escape . T.encodeUtf8 . T.pack . newlineNormalize newlineNormalize :: String -> String newlineNormalize input = case input of [] -> [] '\n' : xs -> '\r' : '\n': newlineNormalize xs x : xs -> x : newlineNormalize xs escape :: ByteString -> Builder escape = mconcat . map f . B.unpack where f :: Word8 -> Builder f c | p c = Builder.word8 c | c == ord ' ' = plus | otherwise = percentEncode c p :: Word8 -> Bool p c = ord 'a' <= c && c <= ord 'z' || c == ord '_' || c == ord '*' || c == ord '-' || c == ord '.' || ord '0' <= c && c <= ord '9' || ord 'A' <= c && c <= ord 'Z' ord :: Char -> Word8 ord = fromIntegral . Char.ord percentEncode :: Word8 -> Builder percentEncode n = percent <> hex hi <> hex lo where (hi, lo) = n `divMod` 16 hex :: Word8 -> Builder hex n = Builder.word8 (offset + n) where offset | n < 10 = 48 | otherwise = 55 hspec-wai-0.11.1/test/0000755000000000000000000000000007346545000012622 5ustar0000000000000000hspec-wai-0.11.1/test/Spec.hs0000644000000000000000000000005407346545000014047 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-wai-0.11.1/test/Test/Hspec/Wai/0000755000000000000000000000000007346545000015323 5ustar0000000000000000hspec-wai-0.11.1/test/Test/Hspec/Wai/MatcherSpec.hs0000644000000000000000000000532207346545000020057 0ustar0000000000000000{-# 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" ] hspec-wai-0.11.1/test/Test/Hspec/Wai/UtilSpec.hs0000644000000000000000000000613107346545000017410 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Test.Hspec.Wai.UtilSpec (main, spec) where import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import Test.Hspec.Wai.Util 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 #if !MIN_VERSION_base(4,11,0) import Data.Monoid #endif 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 hspec-wai-0.11.1/test/Test/Hspec/0000755000000000000000000000000007346545000014603 5ustar0000000000000000hspec-wai-0.11.1/test/Test/Hspec/WaiSpec.hs0000644000000000000000000000460407346545000016476 0ustar0000000000000000{-# 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 <- getRequestBodyChunk 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")]