wai 3.0.5.0 → 3.2.4
raw patch · 7 files changed
Files
- ChangeLog.md +52/−3
- Network/Wai.hs +287/−44
- Network/Wai/HTTP2.hs +0/−272
- Network/Wai/Internal.hs +38/−112
- README.md +1/−1
- test/Network/WaiSpec.hs +18/−23
- wai.cabal +11/−13
ChangeLog.md view
@@ -1,14 +1,63 @@+# ChangeLog for wai++## 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,15 +1,14 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE CPP #-} {-| 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 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.+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'@@ -31,9 +30,9 @@ [wai-extra] <http://hackage.haskell.org/package/wai-extra> -[wai-test] <http://hackage.haskell.org/package/wai-test>- -}+-- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response.+{-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.Wai ( -- * Types@@ -54,13 +53,22 @@ , remoteHost , pathInfo , queryString+ , getRequestBodyChunk , requestBody , vault , requestBodyLength , requestHeaderHost , requestHeaderRange+ , requestHeaderReferer+ , requestHeaderUserAgent+ -- $streamingRequestBodies , strictRequestBody+ , consumeRequestBodyStrict , lazyRequestBody+ , consumeRequestBodyLazy+ -- ** Request modifiers+ , setRequestBodyChunks+ , mapRequestHeaders -- * Response , Response , StreamingBody@@ -77,21 +85,20 @@ -- ** Response modifiers , responseToStream , mapResponseHeaders+ , mapResponseStatus -- * Middleware composition , ifRequest+ , modifyRequest , modifyResponse ) where -import Blaze.ByteString.Builder (Builder, fromLazyByteString)-import Blaze.ByteString.Builder (fromByteString)+import Data.ByteString.Builder (Builder, byteString, lazyByteString) import Control.Monad (unless) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L 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@@ -101,6 +108,8 @@ ---------------------------------------------------------------- -- | Creating 'Response' from a file.+--+-- @since 2.0.0 responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile = ResponseFile @@ -119,21 +128,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,16 +160,16 @@ -- (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+-- @since 3.0.0 responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody@@ -173,7 +186,7 @@ -- In the event that you read from the request body before returning a -- @responseRaw@, behavior is undefined. ----- Since 2.1.0+-- @since 2.1.0 responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) -> Response -> Response@@ -182,6 +195,8 @@ ---------------------------------------------------------------- -- | Accessing 'H.Status' in 'Response'.+--+-- @since 1.2.0 responseStatus :: Response -> H.Status responseStatus (ResponseFile s _ _ _) = s responseStatus (ResponseBuilder s _ _ ) = s@@ -189,6 +204,8 @@ 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@@ -196,6 +213,8 @@ responseHeaders (ResponseRaw _ res) = responseHeaders res -- | Converting the body information in 'Response' to a 'StreamingBody'.+--+-- @since 3.0.0 responseToStream :: Response -> ( H.Status , H.ResponseHeaders@@ -212,7 +231,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 )@@ -223,7 +242,7 @@ 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 +250,23 @@ 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.@@ -257,7 +287,7 @@ -- | A default, blank request. ----- Since 2.0.0+-- @since 2.0.0 defaultRequest :: Request defaultRequest = Request { requestMethod = H.methodGet@@ -274,64 +304,277 @@ , requestBodyLength = KnownLength 0 , requestHeaderHost = Nothing , requestHeaderRange = Nothing+ , requestHeaderReferer = Nothing+ , requestHeaderUserAgent = Nothing } --- | 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,36 +1,22 @@ {-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -- | 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.ByteString.Builder (Builder)+import qualified Data.ByteString as B 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 -- | Information on the request sent by the client. This abstracts away the -- details of the underlying implementation.+{-# 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 { -- | Request method such as GET. requestMethod :: H.Method@@ -76,26 +62,52 @@ -- | Parsed query string information. , queryString :: H.Query -- | Get the next chunk of the body. Returns 'B.empty' when the- -- body is fully consumed.+ -- body is fully consumed. Since 3.2.2, this is deprecated in favor of 'getRequestBodyChunk'. , 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+ -- @since 1.4.0 , requestBodyLength :: RequestBodyLength -- | The value of the Host header in a HTTP request. --- -- Since 2.0.0+ -- @since 2.0.0 , requestHeaderHost :: Maybe B.ByteString -- | The value of the Range header in a HTTP request. --- -- Since 2.0.0+ -- @since 2.0.0 , requestHeaderRange :: Maybe B.ByteString+ -- | The value of the Referer header in a HTTP request.+ --+ -- @since 3.2.0+ , requestHeaderReferer :: Maybe B.ByteString+ -- | The value of the User-Agent header in a HTTP request.+ --+ -- @since 3.2.0+ , requestHeaderUserAgent :: Maybe B.ByteString } deriving (Typeable) +-- | 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@@ -129,18 +141,20 @@ -- 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+-- @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 , filePartByteCount :: Integer@@ -154,94 +168,6 @@ -- 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,14 +1,14 @@+{-# 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.Word (Word8) import Data.IORef-import Data.Monoid import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Blaze.ByteString.Builder (toByteString, Builder, fromWord8)+import Data.ByteString.Builder (Builder, toLazyByteString, word8) import Control.Monad (forM_) spec :: Spec@@ -24,17 +24,17 @@ 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+ $ 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"@@ -56,29 +56,24 @@ 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.4 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,7 +12,6 @@ Homepage: https://github.com/yesodweb/wai Category: Web Build-Type: Simple-Cabal-Version: >=1.8 Stability: Stable extra-source-files: README.md ChangeLog.md @@ -19,33 +20,30 @@ location: git://github.com/yesodweb/wai.git 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+ build-tool-depends: hspec-discover:hspec-discover source-repository head type: git