diff --git a/Network/Wai.hs b/Network/Wai.hs --- a/Network/Wai.hs +++ b/Network/Wai.hs @@ -5,10 +5,10 @@ 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, generality and type -safety. 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. +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 @@ -18,11 +18,8 @@ projects that are not universal to all servers. The goal is that the 'Request' object contains only data which is meaningful in all circumstances. -Unlike other approaches, this package declares many data types to assist in -type safety. This feels more inline with the general Haskell spirit. - A final note: please remember when using this package that, while your -application my compile without a hitch against many different servers, there +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 @@ -33,33 +30,34 @@ module Network.Wai ( -- * Data types - -- $show_read -- ** Request method - Method (..) - , methodFromBS - , methodToBS - -- ** URL scheme (http versus https) - , UrlScheme (..) + Method -- ** HTTP protocol versions - , HttpVersion (..) - , httpVersionFromBS - , httpVersionToBS + , HttpVersion + , http09 + , http10 + , http11 + -- ** Case-insensitive byte strings + , CIByteString (..) + , mkCIByteString -- ** Request header names - , RequestHeader (..) - , requestHeader - , requestHeaderFromBS - , requestHeaderToBS - , requestHeaderToLower + , RequestHeader -- ** Response header names - , ResponseHeader (..) - , responseHeader - , responseHeaderFromBS - , responseHeaderToBS - , responseHeaderToLower + , ResponseHeader -- ** Response status code , Status (..) - , statusCode - , statusMessage + , status200 + , status301 + , status302 + , status303 + , status400 + , status401 + , status403 + , status404 + , status405 + , status500 + -- ** Response body + , ResponseBody (..) -- ** Source , Source (..) -- * Enumerator @@ -73,281 +71,113 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as L import Data.Char (toLower) - --- $show_read --- --- For the data types below, you should only use the 'Show' and 'Read' --- instances for debugging purposes. Each datatype (excepting 'UrlScheme') has --- associated functions for converting to and from strict 'B.ByteString's; --- these are approrpiate for generating content. - --- | HTTP request method. This data type is extensible via the Method --- constructor. Request methods are case-sensitive, and comparison is achieved --- by converting to a 'B.ByteString' via 'methodToBS'. -data Method = - OPTIONS - | GET - | HEAD - | POST - | PUT - | DELETE - | TRACE - | CONNECT - | Method B.ByteString - deriving (Show, Read) - -instance Eq Method where - x == y = methodToBS x == methodToBS y - -methodFromBS :: B.ByteString -> Method -methodFromBS bs - | B.length bs <= 7 = case B8.unpack bs of - "OPTIONS" -> OPTIONS - "GET" -> GET - "HEAD" -> HEAD - "POST" -> POST - "PUT" -> PUT - "DELETE" -> DELETE - "TRACE" -> TRACE - "CONNECT" -> CONNECT - _ -> Method bs - | otherwise = Method bs - -methodToBS :: Method -> B.ByteString -methodToBS OPTIONS = B8.pack "OPTIONS" -methodToBS GET = B8.pack "GET" -methodToBS HEAD = B8.pack "HEAD" -methodToBS POST = B8.pack "POST" -methodToBS PUT = B8.pack "PUT" -methodToBS DELETE = B8.pack "DELETE" -methodToBS TRACE = B8.pack "TRACE" -methodToBS CONNECT = B8.pack "CONNECT" -methodToBS (Method bs) = bs +import Data.String (IsString (..)) -data UrlScheme = HTTP | HTTPS - deriving (Show, Eq) +-- | 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. This data type is --- extensible via the HttpVersion constructor. Comparison is achieved by --- converting to a 'B.ByteString' via 'httpVersionToBS'. -data HttpVersion = - Http09 - | Http10 - | Http11 - | HttpVersion B.ByteString - deriving (Show, Read) +-- | 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 -instance Eq HttpVersion where - x == y = httpVersionToBS x == httpVersionToBS y +-- | HTTP/0.9 +http09 :: HttpVersion +http09 = B8.pack "0.9" --- | This function takes the information after \"HTTP\/\". For example: --- --- @ 'httpVersionFromBS' ('B8.pack' \"1.0\") == 'Http10' @ -httpVersionFromBS :: B.ByteString -> HttpVersion -httpVersionFromBS bs - | B.length bs == 3 = case B8.unpack bs of - "0.9" -> Http09 - "1.0" -> Http10 - "1.1" -> Http11 - _ -> HttpVersion bs - | otherwise = HttpVersion bs +-- | HTTP/1.0 +http10 :: HttpVersion +http10 = B8.pack "1.0" --- | Returns the version number, for example: --- --- @ 'B8.unpack' ('httpVersionToBS' 'Http10') == \"1.0\" @ -httpVersionToBS :: HttpVersion -> B.ByteString -httpVersionToBS Http09 = B8.pack "0.9" -httpVersionToBS Http10 = B8.pack "1.0" -httpVersionToBS Http11 = B8.pack "1.1" -httpVersionToBS (HttpVersion bs) = bs +-- | HTTP/1.1 +http11 :: HttpVersion +http11 = B8.pack "1.1" --- | Headers sent from the client to the server. Clearly, this is not a --- complete list of all possible headers, but rather a selection of common --- ones. If other headers are required, they can be created with the --- RequestHeader constructor. --- --- The naming rules are simple: removing any hyphens from the actual name, and --- if there is a naming conflict with a 'ResponseHeader', prefix with Req. +-- | 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. -- --- Equality determined by conversion via 'requestHeaderToLower'. Request --- headers are *not* case sensitive (a change from version 0.0 of WAI). -data RequestHeader = - Accept - | AcceptCharset - | AcceptEncoding - | AcceptLanguage - | Authorization - | Cookie - | ReqContentLength - | ReqContentType - | Host - | Referer - | RequestHeader B.ByteString B.ByteString - deriving (Show, Read) +-- 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 + } -lowerBS :: B.ByteString -> B.ByteString -lowerBS = B8.map toLower +-- | Convert a regular bytestring to a case-insensitive bytestring. +mkCIByteString :: B.ByteString -> CIByteString +mkCIByteString bs = CIByteString bs $ B8.map toLower bs -requestHeader :: B.ByteString -> RequestHeader -requestHeader x = RequestHeader x $ lowerBS x +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 -instance Eq RequestHeader where - x == y = requestHeaderToLower x == requestHeaderToLower y +-- | Headers sent from the client to the server. Note that this is a +-- case-insensitive string, as the HTTP spec specifies. +type RequestHeader = CIByteString -requestHeaderFromBS :: B.ByteString -> RequestHeader -requestHeaderFromBS bs = case B8.unpack bs of - "Accept" -> Accept - "Accept-Charset" -> AcceptCharset - "Accept-Encoding" -> AcceptEncoding - "Accept-Language" -> AcceptLanguage - "Authorization" -> Authorization - "Cookie" -> Cookie - "Content-Length" -> ReqContentLength - "Content-Type" -> ReqContentType - "Host" -> Host - "Referer" -> Referer - _ -> requestHeader bs +-- | Headers sent from the server to the client. Note that this is a +-- case-insensitive string, as the HTTP spec specifies. +type ResponseHeader = CIByteString -requestHeaderToBS :: RequestHeader -> B.ByteString -requestHeaderToBS Accept = B8.pack "Accept" -requestHeaderToBS AcceptCharset = B8.pack "Accept-Charset" -requestHeaderToBS AcceptEncoding = B8.pack "Accept-Encoding" -requestHeaderToBS AcceptLanguage = B8.pack "Accept-Language" -requestHeaderToBS Authorization = B8.pack "Authorization" -requestHeaderToBS Cookie = B8.pack "Cookie" -requestHeaderToBS ReqContentLength = B8.pack "Content-Length" -requestHeaderToBS ReqContentType = B8.pack "Content-Type" -requestHeaderToBS Host = B8.pack "Host" -requestHeaderToBS Referer = B8.pack "Referer" -requestHeaderToBS (RequestHeader bs _) = bs +-- | 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 -requestHeaderToLower :: RequestHeader -> B.ByteString -requestHeaderToLower Accept = B8.pack "accept" -requestHeaderToLower AcceptCharset = B8.pack "accept-charset" -requestHeaderToLower AcceptEncoding = B8.pack "accept-encoding" -requestHeaderToLower AcceptLanguage = B8.pack "accept-language" -requestHeaderToLower Authorization = B8.pack "authorization" -requestHeaderToLower Cookie = B8.pack "cookie" -requestHeaderToLower ReqContentLength = B8.pack "content-Length" -requestHeaderToLower ReqContentType = B8.pack "content-Type" -requestHeaderToLower Host = B8.pack "host" -requestHeaderToLower Referer = B8.pack "referer" -requestHeaderToLower (RequestHeader _ bs) = bs +instance Eq Status where + x == y = statusCode x == statusCode y --- | Headers sent from the server to the client. Clearly, this is not a --- complete list of all possible headers, but rather a selection of common --- ones. If other headers are required, they can be created with the --- ResponseHeader constructor. --- --- if there is a naming conflict with a 'ResponseHeader', prefix with Req. --- --- Equality determined by conversion via 'responseHeaderToLower'. Response --- headers are *not* case sensitive (a change from version 0.0 of WAI). -data ResponseHeader = - ContentEncoding - | ContentLanguage - | ContentLength - | ContentDisposition - | ContentType - | Expires - | Location - | Server - | SetCookie - | ResponseHeader B.ByteString B.ByteString - deriving (Show) +-- | OK +status200 :: Status +status200 = Status 200 $ B8.pack "OK" -instance Eq ResponseHeader where - x == y = responseHeaderToBS x == responseHeaderToBS y +-- | Moved Permanently +status301 :: Status +status301 = Status 301 $ B8.pack "Moved Permanently" -responseHeader :: B.ByteString -> ResponseHeader -responseHeader x = ResponseHeader x $ lowerBS x +-- | Found +status302 :: Status +status302 = Status 302 $ B8.pack "Found" -responseHeaderFromBS :: B.ByteString -> ResponseHeader -responseHeaderFromBS bs = case B8.unpack bs of - "Content-Encoding" -> ContentEncoding - "Content-Language" -> ContentLanguage - "Content-Length" -> ContentLength - "Content-Disposition" -> ContentDisposition - "Content-Type" -> ContentType - "Expires" -> Expires - "Location" -> Location - "Server" -> Server - "Set-Cookie" -> SetCookie - _ -> responseHeader bs +-- | See Other +status303 :: Status +status303 = Status 303 $ B8.pack "See Other" -responseHeaderToBS :: ResponseHeader -> B.ByteString -responseHeaderToBS ContentEncoding = B8.pack "Content-Encoding" -responseHeaderToBS ContentLanguage = B8.pack "Content-Language" -responseHeaderToBS ContentLength = B8.pack "Content-Length" -responseHeaderToBS ContentDisposition = B8.pack "Content-Disposition" -responseHeaderToBS ContentType = B8.pack "Content-Type" -responseHeaderToBS Expires = B8.pack "Expires" -responseHeaderToBS Location = B8.pack "Location" -responseHeaderToBS Server = B8.pack "Server" -responseHeaderToBS SetCookie = B8.pack "Set-Cookie" -responseHeaderToBS (ResponseHeader bs _) = bs +-- | Bad Request +status400 :: Status +status400 = Status 400 $ B8.pack "Bad Request" -responseHeaderToLower :: ResponseHeader -> B.ByteString -responseHeaderToLower ContentEncoding = B8.pack "content-encoding" -responseHeaderToLower ContentLanguage = B8.pack "content-language" -responseHeaderToLower ContentLength = B8.pack "content-length" -responseHeaderToLower ContentDisposition = B8.pack "content-disposition" -responseHeaderToLower ContentType = B8.pack "content-type" -responseHeaderToLower Expires = B8.pack "expires" -responseHeaderToLower Location = B8.pack "location" -responseHeaderToLower Server = B8.pack "server" -responseHeaderToLower SetCookie = B8.pack "set-cookie" -responseHeaderToLower (ResponseHeader _ bs) = bs +-- | Unauthorized +status401 :: Status +status401 = Status 401 $ B8.pack "Unauthorized" --- | This attempts to provide the most common HTTP status codes, not all of --- them. Use the Status constructor when you want to create a status code not --- provided. --- --- The 'Eq' instance tests equality based only on the numeric status code --- value. See 'statusCode'. -data Status = - Status200 - | Status301 - | Status302 - | Status303 - | Status400 - | Status401 - | Status403 - | Status404 - | Status405 - | Status500 - | Status Int B.ByteString - deriving Show +-- | Forbidden +status403 :: Status +status403 = Status 403 $ B8.pack "Forbidden" -instance Eq Status where - x == y = statusCode x == statusCode y +-- | Not Found +status404 :: Status +status404 = Status 404 $ B8.pack "Not Found" -statusCode :: Status -> Int -statusCode Status200 = 200 -statusCode Status301 = 301 -statusCode Status302 = 302 -statusCode Status303 = 303 -statusCode Status400 = 400 -statusCode Status401 = 401 -statusCode Status403 = 403 -statusCode Status404 = 404 -statusCode Status405 = 405 -statusCode Status500 = 500 -statusCode (Status i _) = i +-- | Method Not Allowed +status405 :: Status +status405 = Status 405 $ B8.pack "Method Not Allowed" -statusMessage :: Status -> B.ByteString -statusMessage Status200 = B8.pack "OK" -statusMessage Status301 = B8.pack "Moved Permanently" -statusMessage Status302 = B8.pack "Found" -statusMessage Status303 = B8.pack "See Other" -statusMessage Status400 = B8.pack "Bad Request" -statusMessage Status401 = B8.pack "Unauthorized" -statusMessage Status403 = B8.pack "Forbidden" -statusMessage Status404 = B8.pack "Not Found" -statusMessage Status405 = B8.pack "Method Not Allowed" -statusMessage Status500 = B8.pack "Internal Server Error" -statusMessage (Status _ m) = m +-- | Internal Server Error +status500 :: Status +status500 = Status 500 $ B8.pack "Internal Server Error" -- | 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, @@ -356,6 +186,12 @@ -- -- Be certain not to reuse a 'Source'! It might work fine with some -- implementations of 'Source', while causing bugs with others. +-- +-- 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)) } -- | An enumerator is a data producer. It takes two arguments: a function to @@ -387,6 +223,10 @@ -- '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. +-- +-- 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 @@ -408,13 +248,33 @@ , serverName :: B.ByteString , serverPort :: Int , requestHeaders :: [(RequestHeader, B.ByteString)] - , urlScheme :: UrlScheme + -- ^ 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 } +-- | The response body returned to the server from the application. We provide +-- three separate constructors as optimizations: +-- +-- * 'ResponseEnumerator' is the most general type, allowing constant-memory +-- production of a response, even in the presence of interleaved I\/O actions. +-- +-- * '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. +-- +-- * '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 + data Response = Response { status :: Status , responseHeaders :: [(ResponseHeader, B.ByteString)] @@ -422,7 +282,7 @@ -- 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 :: Either FilePath Enumerator + , responseBody :: ResponseBody } type Application = Request -> IO Response diff --git a/Network/Wai/Enumerator.hs b/Network/Wai/Enumerator.hs --- a/Network/Wai/Enumerator.hs +++ b/Network/Wai/Enumerator.hs @@ -14,12 +14,10 @@ , fromHandle -- ** FilePath , fromFile - , fromEitherFile - -- * Filters - , buffer + , fromResponseBody ) where -import Network.Wai (Enumerator (..), Source (..)) +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 @@ -112,29 +110,10 @@ fromFile fp = Enumerator $ \iter a0 -> withBinaryFile fp ReadMode $ \h -> runEnumerator (fromHandle h) iter a0 --- | Since the response body is defined as an 'Either' 'FilePath' 'Enumerator', --- this function simply reduces the whole operator to an enumerator. This can --- be convenient for server implementations not optimizing file sending. -fromEitherFile :: Either FilePath Enumerator -> Enumerator -fromEitherFile = either fromFile id - --- | Buffer chunks until we have a chunk of 'defaultChunkSize', and then send --- it. -buffer :: Enumerator -> Enumerator -buffer (Enumerator e) = - Enumerator go - where - go iter seed = do - res <- e (iter' iter) (B.empty, seed) - case res of - Left (_, seed') -> return $ Left seed' - Right (buff, seed') -> iter seed' buff - iter' iter (buff, seed) bs = do - if B.length buff + B.length bs < defaultChunkSize - then return $ Right (buff `B.append` bs, seed) - else do - let (x, y) = B.splitAt (defaultChunkSize - B.length buff) bs - res <- iter seed $ buff `B.append` x - case res of - Left seed' -> return $ Left (y, seed') -- y is ignored - Right seed' -> return $ Right (y, seed') +-- | 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/Source.hs b/Network/Wai/Source.hs --- a/Network/Wai/Source.hs +++ b/Network/Wai/Source.hs @@ -3,6 +3,7 @@ -- * Conversions toEnumerator , toLBS + , fromLBS ) where import Network.Wai @@ -35,3 +36,11 @@ 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/wai.cabal b/wai.cabal --- a/wai.cabal +++ b/wai.cabal @@ -1,5 +1,5 @@ Name: wai -Version: 0.1.0 +Version: 0.2.0 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web aplications and web servers. License: BSD3