Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Switched from buffered socket I/O to enumerator I/O.

  • Loading branch information...
commit 093c7226d6d99083da3a1f983fbeb8d36ee7ef47 1 parent 4eae5d8
Johan Tibell authored
Showing with 155 additions and 25 deletions.
  1. +127 −0 Data/Enumerator.hs
  2. +25 −22 Hyena/Http.hs
  3. +3 −3 hyena.cabal
127 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
47 Hyena/Http.hs
View
@@ -36,17 +36,17 @@ module Hyena.Http
import Control.Monad (forM_)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C (map, pack, unpack)
-import Data.ByteString.Parser
import Data.Char (chr, digitToInt, isAlpha, isDigit, isSpace, ord, toLower)
import Data.Either (either)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Data.Word (Word8)
import Network.Socket (Socket)
-import Network.Socket.ByteString (send)
+import Network.Socket.ByteString (recv, send)
import Network.Wai (Enumerator, Headers, Method(..))
-import Hyena.BufferedSocket
+import Data.Enumerator
+import Hyena.Parser
-- ---------------------------------------------------------------------
-- Request and response data types
@@ -116,21 +116,24 @@ sendHeaders sock headers =
-- 'Nothing' is returned.
receiveRequest :: Socket -> IO (Maybe Request)
receiveRequest sock = do
- bsock <- fromSocket sock
- x <- parseIRequest bsock
+ x <- parseIRequest sock
case x of
Nothing -> return Nothing
- Just req ->
- return $ do
- len <- contentLength req
- return $
- Request
- { method = iMethod req
- , requestUri = iRequestUri req
- , httpVersion = iHttpVersion req
- , requestHeaders = iRequestHeaders req
- , requestBody = toEnumerator bsock len
- }
+ Just (req, bs) ->
+ let len = contentLength req
+ -- TODO: Add length?
+ rest = bytesEnum bs
+ enum = case len of
+ Just n -> partialSocketEnum sock n
+ 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
@@ -196,16 +199,15 @@ spaces = many sp
-- 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 :: BufferedSocket -> IO (Maybe IRequest)
-parseIRequest bsock = do
- initial <- readBlock bsock blockSize
+parseIRequest :: Socket -> IO (Maybe (IRequest, S.ByteString))
+parseIRequest sock = do
+ initial <- recv sock blockSize
go $ runParser pIRequest initial
where
- go (Finished req bs) = do putBackBlock bsock bs
- return $ Just req
+ go (Finished req bs) = return $ Just (req, bs)
go (Failed _) = return Nothing
-- TODO: Detect end of input.
- go (Partial k) = readBlock bsock blockSize >>= go . k . Just
+ go (Partial k) = recv sock blockSize >>= go . k . Just
-- | Parser for the internal request data type.
pIRequest :: Parser IRequest
@@ -338,3 +340,4 @@ parseRequest input =
, requestBody = \f z -> either id id `fmap` (f z bs)
}
in return $ Just (req', S.empty)
+
6 hyena.cabal
View
@@ -16,7 +16,8 @@ library
Hyena.Server
Network.Wai
- other-modules: Hyena.Http
+ other-modules: Data.Enumerator
+ Hyena.Http
Hyena.Logging
Hyena.Parser
@@ -25,8 +26,7 @@ library
filepath
else
build-depends: base >= 2.1 && < 3
- build-depends: bsparser >= 0.1 && < 0.2,
- network >= 2.1 && < 2.3,
+ build-depends: network >= 2.1 && < 2.3,
mtl >= 1 && < 1.2,
network-bytestring >= 0.1.1.2 && < 0.2,
unix
Please sign in to comment.
Something went wrong with that request. Please try again.