diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,69 @@ +# 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 + +## 3.0.4.0 + +* A new module `Network.Wai.HTTP2` is exported. + +## 3.0.3.0 + +* `mapResponseHeaders`, `ifRequest` and `modifyResponse` are exported. + +## 3.0.2.3 + +* Allow blaze-builder 0.4 + +## 3.0.2.2 + +* Clarify some documentation on `rawPathInfo`. [Relevant Github + discussion](https://github.com/yesodweb/wai/issues/325#issuecomment-69896780). diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,20 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2010, Michael Snoyman. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO -EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, -OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Network/Wai.hs b/Network/Wai.hs --- a/Network/Wai.hs +++ b/Network/Wai.hs @@ -1,309 +1,580 @@ -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE DeriveDataTypeable #-} {-| 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 'Source' for the request body and -'Enumerator' for the response bodies. The advantages of this approach over lazy -IO have been debated elsewhere. - -Nonetheless, many people find these data structures difficult to work with. For -that reason, this library includes the "Network.Wai.Enumerator" module to -provide more familiar abstractions, including lazy IO. +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. -A final note: 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. +Please remember when using this package that, while your application may +compile without a hitch against many different servers, there are other +considerations to be taken when moving to a new backend. For example, if you +transfer from a CGI application to a FastCGI one, you might suddenly find you +have a memory leak. Conversely, a FastCGI application would be well served to +preload all templates from disk when first starting; this would kill the +performance of a CGI application. +This package purposely provides very little functionality. You can find various +middlewares, backends and utilities on Hackage. Some of the most commonly used +include: + +[warp] + +[wai-extra] + -} +-- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response. +{-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.Wai - ( -- * Data types - - -- ** Request method - Method - -- ** HTTP protocol versions - , HttpVersion - , http09 - , http10 - , http11 - -- ** Case-insensitive byte strings - , CIByteString (..) - , mkCIByteString - -- ** Request header names - , RequestHeader - -- ** Response header names - , ResponseHeader - -- ** Response status code - , Status (..) - , status200 - , status301 - , status302 - , status303 - , status400 - , status401 - , status403 - , status404 - , status405 - , status500 - -- ** Response body - , ResponseBody (..) - -- ** Source - , Source (..) - -- * Enumerator - , Enumerator (..) - -- * WAI interface - , Request (..) - , Response (..) - , Application + ( + -- * Types + Application , Middleware + , ResponseReceived + -- * Request + , Request + , defaultRequest + , RequestBodyLength (..) + -- ** Request accessors + , requestMethod + , httpVersion + , rawPathInfo + , rawQueryString + , requestHeaders + , isSecure + , remoteHost + , pathInfo + , queryString + , getRequestBodyChunk + , requestBody + , vault + , requestBodyLength + , requestHeaderHost + , requestHeaderRange + , requestHeaderReferer + , requestHeaderUserAgent + -- $streamingRequestBodies + , strictRequestBody + , consumeRequestBodyStrict + , lazyRequestBody + , consumeRequestBodyLazy + -- ** Request modifiers + , setRequestBodyChunks + , mapRequestHeaders + -- * Response + , Response + , StreamingBody + , FilePart (..) + -- ** Response composers + , responseFile + , responseBuilder + , responseLBS + , responseStream + , responseRaw + -- ** Response accessors + , responseStatus + , responseHeaders + -- ** Response modifiers + , responseToStream + , mapResponseHeaders + , mapResponseStatus + -- * Middleware composition + , ifRequest + , modifyRequest + , modifyResponse ) where -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Lazy as L -import Data.Char (toLower) -import Data.String (IsString (..)) -import Data.Typeable (Typeable) +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.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) --- | HTTP request method. Since the HTTP protocol allows arbitrary request --- methods, we leave this open as a 'B.ByteString'. Please note the request --- methods are case-sensitive. -type Method = B.ByteString +---------------------------------------------------------------- --- | Version of HTTP protocol used in current request. The value given here --- should be everything following the \"HTTP/\" line in a request. In other --- words, HTTP\/1.1 -> \"1.1\", HTTP\/1.0 -> \"1.0\". -type HttpVersion = B.ByteString +-- | Creating 'Response' from a file. +-- +-- @since 2.0.0 +responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response +responseFile = ResponseFile --- | HTTP/0.9 -http09 :: HttpVersion -http09 = B8.pack "0.9" +-- | Creating 'Response' from 'Builder'. +-- +-- Some questions and answers about the usage of 'Builder' here: +-- +-- Q1. Shouldn't it be at the user's discretion to use Builders internally and +-- then create a stream of ByteStrings? +-- +-- A1. That would be less efficient, as we wouldn't get cheap concatenation +-- with the response headers. +-- +-- Q2. Isn't it really inefficient to convert from ByteString to Builder, and +-- then right back to ByteString? +-- +-- 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 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 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 --- | HTTP/1.0 -http10 :: HttpVersion -http10 = B8.pack "1.0" +-- | 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 . lazyByteString --- | HTTP/1.1 -http11 :: HttpVersion -http11 = B8.pack "1.1" +-- | Creating 'Response' from a stream of values. +-- +-- In order to allocate resources in an exception-safe manner, you can use the +-- @bracket@ pattern outside of the call to @responseStream@. As a trivial +-- example: +-- +-- @ +-- app :: Application +-- app req respond = bracket_ +-- (putStrLn \"Allocating scarce resource\") +-- (putStrLn \"Cleaning up\") +-- $ respond $ responseStream status200 [] $ \\write flush -> do +-- write $ byteString \"Hello\\n\" +-- flush +-- 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 +responseStream = ResponseStream --- | A case insensitive bytestring, where the 'Eq' and 'Ord' instances do --- comparisons based on the lower-cased version of this string. For efficiency, --- this datatype contains both the original and lower-case version of the --- string; this means there is no need to lower-case the bytestring for every --- comparison. +-- | Create a response for a raw application. This is useful for \"upgrade\" +-- situations such as WebSockets, where an application requests for the server +-- to grant it raw network access. -- --- Please note that this datatype has an 'IsString' instance, which can allow --- for very concise code when using the OverloadedStrings language extension. -data CIByteString = CIByteString - { ciOriginal :: !B.ByteString - , ciLowerCase :: !B.ByteString - } +-- This function requires a backup response to be provided, for the case where +-- the handler in question does not support such upgrading (e.g., CGI apps). +-- +-- 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 +responseRaw = ResponseRaw --- | Convert a regular bytestring to a case-insensitive bytestring. -mkCIByteString :: B.ByteString -> CIByteString -mkCIByteString bs = CIByteString bs $ B8.map toLower bs +---------------------------------------------------------------- -instance Show CIByteString where - show = show . ciOriginal -instance Eq CIByteString where - x == y = ciLowerCase x == ciLowerCase y -instance Ord CIByteString where - x <= y = ciLowerCase x <= ciLowerCase y -instance IsString CIByteString where - fromString = mkCIByteString . fromString +-- | 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 --- | Headers sent from the client to the server. Note that this is a --- case-insensitive string, as the HTTP spec specifies. -type RequestHeader = CIByteString +-- | 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 --- | Headers sent from the server to the client. Note that this is a --- case-insensitive string, as the HTTP spec specifies. -type ResponseHeader = CIByteString +-- | Converting the body information in 'Response' to a 'StreamingBody'. +-- +-- @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 + , h + , \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> withBody $ \sendChunk _flush -> do + IO.hSeek handle IO.AbsoluteSeek $ filePartOffset part + let loop remaining | remaining <= 0 = return () + loop remaining = do + bs <- B.hGetSome handle defaultChunkSize + unless (B.null bs) $ do + let x = B.take remaining bs + sendChunk $ byteString x + loop $ remaining - B.length x + loop $ fromIntegral $ filePartByteCount part + ) +responseToStream (ResponseFile s h fp Nothing) = + ( s + , h + , \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> + withBody $ \sendChunk _flush -> fix $ \loop -> do + bs <- B.hGetSome handle defaultChunkSize + unless (B.null bs) $ do + sendChunk $ byteString bs + loop + ) +responseToStream (ResponseBuilder s h b) = + (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b) +responseToStream (ResponseRaw _ res) = responseToStream res --- | HTTP status code; a combination of the integral code and a status message. --- Equality is determined solely on the basis of the integral code. -data Status = Status { statusCode :: Int, statusMessage :: B.ByteString } - deriving Show +-- | 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 -instance Eq Status where - x == y = statusCode x == statusCode y +-- | 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 --- | OK -status200 :: Status -status200 = Status 200 $ B8.pack "OK" +---------------------------------------------------------------- --- | Moved Permanently -status301 :: Status -status301 = Status 301 $ B8.pack "Moved Permanently" +-- | The WAI application. +-- +-- Note that, since WAI 3.0, this type is structured in continuation passing +-- style to allow for proper safe resource handling. This was handled in the +-- past via other means (e.g., @ResourceT@). As a demonstration: +-- +-- @ +-- app :: Application +-- app req respond = bracket_ +-- (putStrLn \"Allocating scarce resource\") +-- (putStrLn \"Cleaning up\") +-- (respond $ responseLBS status200 [] \"Hello World\") +-- @ +type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived --- | Found -status302 :: Status -status302 = Status 302 $ B8.pack "Found" --- | See Other -status303 :: Status -status303 = Status 303 $ B8.pack "See Other" +-- | A default, blank request. +-- +-- @since 2.0.0 +defaultRequest :: Request +defaultRequest = Request + { requestMethod = H.methodGet + , httpVersion = H.http10 + , rawPathInfo = B.empty + , rawQueryString = B.empty + , requestHeaders = [] + , isSecure = False + , remoteHost = SockAddrInet 0 0 + , pathInfo = [] + , queryString = [] + , requestBody = return B.empty + , vault = mempty + , requestBodyLength = KnownLength 0 + , requestHeaderHost = Nothing + , requestHeaderRange = Nothing + , requestHeaderReferer = Nothing + , requestHeaderUserAgent = Nothing + } --- | Bad Request -status400 :: Status -status400 = Status 400 $ B8.pack "Bad Request" --- | Unauthorized -status401 :: Status -status401 = Status 401 $ B8.pack "Unauthorized" - --- | Forbidden -status403 :: Status -status403 = Status 403 $ B8.pack "Forbidden" - --- | Not Found -status404 :: Status -status404 = Status 404 $ B8.pack "Not Found" +-- | A @Middleware@ is a component that sits between the server and application. +-- +-- It can modify both the 'Request' and 'Response', +-- to provide simple transformations that are required for all (or most of) +-- your web server’s routes. +-- +-- = Users of middleware +-- +-- If you are trying to apply one or more 'Middleware's to your 'Application', +-- just call them as functions. +-- +-- For example, if you have @corsMiddleware@ and @authorizationMiddleware@, +-- and you want to authorize first, you can do: +-- +-- @ +-- let allMiddleware app = authorizationMiddleware (corsMiddleware app) +-- @ +-- +-- to get a new 'Middleware', which first authorizes, then sets, CORS headers. +-- The “outer” middleware is called first. +-- +-- You can also chain them via '(.)': +-- +-- @ +-- let allMiddleware = +-- authorizationMiddleware +-- . corsMiddleware +-- . … more middleware here … +-- @ +-- +-- Then, once you have an @app :: Application@, you can wrap it +-- in your middleware: +-- +-- @ +-- let myApp = allMiddleware app :: Application +-- @ +-- +-- and run it as usual: +-- +-- @ +-- Warp.run port myApp +-- @ +-- +-- = Authors of middleware +-- +-- When fully expanded, 'Middleware' has the type signature: +-- +-- > (Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived) -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived +-- +-- or if we shorten to @type Respond = Response -> IO ResponseReceived@: +-- +-- > (Request -> Respond -> IO ResponseReceived) -> Request -> Respond -> IO ResponseReceived +-- +-- so a middleware definition takes 3 arguments, an inner application, a request and a response callback. +-- +-- Compare with the type of a simple `Application`: +-- +-- > Request -> Respond -> IO ResponseReceived +-- +-- It takes the 'Request' and @Respond@, but not the extra application. +-- +-- Said differently, a middleware has the power of a normal 'Application' +-- — it can inspect the 'Request' and return a 'Response' — +-- but it can (and in many cases it /should/) also call the 'Application' which was passed to it. +-- +-- == Modifying the 'Request' +-- +-- A lot of middleware just looks at the request and does something based on its values. +-- +-- For example, the @authorizationMiddleware@ from above could look at the @Authorization@ +-- HTTP header and run verification logic against the database. +-- +-- @ +-- authorizationMiddleware app req respond = do +-- case verifyJWT ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT -> app req respond +-- @ +-- +-- Notice how the inner app is called when the validation was successful. +-- If it was not, we can respond +-- e.g. with , +-- by constructing a 'Response' with 'responseLBS' and passing it to @respond@. +-- +-- == Passing arguments to and from your 'Middleware' +-- +-- Middleware must often be configurable. +-- Let’s say you have a type @JWTSettings@ that you want to be passed to the middleware. +-- Simply pass an extra argument to your middleware. Then your middleware type turns into: +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> Application -> Request -> Respond -> IO ResponseReceived +-- authorizationMiddleware jwtSettings req respond = +-- case verifyJWT jwtSettings ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT -> app req respond +-- @ +-- +-- or alternatively: +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> Middleware +-- @ +-- +-- Perhaps less intuitively, you can also /pass on/ data from middleware to the wrapped 'Application': +-- +-- @ +-- authorizationMiddleware :: JWTSettings -> (JWT -> Application) -> Request -> Respond -> IO ResponseReceived +-- authorizationMiddleware jwtSettings req respond = +-- case verifyJWT jwtSettings ('requestHeaders' req) of +-- InvalidJWT err -> respond (invalidJWTResponse err) +-- ValidJWT jwt -> app jwt req respond +-- @ +-- +-- although then, chaining different middleware has to take this extra argument into account: +-- +-- @ +-- let finalApp = +-- authorizationMiddleware +-- (\\jwt -> corsMiddleware +-- (… more middleware here … +-- (app jwt))) +-- @ +-- +-- == Modifying the 'Response' +-- +-- 'Middleware' can also modify the 'Response' that is returned by the inner application. +-- +-- This is done by taking the @respond@ callback, using it to define a new @respond'@, +-- and passing this new @respond'@ to the @app@: +-- +-- @ +-- gzipMiddleware app req respond = do +-- let respond' resp = do +-- resp' <- gzipResponseBody resp +-- respond resp' +-- app req respond' +-- @ +-- +-- However, modifying the response (especially the response body) is not trivial, +-- so in order to get a sense of how to do it (dealing with the type of 'responseToStream'), +-- it’s best to look at an example, for example . --- | Method Not Allowed -status405 :: Status -status405 = Status 405 $ B8.pack "Method Not Allowed" +type Middleware = Application -> Application --- | Internal Server Error -status500 :: Status -status500 = Status 500 $ B8.pack "Internal Server Error" +-- | Apply a function that modifies a request as a 'Middleware' +-- +-- @since 3.2.4 +modifyRequest :: (Request -> Request) -> Middleware +modifyRequest f app = app . f --- | This is a source for 'B.ByteString's. It is a function (wrapped in a --- newtype) that will return Nothing if the data has been completely consumed, --- or return the next 'B.ByteString' from the source along with a new 'Source' --- to continue reading from. +-- | Apply a function that modifies a response as a 'Middleware' -- --- Be certain not to reuse a 'Source'! It might work fine with some --- implementations of 'Source', while causing bugs with others. +-- @since 3.0.3.0 +modifyResponse :: (Response -> Response) -> Middleware +modifyResponse f app req respond = app req $ respond . f + +-- | Conditionally apply a 'Middleware' -- --- This datatype is used by WAI to represent a request body. We choose this --- over an enumerator in that it gives the application power over control flow. --- This not only makes it easier to use in many situations, but also allows --- implementation of some features such as a backtracking parser which doesn't --- read the entire body into memory. -newtype Source = Source { runSource :: IO (Maybe (B.ByteString, Source)) } +-- @since 3.0.3.0 +ifRequest :: (Request -> Bool) -> Middleware -> Middleware +ifRequest rpred middle app req + | rpred req = middle app req + | otherwise = app req --- | An enumerator is a data producer. It takes two arguments: a function to --- enumerate over (the iteratee) and an accumulating parameter. As the --- enumerator produces output, it calls the iteratee, thereby avoiding the need --- to allocate large amounts of memory for storing the entire piece of data. +-- $streamingRequestBodies -- --- Normally in Haskell, we can achieve the same results with laziness. For --- example, an inifinite list does not require inifinite memory storage; we --- simply get away with thunks. However, when operating in the IO monad, we do --- not have this luxury. There are other approaches, such as lazy I\/O. If you --- would like to program in this manner, please see --- "Network.Wai.Enumerator", in particular toLBS. +-- == Streaming Request Bodies -- --- That said, let's address the details of this particular enumerator --- implementation. You'll notice that the iteratee is a function that takes two --- arguments and returns an 'Either' value. The second argument is simply the --- piece of data generated by the enumerator. The 'Either' value at the end is --- a means to alert the enumerator whether to continue or not. If it returns --- 'Left', then the enumeration should cease. If it returns 'Right', it should --- continue. +-- 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@. -- --- The accumulating parameter (a) has meaning only to the iteratee; the --- enumerator simply passes it around. The enumerator itself also returns an --- 'Either' value; a 'Right' means the enumerator ran to completion, while a --- 'Left' indicates early termination was requested by the iteratee. +-- 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. -- --- 'Enumerator's are not required to be resumable. That is to say, the --- 'Enumerator' may only be called once. While this requirement puts a bit of a --- strain on the caller in some situations, it saves a large amount of --- complication- and thus performance- on the producer. +-- Consider these tips to avoid reading the entire request body into memory: -- --- In WAI, an Enumerator is used to represent the response body. We have --- specifically chosen one of the simplest representations of an enumerator to --- avoid coding complication and performance overhead. -newtype Enumerator = Enumerator { runEnumerator :: forall a. - (a -> B.ByteString -> IO (Either a a)) - -> a - -> IO (Either a a) -} - --- | Information on the request sent by the client. This abstracts away the --- details of the underlying implementation. -data Request = Request - { requestMethod :: Method - , httpVersion :: 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. - , pathInfo :: B.ByteString - -- | If no query string was specified, this should be empty. - , queryString :: B.ByteString - , serverName :: B.ByteString - , serverPort :: Int - , requestHeaders :: [(RequestHeader, B.ByteString)] - -- ^ Was this request made over an SSL connection? - , isSecure :: Bool - , requestBody :: Source - -- ^ Log the given line in some method; how this is accomplished is - -- server-dependant. - , errorHandler :: String -> IO () - -- | The client\'s host information. - , remoteHost :: B.ByteString - } - deriving Typeable - --- | The response body returned to the server from the application. We provide --- three separate constructors as optimizations: +-- * 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. -- --- * 'ResponseEnumerator' is the most general type, allowing constant-memory --- production of a response, even in the presence of interleaved I\/O actions. +-- 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: -- --- * 'ResponseFile' serves a static file from the filesystem. Many servers use --- a sendfile system call to optimize this type of serving, making this a huge --- performance gain. +-- * 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. -- --- * 'ResponseLBS'. Often times, we wish to return a response that includes no --- interleaved I\/O. In this case, we can use Haskell's natural laziness to our --- advantage, and represent the response as a lazy bytestring. -data ResponseBody = ResponseFile FilePath - | ResponseEnumerator Enumerator - | ResponseLBS L.ByteString - deriving Typeable +-- 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. -data Response = Response - { status :: Status - , responseHeaders :: [(ResponseHeader, B.ByteString)] - -- | A common optimization is to use the sendfile system call when sending - -- files from the disk. This datatype facilitates this optimization; if - -- 'Left' is returned, the server will send the file from the disk by - -- whatever means it wishes. If 'Right', it will call the 'Enumerator'. - , responseBody :: ResponseBody - } - deriving Typeable +-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy +-- I\/O, instead reading the entire body into memory strictly. +-- +-- 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 <- getRequestBodyChunk req + if B.null bs + then return $ front LI.Empty + else loop (front . LI.Chunk bs) -type Application = Request -> IO Response +-- | 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 --- | 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. +-- | 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. -- --- 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 signatures for this middleware --- might be: +-- Note: Since this function consumes the request body, future calls to it will return the empty string. -- --- @ loadSession :: ([(String, String)] -> Application) -> Application @ +-- @since 1.4.1 +lazyRequestBody :: Request -> IO L.ByteString +lazyRequestBody req = + loop + where + loop = unsafeInterleaveIO $ do + 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'. -- --- Here, instead of taking a standard 'Application' as its first argument, the --- middleware takes a function which consumes the session information as well. -type Middleware = Application -> Application +-- @since 3.2.3 +consumeRequestBodyLazy :: Request -> IO L.ByteString +consumeRequestBodyLazy = lazyRequestBody + +-- | Apply the provided function to the request header list of the 'Request'. +-- +-- @since 3.2.4 +mapRequestHeaders :: (H.RequestHeaders -> H.RequestHeaders) -> Request -> Request +mapRequestHeaders f request = request { requestHeaders = f (requestHeaders request) } diff --git a/Network/Wai/Enumerator.hs b/Network/Wai/Enumerator.hs deleted file mode 100644 --- a/Network/Wai/Enumerator.hs +++ /dev/null @@ -1,141 +0,0 @@ -{-# LANGUAGE Rank2Types #-} --- | A collection of utility functions for dealing with 'Enumerator's. -module Network.Wai.Enumerator - ( -- * Utilities - mapE - -- * Conversions - , -- ** Lazy byte strings - toLBS - , fromLBS - , fromLBS' - -- ** Source - , toSource - -- ** Handle - , fromHandle - , fromHandleFinally - -- ** FilePath - , fromFile - , fromFileFinally - , fromTempFile - , fromResponseBody - ) where - -import Network.Wai (Enumerator (..), Source (..), ResponseBody (..)) -import qualified Network.Wai.Source as Source -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as B -import System.Directory (removeFile) -import System.IO (withBinaryFile, IOMode (ReadMode), Handle, hIsEOF) -import Data.ByteString.Lazy.Internal (defaultChunkSize) -import Control.Concurrent (forkIO) -import Control.Concurrent.MVar -import Control.Exception -import Control.Monad ((<=<)) - --- | Performs a specified conversion on each 'B.ByteString' output by an --- enumerator. -mapE :: (B.ByteString -> B.ByteString) -> Enumerator -> Enumerator -mapE f (Enumerator e) = Enumerator $ \iter -> e (iter' iter) where - iter' iter a = iter a . f - --- | This uses 'unsafeInterleaveIO' to lazily read from an enumerator. All --- normal lazy I/O warnings apply. In addition, since it is based on --- 'toSource', please observe all precautions for that function. -toLBS :: Enumerator -> IO L.ByteString -toLBS = Source.toLBS <=< toSource - --- | This function safely converts a lazy bytestring into an enumerator. -fromLBS :: L.ByteString -> Enumerator -fromLBS lbs = Enumerator $ \iter a0 -> helper iter a0 $ L.toChunks lbs where - helper _ a [] = return $ Right a - helper iter a (x:xs) = do - ea <- iter a x - case ea of - Left a' -> return $ Left a' - Right a' -> helper iter a' xs - --- | Same as 'fromLBS', but the lazy bytestring is in the IO monad. This allows --- you to lazily read a file into memory, perform some mapping on the data and --- convert it into an enumerator. -fromLBS' :: IO L.ByteString -> Enumerator -fromLBS' lbs' = Enumerator $ \iter a0 -> lbs' >>= \lbs -> - runEnumerator (fromLBS lbs) iter a0 - --- | This function uses another thread to convert an 'Enumerator' to a --- 'Source'. In essence, this allows you to write code which \"pulls\" instead --- of code which is pushed to. While this can be a useful technique, some --- caveats apply: --- --- * It will be more resource heavy than using the 'Enumerator' directly. --- --- * You *must* consume all input. If you do not, then the other thread will be --- deadlocked. -toSource :: Enumerator -> IO Source -toSource (Enumerator e) = do - buff <- newEmptyMVar - _ <- forkIO $ e (helper buff) () >> putMVar buff Nothing - return $ source buff - where - helper :: MVar (Maybe B.ByteString) - -> () - -> B.ByteString - -> IO (Either () ()) - helper buff _ bs = do - putMVar buff $ Just bs - return $ Right () - source :: MVar (Maybe B.ByteString) - -> Source - source mmbs = Source $ do - mbs <- takeMVar mmbs - case mbs of - Nothing -> do - -- By putting Nothing back in, the source can be called - -- again without causing a deadlock. - putMVar mmbs Nothing - return Nothing - Just bs -> return $ Just (bs, source mmbs) - --- | Read a chunk of data from the given 'Handle' at a time. We use --- 'defaultChunkSize' from the bytestring package to determine the largest --- chunk to take. -fromHandle :: Handle -> Enumerator -fromHandle h = Enumerator $ \iter a -> do - eof <- hIsEOF h - if eof - then return $ Right a - else do - bs <- B.hGet h defaultChunkSize - ea' <- iter a bs - case ea' of - Left a' -> return $ Left a' - Right a' -> runEnumerator (fromHandle h) iter a' - --- | Wrapper around fromHandle to perform an action after EOF or an exception. -fromHandleFinally :: Handle -> IO a -> Enumerator -fromHandleFinally h onEOF = Enumerator $ \iter a0 -> - finally (runEnumerator (fromHandle h) iter a0) - onEOF - --- | A little wrapper around 'fromHandle' which first opens a file for reading. -fromFile :: FilePath -> Enumerator -fromFile fp = Enumerator $ \iter a0 -> withBinaryFile fp ReadMode $ \h -> - runEnumerator (fromHandle h) iter a0 - --- | Wrapper around fromFile to perform an action after the file is closed. -fromFileFinally :: FilePath -> IO a -> Enumerator -fromFileFinally fp onClose = Enumerator $ \iter a0 -> - finally (runEnumerator (fromFile fp) iter a0) - onClose - --- | Enumerator to read and remove a file. Being based on 'fromFileFinally', it --- ensures the file is removed, even in the presence of exceptions. -fromTempFile :: FilePath -> Enumerator -fromTempFile fp = fromFileFinally fp $ removeFile fp - --- | Since the response body is defined as a 'ResponseBody', this function --- simply reduces the whole value to an enumerator. This can be convenient for --- server implementations not optimizing file sending. -fromResponseBody :: ResponseBody -> Enumerator -fromResponseBody (ResponseEnumerator e) = e -fromResponseBody (ResponseLBS lbs) = fromLBS lbs -fromResponseBody (ResponseFile fp) = fromFile fp diff --git a/Network/Wai/Internal.hs b/Network/Wai/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Internal.hs @@ -0,0 +1,173 @@ +{-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE RecordWildCards #-} +-- | Internal constructors and helper functions. Note that no guarantees are +-- given for stability of these interfaces. +module Network.Wai.Internal where + +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 Network.Socket (SockAddr) +import Data.List (intercalate) + +-- | 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 + -- | 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. 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 + , 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 + -- | 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 + fields = + [("requestMethod",show requestMethod) + ,("httpVersion",show httpVersion) + ,("rawPathInfo",show rawPathInfo) + ,("rawQueryString",show rawQueryString) + ,("requestHeaders",show requestHeaders) + ,("isSecure",show isSecure) + ,("remoteHost",show remoteHost) + ,("pathInfo",show pathInfo) + ,("queryString",show queryString) + ,("requestBody","") + ,("vault","") + ,("requestBodyLength",show requestBodyLength) + ,("requestHeaderHost",show requestHeaderHost) + ,("requestHeaderRange",show requestHeaderRange) + ] + + +data Response + = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) + | ResponseBuilder H.Status H.ResponseHeaders Builder + | ResponseStream H.Status H.ResponseHeaders StreamingBody + | ResponseRaw (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()) Response + deriving Typeable + +-- | Represents a streaming HTTP response body. It's a function of two +-- parameters; the first parameter provides a means of sending another chunk of +-- data, and the second parameter provides a means of flushing the data to the +-- client. +-- +-- @since 3.0.0 +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 + +-- | 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 + , 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 +-- Application. +-- +-- It is /highly/ advised that only WAI handlers import and use the data +-- constructor for this data type. +-- +-- @since 3.0.0 +data ResponseReceived = ResponseReceived + deriving Typeable diff --git a/Network/Wai/Source.hs b/Network/Wai/Source.hs deleted file mode 100644 --- a/Network/Wai/Source.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Network.Wai.Source - ( - -- * Conversions - toEnumerator - , toLBS - , fromLBS - ) where - -import Network.Wai -import qualified Data.ByteString.Lazy as L -import System.IO.Unsafe (unsafeInterleaveIO) - --- | This function safely converts a 'Source' (where you pull data) to an --- 'Enumerator' (which pushes the data to you). There should be no significant --- performance impact from its use, and it uses no unsafe functions. -toEnumerator :: Source -> Enumerator -toEnumerator source0 = Enumerator $ helper source0 where - helper source iter a = do - next <- runSource source - case next of - Nothing -> return $ Right a - Just (bs, source') -> do - res <- iter a bs - case res of - Left a' -> return $ Left a' - Right a' -> helper source' iter a' - --- | Uses lazy I\/O (via 'unsafeInterleaveIO') to provide a lazy interface to --- the given 'Source'. Normal lazy I\/O warnings apply. -toLBS :: Source -> IO L.ByteString -toLBS source0 = L.fromChunks `fmap` helper source0 where - helper source = unsafeInterleaveIO $ do - next <- runSource source - case next of - Nothing -> return [] - Just (bs, source') -> do - rest <- helper source' - return $ bs : rest - --- | Convert a lazy bytestring to a 'Source'. This operation does not request lazy I\/O. -fromLBS :: L.ByteString -> Source -fromLBS = - go . L.toChunks - where - go [] = Source $ return Nothing - go (x:xs) = Source $ return $ Just (x, go xs) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,116 @@ +WAI: Web Application Interface +============================== + +Getting started +--------------- + +You want a minimal example? Here it is! + +~~~ {.haskell} +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.HTTP.Types +import Network.Wai.Handler.Warp (run) + +app :: Application +app _ respond = do + putStrLn "I've done some IO here" + respond $ responseLBS + status200 + [("Content-Type", "text/plain")] + "Hello, Web!" + +main :: IO () +main = do + putStrLn $ "http://localhost:8080/" + run 8080 app +~~~ + +Put that code into a file named _hello.hs_ and install [wai] and [warp] from Hackage: + + cabal install wai warp + +Run it: + + runhaskell hello.hs + +Point your browser to: + + http://localhost:8080/ + + +Serving static content +---------------------- + +We can modify our previous example to serve static content. For this create a file named _index.html_: + +

Hello, Web!

+ +Now we redefine `responseBody` to refer to that file: + +~~~ {.haskell} +app2 :: Application +app2 _ respond = respond index + +index :: Response +index = responseFile + status200 + [("Content-Type", "text/html")] + "index.html" + Nothing +~~~ + + +Basic dispatching +----------------- + +An `Application` maps `Request`s to `Response`s: + + ghci> :info Application + type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived + +Depending on the path info provided with each `Request` we can serve different `Response`s: + +~~~ {.haskell} +app3 :: Application +app3 request respond = respond $ case rawPathInfo request of + "/" -> index + "/raw/" -> plainIndex + _ -> notFound + +plainIndex :: Response +plainIndex = responseFile + status200 + [("Content-Type", "text/plain")] + "index.html" + Nothing + +notFound :: Response +notFound = responseLBS + status404 + [("Content-Type", "text/plain")] + "404 - Not Found" +~~~ + + +Doing without overloaded strings +-------------------------------- + +For the sake of efficiency, WAI uses the [bytestring] package. We used GHCs [overloaded strings] to almost hide this fact. But we can easily do without. What follows is a more verbose definition of `notFound`, that works without GHC extensions: + +~~~ {.haskell .ignore} +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy.Char8 as LB8 +import Data.CaseInsensitive (mk) + +notFound = responseLBS + status404 + [(mk $ B8.pack "Content-Type", B8.pack "text/plain")] + (LB8.pack "404 - Not Found") +~~~ + + + [wai]: http://hackage.haskell.org/package/wai + [warp]: http://hackage.haskell.org/package/warp + [overloaded strings]: http://www.haskell.org/ghc/docs/latest/html/users_guide/type-class-extensions.html#overloaded-strings + [bytestring]: http://hackage.haskell.org/package/bytestring diff --git a/test/Network/WaiSpec.hs b/test/Network/WaiSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/WaiSpec.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE LambdaCase #-} +module Network.WaiSpec (spec) where + +import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import Network.Wai +import Data.Word (Word8) +import Data.IORef +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import Data.ByteString.Builder (Builder, toLazyByteString, word8) +import Control.Monad (forM_) + +spec :: Spec +spec = do + describe "responseToStream" $ do + let getBody res = do + let (_, _, f) = responseToStream res + f $ \streamingBody -> do + builderRef <- newIORef mempty + let add :: Builder -> IO () + add b = atomicModifyIORef builderRef $ \builder -> + (builder `mappend` b, ()) + flush :: IO () + flush = return () + streamingBody add flush + 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 word8 bytes + body `shouldBe` S.pack bytes + prop "responseStream" $ \chunks -> do + body <- getBody $ responseStream undefined undefined $ \sendChunk _ -> + forM_ chunks $ \chunk -> sendChunk $ mconcat $ map word8 chunk + body `shouldBe` S.concat (map S.pack chunks) + it "responseFile total" $ do + let fp = "wai.cabal" + body <- getBody $ responseFile undefined undefined fp Nothing + expected <- S.readFile fp + body `shouldBe` expected + prop "responseFile partial" $ \offset' count' -> do + let fp = "wai.cabal" + totalBS <- S.readFile fp + 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 + } + let expected = S.take count $ S.drop offset totalBS + body `shouldBe` expected + describe "lazyRequestBody" $ do + prop "works" $ \chunks -> do + req <- mkRequestFromChunks chunks + body <- lazyRequestBody req + body `shouldBe` L.fromChunks (map S.pack chunks) + it "is lazy" $ do + let req = setRequestBodyChunks (error "requestBody") defaultRequest + _ <- lazyRequestBody req + return () + describe "strictRequestBody" $ do + prop "works" $ \chunks -> do + req <- mkRequestFromChunks chunks + body <- strictRequestBody req + body `shouldBe` L.fromChunks (map S.pack chunks) + +mkRequestFromChunks :: [[Word8]] -> IO Request +mkRequestFromChunks chunks = do + ref <- newIORef $ map S.pack $ filter (not . null) chunks + pure $ + flip setRequestBodyChunks defaultRequest $ + atomicModifyIORef ref $ \case + [] -> ([], S.empty) + x:y -> (y, x) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/wai.cabal b/wai.cabal --- a/wai.cabal +++ b/wai.cabal @@ -1,26 +1,50 @@ +Cabal-Version: >=1.10 Name: wai -Version: 0.2.2.1 +Version: 3.2.4 Synopsis: Web Application Interface. -Description: Provides a common protocol for communication between web aplications and web servers. -License: BSD3 +Description: Provides a common protocol for communication between web applications and web servers. + . + API docs and the README are available at . +License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com -Homepage: http://github.com/snoyberg/wai +Homepage: https://github.com/yesodweb/wai Category: Web Build-Type: Simple -Cabal-Version: >=1.6 Stability: Stable +extra-source-files: README.md ChangeLog.md Source-repository head type: git - location: git://github.com/snoyberg/wai.git + location: git://github.com/yesodweb/wai.git Library - Build-Depends: base >= 3 && < 5, - bytestring >= 0.9 && < 0.10, - directory >= 1.0 && < 1.2 + 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 + , vault >= 0.3 && < 0.4 Exposed-modules: Network.Wai - Network.Wai.Enumerator - Network.Wai.Source + 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 -Wall + cpp-options: -DTEST + build-depends: base >= 4.8 && < 5 + , wai + , hspec + , bytestring + other-modules: Network.WaiSpec + build-tool-depends: hspec-discover:hspec-discover + +source-repository head + type: git + location: git://github.com/yesodweb/wai.git