packages feed

hspec-wai 0.6.6 → 0.12.0

raw patch · 9 files changed

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012-2015 Fujimura Daisuke, Simon Hengel+Copyright (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
hspec-wai.cabal view
@@ -1,25 +1,25 @@--- This file has been generated from package.yaml by hpack version 0.11.0.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack  name:             hspec-wai-version:          0.6.6+version:          0.12.0 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-2015 Simon Hengel+                  (c) 2014-2018 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.10 category:         Testing synopsis:         Experimental Hspec support for testing WAI applications description:      Experimental Hspec support for testing WAI applications- extra-source-files:     changelog @@ -32,25 +32,24 @@       src   ghc-options: -Wall   build-depends:-      base == 4.*+      QuickCheck+    , base >=4.9.1.0 && <5     , base-compat-    , bytestring >= 0.10-    , text-    , transformers+    , bytestring >=0.10     , case-insensitive+    , hspec-core ==2.*+    , hspec-expectations >=0.8.0     , http-types-    , wai >= 3-    , wai-extra >= 3-    , hspec-core == 2.*-    , hspec-expectations-    , QuickCheck-    , with-location >= 0.1.0+    , text+    , transformers+    , wai >=3+    , wai-extra >=3.1.14   exposed-modules:       Test.Hspec.Wai       Test.Hspec.Wai.QuickCheck       Test.Hspec.Wai.Internal-  other-modules:       Test.Hspec.Wai.Matcher+  other-modules:       Test.Hspec.Wai.Util       Paths_hspec_wai   default-language: Haskell2010@@ -60,24 +59,24 @@   main-is: Spec.hs   hs-source-dirs:       src-    , test+      test   ghc-options: -Wall+  build-tool-depends:+      hspec-discover:hspec-discover   build-depends:-      base == 4.*+      QuickCheck+    , base >=4.9.1.0 && <5     , base-compat-    , bytestring >= 0.10-    , text-    , transformers+    , bytestring >=0.10     , case-insensitive-    , http-types-    , wai >= 3-    , wai-extra >= 3-    , hspec-core == 2.*-    , hspec-expectations-    , QuickCheck-    , with-location >= 0.1.0     , hspec-    , QuickCheck+    , hspec-core ==2.*+    , hspec-expectations >=0.8.0+    , http-types+    , text+    , transformers+    , wai >=3.2.2+    , wai-extra >=3.1.14   other-modules:       Test.Hspec.Wai       Test.Hspec.Wai.Internal@@ -87,4 +86,5 @@       Test.Hspec.Wai.MatcherSpec       Test.Hspec.Wai.UtilSpec       Test.Hspec.WaiSpec+      Paths_hspec_wai   default-language: Haskell2010
src/Test/Hspec/Wai.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} -- | Have a look at the <https://github.com/hspec/hspec-wai#readme README> for -- an example of how to use this library. module Test.Hspec.Wai (@@ -21,46 +23,59 @@  -- * Matching on the response , shouldRespondWith+ , ResponseMatcher(..) , MatchHeader(..)+, MatchBody(..)+, Body , (<:>)  -- * Helpers and re-exports , liftIO , with+, withState+, getState , pending , pendingWith+, SResponse(..) ) where +import           Prelude ()+import "base-compat" 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           Data.WithLocation+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.Expectations (expectationFailure)  import           Test.Hspec.Wai.Util import           Test.Hspec.Wai.Internal import           Test.Hspec.Wai.Matcher --- | An alias for `before`.-with :: IO a -> SpecWith a -> Spec-with = before+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 ()+pending :: WaiSession st () pending = liftIO Core.pending  -- | A lifted version of `Core.pendingWith`.-pendingWith :: String -> WaiSession ()+pendingWith :: String -> WaiSession st () pendingWith = liftIO . Core.pendingWith  -- | Set the expectation that a response matches a specified `ResponseMatcher`.@@ -96,40 +111,40 @@ -- `matchHeaders`: -- -- > get "/" `shouldRespondWith` "foo" {matchHeaders = ["Content-Type" <:> "text/plain"]}--- > -- matches if body is "foo", status is 200 and ther is a header field "Content-Type: text/plain"-shouldRespondWith :: WithLocation (WaiSession SResponse -> ResponseMatcher -> WaiExpectation)+-- > -- 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 SResponse+get :: ByteString -> WaiSession st SResponse get path = request methodGet path [] ""  -- | Perform a @POST@ request to the application under test.-post :: ByteString -> LB.ByteString -> WaiSession SResponse+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 SResponse+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 SResponse+patch :: ByteString -> LB.ByteString -> WaiSession st SResponse patch path = request methodPatch path []  -- | Perform an @OPTIONS@ request to the application under test.-options :: ByteString -> WaiSession SResponse+options :: ByteString -> WaiSession st SResponse options path = request methodOptions path [] ""  -- | Perform a @DELETE@ request to the application under test.-delete :: ByteString -> WaiSession SResponse+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 SResponse-request method path headers body = getApp >>= liftIO . runSession (Wai.srequest $ SRequest req 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 @@ -138,6 +153,6 @@ -- The specified list of key-value pairs is encoded as -- @application/x-www-form-urlencoded@ and used as request body. ----- In additon the @Content-Type@ is set to @application/x-www-form-urlencoded@.-postHtmlForm :: ByteString -> [(String, String)] -> WaiSession SResponse+-- 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
src/Test/Hspec/Wai/Internal.hs view
@@ -2,44 +2,59 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-} module Test.Hspec.Wai.Internal (   WaiExpectation , WaiSession(..) , runWaiSession+, runWithState , withApplication , getApp+, getState , formatHeader ) where -import           Prelude ()-import           Prelude.Compat- 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) && !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail+#endif+ -- | An expectation in the `WaiSession` monad.  Failing expectations are--- communicated through exceptions (similar to `Expectation` and+-- communicated through exceptions (similar to `Test.Hspec.Expectations.Expectation` and -- `Test.HUnit.Base.Assertion`).-type WaiExpectation = WaiSession ()+type WaiExpectation st = WaiSession st ()  -- | A <http://www.yesodweb.com/book/web-application-interface WAI> test--- session that carries the `Application` under test an some client state.-newtype WaiSession a = WaiSession {unWaiSession :: Session a}-  deriving (Functor, Applicative, Monad, MonadIO)+-- 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 = runSession . unWaiSession+runWaiSession :: WaiSession () a -> Application -> IO a+runWaiSession action app = runWithState action ((), app) -withApplication :: Application -> WaiSession a -> IO a+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 where-  type Arg WaiExpectation = Application-  evaluateExample e p action = evaluateExample (action $ runWaiSession e) p ($ ())+instance Example (WaiExpectation st) where+  type Arg (WaiExpectation st) = (st, Application)+  evaluateExample e p action = evaluateExample (action $ runWithState e) p ($ ()) -getApp :: WaiSession Application-getApp = WaiSession ask+getApp :: WaiSession st Application+getApp = WaiSession (lift ask)++getState :: WaiSession st st+getState = WaiSession ask
src/Test/Hspec/Wai/Matcher.hs view
@@ -1,18 +1,24 @@+{-# LANGUAGE PackageImports #-} {-# LANGUAGE ViewPatterns #-} module Test.Hspec.Wai.Matcher (   ResponseMatcher(..) , MatchHeader(..)+, MatchBody(..)+, Body , (<:>)+, bodyEquals , match+, formatHeader ) where  import           Prelude ()-import           Prelude.Compat+import "base-compat" 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@@ -20,19 +26,39 @@  import           Test.Hspec.Wai.Util +type Body = LB.ByteString+ data ResponseMatcher = ResponseMatcher {   matchStatus :: Int , matchHeaders :: [MatchHeader]-, matchBody :: Maybe LB.ByteString+, matchBody :: MatchBody } -data MatchHeader = MatchHeader ([Header] -> Maybe String)+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 s = ResponseMatcher 200 [] (Just . encodeUtf8 . fromString $ s)+  fromString = ResponseMatcher 200 [] . fromString  instance Num ResponseMatcher where-  fromInteger n = ResponseMatcher (fromInteger n) [] Nothing+  fromInteger n = ResponseMatcher (fromInteger n) [] matchAny   (+) =    error "ResponseMatcher does not support (+)"   (-) =    error "ResponseMatcher does not support (-)"   (*) =    error "ResponseMatcher does not support (*)"@@ -40,34 +66,28 @@   signum = error "ResponseMatcher does not support `signum`"  match :: SResponse -> ResponseMatcher -> Maybe String-match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders expectedBody) = mconcat [+match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders (MatchBody bodyMatcher)) = mconcat [     actualExpected "status mismatch:" (show status) (show expectedStatus) <$ guard (status /= expectedStatus)-  , checkHeaders headers expectedHeaders-  , expectedBody >>= matchBody_ body+  , checkHeaders headers body expectedHeaders+  , bodyMatcher headers body   ]-  where-    matchBody_ (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) -    actualExpected :: String -> String -> String -> String-    actualExpected message actual expected = unlines [-        message-      , "  expected: " ++ expected-      , "  but got:  " ++ actual-      ]+actualExpected :: String -> String -> String -> String+actualExpected message actual expected = unlines [+    message+  , "  expected: " ++ expected+  , "  but got:  " ++ actual+  ] -checkHeaders :: [Header] -> [MatchHeader] -> Maybe String-checkHeaders headers m = case go m of+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)+    go = catMaybes . map (\(MatchHeader p) -> p headers body)  (<:>) :: HeaderName -> ByteString -> MatchHeader-name <:> value = MatchHeader $ \headers -> guard (header `notElem` headers) >> (Just . unlines) [+name <:> value = MatchHeader $ \headers _body -> guard (header `notElem` headers) >> (Just . unlines) [     "missing header:"   , formatHeader header   ]
src/Test/Hspec/Wai/QuickCheck.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} module Test.Hspec.Wai.QuickCheck (   property , (==>)@@ -19,26 +20,30 @@  import           Test.Hspec.Wai.Internal -property :: Testable a => a -> Application -> Property+property :: Testable a => a -> (State a, Application) -> Property property = unWaiProperty . toProperty -data WaiProperty = WaiProperty {unWaiProperty :: Application -> Property}+data WaiProperty st = WaiProperty {unWaiProperty :: (st, Application) -> Property}  class Testable a where-  toProperty :: a -> WaiProperty+  type State a+  toProperty :: a -> WaiProperty (State a) -instance Testable WaiProperty where+instance Testable (WaiProperty st) where+  type State (WaiProperty st) = st   toProperty = id -instance Testable WaiExpectation where-  toProperty action = WaiProperty (QuickCheck.property . runWaiSession action)+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+(==>) :: Testable prop => Bool -> prop -> WaiProperty (State prop) (==>) = lift (QuickCheck.==>) -lift :: Testable prop => (a -> Property -> Property) -> a -> prop -> WaiProperty+lift :: Testable prop => (a -> Property -> Property) -> a -> prop -> WaiProperty (State prop) lift f a prop = WaiProperty $ \app -> f a (unWaiProperty (toProperty prop) app)
src/Test/Hspec/Wai/Util.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Test.Hspec.Wai.Util where  import           Control.Monad-import           Data.Monoid import           Data.Maybe import           Data.List import           Data.Word@@ -12,12 +12,16 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as LB-import           Data.ByteString.Lazy.Builder (Builder)-import qualified Data.ByteString.Lazy.Builder as Builder+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])
test/Test/Hspec/Wai/UtilSpec.hs view
@@ -1,16 +1,20 @@ {-# 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           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++#if !MIN_VERSION_base(4,11,0)+import           Data.Monoid+#endif  main :: IO () main = hspec spec
test/Test/Hspec/WaiSpec.hs view
@@ -8,6 +8,7 @@ import           Network.Wai  import           Test.Hspec.Wai+import           Test.Hspec.Wai.Internal (withApplication)  main :: IO () main = hspec spec@@ -22,38 +23,45 @@   requestMethod req `shouldBe` method   rawPathInfo req `shouldBe` path   requestHeaders req `shouldBe` headers-  rawBody <- requestBody req+  rawBody <- getRequestBodyChunk req   rawBody `shouldBe` body   respond $ responseLBS status200 [] ""  spec :: Spec spec = do-  describe "get" $ with (return $ expectMethod methodGet) $-    it "sends a get request" $+  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) $-    it "sends a post request" $+  describe "post" $ with (return $ expectMethod methodPost) $ do+    it "sends a post request" $ do       post "/" "" `shouldRespondWith` 200 -  describe "put" $ with (return $ expectMethod methodPut) $-    it "sends a put request" $+  describe "put" $ with (return $ expectMethod methodPut) $ do+    it "sends a put request" $ do       put "/" "" `shouldRespondWith` 200 -  describe "options" $ with (return $ expectMethod methodOptions) $-    it "sends an options request" $+  describe "options" $ with (return $ expectMethod methodOptions) $ do+    it "sends an options request" $ do       options "/" `shouldRespondWith` 200 -  describe "delete" $ with (return $ expectMethod methodDelete) $-    it "sends a delete request" $+  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) $-    it "sends method, path, headers, and body" $+  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) $-    it "sends a post request with form-encoded params" $+  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