wai-test 2.0.1.3 → 3.0.0
raw patch · 4 files changed
+4/−273 lines, 4 filesdep −basedep −blaze-builderdep −blaze-builder-conduitdep ~wai
Dependencies removed: base, blaze-builder, blaze-builder-conduit, bytestring, case-insensitive, conduit, conduit-extra, containers, cookie, deepseq, hspec, http-types, network, text, transformers, wai-test
Dependency ranges changed: wai
Files
- Network/Wai/Test.hs +0/−201
- test/Network/Wai/TestSpec.hs +0/−36
- test/Spec.hs +0/−1
- wai-test.cabal +4/−35
− Network/Wai/Test.hs
@@ -1,201 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-module Network.Wai.Test- ( -- * Session- Session- , runSession- -- * Requests- , request- , srequest- , SRequest (..)- , SResponse (..)- , defaultRequest- , setPath- , setRawPathInfo- -- * Assertions- , assertStatus- , assertContentType- , assertBody- , assertBodyContains- , assertHeader- , assertNoHeader- , WaiTestFailure (..)- ) where--import Network.Wai-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.State (StateT, evalStateT)-import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)-import Control.Monad (unless)-import Control.DeepSeq (deepseq)-import Control.Exception (throwIO, Exception)-import Data.Typeable (Typeable)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as S8-import Data.Conduit.Blaze (builderToByteString)-import Blaze.ByteString.Builder (flush)-import qualified Blaze.ByteString.Builder as B-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as L8-import qualified Network.HTTP.Types as H-import Data.CaseInsensitive (CI)-import qualified Data.ByteString as S-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Conduit as C-import qualified Data.Conduit.List as CL--type Session = ReaderT Application (StateT ClientState IO)--data ClientState = ClientState- { _clientCookies :: Map ByteString ByteString- }--initState :: ClientState-initState = ClientState Map.empty--runSession :: Session a -> Application -> IO a-runSession session app = evalStateT (runReaderT session app) initState--data SRequest = SRequest- { simpleRequest :: Request- , simpleRequestBody :: L.ByteString- }-data SResponse = SResponse- { simpleStatus :: H.Status- , simpleHeaders :: H.ResponseHeaders- , simpleBody :: L.ByteString- }- deriving (Show, Eq)-request :: Request -> Session SResponse-request = srequest . flip SRequest L.empty---- | Set whole path (request path + query string).-setPath :: Request -> S8.ByteString -> Request-setPath req path = req {- pathInfo = segments- , rawPathInfo = B.toByteString (H.encodePathSegments segments)- , queryString = query- , rawQueryString = (H.renderQuery True query)- }- where- (segments, query) = H.decodePath path--setRawPathInfo :: Request -> S8.ByteString -> Request-setRawPathInfo r rawPinfo =- let pInfo = dropFrontSlash $ T.split (== '/') $ TE.decodeUtf8 rawPinfo- in r { rawPathInfo = rawPinfo, pathInfo = pInfo }- where- dropFrontSlash ("":"":[]) = [] -- homepage, a single slash- dropFrontSlash ("":path) = path- dropFrontSlash path = path--srequest :: SRequest -> Session SResponse-srequest (SRequest req bod) = do- app <- ask- let req' = req- { requestBody = CL.sourceList $ L.toChunks bod- }- liftIO $ app req' >>= runResponse- -- FIXME cookie processing- --return sres--runResponse :: Response -> IO SResponse-runResponse res = do- bss <- withBody $ \body -> body C.$= CL.map toBuilder C.$= builderToByteString C.$$ CL.consume- return $ SResponse s h $ L.fromChunks bss- where- (s, h, withBody) = responseToSource res- toBuilder (C.Chunk builder) = builder- toBuilder C.Flush = flush--assertBool :: String -> Bool -> Session ()-assertBool s b = unless b $ assertFailure s--assertString :: String -> Session ()-assertString s = unless (null s) $ assertFailure s--assertFailure :: String -> Session ()-assertFailure msg = msg `deepseq` liftIO (throwIO (WaiTestFailure msg))--data WaiTestFailure = WaiTestFailure String- deriving (Show, Eq, Typeable)-instance Exception WaiTestFailure--assertContentType :: ByteString -> SResponse -> Session ()-assertContentType ct SResponse{simpleHeaders = h} =- case lookup "content-type" h of- Nothing -> assertString $ concat- [ "Expected content type "- , show ct- , ", but no content type provided"- ]- Just ct' -> assertBool (concat- [ "Expected content type "- , show ct- , ", but received "- , show ct'- ]) (go ct == go ct')- where- go = S8.takeWhile (/= ';')--assertStatus :: Int -> SResponse -> Session ()-assertStatus i SResponse{simpleStatus = s} = assertBool (concat- [ "Expected status code "- , show i- , ", but received "- , show sc- ]) $ i == sc- where- sc = H.statusCode s--assertBody :: L.ByteString -> SResponse -> Session ()-assertBody lbs SResponse{simpleBody = lbs'} = assertBool (concat- [ "Expected response body "- , show $ L8.unpack lbs- , ", but received "- , show $ L8.unpack lbs'- ]) $ lbs == lbs'--assertBodyContains :: L.ByteString -> SResponse -> Session ()-assertBodyContains lbs SResponse{simpleBody = lbs'} = assertBool (concat- [ "Expected response body to contain "- , show $ L8.unpack lbs- , ", but received "- , show $ L8.unpack lbs'- ]) $ strict lbs `S.isInfixOf` strict lbs'- where- strict = S.concat . L.toChunks--assertHeader :: CI ByteString -> ByteString -> SResponse -> Session ()-assertHeader header value SResponse{simpleHeaders = h} =- case lookup header h of- Nothing -> assertString $ concat- [ "Expected header "- , show header- , " to be "- , show value- , ", but it was not present"- ]- Just value' -> assertBool (concat- [ "Expected header "- , show header- , " to be "- , show value- , ", but received "- , show value'- ]) (value == value')--assertNoHeader :: CI ByteString -> SResponse -> Session ()-assertNoHeader header SResponse{simpleHeaders = h} =- case lookup header h of- Nothing -> return ()- Just s -> assertString $ concat- [ "Unexpected header "- , show header- , " containing "- , show s- ]
− test/Network/Wai/TestSpec.hs
@@ -1,36 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Wai.TestSpec (main, spec) where--import Test.Hspec--import Network.Wai-import Network.Wai.Test--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "setPath" $ do-- let req = setPath defaultRequest "/foo/bar/baz?foo=23&bar=42&baz"-- it "sets pathInfo" $ do- pathInfo req `shouldBe` ["foo", "bar", "baz"]-- it "utf8 path" $- pathInfo (setPath defaultRequest "/foo/%D7%A9%D7%9C%D7%95%D7%9D/bar") `shouldBe`- ["foo", "שלום", "bar"]-- it "sets rawPathInfo" $ do- rawPathInfo req `shouldBe` "/foo/bar/baz"-- it "sets queryString" $ do- queryString req `shouldBe` [("foo", Just "23"), ("bar", Just "42"), ("baz", Nothing)]-- it "sets rawQueryString" $ do- rawQueryString req `shouldBe` "?foo=23&bar=42&baz"-- context "when path has no query string" $ do- it "sets rawQueryString to empty string" $ do- rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
− test/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
wai-test.cabal view
@@ -1,47 +1,16 @@ name: wai-test-version: 2.0.1.3+version: 3.0.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com> maintainer: Michael Snoyman <michael@snoyman.com>-synopsis: Unit test framework (built on HUnit) for WAI applications.+synopsis: Unit test framework (built on HUnit) for WAI applications. (deprecated)+description: Since WAI 3.0, this code has been merged into wai-extra. category: Testing, Web, Yesod stability: Stable cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/web-application-interface-description: Unit test framework (built on HUnit) for WAI applications. library- build-depends: base >= 4 && < 5- , wai >= 2.0 && < 2.2- , bytestring >= 0.9.1.4- , text >= 0.7- , blaze-builder >= 0.2.1.4 && < 0.4- , transformers >= 0.2.2- , containers >= 0.2- , conduit >= 0.5 && < 1.2- , conduit-extra- , blaze-builder-conduit >= 0.5 && < 1.2- , cookie >= 0.2 && < 0.5- , http-types >= 0.7- , case-insensitive >= 0.2- , network- , deepseq- exposed-modules: Network.Wai.Test- ghc-options: -Wall--test-suite spec- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Spec.hs- other-modules: Network.Wai.TestSpec- build-depends: base >= 4 && < 5- , wai-test- , wai- , hspec >= 1.3- ghc-options: -Wall -Werror--source-repository head- type: git- location: git://github.com/yesodweb/wai.git+ build-depends: wai >= 3.0