wai-extra 3.1.5 → 3.1.6
raw patch · 5 files changed
+123/−17 lines, 5 filesdep −deepseqdep −old-localedep −unix-compatdep ~directory
Dependencies removed: deepseq, old-locale, unix-compat, void
Dependency ranges changed: directory
Files
- ChangeLog.md +4/−0
- Network/Wai/Middleware/StreamFile.hs +1/−6
- Network/Wai/Test.hs +0/−3
- test/Network/Wai/Middleware/RequestSizeLimitSpec.hs +114/−0
- wai-extra.cabal +4/−8
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for wai-extra +## 3.1.6++* Remove unused dependencies [#837](https://github.com/yesodweb/wai/pull/837)+ ## 3.1.5 * `Network.Wai.Middleware.RealIp`: Add a new middleware to infer the remote IP address from headers [#834](https://github.com/yesodweb/wai/pull/834)
Network/Wai/Middleware/StreamFile.hs view
@@ -8,7 +8,7 @@ import Network.Wai.Internal import Network.Wai (Middleware, responseToStream) import qualified Data.ByteString.Char8 as S8-import System.PosixCompat (getFileStatus, fileSize, FileOffset)+import System.Directory (getFileSize) import Network.HTTP.Types (hContentLength) -- |Convert ResponseFile type responses into ResponseStream type@@ -36,8 +36,3 @@ let hs' = (hContentLength, (S8.pack (show len))) : hs sendResponse $ responseStream s hs' body _ -> sendResponse res--getFileSize :: FilePath -> IO FileOffset-getFileSize path = do- stat <- getFileStatus path- return (fileSize stat)
Network/Wai/Test.hs view
@@ -44,9 +44,6 @@ import qualified Control.Monad.Trans.State as ST import Control.Monad.Trans.Reader (runReaderT, ask) import Control.Monad (unless)-import Control.DeepSeq (deepseq)-import Control.Exception (throwIO, Exception)-import Data.Typeable (Typeable) import qualified Data.Map as Map import qualified Web.Cookie as Cookie import Data.ByteString (ByteString)
+ test/Network/Wai/Middleware/RequestSizeLimitSpec.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.RequestSizeLimitSpec (main, spec) where++import Test.Hspec++import Network.Wai+import Network.Wai.Test+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S8+import Network.Wai.Middleware.RequestSizeLimit+import Network.HTTP.Types.Status (status200, status413)+import Control.Monad (replicateM)+import Data.Aeson (encode, object, (.=))+import Data.Text (Text)++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "RequestSizeLimitMiddleware" $ do+ describe "Plain text response" $ do+ runStrictBodyTests "returns 413 for request bodies > 10 bytes, when streaming the whole body" tenByteLimitSettings "1234567890a" isStatus413+ runStrictBodyTests "returns 200 for request bodies <= 10 bytes, when streaming the whole body" tenByteLimitSettings "1234567890" isStatus200++ describe "JSON response" $ do+ runStrictBodyTests "returns 413 for request bodies > 10 bytes, when streaming the whole body" tenByteLimitJSONSettings "1234567890a" (isStatus413 >> isJSONContentType)+ runStrictBodyTests "returns 200 for request bodies <= 10 bytes, when streaming the whole body" tenByteLimitJSONSettings "1234567890" (isStatus200)++ describe "Per-request sizes" $ do++ it "allows going over the limit, when the path has been whitelisted" $ do+ let req = SRequest defaultRequest+ { pathInfo = ["upload", "image"]+ } "1234567890a"+ settings =+ setMaxLengthForRequest + (\req -> if pathInfo req == ["upload", "image"] then pure $ Just 20 else pure $ Just 10)+ defaultRequestSizeLimitSettings+ resp <- runStrictBodyApp settings req+ isStatus200 resp++ describe "streaming chunked bodies" $ do+ let streamingReq = defaultRequest+ { isSecure = False+ , requestBodyLength = ChunkedBody+ , requestBody = return "a"+ }+ it "413s if the combined chunk size is > the size limit" $ do+ resp <- runStreamingChunkApp 11 tenByteLimitSettings streamingReq+ simpleStatus resp `shouldBe` status413+ it "200s if the combined chunk size is <= the size limit" $ do+ resp <- runStreamingChunkApp 10 tenByteLimitSettings streamingReq+ simpleStatus resp `shouldBe` status200++ where+ tenByteLimitSettings = + setMaxLengthForRequest+ (\_req -> pure $ Just 10)+ defaultRequestSizeLimitSettings+ tenByteLimitJSONSettings = + setOnLengthExceeded+ (\_maxLen _app _req sendResponse -> sendResponse $ responseLBS status413 [("Content-Type", "application/json")] (encode $ object ["error" .= ("request size too large" :: Text)]))+ tenByteLimitSettings++ isStatus413 = \sResp -> simpleStatus sResp `shouldBe` status413+ isStatus200 = \sResp -> simpleStatus sResp `shouldBe` status200+ isJSONContentType = \sResp -> simpleHeaders sResp `shouldBe` [("Content-Type", "application/json")]++data LengthType = UseKnownLength | UseChunked+ deriving (Show, Eq)++runStrictBodyTests :: String -> RequestSizeLimitSettings -> ByteString -> (SResponse -> Expectation) -> Spec+runStrictBodyTests name settings requestBody runExpectations = describe name $ do+ it "chunked" $ do+ let req = mkRequestWithBytestring requestBody UseChunked+ resp <- runStrictBodyApp settings req++ runExpectations resp+ it "non-chunked" $ do+ let req = mkRequestWithBytestring requestBody UseKnownLength+ resp <- runStrictBodyApp settings req++ runExpectations resp+ where+ mkRequestWithBytestring :: ByteString -> LengthType -> SRequest+ mkRequestWithBytestring body lengthType = SRequest defaultRequest+ { requestHeaders =+ if lengthType == UseKnownLength+ then [("content-length", S8.pack $ show $ S.length body)]+ else []+ , requestMethod = "POST"+ , requestBodyLength =+ if lengthType == UseKnownLength+ then KnownLength $ fromIntegral $ S.length body+ else ChunkedBody+ } $ L.fromChunks $ map S.singleton $ S.unpack body++runStrictBodyApp :: RequestSizeLimitSettings -> SRequest -> IO SResponse+runStrictBodyApp settings req = runSession+ (srequest req) $ (requestSizeLimitMiddleware settings) app+ where+ app req respond = do+ _body <- strictRequestBody req+ respond $ responseLBS status200 [] ""++runStreamingChunkApp :: Int -> RequestSizeLimitSettings -> Request -> IO SResponse+runStreamingChunkApp times settings req = runSession+ (request req) $ (requestSizeLimitMiddleware settings) app+ where+ app req respond = do+ _chunks <- replicateM times (getRequestBodyChunk req)+ respond $ responseLBS status200 [] ""
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name: wai-extra-Version: 3.1.5+Version: 3.1.6 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality:@@ -90,10 +90,9 @@ Build-Depends: base >= 4.10 && < 5 , bytestring >= 0.10.4 , wai >= 3.0.3.0 && < 3.3- , old-locale >= 1.0.0.2 && < 1.1 , time >= 1.1.4 , network >= 2.6.1.0- , directory >= 1.0.1+ , directory >= 1.2.7.0 , transformers >= 0.2.2 , http-types >= 0.7 , text >= 0.7@@ -103,16 +102,12 @@ , wai-logger >= 2.3.2 , ansi-terminal , resourcet >= 0.4.6 && < 1.3- , void >= 0.5 , containers , base64-bytestring , word8- , deepseq , streaming-commons >= 0.2- , unix-compat , cookie , vault- , zlib , aeson , iproute >= 1.7.8 , http2@@ -189,10 +184,11 @@ Network.Wai.RequestSpec Network.Wai.Middleware.ApprootSpec Network.Wai.Middleware.ForceSSLSpec+ Network.Wai.Middleware.RealIpSpec+ Network.Wai.Middleware.RequestSizeLimitSpec Network.Wai.Middleware.RoutedSpec Network.Wai.Middleware.StripHeadersSpec Network.Wai.Middleware.TimeoutSpec- Network.Wai.Middleware.RealIpSpec WaiExtraSpec build-depends: base >= 4 && < 5 , wai-extra