hyena (empty) → 0.1
raw patch · 10 files changed
+1459/−0 lines, 10 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, directory, extensible-exceptions, filepath, mtl, network, network-bytestring, unix
Files
- Data/Enumerator.hs +127/−0
- Hyena/Config.hs +212/−0
- Hyena/Http.hs +340/−0
- Hyena/Logging.hs +145/−0
- Hyena/Parser.hs +197/−0
- Hyena/Server.hs +251/−0
- LICENSE +31/−0
- Network/Wai.hs +109/−0
- Setup.hs +3/−0
- hyena.cabal +44/−0
+ Data/Enumerator.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE Rank2Types #-}++module Data.Enumerator+ ( -- Enumerators+ bytesEnum,+ chunkEnum,+ partialSocketEnum,+ socketEnum,++ -- Combining enumerators+ compose+ ) where++import Control.Monad (liftM)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C (unpack)+import Data.Word (Word8)+import Network.Socket (Socket)+import Network.Socket.ByteString (recv)+import Numeric (readHex)++type IterateeM a m = a -> S.ByteString -> m (Either a a)+type EnumeratorM m = forall a. IterateeM a m -> a -> m a++-- -----------------------------------------------------------+-- Enumerators++-- | Enumerates a 'ByteString'.+bytesEnum :: Monad m => S.ByteString -> EnumeratorM m+bytesEnum bs f seed = do+ seed' <- f seed bs+ case seed' of+ Left seed'' -> return seed''+ Right seed'' -> return seed''+++nl :: Word8+nl = 10++-- | Enumerates chunks of data encoded using HTTP chunked encoding.+chunkEnum :: Monad m => EnumeratorM m -> EnumeratorM m+chunkEnum enum f initSeed = fst `liftM` enum go (initSeed, Left S.empty)+ where+ go (seed, Left acc) bs =+ case S.elemIndex nl bs of+ Just ix -> let (line, rest) = S.splitAt (ix + 1) bs+ hdr = S.append acc line+ chunkLen = pHeader hdr+ in case chunkLen of+ Just n -> go (seed, Right n) rest+ Nothing -> error $ "malformed header" ++ show hdr+ Nothing -> return $ Right (seed, Left (S.append acc bs))+ go (seed, Right n) bs =+ let len = S.length bs+ in if len < n+ then do+ seed' <- f seed bs+ case seed' of+ Right seed'' -> return $ Right (seed'', Right $! n - len)+ Left seed'' -> return $ Left (seed'', Right $! n - len)+ else let (bs', rest) = S.splitAt n bs+ in do+ seed' <- f seed bs'+ case seed' of+ Right seed'' -> go (seed'', Left S.empty) rest+ Left seed'' -> return $ Left (seed'', Left rest)++-- TODO: Ignore header.+pHeader :: S.ByteString -> Maybe Int+pHeader bs =+ case readHex $ C.unpack hdr of+ [(n, "")] -> Just n+ _ -> Nothing+ where+ hdr = S.take (S.length bs - 2) bs++-- | Maximum number of bytes sent or received in every socket+-- operation.+blockSize :: Int+blockSize = 4 * 1024++-- | @partialSocketEnum sock numBytes@ enumerates @numBytes@ bytes+-- received through the given socket. Does not close the socket.+partialSocketEnum :: Socket -> Int -> EnumeratorM IO+partialSocketEnum sock numBytes f initSeed = go initSeed numBytes+ where+ go seed 0 = return seed+ go seed n = do+ bs <- recv sock blockSize+ if S.null bs+ then return seed+ else do+ seed' <- f seed bs+ case seed' of+ Right seed'' -> go seed'' $! n - S.length bs+ Left seed'' -> return seed''++-- | Enumerates data received through the given socket. Does not+-- close the socket.+socketEnum :: Socket -> EnumeratorM IO+socketEnum sock f initSeed = go initSeed+ where+ go seed = do+ bs <- recv sock blockSize+ if S.null bs+ then return seed+ else do+ seed' <- f seed bs+ case seed' of+ Right seed'' -> go seed''+ Left seed'' -> return seed''++-- -----------------------------------------------------------+-- Combining enumerators++-- Make two enumerators behave like one.+compose :: Monad m => EnumeratorM m -> EnumeratorM m -> EnumeratorM m+compose enum1 enum2 f initSeed = enum1 f1 (Right initSeed) >>= k+ where+ f1 (Right seed) bs = do+ r <- f seed bs+ case r of+ x@(Right _) -> return $ Right x+ x -> return $ Left x+ f1 x _ = return $ Left x -- Cannot happen.+ k (Left seed) = return seed+ k (Right seed) = enum2 f seed
+ Hyena/Config.hs view
@@ -0,0 +1,212 @@+------------------------------------------------------------------------+-- |+-- Module : Hyena.Config+-- Copyright : (c) Johan Tibell 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- This module specifies the server configuration.+--+------------------------------------------------------------------------++module Hyena.Config+ ( Config(..),+ configFromFlags,+ defaultConfig+ ) where++import Control.Monad (when)+import Data.Monoid (Monoid(..))+import System.Console.GetOpt+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure)+import System.FilePath ((</>), dropFileName)+import System.IO (BufferMode(..), Handle, IOMode(..), hSetBuffering, openFile,+ stderr)++-- ---------------------------------------------------------------------+-- Config type++-- | The server configuration.+data Config = Config+ { address :: String+ -- ^ Address (hostname or IP) to bind to when listening for+ -- connections.+ , daemonize :: Bool+ -- ^ Run in the background.+ , debug :: Bool+ -- ^ Print lots of debug information.+ , logHandle :: Handle+ -- ^ Where to dump log messages in daemon mode.+ , port :: Int+ -- ^ Port to bind to when listening for connections.+ } deriving Show++-- | Converts a set of flags into a server configuration.+flagsToConfig :: Flags -> IO Config+flagsToConfig flags = do+ when (flag flagDaemonize) $+ createDirectoryIfMissing True $ dropFileName (flag flagLogFile)+ logHandle' <- if flag flagDaemonize+ then openFile (flag flagLogFile) AppendMode+ else return stderr+ hSetBuffering logHandle' LineBuffering+ return Config+ { address = flag flagAddress+ , daemonize = flag flagDaemonize+ , debug = flag flagDebug+ , logHandle = logHandle'+ , port = flag flagPort+ }+ where flag field = fromFlag $ field flags++-- | Reads the server options from the command line. Settings from+-- 'defaultConfig' is used for unspecified options. Creates missing+-- directories as needed for the log file referred to by the @--log@+-- flag when in 'daemonize'd mode.+configFromFlags :: IO Config+configFromFlags = do+ argv <- getArgs+ cwd <- getCurrentDirectory+ progName <- getProgName+ case parseArgs argv progName of+ Left err -> putStr err >> exitFailure+ Right flags -> flagsToConfig $ defaultFlags cwd `mappend` flags++-- | A set of default options most users should use. Creates missing+-- directories as needed for the default log file when in 'daemonize'd+-- mode.+defaultConfig :: IO Config+defaultConfig = do+ cwd <- getCurrentDirectory+ flagsToConfig $ defaultFlags cwd++-- ---------------------------------------------------------------------+-- Flag type++data Flag a = Flag a | NoFlag deriving Show++instance Functor Flag where+ fmap f (Flag x) = Flag (f x)+ fmap _ NoFlag = NoFlag++instance Monoid (Flag a) where+ mempty = NoFlag+ _ `mappend` f@(Flag _) = f+ f `mappend` NoFlag = f++fromFlag :: Flag a -> a+fromFlag (Flag x) = x+fromFlag NoFlag = error "fromFlag NoFlag"++-- ---------------------------------------------------------------------+-- Config flags++data Flags = Flags+ { flagAddress :: Flag String+ , flagDaemonize :: Flag Bool+ , flagDebug :: Flag Bool+ , flagLogFile :: Flag FilePath+ , flagPort :: Flag Int+ } deriving Show++defaultFlags :: FilePath -> Flags+defaultFlags cwd =+ -- NOTE: If we add a flag to change the working directory it has+ -- to be taken into account here.+ Flags { flagAddress = Flag "0.0.0.0"+ , flagDaemonize = Flag False+ , flagDebug = Flag False+ , flagLogFile = Flag $ cwd </> "log/hyena.log"+ , flagPort = Flag 3000+ }++emptyFlags :: Flags+emptyFlags = mempty++instance Monoid Flags where+ mempty = Flags+ { flagAddress = mempty+ , flagDaemonize = mempty+ , flagDebug = mempty+ , flagLogFile = mempty+ , flagPort = mempty+ }+ mappend a b = Flags+ { flagAddress = combine flagAddress+ , flagDaemonize = combine flagDaemonize+ , flagDebug = combine flagDebug+ , flagLogFile = combine flagLogFile+ , flagPort = combine flagPort+ }+ where combine field = field a `mappend` field b++-- ---------------------------------------------------------------------+-- Args parsing++-- | Converts a 'String' containing a port number to an integer and+-- fails with an 'error' if the 'String' contained non-digit+-- characters.+flagToPort :: String -> Int+flagToPort str =+ case reads str of+ [(i, "")] -> i+ _ -> error $ "--port: invalid port `" ++ str ++ "'"++-- | The command line options.+options :: [OptDescr (Flags -> Flags)]+options =+ [Option "a" ["address"]+ (reqArgFlag "ADDRESS" flagAddress+ (\v flags -> flags {flagAddress = v}))+ "bind to ADDRESS (hostname or IP) on localhost"+ ,Option "d" ["daemonize"]+ (trueArg flagDaemonize (\v flags -> flags {flagDaemonize = v}))+ "run in the background"+ ,Option "B" ["debug"]+ (trueArg flagDebug (\v flags -> flags {flagDebug = v}))+ "print lots of debug information"+ ,Option "l" ["log"]+ (reqArgFlag "FILE" flagLogFile+ (\v flags -> flags {flagLogFile = v}))+ "dump log messages to FILE when daemonized"+ ,Option "p" ["port"]+ (reqArg "PORT" (Flag . flagToPort)+ flagPort (\v flags -> flags {flagPort = v}))+ "bind to PORT on localhost"+ ]++-- | Parses the given command line arguments. Returns either the+-- parsed flags or a 'String' explaining the error on failure.+parseArgs :: [String] -> String -> Either String Flags+parseArgs argv progName =+ case getOpt Permute options argv of+ (flags, _, []) -> Right $ foldl (flip id) emptyFlags flags+ (_, _, errs) -> Left $ concat errs ++ usageInfo header options+ where header = "Usage: " ++ progName ++ " [OPTION]..."++-- ---------------------------------------------------------------------+-- GetOpt helpers++reqArg :: (Monoid a) =>+ String -> (String -> a) -> (t -> a) -> (a -> t -> t1)+ -> ArgDescr (t -> t1)+reqArg name mkFlag get set =+ ReqArg (\v flags -> set (get flags `mappend` mkFlag v) flags) name++noArg :: (Monoid a) => a -> (t -> a) -> (a -> t -> t1) -> ArgDescr (t -> t1)+noArg flag get set =+ NoArg (\flags -> set (get flags `mappend` flag) flags)++trueArg :: (t -> Flag Bool) -> (Flag Bool -> t -> t1)+ -> ArgDescr (t -> t1)+trueArg = noArg (Flag True)++reqArgFlag :: String -> (t -> Flag String) -> (Flag String -> t -> t1)+ -> ArgDescr (t -> t1)+reqArgFlag name = reqArg name Flag+
+ Hyena/Http.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE Rank2Types #-}++-- See: http://www.w3.org/Protocols/rfc2616/rfc2616.html++------------------------------------------------------------------------+-- |+-- Module : Hyena.Http+-- Copyright : (c) Johan Tibell 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- Receiving and sending HTTP requests and responses.+--+------------------------------------------------------------------------++module Hyena.Http+ ( -- * The request and response data types+ Request(..),+ Response(..),++ -- * Sending and receiving+ sendResponse,+ isValidStatusCode,+ receiveRequest,++ -- * Common responses+ errorResponse,++ -- * Parsing+ parseRequest+ ) where++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C (map, pack, unpack)+import Data.Char (chr, digitToInt, isAlpha, isDigit, isSpace, ord, toLower)+import Data.Either (either)+import Control.Arrow+import qualified Data.Map as M+import Data.Maybe (fromJust)+import Data.Word (Word8)+import Network.Socket (Socket)+import Network.Socket.ByteString (recv, send)+import Network.Wai (Enumerator, Headers, Method(..))++import Data.Enumerator+import Hyena.Parser++-- ---------------------------------------------------------------------+-- Request and response data types++-- | An HTTP request.+data Request = Request+ { method :: Method+ , requestUri :: S.ByteString+ , httpVersion :: (Int, Int)+ , requestHeaders :: [(S.ByteString, S.ByteString)]+ , requestBody :: Enumerator+ }++-- | An internal representation of the request header part of an HTTP+-- request.+data IRequest = IRequest+ { iMethod :: Method+ , iRequestUri :: S.ByteString+ , iHttpVersion :: (Int, Int)+ , iRequestHeaders :: [(S.ByteString, S.ByteString)]+ } deriving Show++-- | An HTTP response.+data Response = Response+ { statusCode :: Int+ , reasonPhrase :: S.ByteString+ , responseHeaders :: [(S.ByteString, S.ByteString)]+ , responseBody :: Enumerator+ }++-- ---------------------------------------------------------------------+-- Sending and receiving++-- | Maximum number of bytes sent or received in every socket operation.+blockSize :: Int+blockSize = 4 * 1024++-- | Send response over socket.+sendResponse :: Socket -> Response -> IO ()+sendResponse sock resp = do+ -- TODO: Check if all data was sent.+ send sock $ S.concat [C.pack "HTTP/1.1 "+ ,(C.pack $ show (statusCode resp) ++ " "+ ++(C.unpack $ reasonPhrase resp))+ ,C.pack "\r\n"]+ sendHeaders sock (responseHeaders resp)+ send sock $ C.pack "\r\n"+ responseBody resp (sendMessageBody sock) ()+ -- TODO: Flush the socket.++-- TODO: Check if all bytes were sent, otherwise retry.++-- | Iteratee used for sending message body over socket.+sendMessageBody :: Socket -> () -> S.ByteString -> IO (Either () ())+sendMessageBody sock _ bs = send sock bs >> return (Right ())++-- | Send headers over socket.+sendHeaders :: Socket -> Headers -> IO ()+sendHeaders sock headers = do+ send sock $ S.concat $ map go headers+ return ()+ where go (k, v) = S.concat [k, C.pack ": "+ ,v, C.pack "\r\n"]++-- | Receive request from socket. If the request is malformed+-- 'Nothing' is returned.+receiveRequest :: Socket -> IO (Maybe Request)+receiveRequest sock = do+ x <- parseIRequest sock+ case x of+ Nothing -> return Nothing+ Just (req, bs) ->+ let len = contentLength req+ rest = bytesEnum bs+ enum = case len of+ Just n -> partialSocketEnum sock (n - S.length bs)+ Nothing -> chunkEnum $ socketEnum sock+ in return $ Just+ Request+ { method = iMethod req+ , requestUri = iRequestUri req+ , httpVersion = iHttpVersion req+ , requestHeaders = iRequestHeaders req+ , requestBody = compose rest enum+ }++-- | The length of the request's message body, if present.+contentLength :: IRequest -> Maybe Int+contentLength req+ | iMethod req `elem` [Options, Get, Head] = Just 0+ | otherwise = do v <- getHeader "Content-Length" req+ toInt $ C.unpack v+ where+ toInt str = case reads str of+ [(i, "")] -> Just i+ _ -> Nothing++-- | Get header if present.+getHeader :: String -> IRequest -> Maybe S.ByteString+getHeader hdr req = lookup (C.map toLower $ C.pack hdr) headers+ where+ mapFst = map . first+ headers = mapFst (C.map toLower) (iRequestHeaders req)++-- ---------------------------------------------------------------------+-- Common responses++-- | An error response with an empty message body. Closes the+-- connection.+errorResponse :: Int -> Response+errorResponse status =+ Response+ { statusCode = status+ , reasonPhrase = fromJust $ M.lookup status reasonPhrases+ , responseHeaders = [(C.pack "Connection", C.pack "close")]+ , responseBody = emptyMessageBody+ }++-- ---------------------------------------------------------------------+-- Parsing requests++c2w :: Char -> Word8+c2w = fromIntegral . ord++-- | Parsers for different tokens in an HTTP request.+sp, digit, letter, nonSpace, notEOL :: Parser Word8+sp = byte $ c2w ' '+digit = satisfies (isDigit . chr . fromIntegral)+letter = satisfies (isAlpha . chr . fromIntegral)+nonSpace = satisfies (not . isSpace . chr . fromIntegral)+notEOL = noneOf $ map c2w "\r\n"++-- | Parser for request \"\r\n\" sequence.+crlf :: Parser S.ByteString+crlf = bytes $ C.pack "\r\n"++-- | Parser that recognize if the current byte is an element of the+-- given sequence of bytes.+oneOf, noneOf :: [Word8] -> Parser Word8+oneOf bs = satisfies (`elem` bs)+noneOf bs = satisfies (`notElem` bs)++-- | Parser for zero or more spaces.+spaces :: Parser [Word8]+spaces = many sp++-- | Parses the header part (i.e. everything expect for the request+-- body) of an HTTP request. Returns any bytes read that were not+-- used when parsing. Returns @Nothing@ on failure and @Just+-- (request, remaining)@ on success.+parseIRequest :: Socket -> IO (Maybe (IRequest, S.ByteString))+parseIRequest sock = do+ initial <- recv sock blockSize+ go $ runParser pIRequest initial+ where+ go (Finished req bs) = return $ Just (req, bs)+ go (Failed _) = return Nothing+ -- TODO: Detect end of input.+ go (Partial k) = recv sock blockSize >>= go . k . Just++-- | Parser for the internal request data type.+pIRequest :: Parser IRequest+pIRequest = IRequest+ <$> pMethod <* sp+ <*> pUri <* sp+ <*> pVersion <* crlf+ <*> pHeaders <* crlf++-- | Parser for the request method.+pMethod :: Parser Method+pMethod = (Options <$ bytes (C.pack "OPTIONS"))+ <|> (Get <$ bytes (C.pack "GET"))+ <|> (Head <$ bytes (C.pack "HEAD"))+ <|> byte (c2w 'P') *> ((Post <$ bytes (C.pack "OST")) <|>+ (Put <$ bytes (C.pack "UT")))+ <|> (Delete <$ bytes (C.pack "DELETE"))+ <|> (Trace <$ bytes (C.pack "TRACE"))+ <|> (Connect <$ bytes (C.pack "CONNECT"))++-- | Parser for the request URI.+pUri :: Parser S.ByteString+pUri = fmap S.pack $ many nonSpace++-- | Parser for the request's HTTP protocol version.+pVersion :: Parser (Int, Int)+pVersion = bytes (C.pack "HTTP/") *>+ liftA2 (,) (digit' <* byte (c2w '.')) digit'+ where+ digit' = fmap (digitToInt . chr . fromIntegral) digit++-- | Parser for request headers.+pHeaders :: Parser [(S.ByteString, S.ByteString)]+pHeaders = many header+ where+ header = liftA2 (,) fieldName (byte (c2w ':') *> spaces *> contents)+ fieldName = liftA2 S.cons letter fieldChars+ contents = liftA2 S.append (fmap S.pack $ some notEOL <* crlf)+ (continuation <|> pure S.empty)+ continuation = liftA2 S.cons (c2w ' ' <$+ some (oneOf (map c2w " \t"))) contents++-- It's important that all these three definitions are kept on the top+-- level to have RULES fire correctly.++-- | Parser for zero or more bytes in a header field.+fieldChars :: Parser S.ByteString+fieldChars = fmap S.pack $ many fieldChar++-- fieldChar = letter <|> digit <|> oneOf (map c2w "-_")++-- | Parser for one header field byte.+fieldChar :: Parser Word8+fieldChar = satisfies isFieldChar+ where+ isFieldChar b = (isDigit $ chr $ fromIntegral b) ||+ (isAlpha $ chr $ fromIntegral b) ||+ (b `elem` map c2w "-_")++-- ---------------------------------------------------------------------+-- Helpers++-- | An empty 'Enumerator' that just returns the passed in seed.+emptyMessageBody :: Enumerator+emptyMessageBody _ = return++-- | Test if the given HTTP status code is valid.+isValidStatusCode :: Int -> Bool+isValidStatusCode code = M.member code reasonPhrases++-- | Mapping from status code to reason phrases.+reasonPhrases :: M.Map Int S.ByteString+reasonPhrases = M.fromList . map (second C.pack) $+ [(100, "Continue")+ ,(101, "Switching Protocols")+ ,(200, "OK")+ ,(201, "Created")+ ,(202, "Accepted")+ ,(203, "Non-Authoritative Information")+ ,(204, "No Content")+ ,(205, "Reset Content")+ ,(206, "Partial Content")+ ,(300, "Multiple Choices")+ ,(301, "Moved Permanently")+ ,(302, "Found")+ ,(303, "See Other")+ ,(304, "Not Modified")+ ,(305, "Use Proxy")+ ,(307, "Temporary Redirect")+ ,(400, "Bad Request")+ ,(401, "Unauthorized")+ ,(402, "Payment Required")+ ,(403, "Forbidden")+ ,(404, "Not Found")+ ,(405, "Method Not Allowed")+ ,(406, "Not Acceptable")+ ,(407, "Proxy Authentication Required")+ ,(408, "Request Time-out")+ ,(409, "Conflict")+ ,(410, "Gone")+ ,(411, "Length Required")+ ,(412, "Precondition Failed")+ ,(413, "Request Entity Too Large")+ ,(414, "Request-URI Too Large")+ ,(415, "Unsupported Media Type")+ ,(416, "Requested range not satisfiable")+ ,(417, "Expectation Failed")+ ,(500, "Internal Server Error")+ ,(501, "Not Implemented")+ ,(502, "Bad Gateway")+ ,(503, "Service Unavailable")+ ,(504, "Gateway Time-out")+ ,(505, "HTTP Version not supported")]++-- TODO: Return remaining bytes if Content-Length present.++-- | Parse a request from a sequence of bytes.+parseRequest :: S.ByteString -> IO (Maybe (Request, S.ByteString))+parseRequest input =+ go $ runParser pIRequest input+ where+ go (Failed _) = return Nothing+ go (Partial k) = go (k Nothing)+ go (Finished req bs) =+ let req' = Request+ { method = iMethod req+ , requestUri = iRequestUri req+ , httpVersion = iHttpVersion req+ , requestHeaders = iRequestHeaders req+ , requestBody = \f z -> either id id `fmap` f z bs+ }+ in return $ Just (req', S.empty)
+ Hyena/Logging.hs view
@@ -0,0 +1,145 @@+module Hyena.Logging+ ( -- * The Logger and LogRequest types+ AccessLogger,+ LogRequest(..),+ ErrorLogger,++ -- * Logging+ startAccessLogger,+ stopAccessLogger,+ logAccess,+ startErrorLogger,+ stopErrorLogger,+ logError,+ ) where++import qualified Data.ByteString.Char8 as C+import Control.Concurrent (forkIO)+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)+import Network.Socket (HostAddress, inet_ntoa)+import Network.Wai (Method(..))+import Prelude hiding (log)+import System.IO (Handle, hFlush, hPutStr, hPutStrLn)+import Text.Printf (printf)++import Hyena.Http (Request(..), Response(..))++-- ---------------------------------------------------------------------+-- The Logger and LogRequest types++-- | A queue of messages waiting to be logged.+data Logger a = Logger+ { channel :: Chan (Maybe a)+ , finished :: MVar ()+ -- ^ The logger puts a value here once it has terminated.+ }++-- | A description of a processed request.+data LogRequest = LogRequest+ { hostAddress :: HostAddress+ , request :: Request+ , response :: Response+ }++-- | A logger for client requests.+newtype AccessLogger = AccessLogger (Logger LogRequest)++-- | A logger for error messages.+newtype ErrorLogger = ErrorLogger (Logger String)++-- ---------------------------------------------------------------------+-- Logging++-- | Start a new logger in a separate thread that runs until+-- 'stopLogger' is called. Returns a 'Logger' that can be used to log+-- messages.+startLogger :: (Handle -> a -> IO ()) -> Handle -> IO (Logger a)+startLogger writer logHandle = do+ chan <- newChan+ finished' <- newEmptyMVar+ forkIO $ logMessages chan finished'+ return Logger { channel = chan+ , finished = finished'+ }+ where+ logMessages chan finished' = do+ msg <- readChan chan+ case msg of+ Just msg' -> writer logHandle msg' >>+ logMessages chan finished'+ Nothing -> putMVar finished' ()++-- | Stop the access after all currently enqueued log requests have+-- been processed. Waits until the logger has finished.+stopLogger :: Logger a -> IO ()+stopLogger logger = do+ writeChan (channel logger) Nothing+ takeMVar (finished logger)++-- | Start a new logger that logs client requests.+startAccessLogger :: Handle -> IO AccessLogger+startAccessLogger = fmap AccessLogger . startLogger writeAccess++-- | Stop a client request logger.+stopAccessLogger :: AccessLogger -> IO ()+stopAccessLogger (AccessLogger logger) = stopLogger logger++-- | Start a new logger that logs error messages.+startErrorLogger :: Handle -> IO ErrorLogger+startErrorLogger = fmap ErrorLogger . startLogger writeError++-- | Stop error message logger.+stopErrorLogger :: ErrorLogger -> IO ()+stopErrorLogger (ErrorLogger logger) = stopLogger logger++-- | Log an error.+logError :: ErrorLogger -> String -> IO ()+logError (ErrorLogger logger) = writeChan (channel logger) . Just++-- | Write error message to the given 'Handle'.+writeError :: Handle -> String -> IO ()+writeError handle msg = hPutStr handle msg >> hFlush handle++-- | Log a client request.+logAccess :: AccessLogger -> Request -> Response -> HostAddress -> IO ()+logAccess (AccessLogger logger) req resp haddr =+ writeChan (channel logger) $ Just+ LogRequest+ { hostAddress = haddr+ , request = req+ , response = resp+ }++-- | Write client request log message to the given 'Handle'.+writeAccess :: Handle -> LogRequest -> IO ()+writeAccess h logReq = do+ host <- inet_ntoa (hostAddress logReq)+ let requestLine = printf "\"%s %s HTTP/%s\"" method' uri version+ response' = show (statusCode $ response logReq) ++ " " ++ show length'+ hPutStrLn h $ host ++ " " ++ requestLine ++ " " ++ response'+ where+ (major, minor) = httpVersion $ request logReq+ version = show major ++ "." ++ show minor+ method' = prettyPrint $ method $ request logReq+ uri = C.unpack $ requestUri $ request logReq+ respHeaders = responseHeaders $ response logReq+ -- TODO: Calculate the size in case Content-Length is missing.+ length' :: Int+ length' = maybe 0 (read . C.unpack)+ (lookup (C.pack "Content-Length") respHeaders)++class PrettyPrint a where+ prettyPrint :: a -> String++-- | Converts from a 'Method' enumeration to the corresponding HTTP+-- string.+instance PrettyPrint Method where+ prettyPrint Options = "OPTIONS"+ prettyPrint Get = "GET"+ prettyPrint Head = "HEAD"+ prettyPrint Post = "POST"+ prettyPrint Put = "PUT"+ prettyPrint Delete = "DELETE"+ prettyPrint Trace = "TRACE"+ prettyPrint Connect = "CONNECT"
+ Hyena/Parser.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE Rank2Types #-}++------------------------------------------------------------------------+-- |+-- Module : Hyena.Parser+-- Copyright : (c) Johan Tibell 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- A resumable LL(1) parser combinator library for 'ByteString's.+--+------------------------------------------------------------------------++module Hyena.Parser+ (+ -- * The Parser type+ Parser,+ Result(..),+ runParser,++ -- * Primitive parsers+ satisfies,+ byte,+ bytes,++ module Control.Applicative+ ) where++import Control.Applicative+import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import Data.Int (Int64)+import Data.Word (Word8)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (peekByteOff)+import Prelude hiding (fail, rem, succ)+import Text.Show.Functions ()++-- ---------------------------------------------------------------------+-- The Parser type++-- | The parse state.+data S r = S+ {-# UNPACK #-} !S.ByteString+ {-# UNPACK #-} !Int64+ {-# UNPACK #-} !Bool+ {-# UNPACK #-} !(S r -> Result r)+ deriving Show++-- | Set the failure continuation.+setFail :: S r -> (S r -> Result r) -> S r+setFail (S bs pos eof _) = S bs pos eof+{-# INLINE setFail #-}++-- | A parse either succeeds, fails or returns a suspension with which+-- the parsing can be resumed.+data Result a = Finished a S.ByteString+ -- ^ Parsing succeeded and produced a value of type+ -- @a@. The returned 'S.ByteString' is the remaining+ -- unconsumed input.+ | Failed Int64+ -- ^ Parsing failed at the given position. Either+ -- because the parser didn't match the input or because+ -- an unexpected end of input was reached during+ -- parsing.+ | Partial (Maybe S.ByteString -> Result a)+ -- ^ The parsing needs more input to continue. Pass in+ -- @Just input@ to continue parsing and @Nothing@ to+ -- signal end of input. If @Nothing@ is passed the+ -- 'Result' is either 'Finished' or 'Failed'.+ deriving Show++-- | A parser takes a parse state, a success continuation and returns+-- a 'Result'.+newtype Parser a = Parser+ { unParser :: forall r. S r -> (a -> S r -> Result r) -> Result r }++-- ---------------------------------------------------------------------+-- Instances++instance Functor Parser where+ fmap f p = Parser $ \s succ -> unParser p s (succ . f)+ {-# INLINE fmap #-}++instance Applicative Parser where+ pure a = Parser $ \s succ -> succ a s+ {-# INLINE pure #-}++ p <*> p' = Parser $ \s succ ->+ let succ' f s' = unParser p' s' (succ . f)+ in unParser p s succ'+ {-# INLINE (<*>) #-}++instance Alternative Parser where+ empty = Parser $ \s@(S _ _ _ fail) _ -> fail s+ {-# INLINE empty #-}++ p <|> p' = Parser $ \s@(S _ _ _ fail) succ ->+ let fail' s' = unParser p' (setFail s' fail) succ+ in unParser p (setFail s fail') succ+ {-# INLINE (<|>) #-}++-- ---------------------------------------------------------------------+-- Running a parser++initState :: S.ByteString -> S r+initState bs = S bs 0 False failed+{-# INLINE initState #-}++-- | This is the final continuation that turns a successful parse into+-- a 'Result'.+finished :: a -> S r -> Result a+finished v (S bs _ _ _) = Finished v bs++-- | This is the final continuation that turns an unsuccessful parse+-- into a 'Result'.+failed :: S r -> Result a+failed (S _ pos _ _) = Failed pos++-- | TODO: Write documentation.+runParser :: Parser a -> S.ByteString -> Result a+runParser p bs = unParser p (initState bs) finished++-- ---------------------------------------------------------------------+-- Primitive parsers++-- | The parser @satisfies p@ succeeds for any byte for which the+-- supplied function @p@ returns 'True'. Returns the byte that is+-- actually parsed.+satisfies :: (Word8 -> Bool) -> Parser Word8+satisfies p =+ Parser $ \s@(S bs pos eof fail) succ ->+ case S.uncons bs of+ Just (b, bs') -> if p b+ then succ b (S bs' (pos + 1) eof failed)+ else fail s+ Nothing -> if eof+ then fail s+ else Partial $ \x ->+ case x of+ Just bs' -> retry (S bs' pos eof fail)+ Nothing -> fail (S bs pos True fail)+ where retry s' = unParser (satisfies p) s' succ++-- | @byte b@ parses a single byte @b@. Returns the parsed byte+-- (i.e. @b@).+byte :: Word8 -> Parser Word8+byte b = satisfies (== b)++-- TODO: Check when we can let go of the failure continuation.++-- | @bytes bs@ parses a sequence of bytes @bs@. Returns the parsed+-- bytes (i.e. @bs@).+bytes :: S.ByteString -> Parser S.ByteString+bytes bs =+ Parser $ \(S bs' pos eof fail) succ ->+ let go rem inp+ | len == remLen =+ succ bs (S (S.drop len inp) newPos eof failed)+ | len < remLen && inpLen >= remLen =+ fail (S (S.drop len inp) newPos eof fail)+ | otherwise =+ Partial $ \x ->+ case x of+ Just bs'' -> go (S.drop len rem) bs''+ Nothing -> fail (S S.empty newPos True fail)+ where+ len = commonPrefixLen rem inp+ remLen = S.length rem+ newPos = pos + fromIntegral len+ inpLen = S.length inp+ in go bs bs'++-- ---------------------------------------------------------------------+-- Internal utilities++-- | /O(n)/ @commonPrefixLen xs ys@ returns the length of the longest+-- common prefix of @xs@ and @ys@.+commonPrefixLen :: S.ByteString -> S.ByteString -> Int+commonPrefixLen (S.PS fp1 off1 len1) (S.PS fp2 off2 len2) =+ S.inlinePerformIO $+ withForeignPtr fp1 $ \p1 ->+ withForeignPtr fp2 $ \p2 ->+ lcp (p1 `plusPtr` off1) (p2 `plusPtr` off2) 0 len1 len2++lcp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Int+lcp p1 p2 n len1 len2+ | n == len1 = return len1+ | n == len2 = return len2+ | otherwise = do+ a <- peekByteOff p1 n :: IO Word8+ b <- peekByteOff p2 n+ if a == b then lcp p1 p2 (n + 1) len1 len2 else return n
+ Hyena/Server.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, ScopedTypeVariables, RankNTypes #-}++------------------------------------------------------------------------+-- |+-- Module : Hyena.Server+-- Copyright : (c) Johan Tibell 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : experimental+-- Portability : not portable, uses cunning newtype deriving+--+-- Core module of the server. Receives HTTP requests, runs the+-- application and sends responses.+--+------------------------------------------------------------------------++module Hyena.Server+ ( serve,+ serveWithConfig+ ) where++import Control.Concurrent (ThreadId, forkIO)+import Control.Exception.Extensible+import Control.Monad (unless, when)+import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, ask, asks,+ liftIO, runReaderT)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C (elemIndex, pack)+import Network.BSD (getProtocolNumber)+import Network.Socket (Family(..), HostAddress, SockAddr(..), Socket,+ SocketOption(..), SocketType(..), accept, bindSocket,+ listen, inet_addr, maxListenQueue, sClose,+ setSocketOption, socket, withSocketsDo)+import Network.Wai+import Prelude hiding (catch, log)+import System.Exit (exitFailure, ExitCode(..))+import System.IO (Handle, stderr, hPutStrLn)+#ifndef mingw32_HOST_OS+import System.Posix.Signals (Handler(..), installHandler, sigPIPE)+#endif++import Hyena.Config+import Hyena.Http+import Hyena.Logging++-- TODO: Header names are not case sensitive and header values may or+-- may not be.++-- TODO: How do we handle the fact that an error can be detected in+-- the middle of receiving data using chunked encoding, e.g. the+-- number indicating the chunk size contains non-hex characters.++-- ---------------------------------------------------------------------+-- The Server type++newtype Server a = Server (ReaderT ServerConfig IO a)+ deriving (Monad, MonadIO, MonadReader ServerConfig)++-- | The server configuration. Includes the user supplied+-- configuration and the loggers used by the server.+data ServerConfig = ServerConfig+ { config :: Config -- ^ The initial user configuration.+ , accessLogger :: AccessLogger -- ^ Access logger.+ , errorLogger :: ErrorLogger -- ^ Error logger.+ }++-- | Run the server action.+runServer :: ServerConfig -> Server a -> IO a+runServer conf (Server a) = runReaderT a conf++-- | Run action in the server monad, and in case of exception, and+-- catch it and run the error case.+catchServer ::Server a -> (forall e. (Exception e) => e ->Server a) -> Server a+catchServer m k = do+ conf <- ask+ io $ runServer conf m `catches` handlers conf+ where handlers c + = [ Handler $ \(e::ExitCode) ->throw e+ , Handler $ \(e::SomeException) ->runServer c $ k e ]++-- | Run the first action and then the second action. The second+-- action is run even if the first action threw and exception.+finallyServer :: Server a -> Server b -> Server a+finallyServer m k = do+ conf <- ask+ io $ runServer conf m `finally` runServer conf k++-- | Fork a new thread.+forkServer :: Server () -> Server ThreadId+forkServer m = do+ conf <- ask+ io $ forkIO $ runServer conf m++-- ---------------------------------------------------------------------+-- Running applications++-- | Forward requests to the given 'Application' forever. Read server+-- configuration from command line flags.+serve :: Application -> IO ()+serve application = do+ conf <- configFromFlags+ serveWithConfig conf application++-- TODO: Fork a new daemonized thread/process if daemonized mode is+-- requested. This is currently not possible because of limitations+-- in the GHC RTS.++-- | Forward requests to the given 'Application' forever. Use+-- supplied server configuration.+serveWithConfig :: Config -> Application -> IO ()+serveWithConfig conf application = do+#ifndef mingw32_HOST_OS+ installHandler sigPIPE Ignore Nothing+#endif+ when (daemonize conf) $ do+ hPutStrLn stderr "Daemonized mode not supported at the moment."+ hPutStrLn stderr $ "If you need this feature please say so in " +++ "GHC ticket #1185."+ exitFailure+ bracketLoggers (logHandle conf) $ \accessLog errorLog ->+ let serverConf = ServerConfig+ { config = conf+ , accessLogger = accessLog+ , errorLogger = errorLog+ }+ in runServer serverConf $ serve' application++-- ---------------------------------------------------------------------+-- Networking++-- | Start loggers, run an action using those loggers and when+-- finished, stop the loggers.+bracketLoggers :: Handle -> (AccessLogger -> ErrorLogger -> IO ()) -> IO ()+bracketLoggers h =+ bracket (do accessLog <- startAccessLogger h+ errorLog <- startErrorLogger stderr+ return (accessLog, errorLog))+ (\(accessLog, errorLog) -> do+ stopErrorLogger errorLog+ stopAccessLogger accessLog)+ . uncurry++-- | Open the server socket and start accepting connections.+serve' :: Application -> Server ()+serve' application = do+ conf <- ask+ port' <- asks (fromIntegral . port . config)+ address' <- asks (address . config)+ io $ withSocketsDo $+ do proto <- getProtocolNumber "tcp"+ addr <- inet_addr address'+ bracket (socket AF_INET Stream proto)+ sClose+ (\sock -> do+ setSocketOption sock ReuseAddr 1+ bindSocket sock (SockAddrInet port' addr)+ listen sock maxListenQueue+ runServer conf $ acceptConnections application sock)++-- | Accept connections, and fork off a new thread to handle each one.+acceptConnections :: Application -> Socket -> Server ()+acceptConnections application serverSock = do+ (sock, SockAddrInet _ haddr) <- io $ accept serverSock+ forkServer ((talk sock haddr application `finallyServer`+ (io $ sClose sock))+ `catchServer`+ (\e -> do logger <- asks errorLogger+ io $ logError logger $ show e))+ acceptConnections application serverSock++-- | Read the client input, parse the request, run the application,+-- and send a response.+talk :: Socket -> HostAddress -> Application -> Server ()+talk sock haddr application = do+ req <- io $ receiveRequest sock+ case req of+ Nothing -> io $ sendResponse sock $ errorResponse 400+ Just req' ->+ -- TODO: Validate the request:+ -- * If HTTP 1.1 Host MUST be present.+ do errorLogger' <- asks errorLogger+ let environ = requestToEnvironment (logError errorLogger') req'+ resp <- run environ application+ accessLogger' <- asks accessLogger+ io $ logAccess accessLogger' req' resp haddr+ io $ sendResponse sock resp+ unless (closeConnection req' resp) $+ talk sock haddr application++-- | Run the application and send a response.+run :: Environment -> Application -> Server Response+run environ application = io $ do+ -- TODO: Check the validity of the returned status code and headers+ -- and log an error and send a 500 if either is invalid.+ (status, reason, headers', output) <- application environ+ return Response+ { statusCode = status+ , reasonPhrase = reason+ , responseHeaders = headers'+ , responseBody = output+ }++-- | Check if the connection should be closed after processing this+-- request.+closeConnection :: Request -> Response -> Bool+closeConnection req resp =+ let reqHdr = lookup hdrName (requestHeaders req)+ respHdr = lookup hdrName (responseHeaders resp)+ closeSet =+ case (reqHdr, respHdr) of+ (Just v, _) | v == closeVal -> True+ (_, Just v) | v == closeVal -> True+ _ -> False+ keepAliveSet =+ case reqHdr of+ Just v | v == keepAliveVal -> True+ _ -> False+ in closeSet || (httpVersion req < (1,1) && not keepAliveSet)+ where+ hdrName = C.pack "Connection"+ closeVal = C.pack "close"+ keepAliveVal = C.pack "keep-alive"++-- ---------------------------------------------------------------------+-- General utilities++-- | Lift an IO action into the 'Server' monad.+io :: MonadIO m => IO a -> m a+io = liftIO++-- | Convert an HTTP 'Request' to an 'Environment'.+requestToEnvironment :: (String -> IO ()) -> Request -> Environment+requestToEnvironment err req =+ Environment+ { requestMethod = method req+ , scriptName = S.empty+ , pathInfo = path+ , queryString = query+ , requestProtocol = httpVersion req+ , headers = requestHeaders req+ , input = requestBody req+ , errors = err+ }+ where+ (path, query) = splitRequestUri $ requestUri req+ splitRequestUri uri =+ let index = C.elemIndex '?' uri+ in case index of+ Nothing -> (uri, Nothing)+ Just i -> (S.take i uri, Just $ S.drop (i + 1) uri)
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Johan Tibell 2007++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 Johan Tibell nor the names of other+ 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/Wai.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE Rank2Types, ImpredicativeTypes #-}++------------------------------------------------------------------------+-- |+-- Module : Network.Wai+-- Copyright : (c) Johan Tibell 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : experimental+-- Portability : not portable, uses 2-rank types+--+-- Defines the interface implemented by all web applications.+--+-- Example application:+--+-- > module Main where+-- >+-- > import qualified Data.ByteString as S+-- > import qualified Data.ByteString.Char8 as C (pack, unpack)+-- > import Network.Wai (Application(..), Enumerator(..))+-- > import System.Directory (getCurrentDirectory)+-- > import System.FilePath ((</>), makeRelative)+-- > import System.IO+-- >+-- > sendFile :: FilePath -> IO Enumerator+-- > sendFile fname = do+-- > cwd <- getCurrentDirectory+-- > h <- openBinaryFile (cwd </> makeRelative "/" fname) ReadMode+-- > let yieldBlock f z = do+-- > block <- S.hGetNonBlocking h 1024+-- > if S.null block then hClose h >> return z+-- > else do+-- > z' <- f z block+-- > case z' of+-- > Left z'' -> hClose h >> return z''+-- > Right z'' -> yieldBlock f z''+-- > return yieldBlock+-- >+-- > fileServer :: Application+-- > fileServer environ = do+-- > -- Here you should add security checks, etc.+-- > let contentType = (C.pack "Content-Type",+-- > C.pack "application/octet-stream")+-- > enumerator <- sendFile $ C.unpack $ pathInfo environ+-- > return (200, pack "OK", [contentType], enumerator)+--+------------------------------------------------------------------------++module Network.Wai+ ( -- * The Application type+ Application,+ Enumerator,+ Environment(..),+ Headers,+ Method(..)+ ) where++import qualified Data.ByteString as S++-- | The HTTP request headers.+type Headers = [(S.ByteString, S.ByteString)]++-- | The HTTP request method.+data Method = Options | Get | Head | Post | Put | Delete | Trace | Connect+ deriving (Eq, Show)++-- | An environment providing information regarding the request.+data Environment = Environment+ { requestMethod :: Method+ -- ^ The HTTP request method, such as \"GET\" or \"POST\".+ , scriptName :: S.ByteString+ -- ^ The initial portion of the request URL's \"path\" that+ -- corresponds to the application, so that the application knows+ -- its virtual \"location\". This may be an empty string, if the+ -- application corresponds to the \"root\" of the server.+ , pathInfo :: S.ByteString+ -- ^ The remainder of the request URL's \"path\", designating the+ -- virtual \"location\" of the request's target within the+ -- application. This may be an empty string, if the request URL+ -- targets the application root and does not have a trailing+ -- slash.+ , queryString :: Maybe (S.ByteString)+ -- ^ The portion of the request URL that follows the @\"?\"@, if+ -- any. May be empty or absent.+ , requestProtocol :: (Int, Int)+ -- ^ The version of the protocol the client used to send the+ -- request. Typically this will be @(1, 0)@ or @(1, 1)@ and may+ -- be used by the application to determine how to treat any HTTP+ -- request headers.+ , headers :: Headers+ -- ^ The client-supplied HTTP request headers.+ , input :: Enumerator+ -- ^ An 'Enumerator' from which the HTTP body can be read.+ , errors :: String -> IO ()+ -- ^ A function with which error output can be written, for the+ -- purpose of recording program or other errors in a standardized+ -- and possibly centralized location. This function will not add+ -- a trailing newline to the string.+ }++-- | A left-fold enumerator.+type Enumerator = forall a. (a -> S.ByteString -> IO (Either a a)) -> a -> IO a++-- | An application takes an environment and returns a HTTP status+-- code, a sequence of headers and an 'Enumerator' containing the+-- response body.+type Application = Environment -> IO (Int, S.ByteString, Headers, Enumerator)+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ hyena.cabal view
@@ -0,0 +1,44 @@+name: hyena+version: 0.1+synopsis: Simple web application server+description:+ A simple web application server using iteratees.+license: BSD3+license-file: LICENSE+author: Johan Tibell <johan.tibell@gmail.com>+maintainer: Johan Tibell <johan.tibell@gmail.com>+build-type: Simple+cabal-version: >= 1.6+homepage: http://github.com/tibbe/hyena+category: Network++library+ exposed-modules:+ Hyena.Config+ Hyena.Server+ Network.Wai+ other-modules:+ Data.Enumerator+ Hyena.Http+ Hyena.Logging+ Hyena.Parser++ build-depends:+ base == 4.*,+ bytestring,+ containers,+ directory,+ extensible-exceptions,+ filepath,+ mtl >= 1 && < 1.2,+ network >= 2.1 && < 2.3,+ network-bytestring >= 0.1.1.2 && < 0.2++ if !os(windows)+ build-depends:+ unix++ extensions: Rank2Types+ ghc-options: -funbox-strict-fields -Wall+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs