wai-test-1.3.0.5/0000755000000000000000000000000012121324423011573 5ustar0000000000000000wai-test-1.3.0.5/LICENSE0000644000000000000000000000207512121324423012604 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ 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. wai-test-1.3.0.5/wai-test.cabal0000644000000000000000000000303012121324423014310 0ustar0000000000000000name: wai-test version: 1.3.0.5 license: MIT license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Unit test framework (built on HUnit) for WAI applications. category: Testing, Web, Yesod stability: Stable cabal-version: >= 1.6 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 >= 1.3 && < 1.5 , bytestring >= 0.9.1.4 , text >= 0.7 && < 0.12 , blaze-builder >= 0.2.1.4 && < 0.4 , transformers >= 0.2.2 && < 0.4 , containers >= 0.2 , conduit >= 0.5 && < 1.1 , blaze-builder-conduit >= 0.5 && < 1.1 , cookie >= 0.2 && < 0.5 , HUnit >= 1.2 && < 1.3 , http-types >= 0.7 , case-insensitive >= 0.2 , network exposed-modules: Network.Wai.Test ghc-options: -Wall source-repository head type: git location: git://github.com/yesodweb/wai.git wai-test-1.3.0.5/Setup.lhs0000644000000000000000000000021712121324423013403 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > import System.Cmd (system) > main :: IO () > main = defaultMain wai-test-1.3.0.5/Network/0000755000000000000000000000000012121324423013224 5ustar0000000000000000wai-test-1.3.0.5/Network/Wai/0000755000000000000000000000000012121324423013744 5ustar0000000000000000wai-test-1.3.0.5/Network/Wai/Test.hs0000644000000000000000000001315512121324423015224 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Network.Wai.Test ( -- * Session Session , runSession -- * Requests , request , srequest , SRequest (..) , SResponse (..) , defaultRequest , setRawPathInfo -- * Assertions , assertStatus , assertContentType , assertBody , assertBodyContains , assertHeader , assertNoHeader ) where import Network.Wai import qualified Test.HUnit.Base as H import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (StateT, evalStateT) import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) 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 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 import Data.Monoid (mempty) import Network.Socket.Internal (SockAddr (SockAddrInet)) 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 defaultRequest :: Request defaultRequest = Request { requestMethod = "GET" , httpVersion = H.http11 , rawPathInfo = "/" , rawQueryString = "" , serverName = "localhost" , serverPort = 80 , requestHeaders = [] , isSecure = False , remoteHost = SockAddrInet 0 0 , pathInfo = [] , queryString = [] , requestBody = mempty , vault = mempty #if MIN_VERSION_wai(1, 4, 0) , requestBodyLength = KnownLength 0 #endif } setRawPathInfo :: Request -> S8.ByteString -> Request setRawPathInfo r rawPinfo = let pInfo = T.split (== '/') $ TE.decodeUtf8 rawPinfo in r { rawPathInfo = rawPinfo, pathInfo = pInfo } srequest :: SRequest -> Session SResponse srequest (SRequest req bod) = do app <- ask liftIO $ C.runResourceT $ do let req' = req { requestBody = CL.sourceList $ L.toChunks bod } res <- app req' sres <- runResponse res -- FIXME cookie processing return sres runResponse :: Response -> C.ResourceT IO SResponse runResponse res = do bss <- body C.$= CL.map toBuilder C.$= builderToByteString C.$$ CL.consume return $ SResponse s h $ L.fromChunks bss where (s, h, body) = responseSource res toBuilder (C.Chunk builder) = builder toBuilder C.Flush = flush assertBool :: String -> Bool -> Session () assertBool s b = liftIO $ H.assertBool s b assertString :: String -> Session () assertString s = liftIO $ H.assertString s 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 ]