diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +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: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* 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. + +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. diff --git a/Network/Wai.hs b/Network/Wai.hs new file mode 100644 --- /dev/null +++ b/Network/Wai.hs @@ -0,0 +1,406 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ExistentialQuantification #-} +{-| + +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. + +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. + +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. + +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 +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. + +-} +module Network.Wai + ( -- * Data types + + -- $show_read + -- ** Request method + Method (..) + , methodFromBS + , methodToBS + -- ** URL scheme (http versus https) + , UrlScheme (..) + -- ** HTTP protocol versions + , HttpVersion (..) + , httpVersionFromBS + , httpVersionToBS + -- ** Request header names + , RequestHeader (..) + , requestHeaderFromBS + , requestHeaderToBS + -- ** Response header names + , ResponseHeader (..) + , responseHeaderFromBS + , responseHeaderToBS + -- ** Response status code + , Status (..) + , statusCode + , statusMessage + -- ** Source + , Source (..) + -- * Enumerator + , Enumerator (..) + -- * WAI interface + , Request (..) + , Response (..) + , Application + , Middleware + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 + +-- $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 + +data UrlScheme = HTTP | HTTPS + deriving (Show, Eq) + +-- | 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) + +instance Eq HttpVersion where + x == y = httpVersionToBS x == httpVersionToBS y + +-- | 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 + +-- | 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 + +-- | 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. +-- +-- Equality determined by conversion via 'requestHeaderToBS'. Remember, headers +-- are case sensitive. +data RequestHeader = + Accept + | AcceptCharset + | AcceptEncoding + | AcceptLanguage + | Authorization + | Cookie + | ReqContentLength + | ReqContentType + | Host + | Referer + | RequestHeader B.ByteString + deriving (Show, Read) + +instance Eq RequestHeader where + x == y = requestHeaderToBS x == requestHeaderToBS y + +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 + +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 + + +-- | 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 'responseHeaderToBS'. Remember, +-- headers are case sensitive. +data ResponseHeader = + ContentEncoding + | ContentLanguage + | ContentLength + | ContentDisposition + | ContentType + | Expires + | Location + | Server + | SetCookie + | ResponseHeader B.ByteString + deriving (Show) + +instance Eq ResponseHeader where + x == y = responseHeaderToBS x == responseHeaderToBS y + +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 + +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 + +-- | 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 + +instance Eq Status where + x == y = statusCode x == statusCode y + +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 + +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 + +-- | 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. +-- +-- Be certain not to reuse a 'Source'! It might work fine with some +-- implementations of 'Source', while causing bugs with others. +newtype Source = Source { runSource :: IO (Maybe (B.ByteString, Source)) } + +-- | 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. +-- +-- 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. +-- +-- 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. +-- +-- 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. +-- +-- '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. +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)] + , urlScheme :: UrlScheme + , requestBody :: Source + , errorHandler :: String -> IO () + -- | The client\'s host information. + , remoteHost :: B.ByteString + } + +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 :: Either FilePath Enumerator + } + +type Application = Request -> IO Response + +-- | 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. +-- +-- 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: +-- +-- @ loadSession :: ([(String, String)] -> Application) -> Application @ +-- +-- 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 diff --git a/Network/Wai/Enumerator.hs b/Network/Wai/Enumerator.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Enumerator.hs @@ -0,0 +1,117 @@ +{-# 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 + -- ** FilePath + , fromFile + , fromEitherFile + ) where + +import Network.Wai (Enumerator (..), Source (..)) +import qualified Network.Wai.Source as Source +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as B +import System.IO (withBinaryFile, IOMode (ReadMode), Handle, hIsEOF) +import Data.ByteString.Lazy.Internal (defaultChunkSize) +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar +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 + buffer <- newEmptyMVar + _ <- forkIO $ e (helper buffer) () >> putMVar buffer Nothing + return $ source buffer + where + helper :: MVar (Maybe B.ByteString) + -> () + -> B.ByteString + -> IO (Either () ()) + helper buffer _ bs = do + putMVar buffer $ 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' + +-- | 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 + +-- | 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 diff --git a/Network/Wai/Source.hs b/Network/Wai/Source.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Source.hs @@ -0,0 +1,37 @@ +module Network.Wai.Source + ( + -- * Conversions + toEnumerator + , toLBS + ) 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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/wai.cabal b/wai.cabal new file mode 100644 --- /dev/null +++ b/wai.cabal @@ -0,0 +1,21 @@ +Name: wai +Version: 0.0.0 +Synopsis: Web Application Interface. +Description: Provides a common protocol for communication between web aplications and web servers. +License: BSD3 +License-file: LICENSE +Author: Michael Snoyman +Maintainer: michael@snoyman.com +Homepage: http://github.com/snoyberg/wai +Category: Web +Build-Type: Simple +Cabal-Version: >=1.2 +Stability: Stable + +Library + Build-Depends: base >= 3 && < 5, + bytestring >= 0.9 && < 0.10 + Exposed-modules: Network.Wai + Network.Wai.Enumerator + Network.Wai.Source + ghc-options: -Wall