webserver (empty) → 0.1.0
raw patch · 13 files changed
+1477/−0 lines, 13 filesdep +basedep +bytestringdep +c10ksetup-changed
Dependencies added: base, bytestring, c10k, containers, filepath, haskell98, network, parsec, process, time, unix
Files
- LICENSE +29/−0
- Network/Web/Date.hs +49/−0
- Network/Web/HTTP.hs +374/−0
- Network/Web/Params.hs +322/−0
- Network/Web/Server.hs +124/−0
- Network/Web/Server/Basic.hs +293/−0
- Network/Web/Server/CGI.hs +101/−0
- Network/Web/Server/Lang.hs +49/−0
- Network/Web/Server/Params.hs +45/−0
- Network/Web/Server/Range.hs +45/−0
- Network/Web/Utils.hs +18/−0
- Setup.hs +2/−0
- webserver.cabal +26/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, IIJ Innovation Institute Inc.+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.+ * Neither the name of the copyright holders nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 OWNER OR CONTRIBUTORS 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.
+ Network/Web/Date.hs view
@@ -0,0 +1,49 @@+module Network.Web.Date (parseDate, utcToDate, HttpDate) where++import Data.Time+import Locale+import Control.Monad++type HttpDate = String++-- xxx: ClockTime -> UTCTime+----------------------------------------------------------------++parseDate :: String -> Maybe UTCTime+parseDate str = rfc1123Date str `mplus` rfc850Date str `mplus` asctimeDate str++----------------------------------------------------------------++rfc1123Format :: String+rfc1123Format = "%a, %d %b %Y %H:%M:%S GMT"++rfc850Format :: String+rfc850Format = "%A, %d-%b-%y %H:%M:%S GMT"++-- xxx: allows "Nov 6" as well as "Nov 6", sigh.+asctimeFormat :: String+asctimeFormat = "%a %b %e %H:%M:%S %Y"++preferredFormat :: String+preferredFormat = rfc1123Format++----------------------------------------------------------------++rfc1123Date :: String -> Maybe UTCTime+rfc1123Date = parseTime defaultTimeLocale preferredFormat++rfc850Date :: String -> Maybe UTCTime+rfc850Date str = parseTime defaultTimeLocale rfc850Format str >>= y2k+ where+ y2k utct = let (y,m,d) = toGregorian $ utctDay utct+ in if y < 1950+ then Just utct { utctDay = fromGregorian (y+100) m d }+ else Just utct++asctimeDate :: String -> Maybe UTCTime+asctimeDate = parseTime defaultTimeLocale asctimeFormat++----------------------------------------------------------------++utcToDate :: UTCTime -> HttpDate+utcToDate = formatTime defaultTimeLocale preferredFormat
+ Network/Web/HTTP.hs view
@@ -0,0 +1,374 @@+{-|+ HTTP library for HTTP server.+-}+module Network.Web.HTTP (receive, respond,+ Request,+ reqMethod, reqURI, reqVersion, reqFields,+ reqBody, reqLength,+ Response,+ rspStatus, rspFields, rspBody, rspLength, rspLogMsg,+ makeResponse, makeResponse2, makeResponse3,+ Comm, Fields,+ lookupField, lookupField',+ insertField, insertField',+ receiveFields,+ module Network.Web.Params) where++import Control.Applicative+import Control.Exception (try, throw)+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS hiding (ByteString)+import Data.Char+import Data.List+import Data.Map (Map)+import qualified Data.Map as Map hiding (Map)+import Data.Maybe+import IO hiding (try)+import Network.URI+import Network.Web.Params+import Text.Printf++----------------------------------------------------------------++{-|+ Abstract data type of HTTP request.+-}+data Request = Request {+ -- | Request method+ reqMethod :: Method+ -- | URI parsed from absolute URL or relative URL with the Host: field+ , reqURI :: URI+ -- | HTTP version+ , reqVersion :: Version+ -- | Key-values of request header+ , reqFields :: Fields+ -- | Entity body if exists+ , reqBody :: Maybe ByteString+ -- | Length of entity body from Content-Length:+ , reqLength :: Integer+}++{-|+ Abstract data type of HTTP response.+-}+data Response = Response {+ -- | Response status+ rspStatus :: Status+ , rspFields :: Fields+ , rspBody :: Maybe ByteString -- Nothing -> No entity / No CL:+ -- Just bs+ -- Just bs.empty+ , rspLength :: Maybe Integer -- Nothing -> chunked or close+ -- Just x -> CL: x+ , rspLogMsg :: String+}++{-|+ A class to abstract 'Request' and 'Response'.+-}+class Comm a where+ getFields :: a -> Fields+ setFields :: a -> Fields -> a++instance Comm Request where+ getFields = reqFields+ setFields req hdrs = req { reqFields = hdrs }++instance Comm Response where+ getFields = rspFields+ setFields rsp hdrs = rsp { rspFields = hdrs }++----------------------------------------------------------------++{-|+ Default Request.+-}+defaultRequest :: Request+defaultRequest = Request {+ reqMethod = GET+ , reqURI = undefined+ , reqVersion = HTTP11+ , reqFields = emptyFields+ , reqBody = Nothing+ , reqLength = 0+}++{-|+ Default Response.+-}+defaultResponse :: Response+defaultResponse = Response {+ rspStatus = OK+ , rspFields = emptyFields+ , rspBody = Nothing+ , rspLength = Nothing+ , rspLogMsg = ""+}++----------------------------------------------------------------++{-|+ A function to make 'Response'.+-}+makeResponse :: Status -> [(FieldKey,FieldValue)] -> Response+makeResponse st kvs = defaultResponse { rspStatus = st+ , rspBody = Just body+ , rspLength = Just len+ , rspFields = flds+ }+ where+ cs = "<html><body>" ++ show st ++ "</body></html>\n"+ len = fromIntegral $ length cs+ body = LBS.pack cs+ flds = toFields kvs++{-|+ A function to make 'Response'.+-}+makeResponse2 :: Status -> Maybe ByteString -> Maybe Integer -> [(FieldKey,FieldValue)] -> Response+makeResponse2 st mval mlen kvs = defaultResponse { rspStatus = st+ , rspBody = mval+ , rspLength = mlen+ , rspFields = flds+ }+ where+ flds = toFields kvs++{-|+ A function to make 'Response'.+-}+makeResponse3 :: Status -> Maybe ByteString -> Maybe Integer -> Fields -> Response+makeResponse3 st mval mlen flds = defaultResponse { rspStatus = st+ , rspBody = mval+ , rspLength = mlen+ , rspFields = flds'+ }+ where+ flds' = copyFields flds++----------------------------------------------------------------++{-|+ Receiving HTTP request from 'Handle'.+ If request is broken, 'Nothing' is returned.+-}+receive :: Handle -> IO (Maybe Request)+receive hdl = do+ mreq <- try $ receiveRequest hdl+ case mreq of+ Left e -> if isEOFError e+ then throw TerminatedByClient+ else return Nothing+ Right req -> return $ Just req++receiveRequest :: Handle -> IO Request+receiveRequest hdl = do+ (method,url,version) <- receiveRequestLine hdl+ let req0 = defaultRequest+ req1 = req0 { reqMethod = method, reqVersion = version }+ flds <- receiveFields hdl+ uri <- toURI url flds+ let req2 = req1 { reqURI = uri, reqFields = flds }+ receiveBody hdl flds req2++isEOH :: String -> Bool+isEOH l = null l || l == "\r"++receiveRequestLine :: Handle -> IO (Method,String,Version)+receiveRequestLine hdl = parseRequestLine <$> skipNullLines+ where+ skipNullLines = do+ l <- hGetLine hdl+ if isEOH l+ then skipNullLines+ else return l+{-|+ Parsing HTTP header from 'Handle'.+ This function is useful to parse CGI output.+-}+receiveFields :: Handle -> IO Fields+receiveFields hdl = toFields . map parseField <$> getHeaderLines+ where+ getHeaderLines = do+ l <- hGetLine hdl+ if isEOH l+ then return []+ else (l:) <$> getHeaderLines++toURI :: String -> Fields -> IO URI+toURI url fields = maybe (fail "toURI") return $ toURI' url fields++toURI' :: String -> Fields -> Maybe URI+toURI' url fields+ | isAbsoluteURI url = parseURI url+ | otherwise = lookupField' FkHost fields >>= \host ->+ parseURI $ "http://" ++ host ++ url++receiveBody :: Handle -> Fields -> Request -> IO Request+receiveBody hdl flds req =+ case lookupField' FkContentLength flds of+ Nothing -> return req+ Just cs -> do+ let len = read cs+ body <- LBS.hGet hdl (fromIntegral len)+ return req { reqBody = Just body, reqLength = len }++----------------------------------------------------------------++{-|+ Sending HTTP response to 'Handle'.+ If 'Keep' is specified, the HTTP connection+ will be kept. If 'Close' is specified, the connection will be closed.+ 'Version' should be copied from 'Request'.+-}++respond :: Handle -> Version -> Persist -> Response -> IO ()+respond h ver persist rsp = do+ sendStatusLine h ver rsp+ sendResponseFields h ver persist rsp+ hPutStr h crlf+ sendResponseBody h ver rsp+ hFlush h++sendStatusLine :: Handle -> Version -> Response -> IO ()+sendStatusLine h ver rsp = do+ hPutStr h $ show ver+ hPutStr h spc+ hPutStr h $ show (rspStatus rsp) -- including reason-phrase+ hPutStr h crlf++sendResponseFields :: Handle -> Version -> Persist -> Response -> IO ()+sendResponseFields h ver persist rsp = do+ putFields+ putContentLength+ putTransferEncoding+ putConnection+ where+ putFields = hPutStr h . concatMap composeField . fromFields $ getFields rsp+ putContentLength =+ case rspBody rsp >> rspLength rsp of+ Just len -> hPutStr h $ composeField (FkContentLength, show len)+ Nothing -> return ()+ putTransferEncoding =+ if ver == HTTP11 && isJust (rspBody rsp) && isNothing (rspLength rsp)+ then hPutStr h $ composeField (FkTransferEncoding, "chunked")+ else return ()+ putConnection = hPutStr h $ composeField (FkConnection, show persist)++sendResponseBody :: Handle -> Version -> Response -> IO ()+sendResponseBody h ver rsp =+ case rspBody rsp of+ Just body -> case rspLength rsp of+ Just _ -> LBS.hPut h body+ Nothing -> if ver == HTTP10+ then LBS.hPut h body+ else sendChunk h body+ Nothing -> return ()++sendChunk :: Handle -> ByteString -> IO ()+sendChunk h body = do+ let (fcnk,rest) = LBS.splitAt chunkSize body+ if LBS.null rest+ then do+ putChunk fcnk $ toHex (LBS.length fcnk)+ putLastChunk+ else do+ putChunk fcnk defSize+ sendChunk h rest+ where+ chunkSize = 1024 * 4+ defSize = toHex chunkSize+ toHex = printf "%X"+ putChunk cnk siz = do+ hPutStr h siz+ hPutStr h crlf+ LBS.hPut h cnk+ hPutStr h crlf+ putLastChunk = do+ hPutStr h "0"+ hPutStr h crlf+ hPutStr h crlf++----------------------------------------------------------------++{-|+ Abstract data type for Key-values of HTTP header.+-}+newtype Fields = Fields (Map FieldKey FieldValue) deriving Show++emptyFields :: Fields+emptyFields = Fields Map.empty++{-|+ Looking up the HTTP field value.+-}+lookupField :: Comm a => FieldKey -> a -> Maybe FieldValue+lookupField key comm = lookupField' key (getFields comm)++{-|+ Looking up the HTTP field value.+-}+lookupField' :: FieldKey -> Fields -> Maybe FieldValue+lookupField' key (Fields fields) = maybe Nothing (Just . trim) mvalue+ where+ mvalue = Map.lookup key fields++{-|+ Inserting the HTTP field.+-}+insertField :: Comm a => FieldKey -> FieldValue -> a -> a+insertField key val comm = setFields comm fields+ where+ fields = insertField' key val $ getFields comm++{-|+ Inserting the HTTP field.+-}+insertField' :: FieldKey -> FieldValue -> Fields -> Fields+insertField' key val (Fields fields) = Fields (Map.insert key val fields)++toFields :: [(FieldKey,FieldValue)] -> Fields+toFields kvs = Fields (Map.fromList kvs)++fromFields :: Fields -> [(FieldKey,FieldValue)]+fromFields (Fields fields) = Map.toList fields++copyFields :: Fields -> Fields+copyFields = toFields . map (\(x,y) -> (x, trim y)) . fromFields++----------------------------------------------------------------++composeField :: (FieldKey,FieldValue) -> String+composeField (k,v) = fromFieldKey k ++ ": " ++ v ++ crlf++parseField :: String -> (FieldKey,FieldValue)+parseField l = let kv = break (==':') (chomp l)+ in toKeyValue kv+ where+ toKeyValue (k,"") = (toFieldKey k, "")+ toKeyValue (k,_:v) = (toFieldKey k, v) -- v is trimmed by lookupField++parseRequestLine :: String -> (Method,String,Version)+parseRequestLine l = let (m,l') = break (==' ') (chomp l)+ (u,v') = break (==' ') (chop l')+ v = trim v'+ in (read m, u, read v)++----------------------------------------------------------------++chop :: String -> String+chop = dropWhile isSpace++chomp :: String -> String+chomp = fst . break (=='\r')++trim :: String -> String+trim = reverse . chop . reverse . chop++----------------------------------------------------------------++crlf :: String+crlf = "\r\n"++spc :: String+spc = " "
+ Network/Web/Params.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE DeriveDataTypeable #-}++{-|+ Parameters of HTTP.+-}+module Network.Web.Params (Method(..), Version(..), Status(..),+ toStatus, badStatus,+ Persist(..), ServerException(..),+ FieldKey(..), FieldValue,+ toFieldKey, fromFieldKey,+ CT, textHtml, selectContentType) where++import Control.Exception+import Data.Char+import Data.Map (Map)+import qualified Data.Map as Map hiding (Map)+import Data.Typeable++----------------------------------------------------------------++{-|+ Methods of HTTP.+-}+data Method = GET | HEAD | POST | PUT | DELETE | TRACE | CONNECT+ | UnknownMethod deriving (Show,Eq,Enum,Bounded)++methodAlist :: [(String,Method)]+methodAlist = let methods = [minBound..maxBound]+ in zip (map show methods) methods++readMethod :: String -> Method+readMethod s = maybe UnknownMethod id $ lookup s methodAlist++instance Read Method where+ readsPrec _ s = [(readMethod s,"")]++----------------------------------------------------------------++{-|+ Versions of HTTP.+-}+data Version = HTTP10 | HTTP11 deriving Eq++instance Show Version where+ show HTTP10 = "HTTP/1.0"+ show HTTP11 = "HTTP/1.1"++readVersion :: String -> Version+readVersion "HTTP/1.1" = HTTP11+readVersion _ = HTTP10++instance Read Version where+ readsPrec _ s = [(readVersion s,"")]++----------------------------------------------------------------++{-|+ Status of HTTP.+-}++data Status = Continue | SwitchingProtocols+ -- 2xx+ | OK | Created | Accepted | NonAuthoritativeInformation+ | NoContent | ResetContent | PartialContent Integer Integer+ -- 3xx+ | MultipleChoices | MovedPermanently | Found | SeeOther+ | NotModified | UseProxy | TemporaryRedirect+ -- 4xx+ | BadRequest | Unauthorized | PaymentRequired | Forbidden+ | NotFound | MethodNotAllowed | NotAcceptable+ | ProxyAuthenticationRequired | RequestTimeout | Conflict+ | Gone | LengthRequired | PreconditionFailed+ | RequestEntityTooLarge | RequestURITooLarge+ | UnsupportedMediaType | RequestedRangeNotSatisfiable+ | ExpectationFailed+ -- 5xx+ | InternalServerError | NotImplemented | BadGateway+ | ServiceUnavailable | GatewayTimeout | HTTPVersionNotSupported++instance Show Status where+ show Continue = "100 Continue"+ show SwitchingProtocols = "101 Switching Protocols"+ show OK = "200 OK"+ show Created = "201 Created"+ show Accepted = "202 Accepted"+ show NonAuthoritativeInformation = "203 Non-Authoritative Information"+ show NoContent = "204 No Content"+ show ResetContent = "205 Reset Content"+ show (PartialContent _ _) = "206 Partial Content"+ show MultipleChoices = "300 Multiple Choices"+ show MovedPermanently = "301 Moved Permanently"+ show Found = "302 Found"+ show SeeOther = "303 See Other"+ show NotModified = "304 Not Modified"+ show UseProxy = "305 Use Proxy"+ show TemporaryRedirect = "307 Temporary Redirect"+ show BadRequest = "400 Bad Request"+ show Unauthorized = "401 Unauthorized"+ show PaymentRequired = "402 Payment Required"+ show Forbidden = "403 Forbidden"+ show NotFound = "404 Not Found"+ show MethodNotAllowed = "405 Method Not Allowed"+ show NotAcceptable = "406 Not Acceptable"+ show ProxyAuthenticationRequired = "407 Proxy Authentication Required"+ show RequestTimeout = "408 RequestTimeout"+ show Conflict = "409 Conflict"+ show Gone = "410 Gone"+ show LengthRequired = "411 Length Required"+ show PreconditionFailed = "412 Precondition Failed"+ show RequestEntityTooLarge = "413 Request Entity Too Large"+ show RequestURITooLarge = "414 Request-URI Too Large"+ show UnsupportedMediaType = "415 Unsupported Media Type"+ show RequestedRangeNotSatisfiable = "416 Requested Range Not Satisfiable"+ show ExpectationFailed = "417 Expectation Failed"+ show InternalServerError = "500 Internal Server Error"+ show NotImplemented = "501 Not Implemented"+ show BadGateway = "502 Bad Gateway"+ show ServiceUnavailable = "503 Service Unavailable"+ show GatewayTimeout = "504 Gateway Time-out"+ show HTTPVersionNotSupported = "505 HTTP Version Not Supported"++{-|+ Converting numeric status to 'Status'.+-}+toStatus :: String -> Maybe Status+toStatus "200" = Just OK+toStatus "302" = Just Found+toStatus "400" = Just BadRequest+toStatus "501" = Just NotImplemented+toStatus _ = Nothing++{-|+ Returning 'True' for 4xx and 5xx.+-}+badStatus :: Status -> Bool+badStatus status = n == '4' || n == '5'+ where+ n:_ = show status++----------------------------------------------------------------++{-|+ Field key of HTTP header.+-}+data FieldKey = FkAcceptLanguage+ | FkCacheControl+ | FkConnection+ | FkContentLength+ | FkContentType+ | FkCookie+ | FkDate+ | FkHost+ | FkIfModifiedSince+ | FkIfRange+ | FkIfUnmodifiedSince+ | FkLastModified+ | FkLocation+ | FkRange+ | FkServer+ | FkSetCookie2+ | FkStatus+ | FkTransferEncoding+ | FkOther String+ deriving (Eq,Show,Ord)++fieldKeyList :: [FieldKey]+fieldKeyList = [ FkAcceptLanguage+ , FkCacheControl+ , FkConnection+ , FkContentLength+ , FkContentType+ , FkCookie+ , FkDate+ , FkHost+ , FkIfModifiedSince+ , FkIfRange+ , FkIfUnmodifiedSince+ , FkLastModified+ , FkLocation+ , FkRange+ , FkServer+ , FkSetCookie2+ , FkStatus+ , FkTransferEncoding ]++fieldStringList :: [String]+fieldStringList = [ "Accept-Language"+ , "Cache-Control"+ , "Connection"+ , "Content-Length"+ , "Content-Type"+ , "Cookie"+ , "Date"+ , "Host"+ , "If-Modified-Since"+ , "If-Range"+ , "If-Unmodified-Since"+ , "Last-Modified"+ , "Location"+ , "Range"+ , "Server"+ , "Set-Cookie2"+ , "Status"+ , "Transfer-Encoding" ]++{-|+ Field value of HTTP header.+-}+type FieldValue = String++stringFieldKey :: Map FieldValue FieldKey+stringFieldKey = Map.fromList (zip fieldStringList fieldKeyList)++fieldKeyString :: Map FieldKey FieldValue+fieldKeyString = Map.fromList (zip fieldKeyList fieldStringList)++{-|+ Converting field key to 'FieldKey'.+-}+toFieldKey :: String -> FieldKey+toFieldKey str = maybe (FkOther cstr) id $ Map.lookup cstr stringFieldKey+ where+ cstr = capitalize str++{-|+ Converting 'FieldKey' to field key.+-}+fromFieldKey :: FieldKey -> String+fromFieldKey (FkOther cstr) = cstr+fromFieldKey key = maybe err id $ Map.lookup key fieldKeyString+ where+ err = error "fromFieldKey"++capitalize :: String -> String+capitalize s = toup s+ where+ toup [] = []+ toup (x:xs)+ | isLetter x = toUpper x : stay xs+ | otherwise = x : toup xs+ stay [] = []+ stay (x:xs)+ | isLetter x = x : stay xs+ | otherwise = x : toup xs++----------------------------------------------------------------++{-|+ The type for Content-Type.+-}++type CT = String++{-|+ Selecting a value of Content-Type from a file suffix.+-}+selectContentType :: String -> CT+selectContentType "" = textPlain+selectContentType ext = maybe appOct id (lookup lext contentTypeDB)+ where+ lext = map toLower ext++{-|+ The value for text/html.+-}+textHtml :: CT+textHtml = "text/html"++textPlain :: CT+textPlain = "text/plain"++appOct :: CT+appOct = "application/octet-stream"++contentTypeDB :: [(FilePath,CT)]+contentTypeDB = [ (".html", textHtml)+ , (".txt", textPlain)+ , (".css", "text/css")+ , (".js", "application/javascript")+ , (".jpg", "image/jpeg")+ , (".png", "image/png")+ , (".gif", "image/gif")+ , (".pdf", "application/pdf")+ , (".zip", "application/zip")+ , (".gz", appOct)+ , (".ico", "image/x-icon")+ ]++----------------------------------------------------------------++-- | The type for persist connection or not+data Persist = Close | Keep | PerUnknown deriving Eq++instance Show Persist where+ show Close = "close"+ show Keep = "keep-alive"+ show PerUnknown = "unknown"++instance Read Persist where+ readsPrec _ s = [(readPersist s,"")]++readPersist :: String -> Persist+readPersist cs = readPersist' (downcase cs)+ where+ downcase = map toLower+ readPersist' "close" = Close+ readPersist' "keep-alive" = Keep+ readPersist' _ = PerUnknown++----------------------------------------------------------------++-- | Exceptions for Web server+data ServerException+ = TimeOut+ | TerminatedByClient+ deriving (Eq, Ord, Typeable)++instance Exception ServerException++instance Show ServerException where+ showsPrec _ TimeOut = showString "Connection time out"+ showsPrec _ TerminatedByClient = showString "Connection is terminated by client"
+ Network/Web/Server.hs view
@@ -0,0 +1,124 @@+{-|+ A library for HTTP server.+-}+module Network.Web.Server (connection, WebServer, WebConfig(..)) where++import Control.Exception+import Control.Monad+import Control.Applicative+import Data.Char+import Data.Maybe+import Data.Time+import IO+import Network.Web.HTTP hiding (receive,respond)+import qualified Network.Web.HTTP as HTTP (receive,respond)+import Network.Web.Date+import Network.Web.Params+import System.Timeout++----------------------------------------------------------------++{-|+ The type for HTTP server.+-}+type WebServer = Maybe Request -> IO Response++{-|+ The configuration for 'connection'.+-}+data WebConfig = WebConfig {+ -- | A hook to be called when an HTTP connection is closed.+ closedHook :: String -> IO ()+ -- | A hook to be called when access succeeds.+ , accessHook :: String -> IO ()+ -- | A hook to be called when an access error occurs.+ , errorHook :: String -> IO ()+ -- | A hook to be called when a fatal error occurs.+ , fatalErrorHook :: String -> IO ()+ -- | A time to unblock receiving an HTTP request in seconds.+ , connectionTimer :: Int+}++----------------------------------------------------------------++{-|+ A function to run an 'WebServer'. 'Handle' should be mode by+ converting an accepted socket.+ Keep-alive / termination of HTTP 1.0 and HTTP 1.1 is correctly handled.+ So, 'WebServer' need not to handle the Connection: header in response.+ The Date: header is automatically added in response.+-}+connection :: Handle -> WebServer -> WebConfig -> IO ()+connection hdl srv cnf = session hdl srv cnf `catches` serverError+ where+ serverError =+ [Handler (\e -> closedHook cnf (show (e::ServerException))),+ Handler (\e -> errorHook cnf (show (e::SomeException)))]++----------------------------------------------------------------++session :: Handle -> WebServer -> WebConfig -> IO ()+session hdl svr cnf = do+ mreq <- recvRequest hdl cnf+ rsp <- runServer svr mreq+ persist <- sendResponse hdl cnf rsp mreq+ case persist of+ Close -> closedHook cnf $ "Connection is closed"+ Keep -> session hdl svr cnf+ _ -> return () -- never reached+ where+ runServer server mreq = do+ date <- utcToDate <$> getCurrentTime+ addDate date <$> server mreq+ addDate date rsp = insertField FkDate date rsp++----------------------------------------------------------------++recvRequest :: Handle -> WebConfig -> IO (Maybe Request)+recvRequest hdl cnf = do+ mmreq <- timeout tm (HTTP.receive hdl)+ case mmreq of+ Nothing -> throw TimeOut+ Just mreq -> return mreq+ where+ microseconds = 1000000+ tm = connectionTimer cnf * microseconds++----------------------------------------------------------------++sendResponse :: Handle -> WebConfig -> Response -> Maybe Request -> IO Persist+sendResponse hdl cnf rsp (Just req) = do+ let ver = reqVersion req+ cnct = lookupField FkConnection req+ status = rspStatus rsp+ persist = if badStatus status+ then Close+ else checkPersist ver cnct rsp+ hook = accessHook cnf+ sendResponse' hdl ver persist rsp hook+sendResponse hdl cnf rsp Nothing = do+ let hook = errorHook cnf+ sendResponse' hdl HTTP10 Close rsp hook++sendResponse' :: Handle -> Version -> Persist -> Response -> (String -> IO ()) -> IO Persist+sendResponse' hdl ver persist rsp hook = do+ HTTP.respond hdl ver persist rsp+ hook $ rspLogMsg rsp ++ " [" ++ show (rspStatus rsp) ++ "]"+ return persist++----------------------------------------------------------------++-- CGI and HTTP/1.0 -> Close++checkPersist :: Version -> Maybe String -> Response -> Persist+checkPersist HTTP11 Nothing _ = Keep+checkPersist HTTP11 (Just cnct) _+ | read cnct == Close = Close+ | otherwise = Keep+checkPersist HTTP10 Nothing _ = Close+checkPersist HTTP10 (Just cnct) rsp+ | read cnct == Keep = if isJust (rspBody rsp) &&+ isNothing (rspLength rsp)+ then Close+ else Keep+ | otherwise = Close
+ Network/Web/Server/Basic.hs view
@@ -0,0 +1,293 @@+{-|+ Creating basic 'WebServer'.+ Created 'WebServer' can handle GET \/ HEAD \/ POST;+ OK, Not Found, Not Modified, Moved Permanently, etc;+ partial getting; language negotication;+ CGI, chunked data for CGI output;+-}++module Network.Web.Server.Basic (basicServer,+ module Network.Web.Server.Params) where++import Control.Applicative+import Control.Monad+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.List+import Data.Time+import Network.TCPInfo+import Network.URI hiding (path)+import Network.Web.Date+import Network.Web.HTTP+import Network.Web.Server+import Network.Web.Server.CGI+import Network.Web.Server.Lang+import Network.Web.Server.Params+import Network.Web.Server.Range+import Network.Web.Utils+import System.FilePath++----------------------------------------------------------------++{-|+ Creating 'WebServer' with 'BasicConfig'.+ The created 'WebServer' can handle GET \/ HEAD \/ POST;+ OK, Not Found, Not Modified, Moved Permanently, etc;+ partial getting; language negotication;+ CGI, chunked data for CGI output;+ If http:\/\/example.com\/path does not exist but+ http:\/\/example.com\/path\/ exists, the created 'WebServer'+ redirects it. http:\/\/example.com\/path\/ is mapped to+ \/somewhere\/path\/ by 'mapper' and index.html and index.html.en+ automatically added and try to read by 'obtain'.+ If Accept-Language is "xx" and "yy" in order,+ index.html.xx, index.html.yy, index.html and index.html.en+ are tried. The created 'WebServer' does not dynamically+ make index.html for a directory even if index.html does not+ exist for security reasons.+-}+basicServer :: BasicConfig -> WebServer+basicServer cnf mreq = case mreq of+ Nothing -> adjust <$> pure responseBadRequest+ Just req -> case reqMethod req of+ GET -> adjust <$> processGET cnf req+ HEAD -> adjust <$> processHEAD cnf req+ POST -> adjust <$> processPOST cnf req+ _ -> adjust <$> pure responseNotImplement+ where+ adjust = addServer . addPeerToLog+ addServer rsp = insertField FkServer (serverName cnf) rsp+ addPeerToLog rsp = rsp { rspLogMsg = logmsg}+ peer = peerAddr (tcpInfo cnf)+ logmsg = "[" ++ peer ++ "] " ++ maybe "" uri mreq+ uri req = "\"" ++ toURLwoPort (reqURI req) ++ "\""++----------------------------------------------------------------++runAnyIO :: [IO (Maybe a)] -> IO a+runAnyIO [] = error "runAnyIO"+runAnyIO (a:as) = do+ mrsp <- a+ case mrsp of+ Nothing -> runAnyIO as+ Just rsp -> return rsp++runAnyMaybeIO :: [IO (Maybe a)] -> IO (Maybe a)+runAnyMaybeIO [] = return Nothing+runAnyMaybeIO (a:as) = do+ mx <- a+ case mx of+ Nothing -> runAnyMaybeIO as+ Just _ -> return mx++processGET :: BasicConfig -> Request -> IO Response+processGET cnf req = do+ let uri = reqURI req+ langs = map ('.':) (languages req) ++ ["",".en"]+ runAnyIO [ tryGet cnf req uri langs+ , tryRedirect cnf uri langs+ , notFound ] -- always Just++processHEAD :: BasicConfig -> Request -> IO Response+processHEAD cnf req = do+ let uri = reqURI req+ langs = map ('.':) (languages req) ++ ["",".en"]+ runAnyIO [ tryHead cnf uri langs+ , tryRedirect cnf uri langs+ , notFound ] -- always Just++processPOST :: BasicConfig -> Request -> IO Response+processPOST cnf req = tryPost cnf req++languages :: Request -> [String]+languages req = maybe [] (parseLang) $ lookupField FkAcceptLanguage req++----------------------------------------------------------------++(>>|) :: Maybe a -> (a -> IO (Maybe b)) -> IO (Maybe b)+v >>| act =+ case v of+ Nothing -> return Nothing+ Just x -> act x++(|>|) :: IO (Maybe a) -> (a -> IO (Maybe b)) -> IO (Maybe b)+a |>| act = do+ v <- a+ case v of+ Nothing -> return Nothing+ Just x -> act x++(|||) :: Maybe Status -> Maybe Status -> Maybe Status+(|||) = mplus++----------------------------------------------------------------++ifModifiedSince :: Request -> Maybe UTCTime+ifModifiedSince = lookupAndParseDate FkIfModifiedSince++ifUnmodifiedSince :: Request -> Maybe UTCTime+ifUnmodifiedSince = lookupAndParseDate FkIfUnmodifiedSince++ifRange :: Request -> Maybe UTCTime+ifRange = lookupAndParseDate FkIfRange++lookupAndParseDate :: FieldKey -> Request -> Maybe UTCTime+lookupAndParseDate key req = lookupField key req >>= parseDate++tryGet :: BasicConfig -> Request -> URI -> [String] -> IO (Maybe Response)+tryGet cnf req uri langs = tryGet' $ mapper cnf uri+ where+ tryGet' None = return Nothing+ tryGet' (CGI cgi param snm) = tryGetCGI cnf req cgi param snm+ tryGet' (File file) = tryGetFile cnf req file langs++tryGetFile :: BasicConfig -> Request -> FilePath -> [String] -> IO (Maybe Response)+tryGetFile cnf req file langs+ | ".html" `isSuffixOf` file = runAnyMaybeIO $ map (tryGetFile' cnf req file) langs+ | otherwise = tryGetFile' cnf req file ""++tryGetFile' :: BasicConfig -> Request -> FilePath -> String -> IO (Maybe Response)+tryGetFile' cnf req file lang = do+ let file' = file ++ lang+ info cnf file' |>| \(size, mtime) -> do+ let ext = takeExtension file+ ct = selectContentType ext+ modified = utcToDate mtime+ mst = ifmodified req size mtime+ ||| ifunmodified req size mtime+ ||| ifrange req size mtime+ ||| unconditional req size mtime+ case mst of+ Just OK -> do+ val <- obtain cnf file' Nothing+ return . Just $ response OK val size ct modified+ Just st@(PartialContent skip len) -> do+ val <- obtain cnf file' $ Just (skip,len)+ return . Just $ response st val len ct modified+ Just st ->+ return . Just $ response st LBS.empty 0 ct modified+ _ -> return Nothing -- never reached++ifmodified :: Request -> Integer -> UTCTime -> Maybe Status+ifmodified req size mtime = do+ date <- ifModifiedSince req+ if date /= mtime+ then unconditional req size mtime+ else Just NotModified -- xxx rspBody should be Nothing++ifunmodified :: Request -> Integer -> UTCTime -> Maybe Status+ifunmodified req size mtime = do+ date <- ifUnmodifiedSince req+ if date == mtime+ then unconditional req size mtime+ else Just PreconditionFailed++ifrange :: Request -> Integer -> UTCTime -> Maybe Status+ifrange req size mtime = do+ date <- ifRange req+ rng <- lookupField FkRange req+ if date == mtime+ then Just OK+ else range size rng++unconditional :: Request -> Integer -> UTCTime -> Maybe Status+unconditional req size _ =+ maybe (Just OK) (range size) $ lookupField FkRange req++range :: Integer -> String -> Maybe Status+range size rng = case skipAndSize rng size of+ Nothing -> Just RequestedRangeNotSatisfiable+ Just (skip,len) -> Just (PartialContent skip len)++----------------------------------------------------------------++tryHead :: BasicConfig -> URI -> [String] -> IO (Maybe Response)+tryHead cnf uri langs = tryHead' (mapper cnf uri)+ where+ tryHead' None = return Nothing+ tryHead' (CGI _ _ _) = return Nothing+ tryHead' (File file) = tryHeadFile cnf file langs++tryHeadFile :: BasicConfig -> FilePath -> [String] -> IO (Maybe Response)+tryHeadFile cnf file langs+ | ".html" `isSuffixOf` file = runAnyMaybeIO $ map (tryHeadFile' cnf file) langs+ | otherwise = tryHeadFile' cnf file ""++tryHeadFile' :: BasicConfig -> FilePath -> String -> IO (Maybe Response)+tryHeadFile' cnf file lang = do+ let ext = takeExtension file+ ct = selectContentType ext+ file' = file ++ lang+ minfo <- info cnf file'+ case minfo of+ Nothing -> return Nothing+ Just (_,mt) -> return $ Just (responseOK ct (utcToDate mt))++----------------------------------------------------------------++redirectURI :: URI -> Maybe URI+redirectURI uri =+ let path = uriPath uri+ in if hasTrailingPathSeparator path+ then Nothing+ else Just uri { uriPath = addTrailingPathSeparator path}++tryRedirect :: BasicConfig -> URI -> [String] -> IO (Maybe Response)+tryRedirect cnf uri langs =+ redirectURI uri >>| \ruri -> tryRedirect' (mapper cnf ruri) ruri+ where+ tryRedirect' None _ = return Nothing+ tryRedirect' (CGI _ _ _) _ = return Nothing+ tryRedirect' (File file) ruri = runAnyMaybeIO $ map (tryRedirectFile cnf ruri file) langs++tryRedirectFile :: BasicConfig -> URI -> FilePath -> String -> IO (Maybe Response)+tryRedirectFile cnf ruri file lang = do+ let file' = file ++ lang+ minfo <- info cnf file'+ case minfo of+ Nothing -> return Nothing+ Just _ -> return $ Just (responseRedirect ruri)++----------------------------------------------------------------++tryPost :: BasicConfig -> Request -> IO Response+tryPost cnf req = case mapper cnf (reqURI req) of+ CGI cgi param snm -> do+ mres <- tryGetCGI cnf req cgi param snm+ case mres of+ Nothing -> undefined -- never reached+ Just res -> return res+ _ -> return responseBadRequest++----------------------------------------------------------------++notFound :: IO (Maybe Response)+notFound = return $ Just responseNotFound++----------------------------------------------------------------++response :: Status -> ByteString -> Integer -> CT -> String -> Response+response st val len ct modified = makeResponse2 st (Just val) (Just len) kvs+ where+ kvs = [(FkContentType,ct),(FkLastModified,modified)]++----------------------------------------------------------------++responseOK :: CT -> String -> Response+responseOK ct modified = makeResponse2 OK (Just LBS.empty) (Just 0) kvs+ where+ kvs = [(FkContentType,ct),(FkLastModified,modified)]++responseRedirect :: URI -> Response+responseRedirect rurl = makeResponse MovedPermanently [(FkLocation,show rurl)]++responseNotFound :: Response+responseNotFound = makeResponse NotFound []++----------------------------------------------------------------++responseBadRequest :: Response+responseBadRequest = makeResponse BadRequest []++responseNotImplement :: Response+responseNotImplement = makeResponse NotImplemented []
+ Network/Web/Server/CGI.hs view
@@ -0,0 +1,101 @@+module Network.Web.Server.CGI (tryGetCGI) where++import Control.Applicative+import Control.Concurrent+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Char+import Network.TCPInfo+import Network.URI+import Network.Web.HTTP+import Network.Web.Server.Params+import Network.Web.Utils+import System.IO+import System.Posix.IO+import System.Process+import System.Timeout++gatewayInterface :: String+gatewayInterface = "CGI/1.1"++----------------------------------------------------------------++tryGetCGI :: BasicConfig -> Request -> FilePath -> URLParameter -> ScriptName -> IO (Maybe Response)+tryGetCGI cnf req prog param snm = processCGI `catch` const internalError+ where+ processCGI = do+ (mrhdl0,mhb) <- maybeCreateHandle+ (rhdl1,whdl1) <- createHandle+ let envVars = makeEnv cnf req param snm+ forkIO $ execCGI prog envVars mrhdl0 (Just whdl1) mhb+ mrsp <- timeout (10 * 1000000) $ processCGIoutput rhdl1+ maybe internalError (return . Just) mrsp+ maybeCreateHandle = case reqBody req of+ Nothing -> return (Nothing,Nothing)+ Just body -> do+ (rhdl0,whdl0) <- createHandle+ return (Just rhdl0, Just (whdl0,body))+ internalError = return $ Just responseInternalServerError++createHandle :: IO (Handle,Handle)+createHandle = do+ (rfd,wfd) <- createPipe+ rhdl <- fdToHandle rfd+ whdl <- fdToHandle wfd+ return (rhdl,whdl)++type ENVVARS = [(String,String)]++execCGI :: FilePath -> ENVVARS -> Maybe Handle -> Maybe Handle -> Maybe (Handle,ByteString) -> IO ()+execCGI prog envVars sti sto mhb = do+ runProcess prog [] Nothing (Just envVars) sti sto Nothing+ case mhb of+ Nothing -> return ()+ Just (whdl,body) -> do+ LBS.hPut whdl body+ hClose whdl++makeEnv :: BasicConfig -> Request -> URLParameter -> ScriptName -> ENVVARS+makeEnv cnf req param snm = addLength . addType . addCookie $ pathOrQuery param ++ baseEnv+ where+ baseEnv = [("GATEWAY_INTERFACE", gatewayInterface)+ ,("SCRIPT_NAME", snm)+ ,("REQUEST_METHOD", show (reqMethod req))+ ,("SERVER_NAME", uriHostName (reqURI req))+ ,("SERVER_PORT", myPort (tcpInfo cnf))+ ,("REMOTE_ADDR", peerAddr (tcpInfo cnf))+ ,("SERVER_PROTOCOL", show (reqVersion req))+ ,("SERVER_SOFTWARE", serverName cnf)]+ pathOrQuery par+ | par == "" = [("QUERY_STRING","")+ ,("PATH_INFO", "")]+ | head par == '?' = [("QUERY_STRING", unEscapeString(tail par))+ ,("PATH_INFO", "")]+ | otherwise = [("QUERY_STRING","")+ ,("PATH_INFO", unEscapeString par)]+ addLength = add "CONTENT_LENGTH" (lookupField FkContentLength req)+ addType = add "CONTENT_TYPE" (lookupField FkContentType req)+ addCookie = add "HTTP_COOKIE" (lookupField FkCookie req)+ add _ Nothing envs = envs+ add key (Just val) envs = (key,val) : envs++processCGIoutput :: Handle -> IO Response+processCGIoutput rhdl = do+ flds <- receiveFields rhdl -- xxx CT: [and Status:] in order+ case lookupField' FkContentType flds of+ Nothing -> return responseInternalServerError+ Just _ -> do+ let st = maybe OK id (lookupField' FkStatus flds >>= toStatus)+ responseAny st flds <$> LBS.hGetContents rhdl++----------------------------------------------------------------++responseAny :: Status -> Fields -> ByteString -> Response+responseAny st flds val = makeResponse3 st (Just val) Nothing flds'+ where+ flds' = case lookupField' FkSetCookie2 flds of+ Nothing -> flds+ Just _ -> insertField' FkCacheControl "no-cache=\"set-cookie2\"" flds++responseInternalServerError :: Response+responseInternalServerError = makeResponse InternalServerError []
+ Network/Web/Server/Lang.hs view
@@ -0,0 +1,49 @@+module Network.Web.Server.Lang (parseLang) where++import Control.Applicative ((<$>),(<$),(<*>),(*>))+import Data.List+import Data.Ord+import Text.Parsec+import Text.Parsec.String++parseLang :: String -> [String]+parseLang xs = case parse acceptLanguage "" xs of+ Left _ -> []+ Right ls -> map fst $ sortBy detrimental ls+ where+ detrimental = flip (comparing snd)++----------------------------------------------------------------++acceptLanguage :: Parser [(String,Int)]+acceptLanguage = rangeQvalue `sepBy1` (spaces *> char ',' *> spaces)++rangeQvalue :: Parser (String,Int)+rangeQvalue = (,) <$> languageRange <*> quality++languageRange :: Parser String+languageRange = (++) <$> language <*> sublang++language :: Parser String+language = many1 letter++sublang :: Parser String+sublang = option "" ((:) <$> char '-' <*> many1 letter)++quality :: Parser Int+quality = option 1000 (string ";q=" *> qvalue)++qvalue :: Parser Int+qvalue = 1000 <$ (char '1' *> optional (char '.' *> range 0 3 digit))+ <|> read3 <$> (char '0' *> option "0" (char '.' *> range 0 3 digit))+ where+ read3 n = read . take 3 $ n ++ repeat '0'++----------------------------------------------------------------++range :: Int -> Int -> GenParser tok st a -> GenParser tok st [a]+range n m p = (++) <$> count n p <*> upto (m - n) p++upto :: Int -> GenParser tok st a -> GenParser tok st [a]+upto 0 _ = return []+upto n p = (:) <$> p <*> upto (n - 1) p <|> return []
+ Network/Web/Server/Params.hs view
@@ -0,0 +1,45 @@+module Network.Web.Server.Params where++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Time+import Network.URI+import Network.TCPInfo++{-|+ The configuration for the basic web server.+-}+data BasicConfig = BasicConfig {+ -- | A mapper from 'URI' to 'Path'.+ mapper :: URI -> Path+ -- | Resource obtaining function. The second argument is+ -- (offset of the resource, and length from the offset).+ , obtain :: FilePath -> Maybe (Integer,Integer) -> IO ByteString+ -- | A function to return the size of the resource and+ -- its modification time if exists.+ , info :: FilePath -> IO (Maybe (Integer, UTCTime))+ -- | A server name specified the Server: field.+ , serverName :: String+ -- | 'TCPInfo' for passing CGI. (See c10k library.)+ , tcpInfo :: TCPInfo+}++{-|+ Control information of how to handle 'URI'.+-}+data Path =+ -- | 'URI' cannot be converted into any resources.+ None+ -- | 'URI' is converted into a resource (typically a file).+ | File FilePath+ -- | 'URI' is converted into CGI.+ | CGI FilePath URLParameter ScriptName deriving (Eq,Show)++{-|+ A type for URL parameter.+-}+type URLParameter = String++{-|+ A type for script name.+-}+type ScriptName = String
+ Network/Web/Server/Range.hs view
@@ -0,0 +1,45 @@+module Network.Web.Server.Range (skipAndSize) where++import Control.Applicative ((<$>),(<*),(<*>),(*>))+import Text.Parsec+import Text.Parsec.String++skipAndSize :: String -> Integer -> Maybe (Integer,Integer)+skipAndSize str size = case parseRange str of+ Just [(mbeg,mend)] -> adjust mbeg mend size+ _ -> Nothing++adjust :: Maybe Integer -> Maybe Integer -> Integer -> Maybe (Integer,Integer)+adjust (Just beg) (Just end) siz+ | beg <= end && end <= siz = Just (beg, end - beg + 1)+ | otherwise = Nothing+adjust (Just beg) Nothing siz+ | beg <= siz = Just (beg, siz - beg)+ | otherwise = Nothing+adjust Nothing (Just end) siz+ | end <= siz = Just (siz - end, end)+ | otherwise = Nothing+adjust Nothing Nothing _ = Nothing++type Range = (Maybe Integer, Maybe Integer)++parseRange :: String -> Maybe [Range]+parseRange xs = case parse byteRange "" xs of+ Left _ -> Nothing+ Right x -> Just x++byteRange :: Parser [Range]+byteRange = string "bytes=" *> (ranges <* eof)++ranges :: Parser [Range]+ranges = sepBy1 (range <|> suffixRange) (spaces >> char ',' >> spaces)++range :: Parser Range+range = (,) <$> ((Just <$> num) <* char '-')+ <*> (option Nothing (Just <$> num))++suffixRange :: Parser Range+suffixRange = (,) Nothing <$> (char '-' *> (Just <$> num))++num :: Parser Integer+num = read <$> many1 digit
+ Network/Web/Utils.hs view
@@ -0,0 +1,18 @@+{-|+ Utility functions.+-}+module Network.Web.Utils where++import Network.URI++{-|+ Getting a hostname from 'URI'.+-}+uriHostName :: URI -> String+uriHostName uri = maybe "" uriRegName $ uriAuthority uri++{-|+ Making a URL string from 'URI' without port.+-}+toURLwoPort :: URI -> String+toURLwoPort uri = uriScheme uri ++ "//" ++ uriHostName uri ++ uriPath uri ++ uriQuery uri
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ webserver.cabal view
@@ -0,0 +1,26 @@+Name: webserver+Version: 0.1.0+Author: Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+License: BSD3+License-File: LICENSE+Synopsis: HTTP server library+Description: A simple but practical library of HTTP server.+Category: Netowrk+Cabal-Version: >= 1.6+Build-Type: Simple+library+ GHC-Options: -Wall -O2+ Exposed-Modules: Network.Web.HTTP,+ Network.Web.Server,+ Network.Web.Server.Basic,+ Network.Web.Utils+ Other-Modules: Network.Web.Date,+ Network.Web.Params,+ Network.Web.Server.CGI,+ Network.Web.Server.Lang,+ Network.Web.Server.Params,+ Network.Web.Server.Range+ Build-Depends: base >= 4 && < 10, parsec >= 3,+ haskell98, network, bytestring, containers,+ filepath, time, unix, process, c10k