diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for wai-extra +## 3.1.1 + +* 'Network.Wai.Middleware.RequestSizeLimit': Add a new middleware to reject request bodies above a certain size. [#818](https://github.com/yesodweb/wai/pull/818/files) + ## 3.1.0 * `Network.Wai.Test`: Add support for source locations to assertion primitives [#817](https://github.com/yesodweb/wai/pull/817) diff --git a/Network/Wai/Middleware/RequestSizeLimit.hs b/Network/Wai/Middleware/RequestSizeLimit.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Middleware/RequestSizeLimit.hs @@ -0,0 +1,73 @@ +-- | The functions in this module allow you to limit the total size of incoming request bodies. +-- +-- Limiting incoming request body size helps protect your server against denial-of-service (DOS) attacks, +-- in which an attacker sends huge bodies to your server. +module Network.Wai.Middleware.RequestSizeLimit + ( + -- * Middleware + requestSizeLimitMiddleware + -- * Constructing 'RequestSizeLimitSettings' + , defaultRequestSizeLimitSettings + -- * 'RequestSizeLimitSettings' and accessors + , RequestSizeLimitSettings + , setMaxLengthForRequest + , setOnLengthExceeded + ) where + +import Network.Wai +import Network.Wai.Request +import qualified Data.ByteString.Lazy as BSL +import Data.Word (Word64) +import Network.HTTP.Types.Status (requestEntityTooLarge413) +import qualified Data.ByteString.Lazy.Char8 as LS8 +import Control.Exception (try, catch) +import Data.Monoid ((<>)) +import Network.Wai.Middleware.RequestSizeLimit.Internal (RequestSizeLimitSettings(..), setMaxLengthForRequest, setOnLengthExceeded) + +-- | Create a 'RequestSizeLimitSettings' with these settings: +-- +-- * 2MB size limit for all requests +-- * When the limit is exceeded, return a plain text response describing the error, with a 413 status code. +-- +-- @since 3.1.1 +defaultRequestSizeLimitSettings :: RequestSizeLimitSettings +defaultRequestSizeLimitSettings = RequestSizeLimitSettings + { maxLengthForRequest = \_req -> pure $ Just $ 2 * 1024 * 1024 + , onLengthExceeded = \maxLen _app req sendResponse -> sendResponse (tooLargeResponse maxLen (requestBodyLength req)) + } + +-- | Middleware to limit request bodies to a certain size. +-- +-- This uses 'requestSizeCheck' under the hood; see that function for details. +-- +-- @since 3.1.1 +requestSizeLimitMiddleware :: RequestSizeLimitSettings -> Middleware +requestSizeLimitMiddleware settings app req sendResponse = do + maybeMaxLen <- (maxLengthForRequest settings) req + + case maybeMaxLen of + Nothing -> app req sendResponse + Just maxLen -> do + eitherSizeExceptionOrNewReq <- try (requestSizeCheck maxLen req) + case eitherSizeExceptionOrNewReq of + -- In the case of a known-length request, RequestSizeException will be thrown immediately + Left (RequestSizeException _maxLen) -> handleLengthExceeded maxLen + -- In the case of a chunked request (unknown length), RequestSizeException will be thrown during the processing of a body + Right newReq -> app newReq sendResponse `catch` \(RequestSizeException _maxLen) -> handleLengthExceeded maxLen + + where + handleLengthExceeded maxLen = (onLengthExceeded settings) maxLen app req sendResponse + +tooLargeResponse :: Word64 -> RequestBodyLength -> Response +tooLargeResponse maxLen bodyLen = responseLBS + requestEntityTooLarge413 + [("Content-Type", "text/plain")] + (BSL.concat + [ "Request body too large to be processed. The maximum size is " + , (LS8.pack (show maxLen)) + , " bytes; your request body was " + , case bodyLen of + KnownLength knownLen -> (LS8.pack (show knownLen)) <> " bytes." + ChunkedBody -> "split into chunks, whose total size is unknown, but exceeded the limit." + , " . If you're the developer of this site, you can configure the maximum length with `requestSizeLimitMiddleware`." + ]) diff --git a/Network/Wai/Middleware/RequestSizeLimit/Internal.hs b/Network/Wai/Middleware/RequestSizeLimit/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Middleware/RequestSizeLimit/Internal.hs @@ -0,0 +1,57 @@ +-- | Internal constructors and helper functions. Note that no guarantees are given for stability of these interfaces. +module Network.Wai.Middleware.RequestSizeLimit.Internal + ( RequestSizeLimitSettings(..) + , setMaxLengthForRequest + , setOnLengthExceeded + ) where + +import Network.Wai +import Data.Word (Word64) + +-- | Settings to configure 'requestSizeLimitMiddleware'. +-- +-- This type (but not the constructor, or record fields) is exported from "Network.Wai.Middleware.RequestSizeLimit". +-- Since the constructor isn't exported, create a default value with 'defaultRequestSizeLimitSettings' first, +-- then set the values using 'setMaxLengthForRequest' and 'setOnLengthExceeded' (See the examples below). +-- +-- If you need to access the constructor directly, it's exported from "Network.Wai.Middleware.RequestSizeLimit.Internal". +-- +-- ==== __Examples__ +-- +-- ===== Conditionally setting the limit based on the request +-- > {-# LANGUAGE OverloadedStrings #-} +-- > import Network.Wai +-- > import Network.Wai.Middleware.RequestSizeLimit +-- > +-- > let megabyte = 1024 * 1024 +-- > let sizeForReq req = if pathInfo req == ["upload", "image"] then pure $ Just $ megabyte * 20 else pure $ Just $ megabyte * 2 +-- > let finalSettings = setMaxLengthForRequest sizeForReq defaultRequestSizeLimitSettings +-- +-- ===== JSON response +-- > {-# LANGUAGE OverloadedStrings #-} +-- > import Network.Wai +-- > import Network.Wai.Middleware.RequestSizeLimit +-- > import Network.HTTP.Types.Status (requestEntityTooLarge413) +-- > import Data.Aeson +-- > import Data.Text (Text) +-- > +-- > let jsonResponse = \_maxLen _app _req sendResponse -> sendResponse $ responseLBS requestEntityTooLarge413 [("Content-Type", "application/json")] (encode $ object ["error" .= ("request size too large" :: Text)]) +-- > let finalSettings = setOnLengthExceeded jsonResponse defaultRequestSizeLimitSettings +-- +-- @since 3.1.1 +data RequestSizeLimitSettings = RequestSizeLimitSettings + { maxLengthForRequest :: Request -> IO (Maybe Word64) -- ^ Function to determine the maximum request size in bytes for the request. Return 'Nothing' for no limit. Since 3.1.1 + , onLengthExceeded :: Word64 -> Middleware -- ^ Callback function when maximum length is exceeded. The 'Word64' argument is the limit computed by 'maxLengthForRequest'. Since 3.1.1 + } + +-- | Function to determine the maximum request size in bytes for the request. Return 'Nothing' for no limit. +-- +-- @since 3.1.1 +setMaxLengthForRequest :: (Request -> IO (Maybe Word64)) -> RequestSizeLimitSettings -> RequestSizeLimitSettings +setMaxLengthForRequest fn settings = settings { maxLengthForRequest = fn } + +-- | Callback function when maximum length is exceeded. The 'Word64' argument is the limit computed by 'setMaxLengthForRequest'. +-- +-- @since 3.1.1 +setOnLengthExceeded :: (Word64 -> Middleware) -> RequestSizeLimitSettings -> RequestSizeLimitSettings +setOnLengthExceeded fn settings = settings { onLengthExceeded = fn } diff --git a/wai-extra.cabal b/wai-extra.cabal --- a/wai-extra.cabal +++ b/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.1.0 +Version: 3.1.1 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality: @@ -157,6 +157,8 @@ Network.Wai.Test.Internal Network.Wai.EventSource Network.Wai.EventSource.EventStream + Network.Wai.Middleware.RequestSizeLimit + Network.Wai.Middleware.RequestSizeLimit.Internal other-modules: Network.Wai.Middleware.RequestLogger.Internal default-language: Haskell2010 ghc-options: -Wall @@ -206,6 +208,7 @@ , time , case-insensitive , http2 + , aeson ghc-options: -Wall default-language: Haskell2010