wai-test 1.3.1.1 → 3.0.0
raw patch · 4 files changed
Files
- Network/Wai/Test.hs +0/−210
- test/Network/Wai/TestSpec.hs +0/−32
- test/Spec.hs +0/−1
- wai-test.cabal +4/−34
− Network/Wai/Test.hs
@@ -1,210 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-module Network.Wai.Test- ( -- * Session- Session- , runSession- -- * Requests- , request- , srequest- , SRequest (..)- , SResponse (..)- , defaultRequest- , setPath- , 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 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-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- }---- | 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- 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- ]
− test/Network/Wai/TestSpec.hs
@@ -1,32 +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 "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,46 +1,16 @@ name: wai-test-version: 1.3.1.1+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 >= 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--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