diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Network/Web/Date.hs b/Network/Web/Date.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Date.hs @@ -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 diff --git a/Network/Web/HTTP.hs b/Network/Web/HTTP.hs new file mode 100644 --- /dev/null +++ b/Network/Web/HTTP.hs @@ -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 = "" ++ show st ++ "\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 = " " diff --git a/Network/Web/Params.hs b/Network/Web/Params.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Params.hs @@ -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" diff --git a/Network/Web/Server.hs b/Network/Web/Server.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server.hs @@ -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 diff --git a/Network/Web/Server/Basic.hs b/Network/Web/Server/Basic.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server/Basic.hs @@ -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 [] diff --git a/Network/Web/Server/CGI.hs b/Network/Web/Server/CGI.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server/CGI.hs @@ -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 [] diff --git a/Network/Web/Server/Lang.hs b/Network/Web/Server/Lang.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server/Lang.hs @@ -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 [] diff --git a/Network/Web/Server/Params.hs b/Network/Web/Server/Params.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server/Params.hs @@ -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 diff --git a/Network/Web/Server/Range.hs b/Network/Web/Server/Range.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Server/Range.hs @@ -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 diff --git a/Network/Web/Utils.hs b/Network/Web/Utils.hs new file mode 100644 --- /dev/null +++ b/Network/Web/Utils.hs @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/webserver.cabal b/webserver.cabal new file mode 100644 --- /dev/null +++ b/webserver.cabal @@ -0,0 +1,26 @@ +Name: webserver +Version: 0.1.0 +Author: Kazu Yamamoto +Maintainer: Kazu Yamamoto +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