diff --git a/Network/Wai/Application/Classic/CGI.hs b/Network/Wai/Application/Classic/CGI.hs --- a/Network/Wai/Application/Classic/CGI.hs +++ b/Network/Wai/Application/Classic/CGI.hs @@ -61,19 +61,25 @@ -- HTTP body can be obtained in this Iteratee level only toCGI whdl body `catchError` const (liftIO cleanup) liftIO $ hClose whdl - respEnumerator $ \respBuilder -> + respEnumerator $ \respIter -> -- this is IO - fromCGI rhdl cspec req respBuilder `finally` cleanup + fromCGI rhdl cspec req respIter `finally` cleanup where respEnumerator = return . ResponseEnumerator ---------------------------------------------------------------- toCGI :: Handle -> Bool -> Iteratee ByteString IO () -toCGI whdl body = when body $ EL.consume >>= liftIO . mapM_ (BS.hPutStr whdl) +toCGI whdl body = when body tocgi + where + tocgi = do + m <- EL.head + case m of + Nothing -> return () + Just b -> liftIO (BS.hPutStr whdl b) >> tocgi fromCGI :: Handle -> ClassicAppSpec -> Request -> ResponseEnumerator a -fromCGI rhdl cspec req respBuilder = run_ $ EB.enumHandle 4096 rhdl $$ do +fromCGI rhdl cspec req respIter = run_ $ enumOutput $$ do -- consuming the header part of CGI output m <- (>>= check) <$> parseHeader let (st, hdr, hasBody) = case m of @@ -82,14 +88,13 @@ hdr' = addServer cspec hdr -- logging liftIO $ logger cspec req st Nothing -- cannot know body length - -- building HTTP header and optionally HTTP body + -- iteratee to build HTTP header and optionally HTTP body if hasBody - then {- Body -} response st hdr' - else emptyBody $$ response st hdr' + then bodyAsBuilder =$ respIter st hdr' + else enumEOF $$ bodyAsBuilder =$ respIter st hdr' where - enumBody = EL.map BB.fromByteString - emptyBody = enumEOF - response status hs = enumBody =$ respBuilder status hs + enumOutput = EB.enumHandle 4096 rhdl + bodyAsBuilder = EL.map BB.fromByteString check hs = lookup fkContentType hs >> case lookup "status" hs of Nothing -> Just (status200, hs) Just l -> toStatus l >>= \s -> Just (s,hs') diff --git a/Network/Wai/Application/Classic/Lang.hs b/Network/Wai/Application/Classic/Lang.hs --- a/Network/Wai/Application/Classic/Lang.hs +++ b/Network/Wai/Application/Classic/Lang.hs @@ -3,7 +3,7 @@ module Network.Wai.Application.Classic.Lang (parseLang) where import Control.Applicative hiding (optional) -import Data.Attoparsec.ByteString (Parser, takeWhile, parse, feed, IResult(..)) +import Data.Attoparsec.ByteString (Parser, takeWhile, parseOnly) import Data.Attoparsec.ByteString.Char8 (char, string, count, space, digit, option, sepBy1) import Data.ByteString.Char8 hiding (map, count, take, takeWhile, notElem) import Data.List (sortBy) @@ -11,9 +11,9 @@ import Prelude hiding (takeWhile) parseLang :: ByteString -> [ByteString] -parseLang bs = case feed (parse acceptLanguage bs) "" of - Done _ ls -> map fst $ sortBy detrimental ls - _ -> [] +parseLang bs = case parseOnly acceptLanguage bs of + Right ls -> map fst $ sortBy detrimental ls + _ -> [] where detrimental = flip (comparing snd) diff --git a/Network/Wai/Application/Classic/Range.hs b/Network/Wai/Application/Classic/Range.hs --- a/Network/Wai/Application/Classic/Range.hs +++ b/Network/Wai/Application/Classic/Range.hs @@ -27,9 +27,9 @@ type Range = (Maybe Integer, Maybe Integer) parseRange :: ByteString -> Maybe [Range] -parseRange bs = case feed (parse byteRange bs) "" of - Done _ x -> Just x - _ -> Nothing +parseRange bs = case parseOnly byteRange bs of + Right x -> Just x + _ -> Nothing byteRange :: Parser [Range] byteRange = string "bytes=" *> (ranges <* endOfInput) diff --git a/Network/Wai/Application/Classic/RevProxy.hs b/Network/Wai/Application/Classic/RevProxy.hs --- a/Network/Wai/Application/Classic/RevProxy.hs +++ b/Network/Wai/Application/Classic/RevProxy.hs @@ -9,7 +9,7 @@ import Control.Monad.IO.Class (liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL -import Data.Enumerator (Iteratee, run_, (=$), ($$), ($=), enumList) +import Data.Enumerator (Iteratee, Enumeratee, run_, (=$), ($$), enumList) import qualified Data.Enumerator.List as EL import qualified Network.HTTP.Enumerator as H import Network.HTTP.Types @@ -45,31 +45,36 @@ -} revProxyApp :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application -revProxyApp cspec spec route req = return $ ResponseEnumerator $ \respBuilder -> do - -- FIXME: is this stored-and-forward? +revProxyApp cspec spec route req = respEnumerator $ \respIter -> do + -- FIXME: stored-and-forward -> streaming lbs <- BL.fromChunks <$> run_ EL.consume - run_ (H.http (toHTTPRequest req route lbs) (fromBS cspec req respBuilder) mgr) - `catch` badGateway cspec req respBuilder + run_ (H.http (toHTTPRequest req route lbs) (fromBS cspec req respIter) mgr) + `catch` badGateway cspec req respIter where + respEnumerator = return . ResponseEnumerator mgr = revProxyManager spec fromBS :: ClassicAppSpec -> Request -> (Status -> ResponseHeaders -> Iteratee Builder IO a) -> (Status -> ResponseHeaders -> Iteratee ByteString IO a) -fromBS cspec req f s h = do - liftIO $ logger cspec req s Nothing -- FIXME body length - EL.map BB.fromByteString =$ f s h' +fromBS cspec req respIter st hdr = do + liftIO $ logger cspec req st Nothing -- FIXME body length + bodyAsBuilder =$ respIter st hdr' where - h' = addVia cspec req $ filter p h + hdr' = addVia cspec req $ filter p hdr p ("Content-Encoding", _) = False p _ = True badGateway :: ClassicAppSpec -> Request -> (Status -> ResponseHeaders -> Iteratee Builder IO a) -> SomeException -> IO a -badGateway cspec req builder _ = do - liftIO $ logger cspec req statusBadGateway Nothing -- FIXME body length - run_ $ bdy $$ builder statusBadGateway hdr +badGateway cspec req respIter _ = do + liftIO $ logger cspec req st Nothing -- FIXME body length + run_ $ bdy $$ bodyAsBuilder =$ respIter st hdr where hdr = addServer cspec textPlainHeader - bdy = enumList 1 ["Bad Gateway\r\n"] $= EL.map BB.fromByteString + bdy = enumList 1 ["Bad Gateway\r\n"] + st = statusBadGateway + +bodyAsBuilder :: Enumeratee ByteString Builder IO a +bodyAsBuilder = EL.map BB.fromByteString diff --git a/wai-app-file-cgi.cabal b/wai-app-file-cgi.cabal --- a/wai-app-file-cgi.cabal +++ b/wai-app-file-cgi.cabal @@ -1,5 +1,5 @@ Name: wai-app-file-cgi -Version: 0.4.1 +Version: 0.4.2 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3