From ad8eafc6992346e31e81974ed112825d02d05d6e Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 26 Dec 2011 17:10:26 +0200 Subject: [PATCH] Switch to conduits. All packages are getting bumped to 1.0 to signify the difference. --- package-list.sh | 5 +- wai-app-static/wai-app-static.cabal | 6 +- wai-extra/Network/Wai/Handler/CGI.hs | 97 ++++++------- wai-extra/Network/Wai/Middleware/Autohead.hs | 7 +- wai-extra/Network/Wai/Middleware/Gzip.hs | 49 ++++--- wai-extra/Network/Wai/Middleware/Jsonp.hs | 44 ++---- .../Network/Wai/Middleware/RequestLogger.hs | 9 +- wai-extra/Network/Wai/Zlib.hs | 41 ------ wai-extra/wai-extra.cabal | 19 +-- wai-handler-devel/wai-handler-devel.cabal | 12 +- wai-handler-fastcgi/wai-handler-fastcgi.cabal | 6 +- .../Network/Wai/Handler/Launch.hs | 96 +++++-------- wai-handler-launch/wai-handler-launch.cabal | 10 +- wai-handler-scgi/wai-handler-scgi.cabal | 6 +- wai-handler-webkit/wai-handler-webkit.cabal | 6 +- wai-test/Network/Wai/Test.hs | 29 ++-- wai-test/wai-test.cabal | 8 +- wai-websockets/wai-websockets.cabal | 4 +- wai/Network/Wai.hs | 49 +++---- wai/wai.cabal | 1 - warp-static/warp-static.cabal | 8 +- warp/Network/Wai/Handler/Warp.hs | 135 ++++++++---------- warp/warp.cabal | 1 + 23 files changed, 283 insertions(+), 365 deletions(-) delete mode 100644 wai-extra/Network/Wai/Zlib.hs diff --git a/package-list.sh b/package-list.sh index caaf85cc..c45d798b 100644 --- a/package-list.sh +++ b/package-list.sh @@ -1,6 +1,6 @@ #!/bin/bash -pkgs=( ./wai +pkgs=( ./wai ./wai-test ./wai-extra ./warp @@ -9,4 +9,5 @@ pkgs=( ./wai ./wai-handler-launch ./wai-handler-scgi ./warp-static - ./wai-websockets ) + ) + # ./wai-websockets diff --git a/wai-app-static/wai-app-static.cabal b/wai-app-static/wai-app-static.cabal index cf651e68..fd475f92 100644 --- a/wai-app-static/wai-app-static.cabal +++ b/wai-app-static/wai-app-static.cabal @@ -1,5 +1,5 @@ name: wai-app-static -version: 0.3.5.1 +version: 1.0.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -24,7 +24,7 @@ Flag print library build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 , bytestring >= 0.9.1.4 && < 0.10 , http-types >= 0.6 && < 0.7 , transformers >= 0.2.2 && < 0.3 @@ -59,7 +59,7 @@ test-suite runtests , time >= 1.1.4 , old-locale >= 1.0.0.2 && < 1.1 , http-date - , wai-app-static >= 0.3 + , wai-app-static >= 1.0 , wai-test , wai , http-types diff --git a/wai-extra/Network/Wai/Handler/CGI.hs b/wai-extra/Network/Wai/Handler/CGI.hs index aea2da20..ae587ed9 100755 --- a/wai-extra/Network/Wai/Handler/CGI.hs +++ b/wai-extra/Network/Wai/Handler/CGI.hs @@ -19,20 +19,19 @@ import Control.Arrow ((***)) import Data.Char (toLower) import qualified System.IO import qualified Data.String as String -import Data.Enumerator - ( Enumerator, Step (..), Stream (..), continue, yield - , enumList, ($$), joinI, returnI, (>>==), run_ - ) import Data.Monoid (mconcat) import Blaze.ByteString.Builder (fromByteString, toLazyByteString) import Blaze.ByteString.Builder.Char8 (fromChar, fromString) -import Blaze.ByteString.Builder.Enumerator (builderToByteString) +import Data.Conduit.Blaze (builderToByteString) import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy.Internal (defaultChunkSize) import System.IO (Handle) import Network.HTTP.Types (Status (..)) import qualified Network.HTTP.Types as H import qualified Data.CaseInsensitive as CI +import Data.Monoid (mappend) +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL safeRead :: Read a => a -> String -> a safeRead d s = @@ -67,7 +66,7 @@ runSendfile sf app = do -- stick with 'run' or 'runSendfile'. runGeneric :: [(String, String)] -- ^ all variables - -> (forall a. Int -> Enumerator B.ByteString IO a) -- ^ responseBody of input + -> (Int -> C.Source IO B.ByteString) -- ^ responseBody of input -> (B.ByteString -> IO ()) -- ^ destination for output -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header? -> Application @@ -95,26 +94,32 @@ runGeneric vars inputH outputH xsendfile app = do case addrs of a:_ -> addrAddress a [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost' - let env = Request - { requestMethod = rmethod - , rawPathInfo = B.pack pinfo - , pathInfo = H.decodePathSegments $ B.pack pinfo - , rawQueryString = B.pack qstring - , queryString = H.parseQuery $ B.pack qstring - , serverName = B.pack servername - , serverPort = serverport - , requestHeaders = map (cleanupVarName *** B.pack) vars - , isSecure = isSecure' - , remoteHost = addr - , httpVersion = H.http11 -- FIXME - } - -- FIXME worry about exception? - res <- run_ $ inputH contentLength $$ app env - case (xsendfile, res) of - (Just sf, ResponseFile s hs fp Nothing) -> - mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp - _ -> responseEnumerator res $ \s hs -> - joinI $ enumList 1 [headers s hs, fromChar '\n'] $$ builderIter + C.runResourceT $ do + input <- C.bufferSource $ inputH contentLength + let env = Request + { requestMethod = rmethod + , rawPathInfo = B.pack pinfo + , pathInfo = H.decodePathSegments $ B.pack pinfo + , rawQueryString = B.pack qstring + , queryString = H.parseQuery $ B.pack qstring + , serverName = B.pack servername + , serverPort = serverport + , requestHeaders = map (cleanupVarName *** B.pack) vars + , isSecure = isSecure' + , remoteHost = addr + , httpVersion = H.http11 -- FIXME + , requestBody = input + } + -- FIXME worry about exception? + res <- app env + case (xsendfile, res) of + (Just sf, ResponseFile s hs fp Nothing) -> + liftIO $ mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp + _ -> do + let (s, hs, b) = responseSource res + src = CL.sourceList [headers s hs `mappend` fromChar '\n'] + `mappend` b + src C.$$ builderSink where headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs)) status (Status i m) = (fromByteString "Status", mconcat @@ -136,11 +141,11 @@ runGeneric vars inputH outputH xsendfile app = do , fromByteString sf , fromByteString " not supported" ] - bsStep = Continue bsStep' - bsStep' EOF = yield () EOF - bsStep' (Chunks []) = continue bsStep' - bsStep' (Chunks bss) = liftIO (mapM_ outputH bss) >> continue bsStep' - builderIter = builderToByteString bsStep + bsSink = C.Sink $ return $ C.SinkData push (return ()) + push bs = do + liftIO $ outputH bs + return C.Processing + builderSink = builderToByteString C.=$ bsSink fixHeaders h = case lookup "content-type" h of Nothing -> ("Content-Type", "text/html; charset=utf-8") : h @@ -159,21 +164,17 @@ cleanupVarName s = helper' (x:rest) = toLower x : helper' rest helper' [] = [] -requestBodyHandle :: Handle -> Int -> Enumerator B.ByteString IO a -requestBodyHandle h = - requestBodyFunc go - where - go i = Just `fmap` B.hGet h (min i defaultChunkSize) +requestBodyHandle :: Handle -> Int -> C.Source IO B.ByteString +requestBodyHandle h = requestBodyFunc $ \i -> do + bs <- B.hGet h i + return $ if B.null bs then Nothing else Just bs -requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) - -> Int - -> Enumerator B.ByteString IO a -requestBodyFunc _ 0 step = returnI step -requestBodyFunc h len (Continue k) = do - mbs <- liftIO $ h len - case mbs of - Nothing -> continue k - Just bs -> do - let newLen = len - B.length bs - k (Chunks [bs]) >>== requestBodyFunc h newLen -requestBodyFunc _ _ step = returnI step +requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> C.Source IO B.ByteString +requestBodyFunc get count0 = + C.sourceState count0 pull + where + pull 0 = return (0, C.Closed) + pull count = do + mbs <- liftIO $ get $ min count defaultChunkSize + let count' = count - maybe 0 B.length mbs + return (count', maybe C.Closed C.Open mbs) diff --git a/wai-extra/Network/Wai/Middleware/Autohead.hs b/wai-extra/Network/Wai/Middleware/Autohead.hs index d28cf590..c2cabc8a 100644 --- a/wai-extra/Network/Wai/Middleware/Autohead.hs +++ b/wai-extra/Network/Wai/Middleware/Autohead.hs @@ -5,7 +5,6 @@ module Network.Wai.Middleware.Autohead (autohead) where import Network.Wai import Data.Monoid (mempty) -import Data.Enumerator (enumEOF, ($$)) autohead :: Middleware autohead app req @@ -14,10 +13,6 @@ autohead app req case res of ResponseFile s hs _ _ -> return $ ResponseBuilder s hs mempty ResponseBuilder s hs _ -> return $ ResponseBuilder s hs mempty - ResponseEnumerator e -> do - let helper f = - let helper' s hs = enumEOF $$ f s hs - in e helper' - return $ ResponseEnumerator helper + ResponseSource s hs _ -> return $ ResponseBuilder s hs mempty | otherwise = app req diff --git a/wai-extra/Network/Wai/Middleware/Gzip.hs b/wai-extra/Network/Wai/Middleware/Gzip.hs index 273f1bc7..cb001f3d 100644 --- a/wai-extra/Network/Wai/Middleware/Gzip.hs +++ b/wai-extra/Network/Wai/Middleware/Gzip.hs @@ -25,18 +25,20 @@ module Network.Wai.Middleware.Gzip ) where import Network.Wai -import Network.Wai.Zlib import Data.Maybe (fromMaybe) -import Data.Enumerator (($$), joinI, (=$), run) -import Data.Enumerator.Binary (enumFile, iterHandle) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString as S import Data.Default import Network.HTTP.Types (Status, Header) import Control.Monad.IO.Class (liftIO) -import qualified Codec.Zlib.Enum as CZE -import qualified System.IO as SIO import System.Directory (doesFileExist, createDirectoryIfMissing) +import qualified Data.Conduit as C +import qualified Data.Conduit.Zlib as CZ +import qualified Data.Conduit.Binary as CB +import qualified Data.Conduit.List as CL +import Data.Conduit.Blaze (builderToByteString) +import Blaze.ByteString.Builder (fromByteString) +import Control.Exception (try, SomeException) data GzipSettings = GzipSettings { gzipFiles :: GzipFiles @@ -79,7 +81,7 @@ gzip' set app env = do Just m | gzipCheckMime set m -> liftIO $ compressFile s hs file cache _ -> return res - _ -> return $ ResponseEnumerator $ compressE set $ responseEnumerator res + _ -> return $ compressE set res else return res where enc = fromMaybe [] $ (splitCommas . S8.unpack) @@ -94,15 +96,16 @@ compressFile s hs file cache = do then onSucc else do createDirectoryIfMissing True cache - x <- SIO.withFile tmpfile SIO.WriteMode $ \h -> - run - $ enumFile file - $$ CZE.gzip - =$ iterHandle h - either (const onErr) (const onSucc) x + x <- + try $ C.runResourceT $ CB.sourceFile file + C.$$ CZ.gzip C.=$ CB.sinkFile tmpfile + either onErr (const onSucc) x where onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing - onErr = return $ ResponseFile s hs file Nothing + + onErr :: SomeException -> IO Response + onErr = const $ return $ ResponseFile s hs file Nothing -- FIXME log the error message + tmpfile = cache ++ '/' : map safe file safe c | 'A' <= c && c <= 'Z' = c @@ -113,16 +116,18 @@ compressFile s hs file cache = do safe _ = '_' compressE :: GzipSettings - -> (forall a. ResponseEnumerator a) - -> (forall a. ResponseEnumerator a) -compressE set re f = - re f' - --e s hs' + -> Response + -> Response +compressE set res = + case lookup "content-type" hs of + Just m | gzipCheckMime set m -> + let hs' = fixHeaders hs + in ResponseSource s hs' $ b C.$= builderToByteString + C.$= CZ.gzip + C.$= CL.map fromByteString + _ -> res where - f' s hs = - case lookup "content-type" hs of - Just m | gzipCheckMime set m -> joinI $ compress $$ f s (fixHeaders hs) - _ -> f s hs + (s, hs, b) = responseSource res -- Remove Content-Length header, since we will certainly have a -- different length after gzip compression. diff --git a/wai-extra/Network/Wai/Middleware/Jsonp.hs b/wai-extra/Network/Wai/Middleware/Jsonp.hs index 75754516..83156031 100644 --- a/wai-extra/Network/Wai/Middleware/Jsonp.hs +++ b/wai-extra/Network/Wai/Middleware/Jsonp.hs @@ -18,13 +18,13 @@ module Network.Wai.Middleware.Jsonp (jsonp) where import Network.Wai import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 -import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==)) -import Blaze.ByteString.Builder (copyByteString, Builder) +import Blaze.ByteString.Builder (copyByteString) import Blaze.ByteString.Builder.Char8 (fromChar) import Data.Monoid (mappend) import Control.Monad (join) import Data.Maybe (fromMaybe) import qualified Data.ByteString as S +import qualified Data.Conduit.List as CL -- | Wrap json responses in a jsonp callback. -- @@ -54,7 +54,6 @@ jsonp app env = do Nothing -> return res Just c -> go c res where - go c r@(ResponseFile _ hs _ _) = go' c r hs go c r@(ResponseBuilder s hs b) = case checkJSON hs of Nothing -> return r @@ -63,39 +62,26 @@ jsonp app env = do `mappend` fromChar '(' `mappend` b `mappend` fromChar ')' - go c (ResponseEnumerator e) = addCallback c e - go' c r hs = + go c r = case checkJSON hs of - Just _ -> addCallback c $ responseEnumerator r + Just hs' -> addCallback c s hs' b Nothing -> return r + where + (s, hs, b) = responseSource r + checkJSON hs = case lookup "Content-Type" hs of Just x - | B8.pack "application/json" `S.isPrefixOf` x -> Just $ fixHeaders hs + | B8.pack "application/json" `S.isPrefixOf` x -> + Just $ fixHeaders hs _ -> Nothing fixHeaders = changeVal "Content-Type" "text/javascript" - addCallback :: B8.ByteString -> (forall a. ResponseEnumerator a) - -> Iteratee B8.ByteString IO Response - addCallback cb e = - return $ ResponseEnumerator $ helper - where - helper f = - e helper' - where - helper' s hs = - case checkJSON hs of - Just hs' -> wrap $$ f s hs' - Nothing -> f s hs - wrap :: Step Builder IO b -> Iteratee Builder IO b - wrap step = joinI $ after (enumList 1 [fromChar ')']) - $$ enumList 1 [copyByteString cb, fromChar '('] step - after :: Enumerator Builder IO b -> Enumeratee Builder Builder IO b - after enum = - loop - where - loop = checkDone $ continue . step - step k EOF = enum (Continue k) >>== return - step k s = k s >>== loop + + addCallback cb s hs b = + return $ ResponseSource s hs $ + CL.sourceList [copyByteString cb `mappend` fromChar '('] + `mappend` b + `mappend` CL.sourceList [fromChar ')'] changeVal :: Eq a => a diff --git a/wai-extra/Network/Wai/Middleware/RequestLogger.hs b/wai-extra/Network/Wai/Middleware/RequestLogger.hs index 2a7749da..65516b69 100644 --- a/wai-extra/Network/Wai/Middleware/RequestLogger.hs +++ b/wai-extra/Network/Wai/Middleware/RequestLogger.hs @@ -21,9 +21,11 @@ import qualified Data.Text.Encoding as TE import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File) import qualified Data.ByteString.Lazy as LBS import Data.Enumerator (run_, ($$), enumList) -import Data.Enumerator.List (consume) import System.IO (hPutStrLn, stderr) +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL + -- | like @logHandle@, but prints to 'stdout' logStdout :: Middleware logStdout = logHandle $ \bs -> hPutLogStr stdout [LB bs] @@ -68,7 +70,7 @@ logHandleDevLT cb app req = -- For production use use module Network.Wai.Middleware.RequestLogger logHandleDev :: (BS.ByteString -> IO ()) -> Middleware logHandleDev cb app req = do - body <- consume + body <- requestBody req C.$$ CL.consume postParams <- if any (requestMethod req ==) ["GET", "HEAD"] then return [] else do postParams <- liftIO $ allPostParams req body @@ -86,7 +88,8 @@ logHandleDev cb app req = do , paramsToBS "POST " postParams ] -- we just consumed the body- fill the enumerator back up so it is available again - liftIO $ run_ $ enumList 1 body $$ app req + body' <- C.bufferSource $ CL.sourceList body + app req { requestBody = body' } where paramsToBS prefix params = if null params then "" diff --git a/wai-extra/Network/Wai/Zlib.hs b/wai-extra/Network/Wai/Zlib.hs deleted file mode 100644 index f0ecbdf9..00000000 --- a/wai-extra/Network/Wai/Zlib.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Network.Wai.Zlib (compress) where - -import Prelude hiding (head) -import Data.Enumerator - ( Enumeratee, checkDone, Stream (..) - , (>>==), ($$), joinI - ) -import Data.Enumerator.List (head) -import Blaze.ByteString.Builder (Builder, fromByteString) -import Blaze.ByteString.Builder.Enumerator (builderToByteString) -import Control.Monad.IO.Class (liftIO) - -import Codec.Zlib - --- Note: this function really should return a stream of ByteStrings, but the --- WAI protocol needs Builders anyway. -compress :: Enumeratee Builder Builder IO a -compress step0 = joinI $ builderToByteString $$ do - def <- liftIO $ initDeflate 7 $ WindowBits 31 - loop def step0 - where - loop def = checkDone $ step def - step def k = do - minput <- head - case minput of - Nothing -> do - bss <- liftIO $ finishDeflate def drain - k (Chunks bss) >>== return - Just input -> do - bss <- liftIO $ withDeflateInput def input drain - case bss of - [] -> step def k - _ -> k (Chunks bss) >>== loop def - drain = - go id - where - go front mbs' = do - mbs <- mbs' - case mbs of - Nothing -> return $ map fromByteString $ front [] - Just bs -> go (front . (:) bs) mbs' diff --git a/wai-extra/wai-extra.cabal b/wai-extra/wai-extra.cabal index 4f2b4b55..e4fa326f 100644 --- a/wai-extra/wai-extra.cabal +++ b/wai-extra/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 0.4.6 +Version: 1.0.0 Synopsis: Provides some basic WAI handlers and middleware. Description: The goal here is to provide common features without many dependencies. License: BSD3 @@ -22,22 +22,24 @@ extra-source-files: Library Build-Depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 && < 0.10 - , wai >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 , old-locale >= 1.0.0.2 && < 1.1 , time >= 1.1.4 , network >= 2.2.1.5 && < 2.4 , directory >= 1.0.1 && < 1.2 , zlib-bindings >= 0.0 && < 0.1 - , blaze-builder-enumerator >= 0.2 && < 0.3 , transformers >= 0.2.2 && < 0.3 - , enumerator >= 0.4.8 && < 0.5 , blaze-builder >= 0.2.1.4 && < 0.4 , http-types >= 0.6 && < 0.7 , text >= 0.7 && < 0.12 , case-insensitive >= 0.2 - , zlib-enum >= 0.2.1 && < 0.3 , data-default >= 0.3 && < 0.4 , fast-logger >= 0.0.1 + , conduit + , zlib-conduit + , blaze-builder-conduit + -- FIXME this must be removed + , enumerator Exposed-modules: Network.Wai.Handler.CGI Network.Wai.Middleware.AcceptOverride @@ -50,7 +52,6 @@ Library Network.Wai.Middleware.MethodOverride Network.Wai.Middleware.Rewrite Network.Wai.Middleware.Vhost - Network.Wai.Zlib Network.Wai.Parse ghc-options: -Wall @@ -69,16 +70,16 @@ test-suite tests , wai , http-types , transformers - , enumerator , zlib , text , bytestring , directory , zlib-bindings - , blaze-builder-enumerator >= 0.2 && < 0.3 , blaze-builder >= 0.2.1.4 && < 0.4 - , zlib-enum , data-default + , conduit + -- FIXME this must be removed + , enumerator source-repository head type: git diff --git a/wai-handler-devel/wai-handler-devel.cabal b/wai-handler-devel/wai-handler-devel.cabal index c2ac0307..5dfb11f7 100644 --- a/wai-handler-devel/wai-handler-devel.cabal +++ b/wai-handler-devel/wai-handler-devel.cabal @@ -1,5 +1,5 @@ Name: wai-handler-devel -Version: 0.4.4.1 +Version: 1.0.0 Synopsis: WAI server that automatically reloads code after modification. Description: This handler automatically reloads your source code upon any changes. It works by using the hint package, essentially embedding GHC inside the handler. The handler (both the executable and library) takes three arguments: the port to listen on, the module name containing the application function, and the name of the function. . @@ -10,7 +10,7 @@ License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com -Homepage: http://github.com/snoyberg/wai-handler-devel +Homepage: http://github.com/yesodweb/wai Category: Web Build-Type: Simple Cabal-Version: >=1.6 @@ -18,14 +18,14 @@ Stability: Stable Source-repository head type: git - location: git://github.com/snoyberg/wai-handler-devel.git + location: git://github.com/yesodweb/wai.git Library Build-Depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 - , wai-extra >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 , http-types >= 0.6 && < 0.7 - , warp >= 0.4 && < 0.5 + , warp >= 1.0 && < 1.1 , directory >= 1.0.1 && < 1.2 , network >= 2.2.1.5 && < 2.4 , bytestring >= 0.9.1.4 && < 0.10 diff --git a/wai-handler-fastcgi/wai-handler-fastcgi.cabal b/wai-handler-fastcgi/wai-handler-fastcgi.cabal index 0ca4f944..62925096 100644 --- a/wai-handler-fastcgi/wai-handler-fastcgi.cabal +++ b/wai-handler-fastcgi/wai-handler-fastcgi.cabal @@ -1,5 +1,5 @@ name: wai-handler-fastcgi -version: 0.4.2 +version: 1.0.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -15,8 +15,8 @@ description: Calls out to the libfcgi C library. library build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 - , wai-extra >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 , bytestring >= 0.9.1.4 && < 0.10 exposed-modules: Network.Wai.Handler.FastCGI ghc-options: -Wall diff --git a/wai-handler-launch/Network/Wai/Handler/Launch.hs b/wai-handler-launch/Network/Wai/Handler/Launch.hs index 0515fd69..c1781b7c 100644 --- a/wai-handler-launch/Network/Wai/Handler/Launch.hs +++ b/wai-handler-launch/Network/Wai/Handler/Launch.hs @@ -13,7 +13,6 @@ import Data.IORef import Control.Concurrent import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as S -import Data.Enumerator (($$), joinI, Enumeratee, Stream (..), Iteratee (..), Step (..)) import Blaze.ByteString.Builder (fromByteString) #if WINDOWS import Foreign @@ -21,10 +20,10 @@ import Foreign.C.String #else import System.Cmd (rawSystem) #endif -import Codec.Zlib.Enum (ungzip) -import Blaze.ByteString.Builder.Enumerator (builderToByteString) -import qualified Data.Enumerator.List as EL -import Control.Monad.Trans.Class (lift) +import Data.Conduit.Zlib (ungzip) +import Data.Conduit.Blaze (builderToByteString) +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL ping :: IORef Bool -> Middleware ping var app req @@ -42,64 +41,45 @@ ping var app req | not $ isHtml hs -> return res ResponseBuilder _ hs _ | not $ isHtml hs -> return res + ResponseSource _ hs _ + | not $ isHtml hs -> return res _ -> do - let renum = responseEnumerator res - return $ ResponseEnumerator $ \f -> renum $ \status headers -> - if isHtml headers - then do - let (isEnc, headers') = fixHeaders id headers - let headers'' = filter (\(x, _) -> x /= "content-length") headers' - let fixEnc x = - if isEnc - then joinI $ ungzip $$ x - else x - joinI $ builderToByteString $$ fixEnc $ joinI $ insideHead "" $$ joinI $ EL.map fromByteString $$ f status headers'' - else f status headers + let (s, hs, body) = responseSource res + let (isEnc, headers') = fixHeaders id hs + let headers'' = filter (\(x, _) -> x /= "content-length") headers' + let fixEnc src = if isEnc then src C.$= ungzip else src + return $ ResponseSource s headers'' + $ fixEnc (body C.$= builderToByteString) + C.$= insideHead + C.$= CL.map fromByteString -insideHead :: S.ByteString -> Enumeratee S.ByteString S.ByteString IO a -insideHead toInsert = - go "" whole +toInsert :: S.ByteString +toInsert = "" + +insideHead :: C.Conduit S.ByteString IO S.ByteString +insideHead = + C.conduitState (Just (S.empty, whole)) push close where whole = "" - go :: S.ByteString -> S.ByteString -> Step S.ByteString IO a -> Iteratee S.ByteString IO (Step S.ByteString IO a) - go held atFront step = do - mx <- EL.head - case mx of - Nothing -> feedDone $ Chunks [held, toInsert] - Just x - | atFront `S.isPrefixOf` x -> do - let y = S.drop (S.length atFront) x - let stream = Chunks [held, atFront, toInsert, y] - feedDone stream - | whole `S.isInfixOf` x -> do - let (before, rest) = S.breakSubstring whole x - let after = S.drop (S.length whole) rest - feedDone $ Chunks [held, before, whole, toInsert, after] - | x `S.isPrefixOf` atFront -> go - (held `S.append` x) - (S.drop (S.length x) atFront) - step - | otherwise -> do - let (held', atFront', x') = getOverlap whole x - feedCont held' atFront' $ Chunks [held, x'] - where - --feedDone :: Stream S.ByteString -> Iteratee S.ByteString IO (Step S.ByteString IO a) - feedDone stream = - case step of - Continue k -> do - step' <- lift $ runIteratee $ k stream - EL.map id step' - Yield b s -> return $ Yield b s - Error e -> return $ Error e + push (Just (held, atFront)) x + | atFront `S.isPrefixOf` x = do + let y = S.drop (S.length atFront) x + return (Nothing, C.Producing [held, atFront, toInsert, y]) + | whole `S.isInfixOf` x = do + let (before, rest) = S.breakSubstring whole x + let after = S.drop (S.length whole) rest + return (Nothing, C.Producing [held, before, whole, toInsert, after]) + | x `S.isPrefixOf` atFront = do + let held' = held `S.append` x + atFront' = S.drop (S.length x) atFront + return (Just (held', atFront'), C.Producing []) + | otherwise = do + let (held', atFront', x') = getOverlap whole x + return (Just (held', atFront'), C.Producing [held, x']) + push Nothing x = return (Nothing, C.Producing [x]) - --feedCont :: Monad m => S.ByteString -> S.ByteString -> Stream S.ByteString -> Iteratee S.ByteString m (Step S.ByteString m a) - feedCont held' atFront' stream = do - case step of - Continue k -> do - step' <- lift $ runIteratee $ k stream - go held' atFront' step' - Yield b s -> return $ Yield b s - Error e -> return $ Error e + close (Just (held, _)) = return [held, toInsert] + close Nothing = return [] getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString) getOverlap whole x = diff --git a/wai-handler-launch/wai-handler-launch.cabal b/wai-handler-launch/wai-handler-launch.cabal index c99ea4a3..2a8e566a 100644 --- a/wai-handler-launch/wai-handler-launch.cabal +++ b/wai-handler-launch/wai-handler-launch.cabal @@ -1,5 +1,5 @@ Name: wai-handler-launch -Version: 0.0.4 +Version: 1.0.0 Synopsis: Launch a web app in the default browser. Description: This handles cross-platform launching and inserts Javascript code to ping the server. When the server no longer receives pings, it shuts down. License: BSD3 @@ -13,15 +13,17 @@ Cabal-version: >=1.2 Library Exposed-modules: Network.Wai.Handler.Launch build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 - , warp >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 + , warp >= 1.0 && < 1.1 , http-types >= 0.6 && < 0.7 , transformers >= 0.2.2 && < 0.3 , bytestring >= 0.9.1.4 && < 0.10 , blaze-builder >= 0.2.1.4 && < 0.4 , enumerator >= 0.4.8 && < 0.5 , blaze-builder-enumerator >= 0.2 && < 0.3 - , zlib-enum >= 0.2.1 && < 0.3 + , conduit + , blaze-builder-conduit + , zlib-conduit if os(windows) c-sources: windows.c diff --git a/wai-handler-scgi/wai-handler-scgi.cabal b/wai-handler-scgi/wai-handler-scgi.cabal index 6120c5ca..e534418c 100644 --- a/wai-handler-scgi/wai-handler-scgi.cabal +++ b/wai-handler-scgi/wai-handler-scgi.cabal @@ -1,5 +1,5 @@ name: wai-handler-scgi -version: 0.4.1 +version: 1.0.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -14,8 +14,8 @@ description: Wai handler to SCGI library build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 - , wai-extra >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 , bytestring >= 0.9.1.4 && < 0.10 exposed-modules: Network.Wai.Handler.SCGI ghc-options: -Wall diff --git a/wai-handler-webkit/wai-handler-webkit.cabal b/wai-handler-webkit/wai-handler-webkit.cabal index dfd859b0..64d3b44c 100644 --- a/wai-handler-webkit/wai-handler-webkit.cabal +++ b/wai-handler-webkit/wai-handler-webkit.cabal @@ -1,5 +1,5 @@ name: wai-handler-webkit -version: 0.3.0 +version: 1.0.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -16,8 +16,8 @@ homepage: http://www.yesodweb.com/book/wai library build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 - , warp >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 + , warp >= 1.0 && < 1.1 ghc-options: -Wall exposed-modules: Network.Wai.Handler.Webkit c-sources: webkit.cpp diff --git a/wai-test/Network/Wai/Test.hs b/wai-test/Network/Wai/Test.hs index 78f40181..40cdba2f 100644 --- a/wai-test/Network/Wai/Test.hs +++ b/wai-test/Network/Wai/Test.hs @@ -26,14 +26,14 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 -import Data.Enumerator (joinI, ($$), run_, enumList) -import Data.Enumerator.List (consume) -import Blaze.ByteString.Builder.Enumerator (builderToByteString) +import Data.Conduit.Blaze (builderToByteString) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Network.HTTP.Types as H import Data.CaseInsensitive (CI) import qualified Data.ByteString as S +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL type Session = ReaderT Application (StateT ClientState IO) @@ -73,23 +73,26 @@ defaultRequest = Request , remoteHost = error "Network.Wai.Test.defaultRequest{remoteHost}" , pathInfo = [] , queryString = [] + , requestBody = error "requestBody of defaultRequest" } srequest :: SRequest -> Session SResponse srequest (SRequest req bod) = do app <- ask - res <- liftIO $ run_ $ enumList 4 (L.toChunks bod) $$ app req - sres <- liftIO $ runResponse res - -- FIXME cookie processing - return sres + liftIO $ C.runResourceT $ do + body <- C.bufferSource $ CL.sourceList $ L.toChunks bod + let req' = req { requestBody = body } + res <- app req' + sres <- runResponse res + -- FIXME cookie processing + return sres -runResponse :: Response -> IO SResponse -runResponse res = - responseEnumerator res go +runResponse :: Response -> C.ResourceT IO SResponse +runResponse res = do + bss <- body C.$= builderToByteString C.$$ CL.consume + return $ SResponse s h $ L.fromChunks bss where - go s h = do - bss <- joinI $ builderToByteString $$ consume - return $ SResponse s h $ L.fromChunks bss + (s, h, body) = responseSource res assertBool :: String -> Bool -> Session () assertBool s b = liftIO $ H.assertBool s b diff --git a/wai-test/wai-test.cabal b/wai-test/wai-test.cabal index cf0ef602..d6ee0f4a 100644 --- a/wai-test/wai-test.cabal +++ b/wai-test/wai-test.cabal @@ -1,5 +1,5 @@ name: wai-test -version: 0.1.3.1 +version: 1.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -14,14 +14,14 @@ description: Unit test framework (built on HUnit) for WAI applications. library build-depends: base >= 4 && < 5 - , wai >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 , bytestring >= 0.9.1.4 && < 0.10 , blaze-builder >= 0.2.1.4 && < 0.4 , transformers >= 0.2.2 && < 0.3 , containers >= 0.2 && < 0.5 - , enumerator >= 0.4.8 && < 0.5 + , conduit >= 0.0 && < 0.1 + , blaze-builder-conduit >= 0.0 && < 0.1 , cookie >= 0.2 && < 0.4 - , blaze-builder-enumerator >= 0.2 && < 0.3 , HUnit >= 1.2 && < 1.3 , http-types >= 0.6 && < 0.7 , case-insensitive >= 0.2 diff --git a/wai-websockets/wai-websockets.cabal b/wai-websockets/wai-websockets.cabal index 60f4d9d0..b9f90ac0 100644 --- a/wai-websockets/wai-websockets.cabal +++ b/wai-websockets/wai-websockets.cabal @@ -1,5 +1,5 @@ Name: wai-websockets -Version: 0.5.0.1 +Version: 1.0.0 Synopsis: Provide a bridge betweeen WAI and the websockets package. License: BSD3 License-file: LICENSE @@ -19,7 +19,7 @@ flag example Library Build-Depends: base >= 3 && < 5 , bytestring >= 0.9.1.4 && < 0.10 - , wai >= 0.4 && < 0.5 + , wai >= 1.0 && < 1.1 , enumerator >= 0.4.8 && < 0.5 , network-enumerator >= 0.1.2 && < 0.2 , blaze-builder >= 0.2.1.4 && < 0.4 diff --git a/wai/Network/Wai.hs b/wai/Network/Wai.hs index a6805772..4a10c0ab 100644 --- a/wai/Network/Wai.hs +++ b/wai/Network/Wai.hs @@ -39,8 +39,7 @@ module Network.Wai ( -- * WAI interface Request (..) , Response (..) - , ResponseStream - , responseStream + , responseSource , Application , Middleware , FilePart (..) @@ -61,7 +60,6 @@ import qualified Network.HTTP.Types as H import Data.Text (Text) import Data.ByteString.Lazy.Char8 () -- makes it easier to use responseLBS import Blaze.ByteString.Builder (fromByteString) -import Filesystem.Path.CurrentOS (decodeString) -- | Information on the request sent by the client. This abstracts away the -- details of the underlying implementation. @@ -96,21 +94,10 @@ data Request = Request , pathInfo :: [Text] -- | Parsed query string information , queryString :: H.Query - , requestBody :: C.BSource IO B.ByteString + , requestBody :: C.BufferedSource IO B.ByteString } deriving (Typeable) -data Response - = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) - | ResponseBuilder H.Status H.ResponseHeaders Builder - | ResponseStream (forall a. ResponseStream a) - deriving Typeable - -data FilePart = FilePart - { filePartOffset :: Integer - , filePartByteCount :: Integer - } deriving Show - -- | -- -- Some questions and answers about the usage of 'Builder' here: @@ -134,23 +121,29 @@ data FilePart = FilePart -- -- A3. You can force blaze-builder to output a ByteString before it is an -- optimal size by sending a flush command. +data Response + = ResponseFile H.Status H.ResponseHeaders FilePath (Maybe FilePart) + | ResponseBuilder H.Status H.ResponseHeaders Builder + | ResponseSource H.Status H.ResponseHeaders (C.Source IO Builder) + deriving Typeable -type ResponseStream a = - (H.Status -> H.ResponseHeaders -> C.SinkM Builder IO a) - -> ResourceT IO a +data FilePart = FilePart + { filePartOffset :: Integer + , filePartByteCount :: Integer + } deriving Show -responseStream :: Response -> ResponseStream a -responseStream (ResponseStream e) f = e f -responseStream (ResponseFile s h fp (Just part)) f = - sourceFilePart part fp C.$$ CL.map fromByteString C.=$ f s h -responseStream (ResponseFile s h fp Nothing) f = - CB.sourceFile (decodeString fp) C.$$ CL.map fromByteString C.=$ f s h -responseStream (ResponseBuilder s h b) f = - CL.fromList [b] C.$$ f s h +responseSource :: Response -> (H.Status, H.ResponseHeaders, C.Source IO Builder) -- FIXME re-analyze usage of Builder +responseSource (ResponseSource s h b) = (s, h, b) +responseSource (ResponseFile s h fp (Just part)) = + (s, h, sourceFilePart part fp C.$= CL.map fromByteString) +responseSource (ResponseFile s h fp Nothing) = + (s, h, CB.sourceFile fp C.$= CL.map fromByteString) +responseSource (ResponseBuilder s h b) = + (s, h, CL.sourceList [b]) -sourceFilePart :: FilePart -> FilePath -> C.SourceM IO B.ByteString +sourceFilePart :: FilePart -> FilePath -> C.Source IO B.ByteString sourceFilePart (FilePart offset count) fp = - CB.sourceFileRange (decodeString fp) (Just offset) (Just count) + CB.sourceFileRange fp (Just offset) (Just count) responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response responseLBS s h = ResponseBuilder s h . fromLazyByteString diff --git a/wai/wai.cabal b/wai/wai.cabal index 682b9f09..62b652ab 100644 --- a/wai/wai.cabal +++ b/wai/wai.cabal @@ -25,6 +25,5 @@ Library , http-types >= 0.6 && < 0.7 , text >= 0.7 && < 0.12 , transformers >= 0.2.2 && < 0.3 - , system-filepath >= 0.4.3 && < 0.5 Exposed-modules: Network.Wai ghc-options: -Wall diff --git a/warp-static/warp-static.cabal b/warp-static/warp-static.cabal index bb92c3d0..6c4a25e4 100644 --- a/warp-static/warp-static.cabal +++ b/warp-static/warp-static.cabal @@ -1,5 +1,5 @@ Name: warp-static -Version: 0.2.2 +Version: 1.0.0 Synopsis: Static file server based on Warp and wai-app-static Homepage: http://github.com/yesodweb/wai License: BSD3 @@ -15,9 +15,9 @@ Description: Serve up static files by running the warp executable. Based Executable warp Main-is: warp.hs Build-depends: base >= 4 && < 5 - , warp >= 0.4 && < 0.5 - , wai-app-static >= 0.3 && < 0.4 - , wai-extra >= 0.4 && < 0.5 + , warp >= 1.0 && < 1.1 + , wai-app-static >= 1.0 && < 1.1 + , wai-extra >= 1.0 && < 1.1 , cmdargs >= 0.6.7 , directory >= 1.0 , containers >= 0.2 && < 0.5 diff --git a/warp/Network/Wai/Handler/Warp.hs b/warp/Network/Wai/Handler/Warp.hs index 6db3db26..01e54f02 100755 --- a/warp/Network/Wai/Handler/Warp.hs +++ b/warp/Network/Wai/Handler/Warp.hs @@ -96,7 +96,7 @@ import Blaze.ByteString.Builder.HTTP import Blaze.ByteString.Builder (copyByteString, Builder, toLazyByteString, toByteStringIO) import Blaze.ByteString.Builder.Char8 (fromChar, fromShow) -import Data.Monoid (mappend, mconcat) +import Data.Monoid (mappend) import Network.Sendfile import qualified System.PosixCompat.Files as P @@ -211,12 +211,13 @@ serveConnection settings th onException port app conn remoteHost' = do serveConnection' :: ResourceT IO () serveConnection' = do fromClient <- C.bufferSource $ sourceSocket th bytesPerRead conn - (len, env) <- parseRequest port remoteHost' fromClient + env <- parseRequest port remoteHost' fromClient case settingsIntercept settings env of Nothing -> do -- Let the application run for as long as it wants liftIO $ T.pause th res <- app env + -- FIXME flush the rest of the request body liftIO $ T.resume th keepAlive <- sendResponse th env conn res if keepAlive then serveConnection' else return () @@ -225,8 +226,8 @@ serveConnection settings th onException port app conn remoteHost' = do intercept fromClient conn parseRequest :: Port -> SockAddr - -> C.BSource IO S.ByteString - -> ResourceT IO (Integer, Request) + -> C.BufferedSource IO S.ByteString + -> ResourceT IO Request parseRequest port remoteHost' src = do headers' <- takeHeaders src parseRequest' port headers' remoteHost' src @@ -250,8 +251,8 @@ instance Exception InvalidRequest parseRequest' :: Port -> [ByteString] -> SockAddr - -> C.BSource IO S.ByteString - -> ResourceT IO (Integer, Request) + -> C.BufferedSource IO S.ByteString + -> ResourceT IO Request parseRequest' _ [] _ _ = throwIO $ NotEnoughLines [] parseRequest' port (firstLine:otherLines) remoteHost' src = do (method, rpath', gets, httpversion) <- parseFirst firstLine @@ -270,21 +271,21 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do let serverName' = takeUntil 58 host -- ':' -- FIXME isolate takes an Integer instead of Int or Int64. If this is a -- performance penalty, we may need our own version. - rbody <- C.bufferSource $ src C.$= CB.isolate (fromIntegral len) - return (len, Request - { requestMethod = method - , httpVersion = httpversion - , pathInfo = H.decodePathSegments rpath - , rawPathInfo = rpath - , rawQueryString = gets - , queryString = H.parseQuery gets - , serverName = serverName' - , serverPort = port - , requestHeaders = heads - , isSecure = False - , remoteHost = remoteHost' - , requestBody = rbody - }) + rbody <- C.bufferSource $ src C.$= CB.isolate len + return Request + { requestMethod = method + , httpVersion = httpversion + , pathInfo = H.decodePathSegments rpath + , rawPathInfo = rpath + , rawQueryString = gets + , queryString = H.parseQuery gets + , serverName = serverName' + , serverPort = port + , requestHeaders = heads + , isSecure = False + , remoteHost = remoteHost' + , requestBody = rbody + } takeUntil :: Word8 -> ByteString -> ByteString @@ -427,41 +428,33 @@ sendResponse th req socket r = sendResponse' r `mappend` chunkedTransferTerminator else (headers' False) `mappend` b - sendResponse' (ResponseStream res) = - res enumResponse + sendResponse' (ResponseSource s hs body) = + response where - enumResponse :: H.Status -> H.ResponseHeaders -> C.SinkM Builder IO Bool - enumResponse s hs = - response - where - headers' = headers version s hs - -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope) - response - | not (hasBody s req) = do - liftIO $ Sock.sendMany socket - $ L.toChunks $ toLazyByteString - $ headers' False - return (checkPersist req) - | otherwise = C.SinkM $ do - let sink = builderToByteString C.=$ sinkSocket th (isKeepAlive hs) socket - CL.fromList [headers' needsChunked'] C.$$ sink - C.genSink $ chunk' sink - needsChunked' = needsChunked hs - chunk' sink = if needsChunked' - then chunk C.=$ sink - else sink - chunk :: C.ConduitM Builder IO Builder - chunk = C.ConduitM $ return $ C.Conduit - { C.conduitPush = push - , C.conduitClose = close - } + headers' = headers version s hs + -- FIXME perhaps alloca a buffer per thread and reuse that in all + -- functions below. Should lessen greatly the GC burden (I hope) + response + | not (hasBody s req) = do + liftIO $ Sock.sendMany socket + $ L.toChunks $ toLazyByteString + $ headers' False + return (checkPersist req) + | otherwise = do + let src = + CL.sourceList [headers' needsChunked'] `mappend` + (if needsChunked' then body C.$= chunk else body) + src C.$$ builderToByteString C.=$ sinkSocket th socket + return $ isKeepAlive hs + needsChunked' = needsChunked hs + chunk :: C.Conduit Builder IO Builder + chunk = C.Conduit $ return $ C.PreparedConduit + { C.conduitPush = push + , C.conduitClose = close + } - go [] = id - go [x] = (chunkedTransferEncoding x:) - go xs = (chunkedTransferEncoding (mconcat xs):) - - push xs = return $ C.ConduitResult C.Processing $ go xs [] - close xs = return $ C.ConduitResult [] $ go xs [chunkedTransferTerminator] + push x = return $ C.Producing [chunkedTransferEncoding x] + close = return [chunkedTransferTerminator] parseHeaderNoAttr :: ByteString -> H.Header parseHeaderNoAttr s = @@ -473,14 +466,14 @@ parseHeaderNoAttr s = else rest in (CI.mk k, rest') -sourceSocket :: T.Handle -> Int -> Socket -> C.Source IO ByteString -sourceSocket th len socket = C.Source +sourceSocket :: T.Handle -> Int -> Socket -> C.PreparedSource IO ByteString +sourceSocket th len socket = C.PreparedSource { C.sourcePull = do bs <- liftIO $ Sock.recv socket len liftIO $ T.tickle th return $ if S.null bs - then C.SourceResult C.StreamClosed [] - else C.SourceResult C.StreamOpen [bs] + then C.Closed + else C.Open bs , C.sourceClose = return () } @@ -488,23 +481,19 @@ sourceSocket th len socket = C.Source --separate package. sinkSocket :: T.Handle - -> ret -> Socket - -> C.SinkM B.ByteString IO ret -sinkSocket th ret sock = C.SinkM $ return $ C.SinkData + -> C.Sink B.ByteString IO () +sinkSocket th sock = C.Sink $ return $ C.SinkData { C.sinkPush = push , C.sinkClose = close } where - close xs = do + close = do liftIO (T.resume th) - liftIO $ Sock.sendMany sock xs - liftIO (T.resume th) - return (C.SinkResult [] ret) - push [] = return $ C.Processing - push xs = do + return () + push x = do liftIO $ T.resume th - liftIO $ Sock.sendMany sock xs + liftIO $ Sock.sendAll sock x liftIO $ T.pause th return $ C.Processing -- We pause timeouts before passing control back to user code. This ensures @@ -523,7 +512,7 @@ data Settings = Settings , settingsHost :: String -- ^ Host to bind to, or * for all. Default value: * , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr. , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30 - , settingsIntercept :: Request -> Maybe (C.BSource IO S.ByteString -> Socket -> ResourceT IO ()) + , settingsIntercept :: Request -> Maybe (C.BufferedSource IO S.ByteString -> Socket -> ResourceT IO ()) , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing' } @@ -550,7 +539,7 @@ defaultSettings = Settings go' (Just ThreadKilled) = False go' _ = True -takeHeaders :: C.BSource IO ByteString -> ResourceT IO [ByteString] +takeHeaders :: C.BufferedSource IO ByteString -> ResourceT IO [ByteString] takeHeaders src = do !x <- forceHead ConnectionClosedByPeer src takeHeaders' 0 id id x src @@ -561,7 +550,7 @@ takeHeaders' :: Int -> ([ByteString] -> [ByteString]) -> ([ByteString] -> [ByteString]) -> ByteString - -> C.BSource IO ByteString + -> C.BufferedSource IO ByteString -> ResourceT IO [ByteString] takeHeaders' !len _ _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader takeHeaders' !len !lines !prepend !bs src = do @@ -590,7 +579,7 @@ takeHeaders' !len !lines !prepend !bs src = do if start < bsLen then {-# SCC "takeHeaders'.noMoreHeaders.yield" #-} do let !rest = {-# SCC "takeHeaders'.noMoreHeaders.yield.rest" #-} SU.unsafeDrop start bs - C.bsourceUnpull src [rest] + C.bsourceUnpull src rest return lines' else return lines' @@ -606,7 +595,7 @@ takeHeaders' !len !lines !prepend !bs src = do {-# INLINE takeHeaders' #-} forceHead :: InvalidRequest - -> C.BSource IO ByteString + -> C.BufferedSource IO ByteString -> ResourceT IO ByteString forceHead err src = do !mx <- src C.$$ CL.head diff --git a/warp/warp.cabal b/warp/warp.cabal index 9e6309e8..ac5444db 100644 --- a/warp/warp.cabal +++ b/warp/warp.cabal @@ -21,6 +21,7 @@ Library , wai >= 1.0 && < 1.1 , transformers >= 0.2.2 && < 0.3 , conduit >= 0.0 && < 0.1 + , blaze-builder-conduit >= 0.0 && < 0.1 , lifted-base >= 0.1 && < 0.2 , blaze-builder >= 0.2.1.4 && < 0.4 , simple-sendfile >= 0.1 && < 0.3