Add 'wai-test/' from commit '245f105fe1cbbaa69f183f93b74ae36921b0eff1'

git-subtree-dir: wai-test
git-subtree-mainline: 2db4766
git-subtree-split: 245f105

wai-test/LICENSE

@@ -0,0 +1,25 @@
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
+
+Copyright 2010, Michael Snoyman. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

wai-test/Network/Wai/Test.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.Wai.Test
+    ( -- * Session
+      Session
+    , runSession
+      -- * Requests
+    , request
+    , srequest
+    , SRequest (..)
+    , SResponse (..)
+      -- * Assertions
+    , assertStatus
+    , assertContentType
+    , assertBody
+    , 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.Enumerator (joinI, ($$), run_, enumList)
+import Data.Enumerator.List (consume)
+import Blaze.ByteString.Builder.Enumerator (builderToByteString)
+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)
+
+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
+
+srequest :: SRequest -> Session SResponse
+srequest (SRequest req bod) = do
+    app <- ask
+    res <- liftIO $ run_ $ enumList 4 (L.toChunks bod) $$ app req
+    sres <- liftIO $ runResponse res
+    -- FIXME cookie processing
+    return sres
+
+runResponse :: Response -> IO SResponse
+runResponse res =
+    responseEnumerator res go
+  where
+    go s h = do
+        bss <- joinI $ builderToByteString $$ consume
+        return $ SResponse s h $ L.fromChunks bss
+
+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'
+
+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
+            ]

wai-test/Setup.lhs

@@ -0,0 +1,8 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+> import System.Cmd (system)
+
+> main :: IO ()
+> main = defaultMain

wai-test/wai-test.cabal

@@ -0,0 +1,32 @@
+name:            wai-test
+version:         0.1.0.2
+license:         BSD3
+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.
+category:        Testing, Web, Yesod
+stability:       Stable
+cabal-version:   >= 1.6
+build-type:      Simple
+homepage:        http://github.com/snoyberg/wai-test/
+
+library
+    build-depends:   base                      >= 4        && < 5
+                   , wai                       >= 0.4      && < 0.5
+                   , bytestring                >= 0.9.1.4  && < 0.10
+                   , blaze-builder             >= 0.2.1    && < 0.4
+                   , transformers              >= 0.2      && < 0.3
+                   , containers                >= 0.2      && < 0.5
+                   , enumerator                >= 0.4.7    && < 0.5
+                   , cookie                    >= 0.2      && < 0.4
+                   , blaze-builder-enumerator  >= 0.2      && < 0.3
+                   , HUnit                     >= 1.2      && < 1.3
+                   , http-types                >= 0.6      && < 0.7
+                   , case-insensitive          >= 0.2      && < 0.4
+    exposed-modules: Network.Wai.Test
+    ghc-options:     -Wall
+
+source-repository head
+  type:     git
+  location: git://github.com/snoyberg/wai-test.git