2164105 · typeable/wai

git.iko.soy/typeable/wai

refactoring test.

commit2164105cd0edd7c54d2cd4bfcb1b5044ea456c9e authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 15 Sep 2015, 16:04 (11 years ago) parent873b675

4 files changed+40−26

compare with master

unifiedsplit

warp/test/ExceptionSpec.hs+3−18 warp/test/HTTP.hs+29 warp/test/RunSpec.hs+7−8 warp/warp.cabal+1

warp/test/ExceptionSpec.hs+3−18

@@ -6,8 +6,6 @@ module ExceptionSpec (main, spec) where

66import Control.Applicative

77#endif

88import Control.Monad

9−import Network.HTTP

10−import Network.Stream

119import Network.HTTP.Types hiding (Header)

1210import Network.Wai hiding (Response)

1311import Network.Wai.Internal (Request(..))

@@ -18,6 +16,8 @@ import qualified Data.Streaming.Network as N

1816import Control.Concurrent.Async (withAsync)

1917import Network.Socket (sClose)

2018

19+import HTTP

20+

2121main :: IO ()

2222main = hspec spec

2323

@@ -62,20 +62,5 @@ spec = describe "responds even if there is an exception" $ do

6262 sc `shouldBe` (5,0,0)

6363 -}

6464 it "ioException" $ withTestServer $ \prt -> do

65− sc <- rspCode <$> sendGET (concat $ ["http://127.0.0.1:", show prt, "/ioException"])

65+ sc <- rspCode <$> sendGET ("http://127.0.0.1:" ++ show prt ++ "/ioException")

6666 sc `shouldBe` (5,0,0)

67−

68−----------------------------------------------------------------

69−

70−sendGET :: String -> IO (Response String)

71−sendGET url = sendGETwH url []

72−

73−sendGETwH :: String -> [Header] -> IO (Response String)

74−sendGETwH url hdr = unResult $ simpleHTTP $ (getRequest url) { rqHeaders = hdr }

75−

76−unResult :: IO (Result (Response String)) -> IO (Response String)

77−unResult action = do

78− res <- action

79− case res of

80− Right rsp -> return rsp

81− Left _ -> error "Connection error"

warp/test/HTTP.hsnew file+29

@@ -0,0 +1,29 @@

1+module HTTP (

2+ sendGET

3+ , sendGETwH

4+ , rspBody

5+ , rspCode

6+ , getHeaderValue

7+ , HeaderName(..)

8+ ) where

10+import Network.HTTP

11+import Network.Stream

12+

13+sendGET :: String -> IO (Response String)

14+sendGET url = sendGETwH url []

15+

16+sendGETwH :: String -> [Header] -> IO (Response String)

17+sendGETwH url hdr = unResult $ simpleHTTP $ (getRequest url) { rqHeaders = hdr }

18+

19+unResult :: IO (Result (Response String)) -> IO (Response String)

20+unResult action = do

21+ res <- action

22+ case res of

23+ Right rsp -> return rsp

24+ Left _ -> error "Connection error"

25+

26+getHeaderValue :: HasHeaders a => HeaderName -> a -> Maybe String

27+getHeaderValue key r = case retrieveHeaders key r of

28+ [] -> Nothing

29+ x:_ -> Just $ hdrValue x

warp/test/RunSpec.hs+7−8

@@ -18,7 +18,6 @@ import qualified Data.ByteString.Lazy as L

1818import qualified Data.IORef as I

1919import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv)

2020import Network (connectTo, PortID (PortNumber))

21−import qualified Network.HTTP as HTTP

2221import Network.HTTP.Types

2322import Network.Socket (sClose)

2423import Network.Socket.ByteString (sendAll)

@@ -29,6 +28,8 @@ import System.IO.Unsafe (unsafePerformIO)

2928import System.Timeout (timeout)

3029import Test.Hspec

3130

31+import HTTP

32+

3233main :: IO ()

3334main = hspec spec

3435

@@ -349,11 +350,9 @@ spec = do

349350 , ("date", "date")

350351 ] ""

351352 withApp defaultSettings app $ \port -> do

352− Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

353− map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrServer res)

354− `shouldBe` ["server"]

355− map HTTP.hdrValue (HTTP.retrieveHeaders HTTP.HdrDate res)

356− `shouldBe` ["date"]

353+ res <- sendGET $ "http://127.0.0.1:" ++ show port

354+ getHeaderValue HdrServer res `shouldBe` Just "server"

355+ getHeaderValue HdrDate res `shouldBe` Just "date"

357356

358357 it "streaming echo #249" $ do

359358 let app req f = f $ responseStream status200 [] $ \write _ -> do

@@ -375,8 +374,8 @@ spec = do

375374 let app _ f = f $ responseStream status200 [("content-length", "20")] $ \write _ -> do

376375 replicateM_ 4 $ write $ byteString "Hello"

377376 withApp defaultSettings app $ \port -> do

378− Right res <- HTTP.simpleHTTP (HTTP.getRequest $ "http://127.0.0.1:" ++ show port)

379− HTTP.rspBody res `shouldBe` "HelloHelloHelloHello"

377+ res <- sendGET $ "http://127.0.0.1:" ++ show port

378+ rspBody res `shouldBe` "HelloHelloHelloHello"

380379

381380consumeBody :: IO ByteString -> IO [ByteString]

382381consumeBody body =

warp/warp.cabal+1

@@ -125,6 +125,7 @@ Test-Suite spec

125125 ResponseSpec

126126 RunSpec

127127 SendFileSpec

128+ HTTP

128129 Hs-Source-Dirs: test, .

129130 Type: exitcode-stdio-1.0

130131