wai-extra 3.0.23.0 → 3.0.24.0

raw patch · 4 files changed

+97/−1 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• ChangeLog.md +4/−0
• Network/Wai/Middleware/Timeout.hs +33/−0
• test/Network/Wai/Middleware/TimeoutSpec.hs +57/−0
• wai-extra.cabal +3/−1

@@ -1,3 +1,7 @@+## 3.0.24.0++* Add timeout middleware [#702](https://github.com/yesodweb/wai/pull/702).+ ## 3.0.23.0  * Add rewriteRoot middleware [#697](https://github.com/yesodweb/wai/pull/697).

@@ -0,0 +1,33 @@+-- | Timeout requests+module Network.Wai.Middleware.Timeout+    ( timeout+    , timeoutStatus+    , timeoutAs+    ) where++import Network.HTTP.Types (Status, status503)+import Network.Wai+import qualified System.Timeout as Timeout++-- | Time out the request after the given number of seconds+--+-- Timeouts respond with @'status503'@. See @'timeoutStatus'@ or @'timeoutAs'@+-- to customize the behavior of the timed-out case.+--+-- @since 3.0.24.0@+timeout :: Int -> Middleware+timeout = timeoutStatus status503++-- | Time out with the given @'Status'@+--+-- @since 3.0.24.0@+timeoutStatus :: Status -> Int -> Middleware+timeoutStatus status = timeoutAs $ responseLBS status [] ""++-- | Time out with the given @'Response'@+--+-- @since 3.0.24.0@+timeoutAs :: Response -> Int -> Middleware+timeoutAs timeoutReponse seconds app req respond =+    maybe (respond timeoutReponse) pure+        =<< Timeout.timeout (seconds * 1000000) (app req respond)

@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Middleware.TimeoutSpec+    ( spec+    ) where++import Test.Hspec++import Control.Concurrent (threadDelay)+import Network.HTTP.Types (status200, status503, status504)+import Network.Wai+import Network.Wai.Middleware.Timeout+import Network.Wai.Test++spec :: Spec+spec = do+    describe "timeout" $ do+        it "times out slow requests with 503" $ do+            let app _req respond = do+                    threadDelay $ 2 * 1000000+                    respond $ responseLBS status200 [] ""++            resp <- runApp $ timeout 1 app++            simpleStatus resp `shouldBe` status503++        it "does not time out fast requests" $ do+            let app _req respond = respond $ responseLBS status200 [] ""++            resp <- runApp $ timeout 3 app++            simpleStatus resp `shouldBe` status200++    describe "timeoutStatus" $ do+        it "allows customizing the timeout response status" $ do+            let app _req respond = do+                    threadDelay $ 2 * 1000000+                    respond $ responseLBS status200 [] ""++            resp <- runApp $ timeoutStatus status504 1 app++            simpleStatus resp `shouldBe` status504++    describe "timeoutAs" $ do+        it "allows customizing the timeout response" $ do+            let app _req respond = do+                    threadDelay $ 2 * 1000000+                    respond $ responseLBS status200 [] ""+                timeoutResponse = responseLBS status503 [("X-Timeout", "1")] ""++            resp <- runApp $ timeoutAs timeoutResponse 1 app++            simpleStatus resp `shouldBe` status503+            simpleHeaders resp `shouldBe` [("X-Timeout", "1")]++runApp :: Application -> IO SResponse+runApp = runSession $ request defaultRequest

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.23.0+Version:             3.0.24.0 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -148,6 +148,7 @@                      Network.Wai.Middleware.ForceDomain                      Network.Wai.Middleware.ForceSSL                      Network.Wai.Middleware.Routed+                     Network.Wai.Middleware.Timeout                      Network.Wai.Parse                      Network.Wai.Request                      Network.Wai.UrlMap@@ -186,6 +187,7 @@                      Network.Wai.Middleware.ForceSSLSpec                      Network.Wai.Middleware.RoutedSpec                      Network.Wai.Middleware.StripHeadersSpec+                     Network.Wai.Middleware.TimeoutSpec                      WaiExtraSpec     build-depends:   base                      >= 4        && < 5                    , wai-extra