warp 3.1.0 → 3.1.1

raw patch · 7 files changed

+76/−13 lines, 7 files

Files

• Network/Wai/Handler/Warp/Buffer.hs +1/−2
• Network/Wai/Handler/Warp/HTTP2/Receiver.hs +15/−5
• Network/Wai/Handler/Warp/HTTP2/Sender.hs +8/−2
• Network/Wai/Handler/Warp/HTTP2/Worker.hs +1/−1
• Network/Wai/Handler/Warp/Response.hs +1/−1
• test/BufferPoolSpec.hs +47/−0
• warp.cabal +3/−2

@@ -12,7 +12,6 @@   , bufferIO   ) where -import Control.Monad (when) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..), memcpy) import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)@@ -69,7 +68,7 @@ {-# INLINE getBuffer #-}  putBuffer :: BufferPool -> ByteString -> IO ()-putBuffer pool buffer = when (usefulBuffer buffer) $ writeIORef pool buffer+putBuffer pool buffer = writeIORef pool buffer {-# INLINE putBuffer #-}  withForeignBuffer :: ByteString -> ((Buffer, BufSize) -> IO Int) -> IO Int

@@ -142,7 +142,7 @@                  Just strm0 -> do                      when (ftyp == FrameHeaders) $ do                          st <- readIORef $ streamState strm0-                         when (isHalfClosed st) $ E.throwIO $ ConnectionError ProtocolError "header must not be sent to half closed"+                         when (isHalfClosed st) $ E.throwIO $ ConnectionError StreamClosed "header must not be sent to half closed"                      return strm0                  Nothing    -> do                      when (ftyp `notElem` [FrameHeaders,FramePriority]) $@@ -154,8 +154,17 @@                            else                              writeIORef currentStreamId streamId                          cnt <- readIORef concurrency-                         when (cnt >= recommendedConcurrency) $-                             E.throwIO $ ConnectionError RefusedStream "over max concurrency"+                         when (cnt >= recommendedConcurrency) $ do+                             -- Record that the stream is closed, rather than+                             -- idle, so that receiving frames on it is only a+                             -- stream error.+                             consume payloadLength+                             strm <- newStream streamId 0+                             writeIORef (streamState strm) $ Closed $+                                 ResetByMe $ E.toException $+                                     StreamError RefusedStream streamId+                             insert streamTable streamId strm+                             E.throwIO $ StreamError RefusedStream streamId                      ws <- initialWindowSize <$> readIORef http2settings                      newstrm <- newStream streamId (fromIntegral ws)                      when (ftyp == FrameHeaders) $ opened ctx newstrm@@ -291,8 +300,6 @@       else         return $ Open $ Continued rfrags' siz' n' endOfStream pri -stream FrameContinuation _ _ _ _ _ = E.throwIO $ ConnectionError ProtocolError "continue frame cannot come here"- stream FrameWindowUpdate header@FrameHeader{streamId} bs _ s Stream{streamWindow} = do     WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs     w <- (n +) <$> atomically (readTVar streamWindow)@@ -314,6 +321,9 @@     return s  -- this ordering is important+stream FrameContinuation _ _ _ _ _ = E.throwIO $ ConnectionError ProtocolError "continue frame cannot come here" stream _ _ _ _ (Open Continued{}) _ = E.throwIO $ ConnectionError ProtocolError "an illegal frame follows header/continuation frames"+-- Ignore frames to streams we have just reset, per section 5.1.+stream _ _ _ _ st@(Closed (ResetByMe _)) _ = return st stream FrameData FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError StreamClosed streamId stream _ FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError ProtocolError streamId

@@ -23,6 +23,7 @@ import Network.Wai.Handler.Warp.HTTP2.Types import Network.Wai.Handler.Warp.IORef import qualified Network.Wai.Handler.Warp.Settings as S+import qualified Network.Wai.Handler.Warp.Timeout as T import Network.Wai.Handler.Warp.Types import Network.Wai.Internal (Response(..)) import qualified System.PosixCompat.Files as P@@ -32,6 +33,7 @@ #else import Network.Wai.Handler.Warp.FdCache import Network.Wai.Handler.Warp.SendFile (positionRead)+import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd) import System.Posix.Types #endif @@ -230,8 +232,12 @@ #else fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}                         ii off lim (ResponseFile _ _ path mpart) = do-    let Just fdcache = fdCacher ii-    (fd, refresh) <- getFd fdcache path+    (fd, refresh) <- case fdCacher ii of+        Just fdcache -> getFd fdcache path+        Nothing      -> do+            fd' <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}+            th <- T.register (timeoutManager ii) (closeFd fd')+            return (fd', T.tickle th)     let datBuf = connWriteBuffer `plusPtr` off         room = min (connBufferSize - off) lim     (start, bytes) <- fileStartEnd path mpart

@@ -73,7 +73,7 @@         _ -> do             setThreadContinue tconf True             let hasBody = requestMethod req /= H.methodHead-                       || R.hasBody (responseStatus rsp)+                       && R.hasBody (responseStatus rsp)             enqueue outputQ (OResponse strm rsp (Oneshot hasBody)) pri     return ResponseReceived 

@@ -252,7 +252,7 @@                     hook' = hook #else                 (mfd, hook') <- case mfdc of-                   -- Windows or settingsFdCacheDuration is 0+                   -- settingsFdCacheDuration is 0                    Nothing  -> return (Nothing, hook)                    Just fdc -> do                       (fd, fresher) <- F.getFd fdc path

@@ -0,0 +1,47 @@+module BufferPoolSpec where++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B (ByteString(PS))+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Utils (copyBytes)+import Foreign.Ptr (plusPtr)++import Test.Hspec (Spec, hspec, shouldBe, describe, it)++import Network.Wai.Handler.Warp.Buffer+    ( bufferSize+    , newBufferPool+    , withBufferPool+    )+import Network.Wai.Handler.Warp.Types (Buffer, BufSize)++main :: IO ()+main = hspec spec++-- Two ByteStrings each big enough to fill a 'bufferSize' buffer (16K).+wantData, otherData :: B.ByteString+wantData = B.replicate bufferSize 0xac+otherData = B.replicate bufferSize 0x77++spec :: Spec+spec = describe "withBufferPool" $ do+    it "does not clobber buffers" $ do+        pool <- newBufferPool+        -- 'pool' contains B.empty; prime it to contain a real buffer.+        _ <- withBufferPool pool $ const $ return 0+        -- 'pool' contains a 16K buffer; fill it with \xac and keep the result.+        got <- withBufferPool pool $ blitBuffer wantData+        got `shouldBe` wantData+        -- 'pool' should now be empty and reallocate, rather than clobber the+        -- previous buffer.+        _ <- withBufferPool pool $ blitBuffer otherData+        got `shouldBe` wantData++-- Fill the Buffer with the contents of the ByteString and return the number of+-- bytes written.  To be used with 'withBufferPool'.+blitBuffer :: B.ByteString -> (Buffer, BufSize) -> IO Int+blitBuffer (B.PS fp off len) (dst, len') = withForeignPtr fp $ \ptr -> do+    let src = ptr `plusPtr` off+        n = min len len'+    copyBytes dst src n+    return n

@@ -1,5 +1,5 @@ Name:                warp-Version:             3.1.0+Version:             3.1.1 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE@@ -122,7 +122,8 @@  Test-Suite spec     Main-Is:         Spec.hs-    Other-modules:   ConduitSpec+    Other-modules:   BufferPoolSpec+                     ConduitSpec                      ExceptionSpec                      FdCacheSpec                      MultiMapSpec