packages feed

hspec-wai (empty) → 0.0.0

raw patch · 8 files changed

+265/−0 lines, 8 filesdep +basedep +bytestringdep +hspec-metasetup-changed

Dependencies added: base, bytestring, hspec-meta, hspec-wai, hspec2, http-types, text, transformers, wai, wai-extra

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012-2014 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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ example/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ hspec-wai.cabal view
@@ -0,0 +1,74 @@+name:             hspec-wai+version:          0.0.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2012-2014 Fujimura Daisuke,+                  (c) 2014 Simon Hengel+author:           Fujimura Daisuke <me@fujimuradaisuke.com>, Simon Hengel <sol@typeful.net>+maintainer:       Fujimura Daisuke <me@fujimuradaisuke.com>, Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+category:         Testing+synopsis:         Experimental Hspec support for testing WAI applications (depends on hspec2!)+description:      Experimental Hspec support for testing WAI applications (depends on hspec2!)++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.Matcher+  build-depends:+      base == 4.*+    , bytestring+    , text+    , transformers+    , http-types+    , wai >= 3+    , wai-extra >= 3+    , hspec2++test-suite spec+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      src, test+  main-is:+      Spec.hs+  build-depends:+      base == 4.*+    , bytestring+    , text+    , transformers+    , http-types+    , wai+    , wai-extra+    , hspec2++    , hspec-meta++test-suite example+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      example+  main-is:+      Spec.hs+  build-depends:+      base == 4.*+    , hspec2+    , hspec-wai+    , http-types+    , wai
+ src/Test/Hspec/Wai.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, FlexibleInstances, TypeFamilies #-}+module Test.Hspec.Wai (+  with+, get+, post+, put+, request+, shouldHaveHeader+, shouldRespondWith+, ResponseMatcher(..)+) where++import           Data.Foldable+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB+import           Control.Monad.IO.Class+import           Network.Wai (Request(..))+import           Network.HTTP.Types+import           Network.Wai.Test hiding (request)+import qualified Network.Wai.Test as Wai+import           Test.Hspec++import           Test.Hspec.Wai.Internal+import           Test.Hspec.Wai.Matcher++with :: IO a -> SpecWith a -> Spec+with = before++-- |+-- Passes if the given `Header` exists in the response.+shouldHaveHeader :: WaiSession SResponse -> Header -> WaiExpectation+shouldHaveHeader action header = do+  r <- action+  forM_ (haveHeader r header) (liftIO . expectationFailure)++-- |+-- Passs if+--+--   * the given number matches with the HTTP Status code of the response.+--   * the given string matches with the body of the response.+--   * the given `ResponseMatcher` matches with the response.+--+-- Example:+--+-- > get "/foo" `shouldRespondWith` 200                         -- Pass+-- > get "/foo" `shouldRespondWith` "bar"                       -- Pass if the body is "bar"+-- > get "/foo" `shouldRespondWith` "bar" { matchStatus = 200 } -- Pass if the body is "bar" and status is 200+--++shouldRespondWith :: WaiSession SResponse -> ResponseMatcher -> WaiExpectation+shouldRespondWith action matcher = do+  r <- action+  forM_ (match r matcher) (liftIO . expectationFailure)++-- |+-- | Performs `GET` request to running app.+get :: ByteString -> WaiSession SResponse+get p = request methodGet p ""++-- |+-- | Performs `POST` request to running app.+post :: ByteString -> LB.ByteString -> WaiSession SResponse+post = request methodPost++-- |+-- | Performs `PUT` request to running app.+put :: ByteString -> LB.ByteString -> WaiSession SResponse+put = request methodPut++-- |+-- | Performs request to running app, with HTTP Method, path and body.+request :: Method -> ByteString -> LB.ByteString -> WaiSession SResponse+request m p b = getApp >>= liftIO . runSession (Wai.srequest $ SRequest req b)+  where+    req = setPath defaultRequest {requestMethod = m} p
+ src/Test/Hspec/Wai/Internal.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeFamilies               #-}+module Test.Hspec.Wai.Internal (+  WaiExpectation+, WaiSession+, runWaiSession+, getApp+) where++import           Control.Applicative+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Reader+import           Network.Wai                (Application)+import           Network.Wai.Test           hiding (request)+import           Test.Hspec+import           Test.Hspec.Core            (Example (..))++type WaiExpectation = WaiSession ()++newtype WaiSession a = WaiSession {unWaiSession :: Session a}+  deriving (Functor, Applicative, Monad, MonadIO)++runWaiSession :: WaiSession a -> Application -> IO a+runWaiSession = runSession . unWaiSession++instance Example WaiExpectation where+  type Arg WaiExpectation = Application+  evaluateExample e p action = evaluateExample (action $ runWaiSession e) p ($ ())++getApp :: WaiSession Application+getApp = WaiSession ask
+ src/Test/Hspec/Wai/Matcher.hs view
@@ -0,0 +1,59 @@+module Test.Hspec.Wai.Matcher (+  ResponseMatcher(..)+, match+, haveHeader+) where+++import           Control.Monad+import           Data.Monoid+import           Data.Functor+import           Data.String+import           Data.Text.Lazy.Encoding (encodeUtf8)+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy as LB+import           Network.HTTP.Types+import           Network.Wai.Test++data ResponseMatcher = ResponseMatcher {+  matchStatus :: Int+, matchBody :: Maybe LB.ByteString+}++instance IsString ResponseMatcher where+  fromString s = ResponseMatcher 200 (Just . encodeUtf8 . fromString $ s)++instance Num ResponseMatcher where+  fromInteger n = ResponseMatcher (fromInteger n) Nothing+  (+) =    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 _) _ body) (ResponseMatcher expectedStatus expectedBody) = mconcat [+    match_ "status mismatch" status expectedStatus+  , expectedBody >>= match_ "body mismatch" body+  ]+  where+    match_ :: (Show a, Eq a) => String -> a -> a -> Maybe String+    match_ message actual expected = actualExpected message actual expected <$ guard (actual /= expected)++    actualExpected :: Show a => String -> a -> a -> String+    actualExpected message actual expected = unlines [+        message+      , "  expected: " ++ show expected+      , "  but got:  " ++ show actual+      ]++haveHeader :: SResponse -> Header -> Maybe String+haveHeader (SResponse _ headers _) (name, expected) = go $ lookup name headers+  where+    go Nothing = Just $ "header doesn't exist: " ++ show name+    go (Just actual) = if actual == expected+                         then Nothing+                         else (Just . unlines) [ "header mismatch"+                                               , "  expected: \"" ++ B.unpack expected ++ "\""+                                               , "  but got:  \"" ++ B.unpack actual ++ "\""+                                               ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}