diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,73 @@ +# ChangeLog for wai + +## 3.2.5 + +* Add a `requestSendEarlyHints :: [Header] -> IO ()` field to `Request` for sending `103 Early Hints` responses. [#1085](https://github.com/yesodweb/wai/pull/1085) + +## 3.2.4 + +* Add helpers for modifying request headers: `modifyRequest` and `mapRequestHeaders`. [#710](https://github.com/yesodweb/wai/pull/710) [#952](https://github.com/yesodweb/wai/pull/952) +* Small documentation adjustments like adding more `@since` markers. [#952](https://github.com/yesodweb/wai/pull/952) +* Add `setRequestBodyChunks` to mirror `getRequestBodyChunk` and avoid deprecation warnings when using `requestBody` as a setter. [#949](https://github.com/yesodweb/wai/pull/949) +* Overhaul documentation of `Middleware`. [#858](https://github.com/yesodweb/wai/pull/858) + +## 3.2.3 + +* Add documentation recommending streaming request bodies. [#818](https://github.com/yesodweb/wai/pull/818) +* Add two functions, `consumeRequestBodyStrict` and `consumeRequestBodyLazy`, + that are synonyms for `strictRequestBody` and `lazyRequestBody`. [#818](https://github.com/yesodweb/wai/pull/818) + +## 3.2.2.1 + +* Fix missing reexport of `getRequestBodyChunk` [#753](https://github.com/yesodweb/wai/issues/753) + +## 3.2.2 + +* Deprecate `requestBody` in favor of the more clearly named `getRequestBodyChunk`. [#726](https://github.com/yesodweb/wai/pull/726) + +## 3.2.1.2 + +* Remove dependency on blaze-builder [#683](https://github.com/yesodweb/wai/pull/683) + +## 3.2.1.1 + +* Relax upper bound on bytestring-builder + +## 3.2.1 + +* add mapResponseStatus [#532](https://github.com/yesodweb/wai/pull/532) + +## 3.2.0.1 + +* Add missing changelog entry + +## 3.2.0 + +* Major version up due to breaking changes. We chose 3.2.0, not 3.1.0 + for consistency with Warp 3.2.0. +* The `Network.Wai.HTTP2` module was removed. +* `tryGetFileSize`, `hContentRange`, `hAcceptRanges`, `contentRangeHeader` and + `chooseFilePart`, `adjustForFilePart` and `parseByteRanges` were removed + from the `Network.Wai.Internal` module. +* New fields for `Request`: `requestHeaderReferer` and `requestHeaderUserAgent`. + +## 3.0.5.0 + +* Avoid using the `IsString` Builder instance + +## 3.0.4.0 + +* A new module `Network.Wai.HTTP2` is exported. + +## 3.0.3.0 + +* `mapResponseHeaders`, `ifRequest` and `modifyResponse` are exported. + +## 3.0.2.3 + +* Allow blaze-builder 0.4 + +## 3.0.2.2 + +* Clarify some documentation on `rawPathInfo`. [Relevant Github + discussion](https://github.com/yesodweb/wai/issues/325#issuecomment-69896780). diff --git a/Network/Wai.hs b/Network/Wai.hs --- a/Network/Wai.hs +++ b/Network/Wai.hs @@ -1,102 +1,136 @@ -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE CPP #-} -{-| +-- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response. +{-# OPTIONS_GHC -fno-warn-deprecations #-} -This module defines a generic web application interface. It is a common -protocol between web servers and web applications. +-- | +-- +-- This module defines a generic web application interface. It is a common +-- protocol between web servers and web applications. +-- +-- The overriding design principles here are performance and generality. To +-- address performance, this library uses a streaming interface for request and +-- response bodies, paired with bytestring's 'Builder' type. The advantages of a +-- streaming API over lazy IO have been debated elsewhere and so will not be +-- addressed here. However, helper functions like 'responseLBS' allow you to +-- continue using lazy IO if you so desire. +-- +-- Generality is achieved by removing many variables commonly found in similar +-- projects that are not universal to all servers. The goal is that the 'Request' +-- object contains only data which is meaningful in all circumstances. +-- +-- Please remember when using this package that, while your application may +-- compile without a hitch against many different servers, there are other +-- considerations to be taken when moving to a new backend. For example, if you +-- transfer from a CGI application to a FastCGI one, you might suddenly find you +-- have a memory leak. Conversely, a FastCGI application would be well served to +-- preload all templates from disk when first starting; this would kill the +-- performance of a CGI application. +-- +-- This package purposely provides very little functionality. You can find various +-- middlewares, backends and utilities on Hackage. Some of the most commonly used +-- include: +-- +-- [warp] +-- +-- [wai-extra] +module Network.Wai ( + -- * Types + Application, + Middleware, + ResponseReceived, -The overriding design principles here are performance and generality. To -address performance, this library is built on top of the conduit and -blaze-builder packages. The advantages of conduits over lazy IO have been -debated elsewhere and so will not be addressed here. However, helper functions -like 'responseLBS' allow you to continue using lazy IO if you so desire. + -- * Request + Request, + defaultRequest, + RequestBodyLength (..), -Generality is achieved by removing many variables commonly found in similar -projects that are not universal to all servers. The goal is that the 'Request' -object contains only data which is meaningful in all circumstances. + -- ** Request accessors + requestMethod, + httpVersion, + rawPathInfo, + rawQueryString, + requestHeaders, + isSecure, + remoteHost, + pathInfo, + queryString, + getRequestBodyChunk, + requestBody, + vault, + requestBodyLength, + requestHeaderHost, + requestHeaderRange, + requestHeaderReferer, + requestHeaderUserAgent, + requestSendEarlyHints, + -- $streamingRequestBodies + strictRequestBody, + consumeRequestBodyStrict, + lazyRequestBody, + consumeRequestBodyLazy, -Please remember when using this package that, while your application may -compile without a hitch against many different servers, there are other -considerations to be taken when moving to a new backend. For example, if you -transfer from a CGI application to a FastCGI one, you might suddenly find you -have a memory leak. Conversely, a FastCGI application would be well served to -preload all templates from disk when first starting; this would kill the -performance of a CGI application. + -- ** Request modifiers + setRequestBodyChunks, + mapRequestHeaders, -This package purposely provides very little functionality. You can find various -middlewares, backends and utilities on Hackage. Some of the most commonly used -include: + -- * Response + Response, + StreamingBody, + FilePart (..), -[warp] + -- ** Response composers + responseFile, + responseBuilder, + responseLBS, + responseStream, + responseRaw, -[wai-extra] + -- ** Response accessors + responseStatus, + responseHeaders, -[wai-test] + -- ** Response modifiers + responseToStream, + mapResponseHeaders, + mapResponseStatus, --} -module Network.Wai - ( - -- * Types - Application - , Middleware - , ResponseReceived - -- * Request - , Request - , defaultRequest - , RequestBodyLength (..) - -- ** Request accessors - , requestMethod - , httpVersion - , rawPathInfo - , rawQueryString - , requestHeaders - , isSecure - , remoteHost - , pathInfo - , queryString - , requestBody - , vault - , requestBodyLength - , requestHeaderHost - , requestHeaderRange - , strictRequestBody - , lazyRequestBody - -- * Response - , Response - , StreamingBody - , FilePart (..) - -- ** Response composers - , responseFile - , responseBuilder - , responseLBS - , responseStream - , responseRaw - -- * Response accessors - , responseStatus - , responseHeaders - , responseToStream - ) where + -- * Middleware composition + ifRequest, + modifyRequest, + modifyResponse, +) where -import Blaze.ByteString.Builder (Builder, fromLazyByteString) -import Blaze.ByteString.Builder (fromByteString) -import Control.Monad (unless) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L +import Control.Monad (unless) +import qualified Data.ByteString as B +import Data.ByteString.Builder ( + Builder, + byteString, + lazyByteString, + ) +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Lazy.Internal (defaultChunkSize) import qualified Data.ByteString.Lazy.Internal as LI -import Data.ByteString.Lazy.Internal (defaultChunkSize) -import Data.ByteString.Lazy.Char8 () -import Data.Function (fix) -import Data.Monoid (mempty) -import qualified Network.HTTP.Types as H -import Network.Socket (SockAddr (SockAddrInet)) -import Network.Wai.Internal -import qualified System.IO as IO -import System.IO.Unsafe (unsafeInterleaveIO) +import Data.Function (fix) +import qualified Network.HTTP.Types as H +import Network.Socket (SockAddr (SockAddrInet)) +import Network.Wai.Internal +import qualified System.IO as IO +import System.IO.Unsafe (unsafeInterleaveIO) ---------------------------------------------------------------- -- | Creating 'Response' from a file. -responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response +-- +-- Server implementations like @warp@ might disregard the t'Status' when +-- using 'responseFile', since the server might rework the response based on +-- headers or presence/absence of the file. +-- @warp@ does not do do any extra processing when sending file parts, though, +-- so be mindful of how each server implementation handles file responses. +-- +-- /The above was written when @warp-3.4.14@ was the newest version/ +-- +-- @since 2.0.0 +responseFile + :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile = ResponseFile -- | Creating 'Response' from 'Builder'. @@ -114,21 +148,25 @@ -- -- A2. No. If the ByteStrings are small, then they will be copied into a larger -- buffer, which should be a performance gain overall (less system calls). If --- they are already large, then blaze-builder uses an InsertByteString --- instruction to avoid copying. +-- they are already large, then an insert operation is used +-- to avoid copying. -- -- Q3. Doesn't this prevent us from creating comet-style servers, since data -- will be cached? -- --- A3. You can force blaze-builder to output a ByteString before it is an +-- A3. You can force a Builder to output a ByteString before it is an -- optimal size by sending a flush command. +-- +-- @since 2.0.0 responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response responseBuilder = ResponseBuilder -- | Creating 'Response' from 'L.ByteString'. This is a wrapper for -- 'responseBuilder'. +-- +-- @since 0.3.0 responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response -responseLBS s h = ResponseBuilder s h . fromLazyByteString +responseLBS s h = ResponseBuilder s h . lazyByteString -- | Creating 'Response' from a stream of values. -- @@ -142,20 +180,21 @@ -- (putStrLn \"Allocating scarce resource\") -- (putStrLn \"Cleaning up\") -- $ respond $ responseStream status200 [] $ \\write flush -> do --- write $ fromByteString \"Hello\\n\" +-- write $ byteString \"Hello\\n\" -- flush --- write $ fromByteString \"World\\n\" +-- write $ byteString \"World\\n\" -- @ -- -- Note that in some cases you can use @bracket@ from inside @responseStream@ -- as well. However, placing the call on the outside allows your status value -- and response headers to depend on the scarce resource. -- --- Since 3.0.0 -responseStream :: H.Status - -> H.ResponseHeaders - -> StreamingBody - -> Response +-- @since 3.0.0 +responseStream + :: H.Status + -> H.ResponseHeaders + -> StreamingBody + -> Response responseStream = ResponseStream -- | Create a response for a raw application. This is useful for \"upgrade\" @@ -168,34 +207,42 @@ -- In the event that you read from the request body before returning a -- @responseRaw@, behavior is undefined. -- --- Since 2.1.0 -responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) - -> Response - -> Response +-- @since 2.1.0 +responseRaw + :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) + -> Response + -> Response responseRaw = ResponseRaw ---------------------------------------------------------------- -- | Accessing 'H.Status' in 'Response'. +-- +-- @since 1.2.0 responseStatus :: Response -> H.Status -responseStatus (ResponseFile s _ _ _) = s -responseStatus (ResponseBuilder s _ _ ) = s -responseStatus (ResponseStream s _ _ ) = s -responseStatus (ResponseRaw _ res ) = responseStatus res +responseStatus (ResponseFile s _ _ _) = s +responseStatus (ResponseBuilder s _ _) = s +responseStatus (ResponseStream s _ _) = s +responseStatus (ResponseRaw _ res) = responseStatus res -- | Accessing 'H.ResponseHeaders' in 'Response'. +-- +-- @since 2.0.0 responseHeaders :: Response -> H.ResponseHeaders -responseHeaders (ResponseFile _ hs _ _) = hs -responseHeaders (ResponseBuilder _ hs _ ) = hs -responseHeaders (ResponseStream _ hs _ ) = hs -responseHeaders (ResponseRaw _ res) = responseHeaders res +responseHeaders (ResponseFile _ hs _ _) = hs +responseHeaders (ResponseBuilder _ hs _) = hs +responseHeaders (ResponseStream _ hs _) = hs +responseHeaders (ResponseRaw _ res) = responseHeaders res -- | Converting the body information in 'Response' to a 'StreamingBody'. -responseToStream :: Response - -> ( H.Status - , H.ResponseHeaders - , (StreamingBody -> IO a) -> IO a - ) +-- +-- @since 3.0.0 +responseToStream + :: Response + -> ( H.Status + , H.ResponseHeaders + , (StreamingBody -> IO a) -> IO a + ) responseToStream (ResponseStream s h b) = (s, h, ($ b)) responseToStream (ResponseFile s h fp (Just part)) = ( s @@ -207,7 +254,7 @@ bs <- B.hGetSome handle defaultChunkSize unless (B.null bs) $ do let x = B.take remaining bs - sendChunk $ fromByteString x + sendChunk $ byteString x loop $ remaining - B.length x loop $ fromIntegral $ filePartByteCount part ) @@ -215,16 +262,35 @@ ( s , h , \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> - withBody $ \sendChunk _flush -> fix $ \loop -> do + withBody $ \sendChunk _flush -> fix $ \loop -> do bs <- B.hGetSome handle defaultChunkSize unless (B.null bs) $ do - sendChunk $ fromByteString bs + sendChunk $ byteString bs loop ) responseToStream (ResponseBuilder s h b) = (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b) responseToStream (ResponseRaw _ res) = responseToStream res +-- | Apply the provided function to the response header list of the Response. +-- +-- @since 3.0.3.0 +mapResponseHeaders + :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response +mapResponseHeaders f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2 +mapResponseHeaders f (ResponseBuilder s h b) = ResponseBuilder s (f h) b +mapResponseHeaders f (ResponseStream s h b) = ResponseStream s (f h) b +mapResponseHeaders _ r@(ResponseRaw _ _) = r + +-- | Apply the provided function to the response status of the Response. +-- +-- @since 3.2.1 +mapResponseStatus :: (H.Status -> H.Status) -> Response -> Response +mapResponseStatus f (ResponseFile s h b1 b2) = ResponseFile (f s) h b1 b2 +mapResponseStatus f (ResponseBuilder s h b) = ResponseBuilder (f s) h b +mapResponseStatus f (ResponseStream s h b) = ResponseStream (f s) h b +mapResponseStatus _ r@(ResponseRaw _ _) = r + ---------------------------------------------------------------- -- | The WAI application. @@ -240,71 +306,300 @@ -- (putStrLn \"Cleaning up\") -- (respond $ responseLBS status200 [] \"Hello World\") -- @ -type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived +type Application = + Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived --- | Middleware is a component that sits between the server and application. It --- can do such tasks as GZIP encoding or response caching. What follows is the --- general definition of middleware, though a middleware author should feel --- free to modify this. +-- | A default, blank request. -- --- As an example of an alternate type for middleware, suppose you write a --- function to load up session information. The session information is simply a --- string map \[(String, String)\]. A logical type signature for this middleware --- might be: +-- @since 2.0.0 +defaultRequest :: Request +defaultRequest = + Request + { requestMethod = H.methodGet + , httpVersion = H.http10 + , rawPathInfo = B.empty + , rawQueryString = B.empty + , requestHeaders = [] + , isSecure = False + , remoteHost = SockAddrInet 0 0 + , pathInfo = [] + , queryString = [] + , requestBody = return B.empty + , vault = mempty + , requestBodyLength = KnownLength 0 + , requestHeaderHost = Nothing + , requestHeaderRange = Nothing + , requestHeaderReferer = Nothing + , requestHeaderUserAgent = Nothing + , requestSendEarlyHints = \_ -> return () + } + +-- | A @Middleware@ is a component that sits between the server and application. -- --- @ loadSession :: ([(String, String)] -> Application) -> Application @ +-- It can modify both the 'Request' and 'Response', +-- to provide simple transformations that are required for all (or most of) +-- your web server’s routes. -- --- Here, instead of taking a standard 'Application' as its first argument, the --- middleware takes a function which consumes the session information as well. +-- = Users of middleware +-- +-- If you are trying to apply one or more 'Middleware's to your 'Application', +-- just call them as functions. +-- +-- For example, if you have @corsMiddleware@ and @authorizationMiddleware@, +-- and you want to authorize first, you can do: +-- +-- @ +-- let allMiddleware app = authorizationMiddleware (corsMiddleware app) +-- @ +-- +-- to get a new 'Middleware', which first authorizes, then sets, CORS headers. +-- The “outer” middleware is called first. +-- +-- You can also chain them via '(.)': +-- +-- @ +-- let allMiddleware = +-- authorizationMiddleware +-- . corsMiddleware +-- . … more middleware here … +-- @ +-- +-- Then, once you have an @app :: Application@, you can wrap it +-- in your middleware: +-- +-- @ +-- let myApp = allMiddleware app :: Application +-- @ +-- +-- and run it as usual: +-- +-- @ +-- Warp.run port myApp +-- @ +-- +-- = Authors of middleware +-- +-- When fully expanded, 'Middleware' has the type signature: +-- +-- > (Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived) -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived +-- +-- or if we shorten to @type Respond = Response -> IO ResponseReceived@: +-- +-- > (Request -> Respond -> IO ResponseReceived) -> Request -> Respond -> IO ResponseReceived +-- +-- so a middleware definition takes 3 arguments, an inner application, a request and a response callback. +-- +-- Compare with the type of a simple `Application`: +-- +-- > Request -> Respond -> IO ResponseReceived +-- +-- It takes the 'Request' and @Respond@, but not the extra application. +-- +-- Said differently, a middleware has the power of a normal 'Application' +-- — it can inspect the 'Request' and return a 'Response' — +-- but it can (and in many cases it /should/) also call the 'Application' which was passed to it. +-- +-- == Modifying the 'Request' +-- +-- A lot of middleware just looks at the request and does something based on its values. +-- +-- For example, the @authorizationMiddleware@ from above could look at the @Authorization@ +-- HTTP header and run verification logic against the database. +-- +-- @ +-- authorizationMiddleware app req respond = do +-- case verifyJWT ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT -> app req respond +-- @ +-- +-- Notice how the inner app is called when the validation was successful. +-- If it was not, we can respond +-- e.g. with , +-- by constructing a 'Response' with 'responseLBS' and passing it to @respond@. +-- +-- == Passing arguments to and from your 'Middleware' +-- +-- Middleware must often be configurable. +-- Let’s say you have a type @JWTSettings@ that you want to be passed to the middleware. +-- Simply pass an extra argument to your middleware. Then your middleware type turns into: +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> Application -> Request -> Respond -> IO ResponseReceived +-- authorizationMiddleware jwtSettings req respond = +-- case verifyJWT jwtSettings ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT -> app req respond +-- @ +-- +-- or alternatively: +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> Middleware +-- @ +-- +-- Perhaps less intuitively, you can also /pass on/ data from middleware to the wrapped 'Application': +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> (JWT -> Application) -> Request -> Respond -> IO ResponseReceived +-- authorizationMiddleware jwtSettings req respond = +-- case verifyJWT jwtSettings ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT jwt -> app jwt req respond +-- @ +-- +-- although then, chaining different middleware has to take this extra argument into account: +-- +-- @ +-- let finalApp = +-- authorizationMiddleware +-- (\\jwt -> corsMiddleware +-- (… more middleware here … +-- (app jwt))) +-- @ +-- +-- == Modifying the 'Response' +-- +-- 'Middleware' can also modify the 'Response' that is returned by the inner application. +-- +-- This is done by taking the @respond@ callback, using it to define a new @respond'@, +-- and passing this new @respond'@ to the @app@: +-- +-- @ +-- gzipMiddleware app req respond = do +-- let respond' resp = do +-- resp' <- gzipResponseBody resp +-- respond resp' +-- app req respond' +-- @ +-- +-- However, modifying the response (especially the response body) is not trivial, +-- so in order to get a sense of how to do it (dealing with the type of 'responseToStream'), +-- it’s best to look at an example, for example . type Middleware = Application -> Application --- | A default, blank request. +-- | Apply a function that modifies a request as a 'Middleware' -- --- Since 2.0.0 -defaultRequest :: Request -defaultRequest = Request - { requestMethod = H.methodGet - , httpVersion = H.http10 - , rawPathInfo = B.empty - , rawQueryString = B.empty - , requestHeaders = [] - , isSecure = False - , remoteHost = SockAddrInet 0 0 - , pathInfo = [] - , queryString = [] - , requestBody = return B.empty - , vault = mempty - , requestBodyLength = KnownLength 0 - , requestHeaderHost = Nothing - , requestHeaderRange = Nothing - } +-- @since 3.2.4 +modifyRequest :: (Request -> Request) -> Middleware +modifyRequest f app = app . f +-- | Apply a function that modifies a response as a 'Middleware' +-- +-- @since 3.0.3.0 +modifyResponse :: (Response -> Response) -> Middleware +modifyResponse f app req respond = app req $ respond . f + +-- | Conditionally apply a 'Middleware' +-- +-- @since 3.0.3.0 +ifRequest :: (Request -> Bool) -> Middleware -> Middleware +ifRequest rpred middle app req + | rpred req = middle app req + | otherwise = app req + +-- $streamingRequestBodies +-- +-- == Streaming Request Bodies +-- +-- WAI is designed for streaming in request bodies, which allows you to process them incrementally. +-- You can stream in the request body using functions like 'getRequestBodyChunk', +-- the @wai-conduit@ package, or Yesod's @rawRequestBody@. +-- +-- In the normal case, incremental processing is more efficient, since it +-- reduces maximum total memory usage. +-- In the worst case, it helps protect your server against denial-of-service (DOS) attacks, in which +-- an attacker sends huge request bodies to your server. +-- +-- Consider these tips to avoid reading the entire request body into memory: +-- +-- * Look for library functions that support incremental processing. Sometimes these will use streaming +-- libraries like @conduit@, @pipes@, or @streaming@. +-- * Any attoparsec parser supports streaming input. For an example of this, see the +-- "Data.Conduit.Attoparsec" module in @conduit-extra@. +-- * Consider streaming directly to a file on disk. For an example of this, see the +-- "Data.Conduit.Binary" module in @conduit-extra@. +-- * If you need to direct the request body to multiple destinations, you can stream to both those +-- destinations at the same time. +-- For example, if you wanted to run an HMAC on the request body as well as parse it into JSON, +-- you could use Conduit's @zipSinks@ to send the data to @cryptonite-conduit@'s 'sinkHMAC' and +-- @aeson@'s Attoparsec parser. +-- * If possible, avoid processing large data on your server at all. +-- For example, instead of uploading a file to your server and then to AWS S3, +-- you can have the browser upload directly to S3. +-- +-- That said, sometimes it is convenient, or even necessary to read the whole request body into memory. +-- For these purposes, functions like 'strictRequestBody' or 'lazyRequestBody' can be used. +-- When this is the case, consider these strategies to mitigating potential DOS attacks: +-- +-- * Set a limit on the request body size you allow. +-- If certain endpoints need larger bodies, whitelist just those endpoints for the large size. +-- Be especially cautious about endpoints that don't require authentication, since these are easier to DOS. +-- You can accomplish this with @wai-extra@'s @requestSizeLimitMiddleware@ or Yesod's @maximumContentLength@. +-- * Consider rate limiting not just on total requests, but also on total bytes sent in. +-- * Consider using services that allow you to identify and blacklist attackers. +-- * Minimize the amount of time the request body stays in memory. +-- * If you need to share request bodies across middleware and your application, you can do so using Wai's 'vault'. +-- If you do this, remove the request body from the vault as soon as possible. +-- +-- Warning: Incremental processing will not always be sufficient to prevent a DOS attack. +-- For example, if an attacker sends you a JSON body with a 2MB long string inside, +-- even if you process the body incrementally, you'll still end up with a 2MB-sized 'Text'. +-- +-- To mitigate this, employ some of the countermeasures listed above, +-- and try to reject such payloads as early as possible in your codebase. + -- | Get the request body as a lazy ByteString. However, do /not/ use any lazy -- I\/O, instead reading the entire body into memory strictly. -- --- Since 3.0.1 +-- Note: Since this function consumes the request body, future calls to it will return the empty string. +-- +-- @since 3.0.1 strictRequestBody :: Request -> IO L.ByteString strictRequestBody req = loop id where loop front = do - bs <- requestBody req + bs <- getRequestBodyChunk req if B.null bs then return $ front LI.Empty else loop (front . LI.Chunk bs) +-- | Synonym for 'strictRequestBody'. +-- This function name is meant to signal the non-idempotent nature of 'strictRequestBody'. +-- +-- @since 3.2.3 +consumeRequestBodyStrict :: Request -> IO L.ByteString +consumeRequestBodyStrict = strictRequestBody + -- | Get the request body as a lazy ByteString. This uses lazy I\/O under the -- surface, and therefore all typical warnings regarding lazy I/O apply. -- --- Since 1.4.1 +-- Note: Since this function consumes the request body, future calls to it will return the empty string. +-- +-- @since 1.4.1 lazyRequestBody :: Request -> IO L.ByteString lazyRequestBody req = loop where loop = unsafeInterleaveIO $ do - bs <- requestBody req + bs <- getRequestBodyChunk req if B.null bs then return LI.Empty else do bss <- loop return $ LI.Chunk bs bss + +-- | Synonym for 'lazyRequestBody'. +-- This function name is meant to signal the non-idempotent nature of 'lazyRequestBody'. +-- +-- @since 3.2.3 +consumeRequestBodyLazy :: Request -> IO L.ByteString +consumeRequestBodyLazy = lazyRequestBody + +-- | Apply the provided function to the request header list of the 'Request'. +-- +-- @since 3.2.4 +mapRequestHeaders + :: (H.RequestHeaders -> H.RequestHeaders) -> Request -> Request +mapRequestHeaders f request = request{requestHeaders = f (requestHeaders request)} diff --git a/Network/Wai/Internal.hs b/Network/Wai/Internal.hs --- a/Network/Wai/Internal.hs +++ b/Network/Wai/Internal.hs @@ -1,105 +1,177 @@ +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_HADDOCK not-home #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} + -- | Internal constructors and helper functions. Note that no guarantees are -- given for stability of these interfaces. module Network.Wai.Internal where -import Blaze.ByteString.Builder (Builder) -import qualified Data.ByteString as B -import Data.Text (Text) -import Data.Typeable (Typeable) +import qualified Data.ByteString as B +import Data.ByteString.Builder (Builder) +import Data.List (intercalate) +import Data.Text (Text) import Data.Vault.Lazy (Vault) -import Data.Word (Word64) -import qualified Network.HTTP.Types as H -import Network.Socket (SockAddr) +import Data.Word (Word64) +import qualified Network.HTTP.Types as H +import Network.Socket (SockAddr) -- | Information on the request sent by the client. This abstracts away the -- details of the underlying implementation. -data Request = Request { - -- | Request method such as GET. - requestMethod :: H.Method - -- | HTTP version such as 1.1. - , httpVersion :: H.HttpVersion - -- | Extra path information sent by the client. The meaning varies slightly - -- depending on backend; in a standalone server setting, this is most likely - -- all information after the domain name. In a CGI application, this would be - -- the information following the path to the CGI executable itself. - -- Do not modify this raw value- modify pathInfo instead. - , rawPathInfo :: B.ByteString - -- | If no query string was specified, this should be empty. This value - -- /will/ include the leading question mark. - -- Do not modify this raw value - modify queryString instead. - , rawQueryString :: B.ByteString - -- | A list of headers (a pair of key and value) in an HTTP request. - , requestHeaders :: H.RequestHeaders - -- | Was this request made over an SSL connection? - -- - -- Note that this value will /not/ tell you if the client originally made - -- this request over SSL, but rather whether the current connection is SSL. - -- The distinction lies with reverse proxies. In many cases, the client will - -- connect to a load balancer over SSL, but connect to the WAI handler - -- without SSL. In such a case, 'isSecure' will be 'False', but from a user - -- perspective, there is a secure connection. - , isSecure :: Bool - -- | The client\'s host information. - , remoteHost :: SockAddr - -- | Path info in individual pieces - the URL without a hostname/port and - -- without a query string, split on forward slashes. - , pathInfo :: [Text] - -- | Parsed query string information. - , queryString :: H.Query - -- | Get the next chunk of the body. Returns 'B.empty' when the - -- body is fully consumed. - , requestBody :: IO B.ByteString - -- | A location for arbitrary data to be shared by applications and middleware. - , vault :: Vault - -- | The size of the request body. In the case of a chunked request body, - -- this may be unknown. - -- - -- Since 1.4.0 - , requestBodyLength :: RequestBodyLength - -- | The value of the Host header in a HTTP request. - -- - -- Since 2.0.0 - , requestHeaderHost :: Maybe B.ByteString - -- | The value of the Range header in a HTTP request. - -- - -- Since 2.0.0 - , requestHeaderRange :: Maybe B.ByteString - } - deriving (Typeable) +{-# DEPRECATED + requestBody + "requestBody's name is misleading because it only gets a partial chunk of the body. Use getRequestBodyChunk instead when getting the field, and setRequestBodyChunks when setting the field." + #-} +data Request = Request + { requestMethod :: H.Method + -- ^ Request method such as GET. + , httpVersion :: H.HttpVersion + -- ^ HTTP version such as 1.1. + , rawPathInfo :: B.ByteString + -- ^ Extra path information sent by the client. The meaning varies slightly + -- depending on backend; in a standalone server setting, this is most likely + -- all information after the domain name. In a CGI application, this would be + -- the information following the path to the CGI executable itself. + -- + -- Middlewares and routing tools should not modify this raw value, as it may + -- be used for such things as creating redirect destinations by applications. + -- Instead, if you are writing a middleware or routing framework, modify the + -- @pathInfo@ instead. This is the approach taken by systems like Yesod + -- subsites. + -- + -- /Note/: At the time of writing this documentation, there is at least one + -- system (@Network.Wai.UrlMap@ from @wai-extra@) that does not follow the + -- above recommendation. Therefore, it is recommended that you test the + -- behavior of your application when using @rawPathInfo@ and any form of + -- library that might modify the @Request@. + , rawQueryString :: B.ByteString + -- ^ If no query string was specified, this should be empty. This value + -- /will/ include the leading question mark. + -- Do not modify this raw value - modify queryString instead. + , requestHeaders :: H.RequestHeaders + -- ^ A list of headers (a pair of key and value) in an HTTP request. + , isSecure :: Bool + -- ^ Was this request made over an SSL connection? + -- + -- Note that this value will /not/ tell you if the client originally made + -- this request over SSL, but rather whether the current connection is SSL. + -- The distinction lies with reverse proxies. In many cases, the client will + -- connect to a load balancer over SSL, but connect to the WAI handler + -- without SSL. In such a case, 'isSecure' will be 'False', but from a user + -- perspective, there is a secure connection. + , remoteHost :: SockAddr + -- ^ The client\'s host information. + , pathInfo :: [Text] + -- ^ Path info in individual pieces - the URL without a hostname/port and + -- without a query string, split on forward slashes. + , queryString :: H.Query + -- ^ Parsed query string information. + , requestBody :: IO B.ByteString + -- ^ Get the next chunk of the body. Returns 'B.empty' when the + -- body is fully consumed. Since 3.2.2, this is deprecated in favor of 'getRequestBodyChunk'. + , vault :: Vault + -- ^ A location for arbitrary data to be shared by applications and middleware. + , requestBodyLength :: RequestBodyLength + -- ^ The size of the request body. In the case of a chunked request body, + -- this may be unknown. + -- + -- @since 1.4.0 + , requestHeaderHost :: Maybe B.ByteString + -- ^ The value of the Host header in a HTTP request. + -- + -- @since 2.0.0 + , requestHeaderRange :: Maybe B.ByteString + -- ^ The value of the Range header in a HTTP request. + -- + -- @since 2.0.0 + , requestHeaderReferer :: Maybe B.ByteString + -- ^ The value of the Referer header in a HTTP request. + -- + -- @since 3.2.0 + , requestHeaderUserAgent :: Maybe B.ByteString + -- ^ The value of the User-Agent header in a HTTP request. + -- + -- @since 3.2.0 + , requestSendEarlyHints :: H.ResponseHeaders -> IO () + -- ^ Send a @103 Early Hints@ informational response carrying the given + -- headers, ahead of the final response. This lets a client (typically over + -- HTTP\/2) start fetching resources named in @Link@ headers while the final + -- response is still being produced. + -- + -- A handler (e.g. Warp over HTTP\/2) that supports early hints installs an + -- action here; otherwise it is a no-op. + -- + -- @since 3.2.5 + } + +-- | Get the next chunk of the body. Returns 'B.empty' when the +-- body is fully consumed. +-- +-- @since 3.2.2 +getRequestBodyChunk :: Request -> IO B.ByteString +getRequestBodyChunk = requestBody + +-- | Set the 'requestBody' attribute on a request without triggering a +-- deprecation warning. +-- +-- The supplied IO action should return the next chunk of the body each time it +-- is called and 'B.empty' when it has been fully consumed. +-- +-- @since 3.2.4 +setRequestBodyChunks :: IO B.ByteString -> Request -> Request +setRequestBodyChunks requestBody r = + r{requestBody = requestBody} + +instance Show Request where + show Request{..} = "Request {" ++ intercalate ", " [a ++ " = " ++ b | (a, b) <- fields] ++ "}" + where + fields = + [ ("requestMethod", show requestMethod) + , ("httpVersion", show httpVersion) + , ("rawPathInfo", show rawPathInfo) + , ("rawQueryString", show rawQueryString) + , ("requestHeaders", show requestHeaders) + , ("isSecure", show isSecure) + , ("remoteHost", show remoteHost) + , ("pathInfo", show pathInfo) + , ("queryString", show queryString) + , ("requestBody", "") + , ("vault", "") + , ("requestBodyLength", show requestBodyLength) + , ("requestHeaderHost", show requestHeaderHost) + , ("requestHeaderRange", show requestHeaderRange) + ] + data Response = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) | ResponseBuilder H.Status H.ResponseHeaders Builder | ResponseStream H.Status H.ResponseHeaders StreamingBody | ResponseRaw (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) Response - deriving Typeable -- | Represents a streaming HTTP response body. It's a function of two -- parameters; the first parameter provides a means of sending another chunk of -- data, and the second parameter provides a means of flushing the data to the -- client. -- --- Since 3.0.0 +-- @since 3.0.0 type StreamingBody = (Builder -> IO ()) -> IO () -> IO () -- | The size of the request body. In the case of chunked bodies, the size will -- not be known. -- --- Since 1.4.0 -data RequestBodyLength = ChunkedBody | KnownLength Word64 +-- @since 1.4.0 +data RequestBodyLength = ChunkedBody | KnownLength Word64 deriving (Show) -- | Information on which part to be sent. -- Sophisticated application handles Range (and If-Range) then -- create 'FilePart'. +-- +-- @since 0.4.0 data FilePart = FilePart - { filePartOffset :: Integer + { filePartOffset :: Integer , filePartByteCount :: Integer - , filePartFileSize :: Integer - } deriving Show + , filePartFileSize :: Integer + } + deriving (Show) -- | A special datatype to indicate that the WAI handler has received the -- response. This is to avoid the need for Rank2Types in the definition of @@ -108,6 +180,5 @@ -- It is /highly/ advised that only WAI handlers import and use the data -- constructor for this data type. -- --- Since 3.0.0 +-- @since 3.0.0 data ResponseReceived = ResponseReceived - deriving Typeable diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,116 @@ +WAI: Web Application Interface +============================== + +Getting started +--------------- + +You want a minimal example? Here it is! + +~~~ {.haskell} +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.HTTP.Types +import Network.Wai.Handler.Warp (run) + +app :: Application +app _ respond = do + putStrLn "I've done some IO here" + respond $ responseLBS + status200 + [("Content-Type", "text/plain")] + "Hello, Web!" + +main :: IO () +main = do + putStrLn $ "http://localhost:8080/" + run 8080 app +~~~ + +Put that code into a file named _hello.hs_ and install [wai] and [warp] from Hackage: + + cabal install wai warp + +Run it: + + runhaskell hello.hs + +Point your browser to: + + http://localhost:8080/ + + +Serving static content +---------------------- + +We can modify our previous example to serve static content. For this create a file named _index.html_: + +

Hello, Web!

+ +Now we redefine `responseBody` to refer to that file: + +~~~ {.haskell} +app2 :: Application +app2 _ respond = respond index + +index :: Response +index = responseFile + status200 + [("Content-Type", "text/html")] + "index.html" + Nothing +~~~ + + +Basic dispatching +----------------- + +An `Application` maps `Request`s to `Response`s: + + ghci> :info Application + type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived + +Depending on the path info provided with each `Request` we can serve different `Response`s: + +~~~ {.haskell} +app3 :: Application +app3 request respond = respond $ case rawPathInfo request of + "/" -> index + "/raw/" -> plainIndex + _ -> notFound + +plainIndex :: Response +plainIndex = responseFile + status200 + [("Content-Type", "text/plain")] + "index.html" + Nothing + +notFound :: Response +notFound = responseLBS + status404 + [("Content-Type", "text/plain")] + "404 - Not Found" +~~~ + + +Doing without overloaded strings +-------------------------------- + +For the sake of efficiency, WAI uses the [bytestring] package. We used GHCs [overloaded strings] to almost hide this fact. But we can easily do without. What follows is a more verbose definition of `notFound`, that works without GHC extensions: + +~~~ {.haskell .ignore} +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy.Char8 as LB8 +import Data.CaseInsensitive (mk) + +notFound = responseLBS + status404 + [(mk $ B8.pack "Content-Type", B8.pack "text/plain")] + (LB8.pack "404 - Not Found") +~~~ + + + [wai]: http://hackage.haskell.org/package/wai + [warp]: http://hackage.haskell.org/package/warp + [overloaded strings]: http://www.haskell.org/ghc/docs/latest/html/users_guide/type-class-extensions.html#overloaded-strings + [bytestring]: http://hackage.haskell.org/package/bytestring diff --git a/test/Network/WaiSpec.hs b/test/Network/WaiSpec.hs --- a/test/Network/WaiSpec.hs +++ b/test/Network/WaiSpec.hs @@ -1,15 +1,16 @@ +{-# LANGUAGE LambdaCase #-} + module Network.WaiSpec (spec) where -import Test.Hspec -import Test.Hspec.QuickCheck (prop) -import Network.Wai -import Network.Wai.Internal (Request (Request)) -import Data.IORef -import Data.Monoid +import Control.Monad (forM_) import qualified Data.ByteString as S +import Data.ByteString.Builder (Builder, toLazyByteString, word8) import qualified Data.ByteString.Lazy as L -import Blaze.ByteString.Builder (toByteString, Builder, fromWord8) -import Control.Monad (forM_) +import Data.IORef +import Data.Word (Word8) +import Network.Wai +import Test.Hspec +import Test.Hspec.QuickCheck (prop) spec :: Spec spec = do @@ -24,17 +25,20 @@ flush :: IO () flush = return () streamingBody add flush - fmap toByteString $ readIORef builderRef + L.toStrict . toLazyByteString <$> readIORef builderRef prop "responseLBS" $ \bytes -> do body <- getBody $ responseLBS undefined undefined $ L.pack bytes body `shouldBe` S.pack bytes prop "responseBuilder" $ \bytes -> do - body <- getBody $ responseBuilder undefined undefined - $ mconcat $ map fromWord8 bytes + body <- + getBody $ + responseBuilder undefined undefined $ + mconcat $ + map word8 bytes body `shouldBe` S.pack bytes prop "responseStream" $ \chunks -> do body <- getBody $ responseStream undefined undefined $ \sendChunk _ -> - forM_ chunks $ \chunk -> sendChunk $ mconcat $ map fromWord8 chunk + forM_ chunks $ \chunk -> sendChunk $ mconcat $ map word8 chunk body `shouldBe` S.concat (map S.pack chunks) it "responseFile total" $ do let fp = "wai.cabal" @@ -47,38 +51,37 @@ let total = S.length totalBS offset = abs offset' `mod` total count = abs count' `mod` (total - offset) - body <- getBody $ responseFile undefined undefined fp $ Just FilePart - { filePartOffset = fromIntegral offset - , filePartByteCount = fromIntegral count - , filePartFileSize = fromIntegral total - } + body <- + getBody $ + responseFile undefined undefined fp $ + Just + FilePart + { filePartOffset = fromIntegral offset + , filePartByteCount = fromIntegral count + , filePartFileSize = fromIntegral total + } let expected = S.take count $ S.drop offset totalBS body `shouldBe` expected describe "lazyRequestBody" $ do prop "works" $ \chunks -> do - ref <- newIORef $ map S.pack $ filter (not . null) chunks - let req = Request - { requestBody = atomicModifyIORef ref $ \bss -> - case bss of - [] -> ([], S.empty) - x:y -> (y, x) - } + req <- mkRequestFromChunks chunks body <- lazyRequestBody req body `shouldBe` L.fromChunks (map S.pack chunks) it "is lazy" $ do - let req = Request - { requestBody = error "requestBody" - } + let req = setRequestBodyChunks (error "requestBody") defaultRequest _ <- lazyRequestBody req return () describe "strictRequestBody" $ do prop "works" $ \chunks -> do - ref <- newIORef $ map S.pack $ filter (not . null) chunks - let req = Request - { requestBody = atomicModifyIORef ref $ \bss -> - case bss of - [] -> ([], S.empty) - x:y -> (y, x) - } + req <- mkRequestFromChunks chunks body <- strictRequestBody req body `shouldBe` L.fromChunks (map S.pack chunks) + +mkRequestFromChunks :: [[Word8]] -> IO Request +mkRequestFromChunks chunks = do + ref <- newIORef $ map S.pack $ filter (not . null) chunks + pure $ + flip setRequestBodyChunks defaultRequest $ + atomicModifyIORef ref $ \case + [] -> ([], S.empty) + x : y -> (y, x) diff --git a/wai.cabal b/wai.cabal --- a/wai.cabal +++ b/wai.cabal @@ -1,7 +1,10 @@ +Cabal-Version: >=1.10 Name: wai -Version: 3.0.1.1 +Version: 3.2.5 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers. + . + API docs and the README are available at . License: MIT License-file: LICENSE Author: Michael Snoyman @@ -9,17 +12,18 @@ Homepage: https://github.com/yesodweb/wai Category: Web Build-Type: Simple -Cabal-Version: >=1.8 Stability: Stable +extra-source-files: README.md ChangeLog.md Source-repository head type: git - location: git://github.com/yesodweb/wai.git + location: https://github.com/yesodweb/wai.git + subdir: wai Library - Build-Depends: base >= 4 && < 5 - , bytestring >= 0.9.1.4 - , blaze-builder >= 0.2.1.4 && < 0.4 + default-language: Haskell2010 + Build-Depends: base >= 4.12 && < 5 + , bytestring >= 0.10.4 , network >= 2.2.1.5 , http-types >= 0.7 , text >= 0.7 @@ -29,18 +33,15 @@ ghc-options: -Wall test-suite test + default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs type: exitcode-stdio-1.0 - ghc-options: -threaded + ghc-options: -threaded -Wall cpp-options: -DTEST - build-depends: base + build-depends: base >= 4.8 && < 5 , wai , hspec - , blaze-builder , bytestring other-modules: Network.WaiSpec - -source-repository head - type: git - location: git://github.com/yesodweb/wai.git + build-tool-depends: hspec-discover:hspec-discover