git.iko.soy/typeable/wai
on master help sign in
Cleaned up tests
b9fbb4dMichael Snoyman
warp/Network/Wai/Handler/Warp.hs+1−1
compare with master
unifiedsplit
@@ -322,7 +322,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do
322 -- performance penalty, we may need our own version.
322 -- performance penalty, we may need our own version.
323 rbody <- C.bufferSource $
323 rbody <- C.bufferSource $
324 if len == 0
324 if len == 0
325− then CL.sourceList []
325+ then mempty
326 else src C.$= CB.isolate len
326 else src C.$= CB.isolate len
327 return Request
327 return Request
328 { requestMethod = method
328 { requestMethod = method
warp/test/main.hs+74−84
@@ -4,10 +4,12 @@ import Network.Wai.Handler.Warp
4import qualified Data.IORef as I
4import qualified Data.IORef as I
5import Control.Monad.IO.Class (MonadIO, liftIO)
5import Control.Monad.IO.Class (MonadIO, liftIO)
6import Network.HTTP.Types
6import Network.HTTP.Types
7−import Control.Concurrent (forkIO, killThread)
7+import Control.Concurrent (forkIO, killThread, threadDelay)
8+import Control.Monad (forM_)
8
9
9−import System.IO (hFlush, hPutStrLn, stderr)
10+import System.IO (hFlush)
10−import Data.ByteString (hPutStr, hGetSome)
11+import Data.ByteString (ByteString, hPutStr, hGetSome)
12+import qualified Data.ByteString as S
11import qualified Data.ByteString.Lazy as L
13import qualified Data.ByteString.Lazy as L
12import Network (connectTo, PortID (PortNumber))
14import Network (connectTo, PortID (PortNumber))
13
15
@@ -18,97 +20,85 @@ import Test.HUnit
18import Data.Conduit (($$))
20import Data.Conduit (($$))
19import qualified Data.Conduit.List
21import qualified Data.Conduit.List
20
22
21−print' :: (Show a, MonadIO m) => a -> m ()
23+type Counter = I.IORef (Either String Int)
22−print' = liftIO . hPutStrLn stderr . show
24+type CounterApplication = Counter -> Application
23
25
24−readBody :: I.IORef Int -> Application
26+incr :: MonadIO m => Counter -> m ()
27+incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->
28+ ((case ecount of
29+ Left s -> Left s
30+ Right i -> Right $ i + 1), ())
31+
32+err :: (MonadIO m, Show a) => Counter -> a -> m ()
33+err icount msg = liftIO $ I.writeIORef icount $ Left $ show msg
34+
35+readBody :: CounterApplication
25readBody icount req = do
36readBody icount req = do
26 body <- requestBody req $$ Data.Conduit.List.consume
37 body <- requestBody req $$ Data.Conduit.List.consume
38+ case () of
39+ ()
27− if (pathInfo req == ["hello"] && L.fromChunks body /= "Hello")
40+ | pathInfo req == ["hello"] && L.fromChunks body /= "Hello"
28− then print' ("Invalid hello", body)
41+ -> err icount ("Invalid hello" :: String, body)
29− else liftIO $ I.atomicModifyIORef icount $ \count -> (count + 1, ())
42+ | requestMethod req == "GET" && L.fromChunks body /= ""
43+ -> err icount ("Invalid GET" :: String, body)
44+ | not $ requestMethod req `elem` ["GET", "POST"]
45+ -> err icount ("Invalid request method (readBody)" :: String, requestMethod req)
46+ | otherwise -> incr icount
30 return $ responseLBS status200 [] "Read the body"
47 return $ responseLBS status200 [] "Read the body"
31
48
32−ignoreBody :: I.IORef Int -> Application
49+ignoreBody :: CounterApplication
33ignoreBody icount req = do
50ignoreBody icount req = do
34 if (requestMethod req `elem` ["GET", "POST"])
51 if (requestMethod req `elem` ["GET", "POST"])
35− then liftIO $ I.atomicModifyIORef icount $ \count -> (count + 1, ())
52+ then incr icount
36− else print' ("Invalid request method", requestMethod req)
53+ else err icount ("Invalid request method" :: String, requestMethod req)
37 return $ responseLBS status200 [] "Ignored the body"
54 return $ responseLBS status200 [] "Ignored the body"
38
55
56+runTest :: Int -- ^ expected number of requests
57+ -> Int -- ^ port to run on
58+ -> CounterApplication
59+ -> [ByteString] -- ^ chunks to send
60+ -> IO ()
61+runTest expected port app chunks = do
62+ ref <- I.newIORef (Right 0)
63+ tid <- forkIO $ run port $ app ref
64+ threadDelay 1000
65+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
66+ forM_ chunks $ \chunk -> hPutStr handle chunk >> hFlush handle
67+ _ <- hGetSome handle 4096
68+ threadDelay 1000
69+ killThread tid
70+ res <- I.readIORef ref
71+ case res of
72+ Left s -> error s
73+ Right i -> i @?= expected
74+
75+singleGet :: ByteString
76+singleGet = "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
77+
78+singlePostHello :: ByteString
79+singlePostHello = "POST /hello HTTP/1.1\r\nHost: localhost\r\nContent-length: 5\r\n\r\nHello"
80+
39main :: IO ()
81main :: IO ()
40main = hspecX $ do
82main = hspecX $ do
41 describe "non-pipelining" $ do
83 describe "non-pipelining" $ do
42− it "no body" $ do
84+ it "no body, read" $ runTest 5 5007 readBody $ replicate 5 singleGet
43− icount <- I.newIORef 0
85+ it "no body, ignore" $ runTest 5 5003 ignoreBody $ replicate 5 singleGet
44− tid <- forkIO $ run 5003 $ readBody icount
86+ it "has body, read" $ runTest 2 5004 readBody
45− handle <- connectTo "127.0.0.1" $ PortNumber 5003
87+ [ singlePostHello
46− hPutStr handle "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
88+ , singleGet
47− hFlush handle
89+ ]
48− res <- hGetSome handle 4096
90+ it "has body, ignore" $ runTest 2 5005 ignoreBody
49− hPutStr handle "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
91+ [ singlePostHello
50− hFlush handle
92+ , singleGet
51− res <- hGetSome handle 4096
93+ ]
52− killThread tid
53− count <- I.readIORef icount
54− count @?= 2
55− it "app reads the body" $ do
56− icount <- I.newIORef 0
57− tid <- forkIO $ run 5004 $ readBody icount
58− handle <- connectTo "127.0.0.1" $ PortNumber 5004
59− hPutStr handle "POST /hello HTTP/1.1\r\nHost: localhost\r\nContent-length: 5\r\n\r\nHello"
60− hFlush handle
61− res <- hGetSome handle 4096
62− hPutStr handle "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
63− hFlush handle
64− res <- hGetSome handle 4096
65− killThread tid
66− count <- I.readIORef icount
67− count @?= 2
68− it "app ignores the body" $ do
69− icount <- I.newIORef 0
70− tid <- forkIO $ run 5005 $ ignoreBody icount
71− handle <- connectTo "127.0.0.1" $ PortNumber 5005
72− hPutStr handle "POST /hello HTTP/1.1\r\nHost: localhost\r\nContent-length: 5\r\n\r\nHello"
73− hFlush handle
74− res <- hGetSome handle 4096
75− hPutStr handle "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
76− hFlush handle
77− res <- hGetSome handle 4096
78− killThread tid
79− count <- I.readIORef icount
80− count @?= 2
81 describe "pipelining" $ do
94 describe "pipelining" $ do
82− it "no body" $ do
95+ it "no body, read" $ runTest 5 5006 readBody [S.concat $ replicate 5 singleGet]
83− icount <- I.newIORef 0
96+ it "no body, ignore" $ runTest 5 5002 ignoreBody [S.concat $ replicate 5 singleGet]
84− tid <- forkIO $ run 5002 $ readBody icount
97+ it "has body, read" $ runTest 2 5001 readBody $ return $ S.concat
85− handle <- connectTo "127.0.0.1" $ PortNumber 5002
98+ [ singlePostHello
86− hPutStr handle "GET / HTTP/1.1\r\nHost: localhost\r\n\r\nGET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
99+ , singleGet
87− hFlush handle
100+ ]
88− res <- hGetSome handle 4096
101+ it "has body, ignore" $ runTest 2 5000 ignoreBody $ return $ S.concat
89− print res
102+ [ singlePostHello
90− killThread tid
103+ , singleGet
91− count <- I.readIORef icount
104+ ]
92− count @?= 2
93− it "app reads the body" $ do
94− icount <- I.newIORef 0
95− tid <- forkIO $ run 5001 $ readBody icount
96− handle <- connectTo "127.0.0.1" $ PortNumber 5001
97− hPutStr handle "POST / HTTP/1.1\r\nHost: localhost\r\nContent-Length: 5\r\n\r\nHello\r\n\r\nGET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
98− hFlush handle
99− res <- hGetSome handle 4096
100− print res
101− killThread tid
102− count <- I.readIORef icount
103− count @?= 2
104− it "app ignores the body" $ do
105− icount <- I.newIORef 0
106− tid <- forkIO $ run 5000 $ ignoreBody icount
107− handle <- connectTo "127.0.0.1" $ PortNumber 5000
108− hPutStr handle "POST / HTTP/1.1\r\nHost: localhost\r\nContent-Length: 5\r\n\r\nHello\r\nGET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
109− hFlush handle
110− res <- hGetSome handle 4096
111− print res
112− killThread tid
113− count <- I.readIORef icount
114− count @?= 2