30dd777 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge branch to clean up test code for Warp.

30dd777Kazu Yamamoto7 years ago

warp/test/ResponseSpec.hs+10−14

compare with master

unifiedsplit

@@ -10,7 +10,7 @@ import Network.HTTP.Types

10import Network.Wai hiding (responseHeaders)

11import Network.Wai.Handler.Warp

12import Network.Wai.Handler.Warp.Response

13−import RunSpec (withApp, msClose, msWrite, msRead, connectTo)

13+import RunSpec (withApp, msWrite, msRead, withMySocket)

14import Test.Hspec

16main :: IO ()

@@ -20,15 +20,13 @@ testRange :: S.ByteString -- ^ range value

20 -> String -- ^ expected output

21 -> Maybe String -- ^ expected content-range value

22 -> Spec

23−testRange range out crange = it title $ withApp defaultSettings app $ \port -> do

23+testRange range out crange = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do

24− handle <- connectTo port

25− msWrite handle "GET / HTTP/1.0\r\n"

24+ msWrite ms "GET / HTTP/1.0\r\n"

26− msWrite handle "Range: bytes="

25+ msWrite ms "Range: bytes="

27− msWrite handle range

26+ msWrite ms range

28− msWrite handle "\r\n\r\n"

27+ msWrite ms "\r\n\r\n"

29 threadDelay 10000

28 threadDelay 10000

30− bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024

29+ bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024

31− msClose handle

32 last bss `shouldBe` out

30 last bss `shouldBe` out

33 let hs = mapMaybe toHeader bss

31 let hs = mapMaybe toHeader bss

34 lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange

32 lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange

@@ -46,12 +44,10 @@ testPartial :: Integer -- ^ file size

46 -> Integer -- ^ byte count

44 -> Integer -- ^ byte count

47 -> String -- ^ expected output

45 -> String -- ^ expected output

48 -> Spec

46 -> Spec

49−testPartial size offset count out = it title $ withApp defaultSettings app $ \port -> do

47+testPartial size offset count out = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do

50− handle <- connectTo port

51− msWrite handle "GET / HTTP/1.0\r\n\r\n"

48+ msWrite ms "GET / HTTP/1.0\r\n\r\n"

52 threadDelay 10000

49 threadDelay 10000

53− bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024

50+ bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024

54− msClose handle

55 out `shouldBe` last bss

51 out `shouldBe` last bss

56 let hs = mapMaybe toHeader bss

52 let hs = mapMaybe toHeader bss

57 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)

53 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)

warp/test/RunSpec.hs+38−47

@@ -1,7 +1,7 @@

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4−module RunSpec (main, spec, withApp, connectTo, MySocket, msWrite, msRead, msClose) where

4+module RunSpec (main, spec, withApp, MySocket, msWrite, msRead, withMySocket) where

6import Control.Concurrent (forkIO, killThread, threadDelay)

7import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

@@ -37,7 +37,7 @@ type CounterApplication = Counter -> Application

38data MySocket = MySocket

39 { msSocket :: !Socket

40− , _msBuffer :: !(I.IORef ByteString)

40+ , msBuffer :: !(I.IORef ByteString)

41 }

43msWrite :: MySocket -> ByteString -> IO ()

@@ -70,9 +70,16 @@ msClose :: MySocket -> IO ()

70msClose = Network.Socket.close . msSocket

72connectTo :: Int -> IO MySocket

73−connectTo port = MySocket

73+connectTo port = do

74− <$> (fst <$> getSocketTCP "127.0.0.1" port)

74+ s <- fst <$> getSocketTCP "127.0.0.1" port

75− <*> I.newIORef mempty

75+ ref <- I.newIORef mempty

76+ return MySocket {

77+ msSocket = s

78+ , msBuffer = ref

79+ }

80+

81+withMySocket :: (MySocket -> IO a) -> Int -> IO a

82+withMySocket body port = bracket (connectTo port) msClose body

77incr :: MonadIO m => Counter -> m ()

84incr :: MonadIO m => Counter -> m ()

78incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->

85incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->

@@ -150,8 +157,7 @@ runTest :: Int -- ^ expected number of requests

150 -> IO ()

157 -> IO ()

151runTest expected app chunks = do

158runTest expected app chunks = do

152 ref <- I.newIORef (Right 0)

159 ref <- I.newIORef (Right 0)

153− withApp defaultSettings (app ref) $ \port -> do

160+ withApp defaultSettings (app ref) $ withMySocket $ \ms -> do

154− ms <- connectTo port

155 forM_ chunks $ \chunk -> msWrite ms chunk

161 forM_ chunks $ \chunk -> msWrite ms chunk

156 _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096

162 _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096

157 res <- I.readIORef ref

163 res <- I.readIORef ref

@@ -168,10 +174,9 @@ runTerminateTest :: InvalidRequest

168runTerminateTest expected input = do

174runTerminateTest expected input = do

169 ref <- I.newIORef Nothing

175 ref <- I.newIORef Nothing

170 let onExc _ = I.writeIORef ref . Just

176 let onExc _ = I.writeIORef ref . Just

171− withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do

177+ withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do

172− handle <- connectTo port

173− msWrite handle input

178+ msWrite ms input

174− msClose handle

179+ msClose ms -- explicitly

175 threadDelay 1000

180 threadDelay 1000

176 res <- I.readIORef ref

181 res <- I.readIORef ref

177 show res `shouldBe` show (Just expected)

182 show res `shouldBe` show (Just expected)

@@ -242,13 +247,11 @@ spec = do

242 let app req f = do

247 let app req f = do

243 liftIO $ I.writeIORef iheaders $ requestHeaders req

248 liftIO $ I.writeIORef iheaders $ requestHeaders req

244 f $ responseLBS status200 [] ""

249 f $ responseLBS status200 [] ""

245− withApp defaultSettings app $ \port -> do

250+ withApp defaultSettings app $ withMySocket $ \ms -> do

246− handle <- connectTo port

247 let input = S.concat

251 let input = S.concat

248 [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"

252 [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"

249 ]

253 ]

250− msWrite handle input

254+ msWrite ms input

251− msClose handle

252 threadDelay 1000

255 threadDelay 1000

253 headers <- I.readIORef iheaders

256 headers <- I.readIORef iheaders

254 headers `shouldBe`

257 headers `shouldBe`

@@ -259,13 +262,11 @@ spec = do

259 let app req f = do

262 let app req f = do

260 liftIO $ I.writeIORef iheaders $ requestHeaders req

263 liftIO $ I.writeIORef iheaders $ requestHeaders req

261 f $ responseLBS status200 [] ""

264 f $ responseLBS status200 [] ""

262− withApp defaultSettings app $ \port -> do

265+ withApp defaultSettings app $ withMySocket $ \ms -> do

263− handle <- connectTo port

264 let input = S.concat

266 let input = S.concat

265 [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"

267 [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"

266 ]

268 ]

267− msWrite handle input

269+ msWrite ms input

268− msClose handle

269 threadDelay 1000

270 threadDelay 1000

270 headers <- I.readIORef iheaders

271 headers <- I.readIORef iheaders

271 headers `shouldBe`

272 headers `shouldBe`

@@ -281,16 +282,14 @@ spec = do

281 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

282 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

282 atomically $ modifyTVar countVar (+ 1)

283 atomically $ modifyTVar countVar (+ 1)

283 f $ responseLBS status200 [] ""

284 f $ responseLBS status200 [] ""

284− withApp defaultSettings app $ \port -> do

285+ withApp defaultSettings app $ withMySocket $ \ms -> do

285− handle <- connectTo port

286 let input = S.concat

287 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

288 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"

289 , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

290 , "b\r\nHello World\r\n0\r\n\r\n"

291 ]

292− msWrite handle input

292+ msWrite ms input

293− msClose handle

294 atomically $ do

293 atomically $ do

295 count <- readTVar countVar

294 count <- readTVar countVar

296 check $ count == 2

295 check $ count == 2

@@ -307,14 +306,12 @@ spec = do

307 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

306 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

308 atomically $ modifyTVar countVar (+ 1)

307 atomically $ modifyTVar countVar (+ 1)

309 f $ responseLBS status200 [] ""

308 f $ responseLBS status200 [] ""

310− withApp defaultSettings app $ \port -> do

309+ withApp defaultSettings app $ withMySocket $ \ms -> do

311− handle <- connectTo port

312 let input = concat $ replicate 2 $

310 let input = concat $ replicate 2 $

313 ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++

311 ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++

314 (replicate 50 "5\r\n12345\r\n") ++

312 (replicate 50 "5\r\n12345\r\n") ++

315 ["0\r\n\r\n"]

313 ["0\r\n\r\n"]

316− mapM_ (msWrite handle) input

314+ mapM_ (msWrite ms) input

317− msClose handle

318 atomically $ do

315 atomically $ do

319 count <- readTVar countVar

316 count <- readTVar countVar

320 check $ count == 2

317 check $ count == 2

@@ -330,16 +327,14 @@ spec = do

330 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

327 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

331 atomically $ modifyTVar countVar (+ 1)

328 atomically $ modifyTVar countVar (+ 1)

332 f $ responseLBS status200 [] ""

329 f $ responseLBS status200 [] ""

333− withApp defaultSettings app $ \port -> do

330+ withApp defaultSettings app $ withMySocket $ \ms -> do

334− handle <- connectTo port

335 let input = S.concat

331 let input = S.concat

336 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

332 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

337 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"

333 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"

338 , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

334 , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"

339 , "b\r\nHello World\r\n0\r\n\r\n"

335 , "b\r\nHello World\r\n0\r\n\r\n"

340 ]

336 ]

341− mapM_ (msWrite handle) $ map S.singleton $ S.unpack input

337+ mapM_ (msWrite ms) $ map S.singleton $ S.unpack input

342− msClose handle

343 atomically $ do

338 atomically $ do

344 count <- readTVar countVar

339 count <- readTVar countVar

345 check $ count == 2

340 check $ count == 2

@@ -360,20 +355,18 @@ spec = do

360 E.throwIO (e :: E.SomeException)

355 E.throwIO (e :: E.SomeException)

361 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

356 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

362 f $ responseLBS status200 [] ""

357 f $ responseLBS status200 [] ""

363− withApp (setTimeout 1 defaultSettings) app $ \port -> do

358+ withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do

364 let bs1 = S.replicate 2048 88

359 let bs1 = S.replicate 2048 88

365 bs2 = "This is short"

360 bs2 = "This is short"

366 bs = S.append bs1 bs2

361 bs = S.append bs1 bs2

367− handle <- connectTo port

368− msWrite handle "POST / HTTP/1.1\r\n"

362+ msWrite ms "POST / HTTP/1.1\r\n"

369− msWrite handle "content-length: "

363+ msWrite ms "content-length: "

370− msWrite handle $ S8.pack $ show $ S.length bs

364+ msWrite ms $ S8.pack $ show $ S.length bs

371− msWrite handle "\r\n\r\n"

365+ msWrite ms "\r\n\r\n"

372 threadDelay 100000

366 threadDelay 100000

373− msWrite handle bs1

367+ msWrite ms bs1

374 threadDelay 100000

368 threadDelay 100000

375− msWrite handle bs2

369+ msWrite ms bs2

376− msClose handle

377 threadDelay 5000000

370 threadDelay 5000000

378 front <- I.readIORef ifront

371 front <- I.readIORef ifront

379 S.concat (front []) `shouldBe` bs

372 S.concat (front []) `shouldBe` bs

@@ -389,8 +382,7 @@ spec = do

389 loop

382 loop

390 loop

383 loop

391 doubleBS = S.concatMap $ \w -> S.pack [w, w]

384 doubleBS = S.concatMap $ \w -> S.pack [w, w]

392− withApp defaultSettings app $ \port -> do

385+ withApp defaultSettings app $ withMySocket $ \ms -> do

393− ms <- connectTo port

394 msWrite ms "POST / HTTP/1.1\r\n\r\n12345"

386 msWrite ms "POST / HTTP/1.1\r\n\r\n12345"

395 timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455")

387 timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455")

396 msWrite ms "67890"

388 msWrite ms "67890"

@@ -418,15 +410,14 @@ spec = do

418 atomically $ modifyTVar countVar (+ 1)

410 atomically $ modifyTVar countVar (+ 1)

419 loop

411 loop

420 loop

412 loop

421− withApp defaultSettings app $ \port -> do

413+ withApp defaultSettings app $ withMySocket $ \ms -> do

422− (sock, _addr) <- getSocketTCP "127.0.0.1" port

423− sendAll sock "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"

414+ msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"

424 threadDelay 10000

415 threadDelay 10000

425− sendAll sock "5\r\nhello\r\n0\r\n\r\n"

416+ msWrite ms "5\r\nhello\r\n0\r\n\r\n"

426 atomically $ do

417 atomically $ do

427 count <- readTVar countVar

418 count <- readTVar countVar

428 check $ count >= 1

419 check $ count >= 1

429− bs <- safeRecv sock 4096

420+ bs <- safeRecv (msSocket ms) 4096 -- must not use msRead

430 S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"

421 S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"

431

422

432 it "streaming response with length" $ do

423 it "streaming response with length" $ do