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 +3/−2
- Network/Wai/Handler/Warp/IO.hs +35/−0
- Network/Wai/Handler/Warp/Response.hs +22/−8
- Network/Wai/Handler/Warp/Run.hs +2/−2
- Network/Wai/Handler/Warp/Types.hs +3/−2
- warp.cabal +2/−1
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