@@ -0,0 +1,71 @@
1+{-# LANGUAGE OverloadedStrings #-}
3+module ExceptionSpec (main, spec) where
5+import Control.Applicative
7+import Control.Concurrent (forkIO, threadDelay)
10+import Network.HTTP.Types hiding (Header)
11+import Network.Wai hiding (Response)
12+import Network.Wai.Handler.Warp
13+import System.IO.Unsafe (unsafePerformIO)
23+testApp :: Application
24+testApp (Network.Wai.Request {pathInfo = [x]})
25+ | x == "statusError" =
26+ return $ responseLBS undefined [] "foo"
27+ | x == "headersError" =
28+ return $ responseLBS ok200 undefined "foo"
29+ | x == "headerError" =
30+ return $ responseLBS ok200 [undefined] "foo"
32+ return $ responseLBS ok200 [] undefined
33+ | x == "ioException" = do
34+ void $ fail "ioException"
35+ return $ responseLBS ok200 [] "foo"
37+ return $ responseLBS ok200 [] "foo"
40+spec = unsafePerformIO $ (forkIO testServer >> threadDelay 100000 >>) $ return $
41+ describe "responds even if there is an exception" $ do
42+ it "statusError" $ do
43+ sc <- rspCode <$> sendGET "http://localhost:2345/statusError"
44+ sc `shouldBe` (5,0,0)
45+ it "headersError" $ do
46+ sc <- rspCode <$> sendGET "http://localhost:2345/headersError"
47+ sc `shouldBe` (5,0,0)
48+ it "headerError" $ do
49+ sc <- rspCode <$> sendGET "http://localhost:2345/headerError"
50+ sc `shouldBe` (5,0,0)
52+ sc <- rspCode <$> sendGET "http://localhost:2345/bodyError"
53+ sc `shouldBe` (5,0,0)
54+ it "ioException" $ do
55+ sc <- rspCode <$> sendGET "http://localhost:2345/ioException"
56+ sc `shouldBe` (5,0,0)
58+----------------------------------------------------------------
60+sendGET :: String -> IO (Response String)
61+sendGET url = sendGETwH url []
63+sendGETwH :: String -> [Header] -> IO (Response String)
64+sendGETwH url hdr = unResult $ simpleHTTP $ (getRequest url) { rqHeaders = hdr }
66+unResult :: IO (Result (Response String)) -> IO (Response String)
70+ Right rsp -> return rsp
71+ Left _ -> error "Connection error"