packages feed

warp 2.0.1 → 2.0.2

raw patch · 6 files changed

+67/−15 lines, 6 filesdep ~base

Dependency ranges changed: base

Files

Network/Wai/Handler/Warp/Buffer.hs view
@@ -7,9 +7,10 @@ import Foreign.Ptr (Ptr, plusPtr)  type Buffer = Ptr Word8+type BufSize = Int  -- FIXME come up with good values here-bufferSize :: Int+bufferSize :: BufSize bufferSize = 4096  allocateBuffer :: Int -> IO Buffer@@ -18,7 +19,7 @@ freeBuffer :: Buffer -> IO () freeBuffer = free -toBlazeBuffer :: Buffer -> Int -> IO B.Buffer+toBlazeBuffer :: Buffer -> BufSize -> IO B.Buffer toBlazeBuffer ptr size = do     fptr <- newForeignPtr_ ptr     return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size)
+ Network/Wai/Handler/Warp/IO.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE BangPatterns #-}++module Network.Wai.Handler.Warp.IO where++import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep)+import Data.ByteString.Internal (ByteString(..))+import Foreign.ForeignPtr (newForeignPtr_)+import Foreign.Ptr (plusPtr, minusPtr)+import Network.Wai.Handler.Warp.Buffer++toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()+toBufIOWith buf !size io (Builder build) = loop firstStep+  where+    firstStep = build (buildStep finalStep)+    finalStep (BufRange p _) = return $ Done p ()+    bufRange = BufRange buf (buf `plusPtr` size)+    runIO ptr = toBS buf (ptr `minusPtr` buf) >>= io+    loop step = do+        signal <- runBuildStep step bufRange+        case signal of+             Done ptr _ -> runIO ptr+             BufferFull minSize ptr next+               | size < minSize -> error "toBufIOWith: BufferFull: minSize"+               | otherwise      -> do+                   runIO ptr+                   loop next+             InsertByteString ptr bs next -> do+                 runIO ptr+                 io bs+                 loop next++toBS :: Buffer -> Int -> IO ByteString+toBS ptr siz = do+    fptr <- newForeignPtr_ ptr+    return $ PS fptr 0 siz
Network/Wai/Handler/Warp/Response.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}  module Network.Wai.Handler.Warp.Response (     sendResponse@@ -10,7 +11,7 @@   , defaultServerValue   ) where -import Blaze.ByteString.Builder (fromByteString, Builder, toByteStringIO, flush)+import Blaze.ByteString.Builder (fromByteString, Builder, flush) import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator) import Control.Applicative import Control.Exception@@ -24,13 +25,19 @@ import Data.Function (on) import Data.List (deleteBy) import Data.Maybe (isJust, listToMaybe)+#if MIN_VERSION_base(4,5,0)+import Data.Monoid ((<>))+#else import Data.Monoid (mappend)+#endif import Data.Version (showVersion) import Network.HTTP.Attoparsec (parseByteRanges) import qualified Network.HTTP.Types as H import Network.Wai import qualified Network.Wai.Handler.Warp.Date as D import Network.Wai.Handler.Warp.Header+import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer)+import Network.Wai.Handler.Warp.IO (toBufIOWith) import Network.Wai.Handler.Warp.ResponseHeader import qualified Network.Wai.Handler.Warp.Timeout as T import Network.Wai.Handler.Warp.Types@@ -39,6 +46,11 @@ import qualified Paths_warp import qualified System.PosixCompat.Files as P +#if !MIN_VERSION_base(4,5,0)+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+#endif+ -- $setup -- >>> :set -XOverloadedStrings @@ -199,20 +211,22 @@  ---------------------------------------------------------------- -sendRsp conn ver s hs (RspBuilder b needsChunked) = do+sendRsp conn ver s hs (RspBuilder body needsChunked) = do     header <- composeHeaderBuilder ver s hs needsChunked-    let body-         | needsChunked = header `mappend` chunkedTransferEncoding b-                                 `mappend` chunkedTransferTerminator-         | otherwise    = header `mappend` b-    flip toByteStringIO body $ \bs -> connSendAll conn bs+    let hdrBdy+         | needsChunked = header <> chunkedTransferEncoding body+                                 <> chunkedTransferTerminator+         | otherwise    = header <> body+        buffer = connBuffer conn+        size = connBufferSize conn+    toBufIOWith buffer size (connSendAll conn) hdrBdy  ----------------------------------------------------------------  sendRsp conn ver s hs (RspSource withBodyFlush needsChunked th) = withBodyFlush $ \bodyFlush -> do     header <- composeHeaderBuilder ver s hs needsChunked     let src = yield header >> cbody bodyFlush-        buffer = connBuffer conn+    buffer <- toBlazeBuffer (connBuffer conn) (connBufferSize conn)     src $$ unsafeBuilderToByteString (return buffer) =$ connSink conn th   where     cbody bodyFlush = if needsChunked then body $= chunk else body
Network/Wai/Handler/Warp/Run.hs view
@@ -45,14 +45,14 @@ socketConnection :: Socket -> IO Connection socketConnection s = do     buf <- allocateBuffer bufferSize-    blazeBuf <- toBlazeBuffer buf bufferSize     return Connection {         connSendMany = Sock.sendMany s       , connSendAll = Sock.sendAll s       , connSendFile = defaultSendFile s       , connClose = sClose s >> freeBuffer buf       , connRecv = receive s buf bufferSize-      , connBuffer = blazeBuf+      , connBuffer = buf+      , connBufferSize = bufferSize       , connSendFileOverride = Override s       } 
Network/Wai/Handler/Warp/Types.hs view
@@ -9,10 +9,10 @@ import Data.Typeable (Typeable) import Network.HTTP.Types.Header import Network.Socket (Socket)-import qualified Blaze.ByteString.Builder.Internal.Buffer as B (Buffer) import qualified Network.Wai.Handler.Warp.Date as D import qualified Network.Wai.Handler.Warp.FdCache as F import qualified Network.Wai.Handler.Warp.Timeout as T+import Network.Wai.Handler.Warp.Buffer (Buffer,BufSize)  ---------------------------------------------------------------- @@ -66,7 +66,8 @@     , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ filepath, offset, length, hook action, HTTP headers     , connClose    :: IO ()     , connRecv     :: IO ByteString-    , connBuffer   :: B.Buffer+    , connBuffer           :: Buffer+    , connBufferSize       :: BufSize     , connSendFileOverride :: ConnSendFileOverride     } 
warp.cabal view
@@ -1,5 +1,5 @@ Name:                warp-Version:             2.0.1+Version:             2.0.2 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE@@ -59,6 +59,7 @@                      Network.Wai.Handler.Warp.Date                      Network.Wai.Handler.Warp.FdCache                      Network.Wai.Handler.Warp.Header+                     Network.Wai.Handler.Warp.IO                      Network.Wai.Handler.Warp.IORef                      Network.Wai.Handler.Warp.ReadInt                      Network.Wai.Handler.Warp.Recv