@@ -0,0 +1,57 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Network.Wai.Middleware.TimeoutSpec
4+ ( spec
5+ ) where
6+
7+import Test.Hspec
8+
9+import Control.Concurrent (threadDelay)
10+import Network.HTTP.Types (status200, status503, status504)
11+import Network.Wai
12+import Network.Wai.Middleware.Timeout
13+import Network.Wai.Test
14+
15+spec :: Spec
16+spec = do
17+ describe "timeout" $ do
18+ it "times out slow requests with 503" $ do
19+ let app _req respond = do
20+ threadDelay $ 2 * 1000000
21+ respond $ responseLBS status200 [] ""
22+
23+ resp <- runApp $ timeout 1 app
24+
25+ simpleStatus resp `shouldBe` status503
26+
27+ it "does not time out fast requests" $ do
28+ let app _req respond = respond $ responseLBS status200 [] ""
29+
30+ resp <- runApp $ timeout 3 app
31+
32+ simpleStatus resp `shouldBe` status200
33+
34+ describe "timeoutStatus" $ do
35+ it "allows customizing the timeout response status" $ do
36+ let app _req respond = do
37+ threadDelay $ 2 * 1000000
38+ respond $ responseLBS status200 [] ""
39+
40+ resp <- runApp $ timeoutStatus status504 1 app
41+
42+ simpleStatus resp `shouldBe` status504
43+
44+ describe "timeoutAs" $ do
45+ it "allows customizing the timeout response" $ do
46+ let app _req respond = do
47+ threadDelay $ 2 * 1000000
48+ respond $ responseLBS status200 [] ""
49+ timeoutResponse = responseLBS status503 [("X-Timeout", "1")] ""
50+
51+ resp <- runApp $ timeoutAs timeoutResponse 1 app
52+
53+ simpleStatus resp `shouldBe` status503
54+ simpleHeaders resp `shouldBe` [("X-Timeout", "1")]
55+
56+runApp :: Application -> IO SResponse
57+runApp = runSession $ request defaultRequest