@@ -0,0 +1,145 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Test
3+ ( -- * Session
4+ Session
5+ , runSession
6+ -- * Requests
7+ , request
8+ , srequest
9+ , SRequest (..)
10+ , SResponse (..)
11+ -- * Assertions
12+ , assertStatus
13+ , assertContentType
14+ , assertBody
15+ , assertHeader
16+ , assertNoHeader
17+ ) where
18+import Network.Wai
19+import qualified Test.HUnit.Base as H
20+import Control.Monad.IO.Class (liftIO)
21+import Control.Monad.Trans.State (StateT, evalStateT)
22+import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
23+import Data.Map (Map)
24+import qualified Data.Map as Map
25+import Data.ByteString (ByteString)
26+import qualified Data.ByteString.Char8 as S8
27+import Data.Enumerator (joinI, ($$), run_, enumList)
28+import Data.Enumerator.List (consume)
29+import Blaze.ByteString.Builder.Enumerator (builderToByteString)
30+import qualified Data.ByteString.Lazy as L
31+import qualified Data.ByteString.Lazy.Char8 as L8
32+import qualified Network.HTTP.Types as H
33+import Data.CaseInsensitive (CI)
34+
35+type Session = ReaderT Application (StateT ClientState IO)
36+
37+data ClientState = ClientState
38+ { clientCookies :: Map ByteString ByteString
39+ }
40+
41+initState :: ClientState
42+initState = ClientState Map.empty
43+
44+runSession :: Session a -> Application -> IO a
45+runSession session app = evalStateT (runReaderT session app) initState
46+
47+data SRequest = SRequest
48+ { simpleRequest :: Request
49+ , simpleRequestBody :: L.ByteString
50+ }
51+data SResponse = SResponse
52+ { simpleStatus :: H.Status
53+ , simpleHeaders :: H.ResponseHeaders
54+ , simpleBody :: L.ByteString
55+ }
56+ deriving (Show, Eq)
57+request :: Request -> Session SResponse
58+request = srequest . flip SRequest L.empty
59+
60+srequest :: SRequest -> Session SResponse
61+srequest (SRequest req bod) = do
62+ app <- ask
63+ res <- liftIO $ run_ $ enumList 4 (L.toChunks bod) $$ app req
64+ sres <- liftIO $ runResponse res
65+ -- FIXME cookie processing
66+ return sres
67+
68+runResponse :: Response -> IO SResponse
69+runResponse res =
70+ responseEnumerator res go
71+ where
72+ go s h = do
73+ bss <- joinI $ builderToByteString $$ consume
74+ return $ SResponse s h $ L.fromChunks bss
75+
76+assertBool :: String -> Bool -> Session ()
77+assertBool s b = liftIO $ H.assertBool s b
78+
79+assertString :: String -> Session ()
80+assertString s = liftIO $ H.assertString s
81+
82+assertContentType :: ByteString -> SResponse -> Session ()
83+assertContentType ct SResponse{simpleHeaders = h} =
84+ case lookup "content-type" h of
85+ Nothing -> assertString $ concat
86+ [ "Expected content type "
87+ , show ct
88+ , ", but no content type provided"
89+ ]
90+ Just ct' -> assertBool (concat
91+ [ "Expected content type "
92+ , show ct
93+ , ", but received "
94+ , show ct'
95+ ]) (go ct == go ct')
96+ where
97+ go = S8.takeWhile (/= ';')
98+
99+assertStatus :: Int -> SResponse -> Session ()
100+assertStatus i SResponse{simpleStatus = s} = assertBool (concat
101+ [ "Expected status code "
102+ , show i
103+ , ", but received "
104+ , show sc
105+ ]) $ i == sc
106+ where
107+ sc = H.statusCode s
108+
109+assertBody :: L.ByteString -> SResponse -> Session ()
110+assertBody lbs SResponse{simpleBody = lbs'} = assertBool (concat
111+ [ "Expected response body "
112+ , show $ L8.unpack lbs
113+ , ", but received "
114+ , show $ L8.unpack lbs'
115+ ]) $ lbs == lbs'
116+
117+assertHeader :: CI ByteString -> ByteString -> SResponse -> Session ()
118+assertHeader header value SResponse{simpleHeaders = h} =
119+ case lookup header h of
120+ Nothing -> assertString $ concat
121+ [ "Expected header "
122+ , show header
123+ , " to be "
124+ , show value
125+ , ", but it was not present"
126+ ]
127+ Just value' -> assertBool (concat
128+ [ "Expected header "
129+ , show header
130+ , " to be "
131+ , show value
132+ , ", but received "
133+ , show value'
134+ ]) (value == value')
135+
136+assertNoHeader :: CI ByteString -> SResponse -> Session ()
137+assertNoHeader header SResponse{simpleHeaders = h} =
138+ case lookup header h of
139+ Nothing -> return ()
140+ Just s -> assertString $ concat
141+ [ "Unexpected header "
142+ , show header
143+ , " containing "
144+ , show s
145+ ]