wai 3.0.5.0 → 3.2.5
raw patch · 7 files changed
Files
- ChangeLog.md +56/−3
- Network/Wai.hs +430/−162
- Network/Wai/HTTP2.hs +0/−272
- Network/Wai/Internal.hs +142/−205
- README.md +1/−1
- test/Network/WaiSpec.hs +37/−34
- wai.cabal +13/−18
ChangeLog.md view
@@ -1,14 +1,67 @@+# 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+* Avoid using the `IsString` Builder instance ## 3.0.4.0 -* A new module Network.Wai.HTTP2 is exported.+* A new module `Network.Wai.HTTP2` is exported. ## 3.0.3.0 -* mapResponseHeaders, ifRequest and modifyResponse are exported.+* `mapResponseHeaders`, `ifRequest` and `modifyResponse` are exported. ## 3.0.2.3
Network/Wai.hs view
@@ -1,107 +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] <http://hackage.haskell.org/package/warp>+--+-- [wai-extra] <http://hackage.haskell.org/package/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] <http://hackage.haskell.org/package/warp>+ -- ** Response composers+ responseFile,+ responseBuilder,+ responseLBS,+ responseStream,+ responseRaw, -[wai-extra] <http://hackage.haskell.org/package/wai-extra>+ -- ** Response accessors+ responseStatus,+ responseHeaders, -[wai-test] <http://hackage.haskell.org/package/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- -- ** Response modifiers- , responseToStream- , mapResponseHeaders- -- * Middleware composition- , ifRequest- , modifyResponse- ) 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'.@@ -119,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. --@@ -147,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\"@@ -173,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@@ -212,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 )@@ -220,10 +262,10 @@ ( 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) =@@ -231,12 +273,24 @@ responseToStream (ResponseRaw _ res) = responseToStream res -- | Apply the provided function to the response header list of the Response.-mapResponseHeaders :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> 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.@@ -252,86 +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 -- | A default, blank request. ----- Since 2.0.0+-- @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- }-+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 ()+ } --- | 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 @Middleware@ is a component that sits between the server and application. ----- 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:+-- 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. ----- @ loadSession :: ([(String, String)] -> Application) -> Application @+-- = Users of middleware ----- Here, instead of taking a standard 'Application' as its first argument, the--- middleware takes a function which consumes the session information as well.+-- 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 <https://jwt.io/ JWT> 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 <https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/401 HTTP 401 Unauthorized>,+-- 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 <https://hackage.haskell.org/package/wai-extra/docs/src/Network.Wai.Middleware.Gzip.html#gzip the GZIP middleware of wai-extra>. type Middleware = Application -> Application +-- | Apply a function that modifies a request as a 'Middleware'+--+-- @since 3.2.4+modifyRequest :: (Request -> Request) -> Middleware+modifyRequest f app = app . f --- | apply a function that modifies a response as a 'Middleware'+-- | 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'+-- | 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-+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)}
− Network/Wai/HTTP2.hs
@@ -1,272 +0,0 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}---- | An HTTP\/2-aware variant of the 'Network.Wai.Application' type. Compared--- to the original, this exposes the new functionality of server push and--- trailers, allows stream fragments to be sent in the form of file ranges, and--- allows the stream body to produce a value to be used in constructing the--- trailers. Existing @Applications@ can be faithfully upgraded to HTTP\/2--- with 'promoteApplication' or served transparently over both protocols with--- the normal Warp 'Network.Wai.Handler.Warp.run' family of functions.------ An 'HTTP2Application' takes a 'Request' and a 'PushFunc' and produces a--- 'Responder' that will push any associated resources and send the response--- body. The response is always a stream of 'Builder's and file chunks.--- Equivalents of the 'Network.Wai.responseBuilder' family of functions are--- provided for creating 'Responder's conveniently.------ Pushed streams are handled by an IO action that triggers a server push. It--- returns @True@ if the @PUSH_PROMISE@ frame was sent, @False@ if not. Note--- this means it will still return @True@ if the client reset or ignored the--- stream. This gives handlers the freedom to implement their own heuristics--- for whether to actually push a resource, while also allowing middleware and--- frameworks to trigger server pushes automatically.--module Network.Wai.HTTP2- (- -- * Applications- HTTP2Application- -- * Responder- , Responder(..)- , RespondFunc- , Body- , Chunk(..)- , Trailers- -- * Server push- , PushFunc- , PushPromise(..)- , promiseHeaders- -- * Conveniences- , promoteApplication- -- ** Responders- , respond- , respondCont- , respondIO- , respondFile- , respondFilePart- , respondNotFound- , respondWith- -- ** Stream Bodies- , streamFilePart- , streamBuilder- , streamSimple- ) where--import Blaze.ByteString.Builder (Builder)-import Blaze.ByteString.Builder.ByteString (fromByteString)-import Control.Exception (Exception, throwIO)-import Control.Monad.Trans.Cont (ContT(..))-import Data.ByteString (ByteString)-#if __GLASGOW_HASKELL__ < 709-import Data.Functor ((<$>))-#endif-import Data.IORef (newIORef, readIORef, writeIORef)-#if __GLASGOW_HASKELL__ < 709-import Data.Monoid (mempty)-#endif-import Data.Typeable (Typeable)-import qualified Network.HTTP.Types as H--import Network.Wai (Application)-import Network.Wai.Internal- ( FilePart(..)- , Request(requestHeaders)- , Response(..)- , ResponseReceived(..)- , StreamingBody- , adjustForFilePart- , chooseFilePart- , tryGetFileSize- )---- | Headers sent after the end of a data stream, as defined by section 4.1.2 of--- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.-type Trailers = [H.Header]---- | The synthesized request and headers of a pushed stream.-data PushPromise = PushPromise- { promisedMethod :: H.Method- , promisedPath :: ByteString- , promisedAuthority :: ByteString- , promisedScheme :: ByteString- , promisedHeader :: H.RequestHeaders- }---- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.-type HTTP2Application = Request -> PushFunc -> Responder---- | Part of a streaming response -- either a 'Builder' or a range of a file.-data Chunk = FileChunk FilePath FilePart | BuilderChunk Builder---- | The streaming body of a response. Equivalent to--- 'Network.Wai.StreamingBody' except that it can also write file ranges and--- return the stream's trailers.-type Body = (Chunk -> IO ()) -> IO () -> IO Trailers---- | Given to 'Responders'; provide a status, headers, and a stream body, and--- we'll give you a token proving you called the 'RespondFunc'.-type RespondFunc s = H.Status -> H.ResponseHeaders -> Body -> IO s---- | The result of an 'HTTP2Application'; or, alternately, an application--- that's independent of the request. This is a continuation-passing style--- function that first provides a response by calling the given respond--- function, then returns the request's 'Trailers'.------ The respond function is similar to the one in 'Network.Wai.Application', but--- it only takes a streaming body, the status and headers are curried, and it--- also produces trailers for the stream.-newtype Responder = Responder- { runResponder :: forall s. RespondFunc s -> IO s }---- | A function given to an 'HTTP2Application' to initiate a server-pushed--- stream. Its argument is the same as the result of an 'HTTP2Application', so--- you can either implement the response inline, or call your own application--- to create the response.------ The result is 'True' if the @PUSH_PROMISE@ frame will be sent, or 'False' if--- it will not. This can happen if server push is disabled, the concurrency--- limit of server-initiated streams is reached, or the associated stream has--- already been closed.------ This function shall ensure that stream data provided after it returns will--- be sent after the @PUSH_PROMISE@ frame, so that servers can implement the--- requirement that any pushed stream for a resource be initiated before--- sending DATA frames that reference it.-type PushFunc = PushPromise -> Responder -> IO Bool---- | Create the 'H.RequestHeaders' corresponding to the given 'PushPromise'.------ This is primarily useful for WAI handlers like Warp, and application--- implementers are unlikely to use it directly.-promiseHeaders :: PushPromise -> H.RequestHeaders-promiseHeaders p =- [ (":method", promisedMethod p)- , (":path", promisedPath p)- , (":authority", promisedAuthority p)- , (":scheme", promisedScheme p)- ] ++ promisedHeader p---- | Create a response body consisting of a single range of a file. Does not--- set Content-Length or Content-Range headers. For that, use--- 'respondFilePart' or 'respondFile'.-streamFilePart :: FilePath -> FilePart -> Body-streamFilePart path part write _ = write (FileChunk path part) >> return []---- | Respond with a single range of a file, adding the Accept-Ranges,--- Content-Length and Content-Range headers and changing the status to 206 as--- appropriate.------ If you want the range to be inferred automatically from the Range header,--- use 'respondFile' instead. On the other hand, if you want to avoid the--- automatic header and status adjustments, use 'respond' and 'streamFilePart'--- directly.-respondFilePart :: H.Status -> H.ResponseHeaders -> FilePath -> FilePart -> Responder-respondFilePart s h path part = Responder $ \k -> do- let (s', h') = adjustForFilePart s h part- k s' h' $ streamFilePart path part---- | Serve the requested range of the specified file (based on the Range--- header), using the given 'H.Status' and 'H.ResponseHeaders' as a base. If--- the file is not accessible, the status will be replaced with 404 and a--- default not-found message will be served. If a partial file is requested,--- the status will be replaced with 206 and the Content-Range header will be--- added. The Content-Length header will always be added.-respondFile :: H.Status -> H.ResponseHeaders -> FilePath -> H.RequestHeaders -> Responder-respondFile s h path reqHdrs = Responder $ \k -> do- fileSize <- tryGetFileSize path- case fileSize of- Left _ -> runResponder (respondNotFound h) k- Right size -> runResponder (respondFileExists s h path size reqHdrs) k---- As 'respondFile', but with prior knowledge of the file's existence and size.-respondFileExists :: H.Status -> H.ResponseHeaders -> FilePath -> Integer -> H.RequestHeaders -> Responder-respondFileExists s h path size reqHdrs =- respondFilePart s h path $ chooseFilePart size $ lookup H.hRange reqHdrs---- | Respond with a minimal 404 page with the given headers.-respondNotFound :: H.ResponseHeaders -> Responder-respondNotFound h = Responder $ \k -> k H.notFound404 h' $- streamBuilder $ fromByteString "File not found."- where- contentType = (H.hContentType, "text/plain; charset=utf-8")- h' = contentType:filter ((/=H.hContentType) . fst) h---- | Construct a 'Responder' that will just call the 'RespondFunc' with the--- given arguments.-respond :: H.Status -> H.ResponseHeaders -> Body -> Responder-respond s h b = Responder $ \k -> k s h b---- | Fold the given bracketing action into a 'Responder'. Note the first--- argument is isomorphic to @Codensity IO a@ or @forall s. ContT s IO a@, and--- is the type of a partially-applied 'Control.Exception.bracket' or--- @with@-style function.------ > respondWith (bracket acquire release) $--- > \x -> respondNotFound [("x", show x)]------ is equivalent to------ > Responder $ \k -> bracket acquire release $--- > \x -> runResponder (respondNotFound [("x", show x)] k------ This is morally equivalent to ('>>=') on 'Codensity' 'IO'.-respondWith :: (forall s. (a -> IO s) -> IO s) -> (a -> Responder) -> Responder-respondWith with f = respondCont $ f <$> ContT with---- | Fold the 'ContT' into the contained 'Responder'.-respondCont :: (forall r. ContT r IO Responder) -> Responder-respondCont cont = Responder $ \k -> runContT cont $ \r -> runResponder r k---- | Fold the 'IO' into the contained 'Responder'.-respondIO :: IO Responder -> Responder-respondIO io = Responder $ \k -> io >>= \r -> runResponder r k---- | Create a response body consisting of a single builder.-streamBuilder :: Builder -> Body-streamBuilder builder write _ = write (BuilderChunk builder) >> return []---- | Create a response body of a stream of 'Builder's.-streamSimple :: StreamingBody -> Body-streamSimple body write flush = body (write . BuilderChunk) flush >> return []---- | Use a normal WAI 'Response' to send the response. Useful if you're--- sharing code between HTTP\/2 applications and HTTP\/1 applications.------ The 'Request' is used to determine the right file range to serve for--- 'ResponseFile'.-promoteResponse :: Request -> Response -> Responder-promoteResponse req response = case response of- (ResponseBuilder s h b) ->- Responder $ \k -> k s h (streamBuilder b)- (ResponseStream s h body) ->- Responder $ \k -> k s h (streamSimple body)- (ResponseRaw _ fallback) -> promoteResponse req fallback- (ResponseFile s h path mpart) -> maybe- (respondFile s h path $ requestHeaders req)- (respondFilePart s h path)- mpart---- | An 'Network.Wai.Application' we tried to promote neither called its--- respond action nor raised; this is only possible if it imported the--- 'ResponseReceived' constructor and used it to lie about having called the--- action.-data RespondNeverCalled = RespondNeverCalled deriving (Show, Typeable)--instance Exception RespondNeverCalled---- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring--- the HTTP/2-specific features.-promoteApplication :: Application -> HTTP2Application-promoteApplication app req _ = Responder $ \k -> do- -- In HTTP2Applications, the Responder is required to ferry a value of- -- arbitrary type from the RespondFunc back to the caller of the- -- application, but in Application the type is fixed to ResponseReceived.- -- To add this extra power to an Application, we have to squirrel it away- -- in an IORef as a hack.- ref <- newIORef Nothing- let k' r = do- writeIORef ref . Just =<< runResponder (promoteResponse req r) k- return ResponseReceived- ResponseReceived <- app req k'- readIORef ref >>= maybe (throwIO RespondNeverCalled) return
Network/Wai/Internal.hs view
@@ -1,151 +1,177 @@-{-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_HADDOCK not-home #-}+ -- | 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 Control.Exception (IOException, try)-import qualified Data.ByteString as B hiding (pack)-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Char8 as B (pack, readInteger)-import qualified Data.ByteString.Lazy as L-#if __GLASGOW_HASKELL__ < 709-import Data.Functor ((<$>))-#endif-import Data.Maybe (listToMaybe)-import Data.Text (Text)-import Data.Typeable (Typeable)-import Data.Vault.Lazy (Vault)-import Data.Word (Word64)-import qualified Network.HTTP.Types as H-import qualified Network.HTTP.Types.Header as HH-import Network.Socket (SockAddr)-import Numeric (showInt)-import Data.List (intercalate)-import qualified System.PosixCompat.Files as P+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) -- | 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.- --- -- 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@.- , 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."+ #-} -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","<IO ByteString>")- ,("vault","<Vault>")- ,("requestBodyLength",show requestBodyLength)- ,("requestHeaderHost",show requestHeaderHost)- ,("requestHeaderRange",show requestHeaderRange)- ]+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", "<IO ByteString>")+ , ("vault", "<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 deriving Show+-- @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@@ -154,94 +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---- | Look up the size of a file in 'Right' or the 'IOException' in 'Left'.-tryGetFileSize :: FilePath -> IO (Either IOException Integer)-tryGetFileSize path =- fmap (fromIntegral . P.fileSize) <$> try (P.getFileStatus path)---- | \"Content-Range\".-hContentRange :: H.HeaderName-hContentRange = "Content-Range"---- | \"Accept-Ranges\".-hAcceptRanges :: H.HeaderName-hAcceptRanges = "Accept-Ranges"---- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'--- for the range specified.-contentRangeHeader :: Integer -> Integer -> Integer -> H.Header-contentRangeHeader beg end total = (hContentRange, range)- where- range = B.pack- -- building with ShowS- $ 'b' : 'y': 't' : 'e' : 's' : ' '- : (if beg > end then ('*':) else- showInt beg- . ('-' :)- . showInt end)- ( '/'- : showInt total "")---- | Given the full size of a file and optionally a Range header value,--- determine the range to serve by parsing the range header and obeying it, or--- serving the whole file if it's absent or malformed.-chooseFilePart :: Integer -> Maybe B.ByteString -> FilePart-chooseFilePart size Nothing = FilePart 0 size size-chooseFilePart size (Just range) = case parseByteRanges range >>= listToMaybe of- -- Range is broken- Nothing -> FilePart 0 size size- Just hrange -> checkRange hrange- where- checkRange (H.ByteRangeFrom beg) = fromRange beg (size - 1)- checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (size - 1) end)- checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (size - count)) (size - 1)-- fromRange beg end = FilePart beg (end - beg + 1) size---- | Adjust the given 'H.Status' and 'H.ResponseHeaders' based on the given--- 'FilePart'. This means replacing the status with 206 if the response is--- partial, and adding the Content-Length and Accept-Ranges (always) and--- Content-Range (if appropriate) headers.-adjustForFilePart :: H.Status -> H.ResponseHeaders -> FilePart -> (H.Status, H.ResponseHeaders)-adjustForFilePart s h part = (s', h'')- where- off = filePartOffset part- len = filePartByteCount part- size = filePartFileSize part-- contentRange = contentRangeHeader off (off + len - 1) size- lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len- s' = if filePartByteCount part /= size then H.partialContent206 else s- h' = (H.hContentLength, lengthBS):(hAcceptRanges, "bytes"):h- h'' = (if len == size then id else (contentRange:)) h'---- | Parse the value of a Range header into a 'HH.ByteRanges'.-parseByteRanges :: B.ByteString -> Maybe HH.ByteRanges-parseByteRanges bs1 = do- bs2 <- stripPrefix "bytes=" bs1- (r, bs3) <- range bs2- ranges (r:) bs3- where- range bs2 = do- (i, bs3) <- B.readInteger bs2- if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")- then Just (HH.ByteRangeSuffix (negate i), bs3)- else do- bs4 <- stripPrefix "-" bs3- case B.readInteger bs4 of- Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5)- _ -> Just (HH.ByteRangeFrom i, bs4)- ranges front bs3- | B.null bs3 = Just (front [])- | otherwise = do- bs4 <- stripPrefix "," bs3- (r, bs5) <- range bs4- ranges (front . (r:)) bs5-- stripPrefix x y- | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)- | otherwise = Nothing
README.md view
@@ -67,7 +67,7 @@ An `Application` maps `Request`s to `Response`s: ghci> :info Application- type Application = Request -> IO Response+ type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived Depending on the path info provided with each `Request` we can serve different `Response`s:
test/Network/WaiSpec.hs view
@@ -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)
wai.cabal view
@@ -1,8 +1,10 @@+Cabal-Version: >=1.10 Name: wai-Version: 3.0.5.0+Version: 3.2.5 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers.-description: API docs and the README are available at <http://www.stackage.org/package/wai>.+ .+ API docs and the README are available at <http://www.stackage.org/package/wai>. License: MIT License-file: LICENSE Author: Michael Snoyman@@ -10,43 +12,36 @@ 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.10- , bytestring-builder >= 0.10.4.0 && < 0.10.7- , blaze-builder >= 0.2.1.4 && < 0.5+ 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- , transformers >= 0.0- , unix-compat >= 0.2 , vault >= 0.3 && < 0.4 Exposed-modules: Network.Wai- Network.Wai.HTTP2 Network.Wai.Internal 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