wai-extra 3.0.14.3 → 3.0.15

raw patch · 4 files changed

+120/−34 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/Wai/Request.hs +53/−3
• test/Network/Wai/RequestSpec.hs +58/−28
• wai-extra.cabal +5/−3

@@ -1,3 +1,7 @@+## 3.0.15++* add requestSizeCheck [#525](https://github.com/yesodweb/wai/pull/525)+ ## 3.0.14.3  * Add missing `requestHeaderReferer` and `requestHeaderUserAgent` fields to CGI [yesod#1186](https://github.com/yesodweb/yesod/issues/1186)

@@ -1,18 +1,26 @@+{-# LANGUAGE DeriveDataTypeable #-} -- | Some helpers for interrogating a WAI 'Request'.  module Network.Wai.Request     ( appearsSecure     , guessApproot+    , RequestSizeException(..)+    , requestSizeCheck     ) where  import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Network.HTTP.Types (HeaderName)-import Network.Wai (Request, isSecure, requestHeaders, requestHeaderHost)+import Network.Wai  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C+import Control.Exception (Exception, throwIO)+import Data.Typeable (Typeable)+import Data.Word (Word64)+import Data.IORef (atomicModifyIORef', newIORef) + -- | Does this request appear to have been made over an SSL connection? -- -- This function first checks @'isSecure'@, but also checks for headers that may@@ -24,7 +32,7 @@ -- force a non-SSL request to SSL by redirect. One can safely choose not to -- redirect when the request /appears/ secure, even if it's actually not. ----- Since 3.0.7+-- @since 3.0.7 appearsSecure :: Request -> Bool appearsSecure request = isSecure request || any (uncurry matchHeader)     [ ("HTTPS"                  , (== "on"))@@ -44,8 +52,50 @@ -- application. For more information and relevant caveats, please see -- "Network.Wai.Middleware.Approot". ----- Since 3.0.7+-- @since 3.0.7 guessApproot :: Request -> ByteString guessApproot req =     (if appearsSecure req then "https://" else "http://") `S.append`     (fromMaybe "localhost" $ requestHeaderHost req)++-- | see 'requestSizeCheck'+--+-- @since 3.0.15+data RequestSizeException+    = RequestSizeException Word64+    deriving (Eq, Ord, Typeable)++instance Exception RequestSizeException++instance Show RequestSizeException where+    showsPrec p (RequestSizeException limit) =+        showString ("Request Body is larger than ") . showsPrec p limit . showString " bytes."++-- | Check request body size to avoid server crash when request is too large.+--+-- This function first checks @'requestBodyLength'@, if content-length is known+-- but larger than limit, or it's unknown but we have received too many chunks,+-- a 'RequestSizeException' are thrown when user use @'requestBody'@ to extract+-- request body inside IO.+--+-- @since 3.0.15+requestSizeCheck :: Word64 -> Request -> IO Request+requestSizeCheck maxSize req =+    case requestBodyLength req of+        KnownLength len  ->+            if len > maxSize+                then return $ req { requestBody = throwIO (RequestSizeException maxSize) }+                else return req+        ChunkedBody      -> do+            currentSize <- newIORef 0+            return $ req+                { requestBody = do+                    bs <- requestBody req+                    total <-+                        atomicModifyIORef' currentSize $ \sz ->+                            let nextSize = sz + fromIntegral (S.length bs)+                            in (nextSize, nextSize)+                    if total > maxSize+                    then throwIO (RequestSizeException maxSize)+                    else return bs+                }

@@ -8,52 +8,82 @@  import Data.ByteString (ByteString) import Network.HTTP.Types (HeaderName)-import Network.Wai (Request(..), defaultRequest)+import Network.Wai (Request(..), defaultRequest, RequestBodyLength(..))  import Network.Wai.Request+import Control.Exception (try)+import Control.Monad (forever)  main :: IO () main = hspec spec  spec :: Spec-spec = describe "appearsSecure" $ do-    let insecureRequest = defaultRequest-            { isSecure = False-            , requestHeaders =-                [ ("HTTPS", "off")-                , ("HTTP_X_FORWARDED_SSL", "off")-                , ("HTTP_X_FORWARDED_SCHEME", "http")-                , ("HTTP_X_FORWARDED_PROTO", "http,xyz")-                ]-            }+spec = do+    describe "requestSizeCheck" $ do+        it "too large content length should throw RequestSizeException" $ do+            let limit = 1024+                largeRequest = defaultRequest+                    { isSecure = False+                    , requestBodyLength = KnownLength (limit + 1)+                    , requestBody = return "repeat this chunk"+                    }+            checkedRequest <- requestSizeCheck limit largeRequest+            body <- try (requestBody checkedRequest)+            case body of+                Left (RequestSizeException l) -> l `shouldBe` limit+                Right _   -> expectationFailure "request size check failed" -    it "returns False for an insecure request" $-        insecureRequest `shouldSatisfy` not . appearsSecure+        it "too many chunks should throw RequestSizeException" $ do+            let limit = 1024+                largeRequest = defaultRequest+                    { isSecure = False+                    , requestBodyLength = ChunkedBody+                    , requestBody = return "repeat this chunk"+                    }+            checkedRequest <- requestSizeCheck limit largeRequest+            body <- try (forever $ requestBody checkedRequest)+            case body of+                Left (RequestSizeException l) -> l `shouldBe` limit+                Right _   -> expectationFailure "request size check failed" -    it "checks if the Request is actually secure" $ do-        let req = insecureRequest { isSecure = True }+    describe "appearsSecure" $ do+        let insecureRequest = defaultRequest+                { isSecure = False+                , requestHeaders =+                    [ ("HTTPS", "off")+                    , ("HTTP_X_FORWARDED_SSL", "off")+                    , ("HTTP_X_FORWARDED_SCHEME", "http")+                    , ("HTTP_X_FORWARDED_PROTO", "http,xyz")+                    ]+                } -        req `shouldSatisfy` appearsSecure+        it "returns False for an insecure request" $+            insecureRequest `shouldSatisfy` not . appearsSecure -    it "checks for HTTP: on" $ do-        let req = addHeader "HTTPS" "on" insecureRequest+        it "checks if the Request is actually secure" $ do+            let req = insecureRequest { isSecure = True } -        req `shouldSatisfy` appearsSecure+            req `shouldSatisfy` appearsSecure -    it "checks for HTTP_X_FORWARDED_SSL: on" $ do-        let req = addHeader "HTTP_X_FORWARDED_SSL" "on" insecureRequest+        it "checks for HTTP: on" $ do+            let req = addHeader "HTTPS" "on" insecureRequest -        req `shouldSatisfy` appearsSecure+            req `shouldSatisfy` appearsSecure -    it "checks for HTTP_X_FORWARDED_SCHEME: https" $ do-        let req = addHeader "HTTP_X_FORWARDED_SCHEME" "https" insecureRequest+        it "checks for HTTP_X_FORWARDED_SSL: on" $ do+            let req = addHeader "HTTP_X_FORWARDED_SSL" "on" insecureRequest -        req `shouldSatisfy` appearsSecure+            req `shouldSatisfy` appearsSecure -    it "checks for HTTP_X_FORWARDED_PROTO: https,..." $ do-        let req = addHeader "HTTP_X_FORWARDED_PROTO" "https,xyz" insecureRequest+        it "checks for HTTP_X_FORWARDED_SCHEME: https" $ do+            let req = addHeader "HTTP_X_FORWARDED_SCHEME" "https" insecureRequest -        req `shouldSatisfy` appearsSecure+            req `shouldSatisfy` appearsSecure++        it "checks for HTTP_X_FORWARDED_PROTO: https,..." $ do+            let req = addHeader "HTTP_X_FORWARDED_PROTO" "https,xyz" insecureRequest++            req `shouldSatisfy` appearsSecure  addHeader :: HeaderName -> ByteString -> Request -> Request addHeader name value req = req

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.14.3+Version:             3.0.15 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -71,7 +71,7 @@ Homepage:            http://github.com/yesodweb/wai Category:            Web Build-Type:          Simple-Cabal-Version:       >=1.8+Cabal-Version:       >=1.10 Stability:           Stable extra-source-files:   test/requests/dalvik-request@@ -119,7 +119,7 @@   else       build-depends: unix -  extensions:        OverloadedStrings+  default-extensions:        OverloadedStrings    Exposed-modules:   Network.Wai.Handler.CGI                      Network.Wai.Handler.SCGI@@ -151,6 +151,7 @@                      Network.Wai.EventSource                      Network.Wai.EventSource.EventStream   other-modules:     Network.Wai.Middleware.RequestLogger.Internal+  default-language:          Haskell2010   ghc-options:       -Wall  test-suite spec@@ -182,6 +183,7 @@                    , time                    , case-insensitive     ghc-options:     -Wall+    default-language:          Haskell2010  source-repository head   type:     git