hyena 0.1 → 0.1.0.1

raw patch · 6 files changed

+99/−55 lines, 6 filesdep ~bytestringdep ~containersdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, containers, mtl

API changes (from Hackage documentation)

Files

• Data/Enumerator.hs +9/−5
• Hyena/Http.hs +50/−27
• Hyena/Logging.hs +1/−1
• Hyena/Server.hs +9/−8
• Network/Wai.hs +22/−10
• hyena.cabal +8/−4

@@ -27,11 +27,15 @@  -- | 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''+bytesEnum bs f seed =+  let block = S.take blockSize bs+  in if S.null block+     then return seed+     else do+       seed' <- f seed block+       case seed' of+         Left seed''  -> return seed''+         Right seed'' -> bytesEnum (S.drop blockSize bs) f seed''   nl :: Word8

@@ -20,6 +20,7 @@     ( -- * The request and response data types       Request(..),       Response(..),+      ReceiveResult(..),        -- * Sending and receiving       sendResponse,@@ -33,16 +34,19 @@       parseRequest     ) where +import Prelude hiding (catch) 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 Control.Exception (IOException, catch, throw)+import Control.Monad (when) import qualified Data.Map as M-import Data.Maybe (fromJust)+import Data.Maybe (isJust, fromJust) import Data.Word (Word8) import Network.Socket (Socket)-import Network.Socket.ByteString (recv, send)+import Network.Socket.ByteString (recv, sendAll) import Network.Wai (Enumerator, Headers, Method(..))  import Data.Enumerator@@ -77,6 +81,13 @@     , responseBody    :: Enumerator     } +-- | A data structure used to keep track of the result of parsing a+-- request from the client.+data ReceiveResult a = ParseSuccess a+                     | ParseError+                     | ClientDisconnect++ -- --------------------------------------------------------------------- -- Sending and receiving @@ -87,44 +98,50 @@ -- | 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) ++ " "+  sendAll sock $ S.concat [C.pack "HTTP/1.1 "+                          ,(C.pack $ show (statusCode resp) ++ " "                               ++(C.unpack $ reasonPhrase resp))-                       ,C.pack "\r\n"]+                          ,C.pack "\r\n"]   sendHeaders sock (responseHeaders resp)-  send sock $ C.pack "\r\n"-  responseBody resp (sendMessageBody sock) ()+  sendAll sock $ C.pack "\r\n"+  r <- responseBody resp (sendMessageBody sock) Nothing+  when (isJust r) $ throw (fromJust r)   -- 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 ())+sendMessageBody :: Socket+                -> Maybe IOException+                -> S.ByteString+                -> IO (Either (Maybe IOException) (Maybe IOException))+sendMessageBody sock _ bs =+  catch (sendAll sock bs >> return (Right Nothing))+        (\e -> return $ Left (Just e))  -- | Send headers over socket. sendHeaders :: Socket -> Headers -> IO () sendHeaders sock headers = do-  send sock $ S.concat $ map go headers+  sendAll 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)+-- | Receive request from socket.  Returns @ParseError@ on parse+-- failure, @ClientDisconnect@ if the client disconnected+-- unexpectedly, and @ParseSuccess request@ on success.+receiveRequest :: Socket -> IO (ReceiveResult Request) receiveRequest sock = do   x <- parseIRequest sock   case x of-    Nothing  -> return Nothing-    Just (req, bs) ->+    ClientDisconnect -> return ClientDisconnect+    ParseError       -> return ParseError++    ParseSuccess (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+        in return $ ParseSuccess            Request            { method         = iMethod req            , requestUri     = iRequestUri req@@ -195,17 +212,23 @@  -- | 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))+-- used when parsing.  Returns @ParseError@ on parse failure,+-- @ClientDisconnect@ if the client disconnected unexpectedly, and+-- @ParseSuccess (request, remaining)@ on success.+parseIRequest :: Socket -> IO (ReceiveResult (IRequest, S.ByteString)) parseIRequest sock = do   initial <- recv sock blockSize-  go $ runParser pIRequest initial+  if S.null initial then+    return ClientDisconnect+    else 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+      go (Finished req bs) = return $ ParseSuccess (req, bs)+      go (Failed _)        = return ParseError+      go (Partial k)       = do+        received <- recv sock blockSize+        if S.null received then do+          return ClientDisconnect+          else (go . k . Just) received  -- | Parser for the internal request data type. pIRequest :: Parser IRequest

@@ -58,7 +58,7 @@ startLogger writer logHandle = do   chan <- newChan   finished' <- newEmptyMVar-  forkIO $ logMessages chan finished'+  _ <- forkIO $ logMessages chan finished'   return Logger { channel  = chan                 , finished = finished'                 }

@@ -111,7 +111,7 @@ serveWithConfig :: Config -> Application -> IO () serveWithConfig conf application = do #ifndef mingw32_HOST_OS-  installHandler sigPIPE Ignore Nothing+  _ <- installHandler sigPIPE Ignore Nothing #endif   when (daemonize conf) $ do     hPutStrLn stderr "Daemonized mode not supported at the moment."@@ -162,11 +162,11 @@ 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))+  _ <- 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,@@ -175,8 +175,9 @@ talk sock haddr application = do   req <- io $ receiveRequest sock   case req of-    Nothing  -> io $ sendResponse sock $ errorResponse 400-    Just req' ->+    ClientDisconnect  -> return ()+    ParseError        -> io $ sendResponse sock $ errorResponse 400+    ParseSuccess req' ->         -- TODO: Validate the request:         --    * If HTTP 1.1 Host MUST be present.         do errorLogger' <- asks errorLogger

@@ -14,19 +14,20 @@ -- -- Example application: --+-- > {-# LANGUAGE Rank2Types, ImpredicativeTypes #-} -- > module Main where--- >+-- -- > import qualified Data.ByteString as S -- > import qualified Data.ByteString.Char8 as C (pack, unpack)--- > import Network.Wai (Application(..), Enumerator(..))+-- > import Hyena.Server+-- > import Network.Wai (Application, Enumerator, pathInfo) -- > 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+-- > sendFile path = do+-- >   h <- openBinaryFile path ReadMode -- >   let yieldBlock f z = do -- >              block <- S.hGetNonBlocking h 1024 -- >              if S.null block then hClose h >> return z@@ -36,14 +37,25 @@ -- >                    Left z''  -> hClose h >> return z'' -- >                    Right z'' -> yieldBlock f z'' -- >   return yieldBlock--- >+-- -- > fileServer :: Application -- > fileServer environ = do+-- >   cwd <- getCurrentDirectory+-- >   let path = (cwd </> makeRelative "/" (C.unpack $ pathInfo environ))+-- >   size <- getFileSize path -- >   -- 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)+-- >                      C.pack "text/plain")+-- >       contentLength = (C.pack "Content-Length",+-- >                        C.pack (show size))+-- >   enumerator <- sendFile path+-- >   return (200, C.pack "OK", [contentType,contentLength], enumerator)+--+-- > getFileSize :: String -> IO Integer+-- > getFileSize fn = withFile fn ReadMode hFileSize+--+-- > main :: IO ()+-- > main = serve fileServer -- ------------------------------------------------------------------------ 

@@ -1,5 +1,5 @@ name:           hyena-version:        0.1+version:        0.1.0.1 synopsis:       Simple web application server description:   A simple web application server using iteratees.@@ -25,12 +25,12 @@    build-depends:     base               == 4.*,-    bytestring,-    containers,+    bytestring         < 1.0,+    containers         >= 0.3 && < 0.4,     directory,     extensible-exceptions,     filepath,-    mtl                >= 1 && < 1.2,+    mtl                >= 1 && < 2.0.2,     network            >= 2.1 && < 2.3,     network-bytestring >= 0.1.1.2 && < 0.2 @@ -42,3 +42,7 @@   ghc-options: -funbox-strict-fields -Wall   if impl(ghc >= 6.8)     ghc-options: -fwarn-tabs++source-repository head+  type:     git+  location: git://github.com/tibbe/hyena.git